C Diógenes Morales Sierra
C------------------------------------------------------------ACTUAL1_TERM---
C
C SUBRUTINA ACTUAL1_TERM
C
C ACTUALIZA LAS CONDICIONES DE CONTACTO TÉRMICO
C
C
SUBROUTINE ACTUAL1_TERM(NODS,PRBT,SOLS,MATT,CNTS,ELTS,NODT,
@ PINTT,ZCTOS,PRBS,FRES)
C
C
IMPLICIT NONE
INCLUDE '_PARAM.FOR'
INCLUDE '_STRUCT.FOR'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES EXTERNAS (ENTRADA)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C PRBT,PRBS : Variables globales del problema
RECORD /S_problema/ PRBT
RECORD /S_problema/ PRBS
C SOLS : Solidos del problema
RECORD /S_solido/ SOLS(N_MAX_SOL)
C MATT : Materiales
RECORD /S_material/ MATT(N_MAX_SOL)
C CNTS : Contornos del problema
RECORD /S_contorno/ CNTS(N_MAX_CNT)
C ELTS : Elementos del problema
RECORD /S_elemento/ ELTS(N_MAX_ELT)
C NODT,NODS: Nodos del problema
RECORD /S_nodo/ NODT(N_MAX_NOD)
RECORD /S_nodo/ NODS(N_MAX_NOD)
C PINTT : Puntos internos del problema
RECORD /S_pntint/ PINTT(N_MAX_PINT)
C ZCTOS: Zonas de contacto del problema
RECORD /S_zncto/ ZCTOS(N_MAX_ZCTO)
C FRES : Funcion de resistencia-tension
RECORD /S_fresTERM/ FRES
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C ELTPS : Tipos de elemento
RECORD /S_tipelt/ ELTPS(N_MAX_TPEL)
C
C NZCTO,CNTA,CNTB,czn,celtp,celt,i,j,cnod
INTEGER nzcto,cntA,cntB,czn,celtp,celt,i,K,j,cnod,csol,L
C AELTA,PA,UA,NA1A,PNODA,UNODA,PELTA,UELTA,SELTA,NS2A
INTEGER AELTA,PA,UA,NA1A,PNODA,UNODA,PELTA,UELTA,SELTA,NS2A
C N1A,N2A,celtA,neltA
INTEGER N1A,N2A,celtA,neltA,S1,S2
C AELTB,PB,UB,NA1B,PNODB,UNODB,PELTB,UELTB,SELTB,NS2B
INTEGER AELTB,PB,UB,NA1B,PNODB,UNODB,PELTB,UELTB,SELTB,NS2B
C N1B,N2B,celtB,neltB
INTEGER N1B,N2B,celtB,neltB
C GUIA
INTEGER GUIA
C UNODRA, UNDORB: Últimos nodos de las zonas reales de contacto
INTEGER UNODRA, UNODRB
C FINP,FINPB: INDICA EL FIN DEL PUNTERO EN CADA ZCTO (POR DIOGENES)
INTEGER FINP(1,PRBS.NZCTO),FINPB(1,PRBS.NZCTO)
INTEGER N1,N2,N3
INTEGER PUNTERO(N_MAX_ELT,PRBS.NZCTO)
INTEGER PUNTEROB(N_MAX_ELT,PRBS.NZCTO)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES INTERNAS (cáculo de los extremos de un sólido)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C NCNTA,CNT1A,PELTSA,UCNTA,NELTUCA,UELTSOLA
INTEGER NCNTA,CNT1A,PELTSOLA,UCNTA,NELTUCA,UELTSOLA
C
C NCNTB,CNT1B,PELTSB,UCNTB,NELTUCB,UELTSOLB
INTEGER NCNTB,CNT1B,PELTSOLB,UCNTB,NELTUCB,UELTSOLB
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
DO czn=1,PRBS.NZCTO
SELECT CASE(ZCTOS(czn).TIP)
C DISTINGO ENTRE INTERFASE Y CONTACTO
CASE(11)
CONTINUE
CASE(21)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 1- SUAVIZO EL CONTORNO A, EVITO CONTACTO PUNTUAL YA QUE NO HAY
C TRANSMISION DE CALOR POR EL
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
cntA=ZCTOS(czn).CNT(1)
S1=CNTS(cntA).SOL
CELTA=ELTS(CNTS(cntA).ELT(1)).NI(1)
UELTA=ELTS(CNTS(cntA).ELT(CNTS(cntA).NELT)).NI(2)
C CREACION DE UN PUNTERO QUE APUNTA A LOS NODOS DE LA ZONA DE CONTACTO
C DISTINGUE ENTRE NUMERACION SIEMPRE CRECIENTE Y DISCONTINUA DE NODOS
I=1
IF(CELTA.GT.UELTA)THEN
IF(CELTA.EQ.SOLS(S1).NOD(1))THEN
PUNTERO(I,CZN)=SOLS(S1).NOD(SOLS(S1).NNOD)
I=I+1
ELSE
PUNTERO(I,CZN)=CELTA-1
I=I+1
END IF
DO L=CELTA, SOLS(S1).NOD(SOLS(S1).NNOD)
PUNTERO(I,CZN)=L
I=I+1
END DO
DO L= SOLS(S1).NOD(1),UELTA
PUNTERO(I,CZN)=L
I=I+1
END DO
IF(UELTA.EQ.SOLS(S1).NOD(SOLS(S1).NNOD))THEN
PUNTERO(I,CZN)=SOLS(S1).NOD(1)
ELSE
PUNTERO(I,CZN)=UELTA+1
END IF
ELSE
IF(CELTA.EQ.SOLS(S1).NOD(1))THEN
PUNTERO(I,CZN)=SOLS(S1).NOD(SOLS(S1).NNOD)
I=I+1
ELSE
PUNTERO(I,CZN)=CELTA-1
I=I+1
END IF
DO L=CELTA,UELTA
PUNTERO(I,CZN)=L
I=I+1
END DO
IF(L.EQ.SOLS(S1).NOD(SOLS(S1).NNOD))THEN
PUNTERO(I,CZN)=SOLS(S1).NOD(1)
ELSE
PUNTERO(I,CZN)=UELTA+1
END IF
END IF
FINP(1,CZN)=I-1
C A CONTINUACION SE ACTUALIZA LA ZONA ELASTICA A (SUAVIZAR)
DO L=2,FINP(1,CZN)
N1=NODS(PUNTERO(L-1,CZN)).CBC(3)
N2=NODS(PUNTERO(L,CZN)).CBC(3)
N3=NODS(PUNTERO(L+1,CZN)).CBC(3)
SELECT CASE (N2)
CASE (2,3,-3)
SELECT CASE (N1)
CASE(0,1)
SELECT CASE(N3)
CASE(0,1)
NODS(PUNTERO(L,CZN)).CBC(3)=1
CASE(2,3,-3)
CONTINUE
END SELECT
END SELECT
CASE(0,1)
CONTINUE
END SELECT
END DO
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 2- ACTUALIZAMOS EL CONTORNO ELASTICO B A PARTIR
C DEL CONTORNO SUAVE A
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
cntB=ZCTOS(czn).CNT(2)
S2=CNTS(cntB).SOL
CELTB=ELTS(CNTS(cntB).ELT(1)).NI(1)
UELTB=ELTS(CNTS(cntB).ELT(CNTS(cntB).NELT)).NI(2)
C CREACION DE UN PUNTERO QUE APUNTA B LOS NODOS DE LA ZONA DE CONTACTO
C DISTINGUE ENTRE NUMERACION SIEMPRE CRECIENTE Y DISCONTINUA DE NODOS
I=1
IF(CELTB.GT.UELTB)THEN
IF(CELTB.EQ.SOLS(S2).NOD(1))THEN
PUNTEROB(I,CZN)=SOLS(S2).NOD(SOLS(S2).NNOD)
I=I+1
ELSE
PUNTEROB(I,CZN)=CELTB-1
I=I+1
END IF
DO L=CELTB, SOLS(S2).NOD(SOLS(S2).NNOD)
PUNTEROB(I,CZN)=L
I=I+1
END DO
DO L= SOLS(S2).NOD(1),UELTB
PUNTEROB(I,CZN)=L
I=I+1
END DO
IF(L.EQ.SOLS(S2).NOD(SOLS(S2).NNOD))THEN
PUNTEROB(I,CZN)=SOLS(S2).NOD(1)
ELSE
PUNTEROB(I,CZN)=UELTB+1
END IF
ELSE
IF(CELTB.EQ.SOLS(S2).NOD(1))THEN
PUNTEROB(I,CZN)=SOLS(S2).NOD(SOLS(S2).NNOD)
I=I+1
ELSE
PUNTEROB(I,CZN)=CELTB-1
I=I+1
END IF
DO L=CELTB,UELTB
PUNTEROB(I,CZN)=L
I=I+1
END DO
IF(L.EQ.SOLS(S2).NOD(SOLS(S2).NNOD))THEN
PUNTEROB(I,CZN)=SOLS(S2).NOD(1)
ELSE
PUNTEROB(I,CZN)=UELTB+1
END IF
END IF
FINPB(1,CZN)=I-1
C ACTUALIZA LA ZONA ELASTICA B DE CONTACTO
DO L=2,FINPB(1,CZN)
K=ZCTOS(CZN).POSA(PUNTEROB(L,CZN))
IF(K.GT.0)THEN
NODS(PUNTEROB(L,CZN)).CBC(3)=
@ NODS(ELTS(ZCTOS(CZN).NDB_ELA(PUNTEROB(L,CZN))).NI(2))
@ .CBC(3)
ELSE
NODS(PUNTEROB(L,CZN)).CBC(3)=
@ NODS(ELTS(ZCTOS(CZN).NDB_ELA(PUNTEROB(L,CZN))).NI(1))
@ .CBC(3)
END IF
END DO
END SELECT
C FIN DEL BUCLE QUE RECORRE LAS ZONAS DE CONTACTO
END DO
DO czn=1,PRBS.NZCTO
SELECT CASE(ZCTOS(czn).TIP)
C DISTINGO ENTRE INTERFASE Y CONTACTO
CASE(11)
CONTINUE
CASE(21)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 3- ACTUALIZAR LA ZONA A DE CONTACTO TERMICO
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
DO L=2,FINP(1,CZN)
CALL ACT1_TERM(PUNTERO(L-1,CZN),PUNTERO(L,CZN)
@ ,PUNTERO(L+1,CZN),NODS,NODT,FRES)
END DO
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 4- ACTUALIZAR LA ZONA B DE CONTACTO TERMICO
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
DO L=2,FINPB(1,CZN)
CALL ACT1_TERM(PUNTEROB(L-1,CZN),PUNTEROB(L,CZN),
@ PUNTEROB(L+1,CZN),NODS,NODT,FRES)
END DO
END SELECT
C FIN DEL BUCLE QUE RECORRE LAS ZONAS DE CONTACTO
END DO
C
RETURN
C
C FORMATOS DE ESCRITURA
C
09111 FORMAT(/,2x,'ERROR 09111 - ACTUAL1_TERM - ')
10123 FORMAT(/,2x,'ERROR 10104 - ACTUAL1_TERM ',/,
@ ' Nodo numero ',i3,' fuera de la zona de contacto.')
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
