C
C-------------------------------------------------------------------ACT2_TERM---
C
C SUBRUTINA ACT2_TERM
C
C PARA UN CONTORNO CALCULAMOS RESISTENCIAS TÉRMICAS
C
SUBROUTINE ACT2_TERM(CNTS,ELTPS,ELTS,NODS,NODT,FRES)
C
IMPLICIT NONE
INCLUDE '_param.for'
INCLUDE '_struct.for'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES EXTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C CNTS : Contornos del problema
RECORD /S_contorno/ CNTS
C ELTS : Elementos del problema
RECORD /S_elemento/ ELTS(N_MAX_ELT)
C NODS : Nodos del problema
RECORD /S_nodo/ NODS(N_MAX_NOD)
RECORD /S_nodo/ NODT(N_MAX_NOD)
C FRES : Funcion de resistencia-tension
RECORD /S_fresTERM/ FRES
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C CELT,CELTP,CNOD,I,J :
C
INTEGER CELT,CELTP,CNOD,I,J
C
C T1A,T1D,KR,LR :
C
REAL*8 T1A,T1D,KR,LR
C
C ELTPS : Tipos de elemento
RECORD /S_tipelt/ ELTPS(N_MAX_TPEL)
C
CCCCCCCCCCCCCC
C RUTINA
CCCCCCCCCCCCCC
C
C Bucle que recorre los elementos del contorno CNTS
C
DO i=1,CNTS.NELT
celt=CNTS.ELT(i)
celtp=ELTS(celt).TIP
C
C Bucle que recorre los nodos del elemento
C
DO j=1,ELTPS(celtp).NNI
cnod=ELTS(celt).NI(j)
C
C Almacenamos la solucion elástica
C
t1a=ABS(NODS(cnod).SOLU(3))
t1d=ABS(NODS(cnod).SOLU(5))
C
C Modificado por: Diógenes Morales Sierra Fecha:17/03/05
C Objeto de la modificación:
C Cuando se separan dos superficies en contacto, las tensiones
C se anulan provocando un 1/0, con esto hacemos el 0 numerico
C y evitamos el infinito. El 0 numerico es TOL
C
IF(t1d.EQ.0)THEN
t1d=t1d+EPSIL
END IF
IF(t1a.EQ.0)THEN
t1a=t1a+EPSIL
END IF
C
C fin de la modificación
C
C Almacenamos kr,lr
C
kr=FRES.KR
lr=FRES.LR
C
SELECT CASE(NODT(cnod).cbc(1))
C
CASE(55)
C
SELECT CASE(NODT(cnod).cbc(2))
C
CASE(0)
C
NODT(cnod).VBC(1)=(kr/(t1a**lr))
NODT(cnod).VBC(2)=(kr/(t1d**lr))
C
CASE(1)
NODT(cnod).VBC(1)=(kr/(t1a**lr))
CASE DEFAULT
WRITE(F_W,13702) cnod,NODT(cnod).cbc(2)
WRITE(*,13702) cnod,NODT(cnod).cbc(2)
STOP
END SELECT
C
CASE(65)
C
NODT(cnod).VBC(2)=(kr/(t1d**lr))
C
CASE(56)
C
NODT(cnod).VBC(2)=(kr/(t1a**lr))
C
CASE(75)
C
NODT(cnod).VBC(2)=(kr/(t1d**lr))
C
CASE(57)
C
NODT(cnod).VBC(2)=(kr/(t1a**lr))
CASE(85)
C
NODT(cnod).VBC(3)=(kr/(t1d**lr))
C
CASE(58)
C
NODT(cnod).VBC(2)=(kr/(t1a**lr))
CASE(46,64,44,47,74,48,84,66,77,88,67,76,68,86,78,87)
C
CONTINUE
CASE DEFAULT
WRITE(F_W,13702) cnod,NODT(cnod).cbc(1)
WRITE(*,13702) cnod,NODT(cnod).cbc(1)
STOP
END SELECT
C
END DO
C
END DO
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA.
C
13702 FORMAT(/,2x,'ERROR 13702 - ACT2_TERM - Nodo (',i2,').',
@ /,' Condicion de contorno (',i2,') no valida.')
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
