C Rutina 051
C--------------------------------------------------------CALC_PC_POT---
C
C SUBRUTINA CALC_PC_POT
C
C CALCULO DE LOS PUNTOS DE COLOCACION CORRESPONDIENTES A UN SOLIDO
C ELEMENTO LINEAL CONTINUO
C
SUBROUTINE CALC_PC_POT(cpc,PC,aelt,delt,ELT,NOD,TP,SOL,MAT,COD)
C
IMPLICIT NONE
INCLUDE '_param.for'
INCLUDE '_struct.for'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES EXTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C CPC : Contador puntos de colocacion
INTEGER CPC
C PC : Puntos de colocacion
RECORD /S_coloc/ PC(N_MAX_PC)
C AELT,DELT : elementos antes y despues del nodo
INTEGER aelt,delt
C ELT : Elementos
RECORD /S_elemento/ ELT(N_MAX_ELT)
C NOD : Nodos
RECORD /S_nodo/ NOD(N_MAX_NOD)
C TP : Tipo de problema
RECORD /S_tipprobl/ TP
C SOL : Solido
RECORD /S_solido/ SOL
C MAT : Constantes del material
RECORD /S_material/ MAT
C COD : Cod=1 - Nodo normal.
C Cod=2 - Nodo inicial (aelt=0).
C Cod=3 - Nodo final (delt=0).
INTEGER COD
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C A1,A2,A3 : Angulos auxiliares
REAL*8 A2,A3
C n1,n2,n3 : Nodos extremos de los elementos
INTEGER n1,n2,n3
C NrmA(),NrmD() : Normal antes y despues del nodo
REAL*8 NrmA(2),NrmD(2)
C LA,LD : Longitud antes y despues del nodo
REAL*8 LA,LD
C DT : Angulo interior entre los elementos
REAL*8 DT
C PI : Pi
REAL*8 PI
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
IF(cpc.GT.N_MAX_PC)THEN
WRITE(F_W,07115)
WRITE (*,07115)
STOP
END IF
C
PI=DACOS(-1.d0)
A2=0
A3=0
DT=0
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C CALCULO DE LOS NODOS EXTREMOS, LAS NORMALES
C Y EL ANGULO INTERIOR ENTRE LOS ELEMENTOS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
SELECT CASE(COD)
CASE (1)
n1=ELT(aelt).NI(1)
n2=ELT(aelt).NI(2)
IF(n2.NE.ELT(delt).NI(1))THEN
WRITE(F_W,07110) 1
WRITE (*,07110) 1
STOP
END IF
n3=ELT(delt).NI(2)
SELECT CASE(MAT.TIP)
C
C Materiales Isotropos
C
CASE(1)
CALL NOR_ELT(NrmA,ELT(aelt),NOD)
CALL NOR_ELT(NrmD,ELT(delt),NOD)
C
C Material Anisotropo y FGM
C
CASE(2,3,4)
C
CALL NOR_ELT_TRFMDO_POT(NrmA,ELT(aelt),NOD)
CALL NOR_ELT_TRFMDO_POT(NrmD,ELT(delt),NOD)
C
CASE DEFAULT
WRITE(F_W,07116) MAT.TIP
WRITE(*,07116) MAT.TIP
STOP
END SELECT
CALL ANGULO(A2,-NrmD(2),NrmD(1))
CALL ANGULO(A3,NrmA(2),-NrmA(1))
CASE (2)
n2=ELT(delt).NI(1)
n3=ELT(delt).NI(2)
SELECT CASE(MAT.TIP)
C
C Materiales Isotropos
C
CASE(1)
CALL NOR_ELT(NrmD,ELT(delt),NOD)
C
C Material Anisotropo y FGM
C
CASE(2,3,4)
C
CALL NOR_ELT_TRFMDO_POT(NrmD,ELT(delt),NOD)
C
CASE DEFAULT
WRITE(F_W,07116) MAT.TIP
WRITE(*,07116) MAT.TIP
STOP
END SELECT
CALL ANGULO(A2,-NrmD(2),NrmD(1))
A3=PI/2.d0
CASE (3)
n1=ELT(aelt).NI(1)
n2=ELT(aelt).NI(2)
SELECT CASE(MAT.TIP)
C
C Materiales Isotropos
C
CASE(1)
CALL NOR_ELT(NrmA,ELT(aelt),NOD)
C
C Material Anisotropo y FGM
C
CASE(2,3,4)
C
CALL NOR_ELT_TRFMDO_POT(NrmA,ELT(aelt),NOD)
C
CASE DEFAULT
WRITE(F_W,07116) MAT.TIP
WRITE(*,07116) MAT.TIP
STOP
END SELECT
A2=3.d0*PI/2.d0
CALL ANGULO(A3,NrmA(2),-NrmA(1))
CASE DEFAULT
WRITE(F_W,07111) COD
WRITE (*,07111) COD
STOP
END SELECT
C
IF(A2.GT.A3) THEN
A3=2.d0*PI+A3
END IF
C
DT=(A3-A2)
C
C Si cod=2 o 3 forzosamente NOD tiene que estar en R=0
C
IF(COD.EQ.2) THEN
IF(NOD(n2).XYZ(1).NE.0.d0) THEN
C El nodo debe pertenecer al eje R=0
WRITE(F_W,07110) 1
WRITE (*,07110) 1
STOP
END IF
END IF
IF(COD.EQ.3) THEN
IF(NOD(n2).XYZ(1).NE.0.d0) THEN
C El nodo debe pertenecer al eje R=0
WRITE(F_W,07110) 1
WRITE (*,07110) 1
STOP
END IF
END IF
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C CALCULO PUNTOS COLOCACION
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C PUNTO DE COLOCACION EN EL NODO
C
PC(cpc).TIP=1
C
SELECT CASE (COD)
CASE(1)
PC(cpc).LOC=-1.d0
PC(cpc).ELT=ELT(delt).NUM
CASE(2)
PC(cpc).LOC=-1.d0
PC(cpc).ELT=ELT(delt).NUM
CASE(3)
PC(cpc).LOC=1.d0
PC(cpc).ELT=ELT(aelt).NUM
CASE DEFAULT
WRITE(F_W,07110) 16
WRITE (*,07110) 16
STOP
END SELECT
C
SELECT CASE(COD)
CASE (1)
IF(TP.TIP.EQ.41)THEN
SOL.NBIE=SOL.NBIE+1
C Monta la unica componente de la BIE(potencial)
PC(cpc).CMP=1
ELSE
SOL.NBIE=SOL.NBIE+2
C Monta las dos componentes de la BIE
PC(cpc).CMP=1
END IF
CASE (2,3)
SOL.NBIE=SOL.NBIE+1
C Monta la componente 2 de la BIE
C Nota: la componente 1 es identicamente nula
PC(cpc).CMP=3
C
CASE DEFAULT
WRITE(F_W,07111) COD
WRITE (*,07111) COD
STOP
END SELECT
C
PC(cpc).XYZ(1)=NOD(n2).XYZ(1)
PC(cpc).XYZ(2)=NOD(n2).XYZ(2)
C
PC(cpc).NUM=cpc
C
CALL CIJ_POT(PC(cpc).CIJ,DT)
C
SOL.NPC=SOL.NPC+1
SOL.PC(SOL.NPC)=cpc
cpc=cpc+1
C
C PUNTO DE COLOCACION ADICIONAL (Segun cdc)
C
SELECT CASE(COD)
CASE (1)
La=DSQRT((NOD(n2).XYZ(1)-NOD(n1).XYZ(1))**2.d0+
@ (NOD(n2).XYZ(2)-NOD(n1).XYZ(2))**2.d0)
Ld=DSQRT((NOD(n3).XYZ(1)-NOD(n2).XYZ(1))**2.d0+
@ (NOD(n3).XYZ(2)-NOD(n2).XYZ(2))**2.d0)
CASE (2)
La=0
Ld=DSQRT((NOD(n3).XYZ(1)-NOD(n2).XYZ(1))**2.d0+
@ (NOD(n3).XYZ(2)-NOD(n2).XYZ(2))**2.d0)
CASE (3)
La=DSQRT((NOD(n2).XYZ(1)-NOD(n1).XYZ(1))**2.d0+
@ (NOD(n2).XYZ(2)-NOD(n1).XYZ(2))**2.d0)
Ld=0
CASE DEFAULT
WRITE(F_W,07111) COD
WRITE (*,07111) COD
STOP
END SELECT
C
SELECT CASE(NOD(n2).CBC(1))
C
CASE(44,46,47,48,64,74,84,55,56,57,58,65,75,85,67,68,76,77,78,
@ 86,87,88)
C
C No hace falta
C
CONTINUE
C
CASE(66)
IF(NOD(n2).CBC(2).EQ.0)THEN
C
IF(La.GT.Ld)THEN
C Punto de colocacion antes del nodo(a 1/3)
C
PC(cpc).LOC=1.d0/3.d0
PC(cpc).XYZ(1)=(NOD(n1).XYZ(1)+2.d0*NOD(n2).XYZ(1))/3.d0
PC(cpc).XYZ(2)=(NOD(n1).XYZ(2)+2.d0*NOD(n2).XYZ(2))/3.d0
PC(cpc).ELT=ELT(aelt).NUM
PC(cpc).CMP=1
CALL CIJ_POT(PC(cpc).CIJ,PI)
C
C
ELSE
C
C Punto de colocacion despues del nodo(a 1/3)
C
PC(cpc).LOC=-1.d0/3.d0
PC(cpc).XYZ(1)=(2.d0*NOD(n2).XYZ(1)+NOD(n3).XYZ(1))/3.d0
PC(cpc).XYZ(2)=(2.d0*NOD(n2).XYZ(2)+NOD(n3).XYZ(2))/3.d0
PC(cpc).ELT=ELT(delt).NUM
PC(cpc).CMP=1
CALL CIJ_POT(PC(cpc).CIJ,PI)
C
END IF
PC(cpc).NUM=cpc
PC(cpc).TIP=2
SOL.NPC=SOL.NPC+1
SOL.PC(SOL.NPC)=cpc
SOL.NBIE=SOL.NBIE+1
cpc=cpc+1
C
END IF
C
CASE DEFAULT
WRITE(F_W,07113) NOD(n2).CBC(1)
WRITE (*,07113) NOD(n2).CBC(1)
STOP
END SELECT
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA
C
07110 FORMAT(/,2x,'ERROR 07110 - CALC_PC_POT - Error Programa (#',
@ i2,'#)')
07111 FORMAT(/,2x,'ERROR 07111 - CALC_PC_POT - Codigo erroneo (',
@ i2,').')
07112 FORMAT(/,2x,'ERROR 07112 - CALC_PC_POT - Nodo: ',i4,'. Codigo (',
@ i2,') incompatible con Cdc. (',i2,').')
07113 FORMAT(/,2x,'ERROR 07113 - CALC_PC_POT - ',
@ 'Condicion de contorno (',i2,') no implementada.')
07114 FORMAT(/,2x,'ERROR 07114 - CALC_PC_POT - Tipo de problema (',i2,
@ ') no implementado.')
07115 FORMAT(/,2x,'ERROR 07115 - CALC_PC_POT - Num. P.C. mayor de lo
* permitido')
07116 FORMAT(/,2x,'ERROR 01205 - LECTURA_POT - Tipo de material (',
@ i2,') no implementado.')
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
