C Rutina 101
C----------------------------------------------------ESCRIBE_CONTACTO_POT---
C
C SUBRUTINA ESCRIBE_CONTACTO_POT
C
C ESCRITURA DE LAS CONDICIONES DE CONTACTO
C
SUBROUTINE ESCRIBE_CONTACTO_POT(CNT,ELTP,ELT,NOD,ZCTO)
C
IMPLICIT NONE
INCLUDE '_param.for'
INCLUDE '_struct.for'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES EXTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C CNT : Contornos del problema
RECORD /S_contorno/ CNT(N_MAX_CNT)
C ELTP : Tipos de elemento
RECORD /S_tipelt/ ELTP(N_MAX_TPEL)
C ELT : Elementos del problema
RECORD /S_elemento/ ELT(N_MAX_ELT)
C NOD : Nodos del problema
RECORD /S_nodo/ NOD(N_MAX_NOD)
C ZCTO : Zona de contacto
RECORD /S_zncto/ ZCTO
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C I,J,K : Contadores
INTEGER I,J
C CNTA,CNTB : Contornos A y B de la zona de contacto
INTEGER CNTA,CNTB
C Contadores
INTEGER ANOD,CELTA,CELTB,CELTPA,CELTPB,CNODA,CNODB
C ctbcA : Condicion de contacto en el nodo de A
INTEGER ctbcA
C
C VARIABLES PARA LA ESCRITURA DE LA ZONA DE CONTACTO
C
INTEGER W,WA,WB
INTEGER W_NODA(N_MAX_NOD),W_NODB(N_MAX_NOD),W_BCA(N_MAX_NOD),
@ W_ELTB(N_MAX_NOD),W_ELTA(N_MAX_NOD)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
anod=0
w=1
C
cntA=ZCTO.CNT(1)
cntB=ZCTO.CNT(2)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C ESCRITURA DE LAS VARIABLES DE CONTACTO
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Bucle que recorre los elementos del contorno A
C
DO i=1 ,CNT(cntA).NELT
celtA=CNT(cntA).ELT(i)
celtpA=ELT(celtA).TIP
C Bucle que recorre los nodos del elemento
DO j=1 , ELTP(celtpA).NNI
cnodA=ELT(celtA).NI(j)
ctbcA=NOD(cnodA).CBC(1)
IF(cnodA.NE.anod)THEN
w_nodA(w)=cnodA
w_bcA(w)=ctbcA
w_eltB(w)=ZCTO.NDA_ELB(cnodA)
w=w+1
anod=cnodA
END IF
C Fin bucle que recorre los nodos del elemento
END DO
C
C Fin bucle que recorre los elementos del contorno A
C
END DO
wA=w-1
C
C Bucle que recorre los elementos del contorno B
C
anod=0
w=1
DO i=1 ,CNT(cntB).NELT
celtB=CNT(cntB).ELT(i)
celtpB=ELT(celtB).TIP
C Bucle que recorre los nodos del elemento
DO j=1 , ELTP(celtpB).NNI
cnodB=ELT(celtB).NI(j)
IF(cnodB.NE.anod)THEN
w_nodB(w)=cnodB
w_eltA(w)=ZCTO.NDB_ELA(cnodB)
w=w+1
anod=cnodB
END IF
C Fin bucle que recorre los nodos del elemento
END DO
C
C Fin bucle que recorre los elementos del contorno A
C
END DO
wB=w-1
C
anod=0
C
IF(W_C.GE.1)THEN
WRITE(F_C,*)
WRITE(F_C,*) ZCTO.NUM
WRITE(F_C,*)
WRITE(F_C,03) (w_nodA(w),w=1,wA)
WRITE(F_C,04) ( w_bcA(w),w=1,wA)
WRITE(F_C,03) (w_eltB(w),w=1,wA)
WRITE(F_C,*)
WRITE(F_C,03) (w_nodB(w),w=1,wB)
WRITE(F_C,03) (w_eltA(w),w=1,wB)
WRITE(F_C,*)
WRITE(*,*)
WRITE(*,01) (w_nodA(w),w=1,wA)
WRITE(*,02) (w_bcA(w),w=1,wA)
WRITE(*,*)
ELSE
WRITE(*,*)
WRITE(*,*) ' Contorno de Contacto numero:',ZCTO.NUM
WRITE(*,*)
WRITE(*,03) (w_nodA(w),w=1,wA)
WRITE(*,04) (w_bcA(w),w=1,wA)
WRITE(*,05) (w_eltB(w),w=1,wA)
WRITE(*,*)
WRITE(*,06) (w_nodB(w),w=1,wB)
WRITE(*,07) (w_eltA(w),w=1,wB)
WRITE(*,*)
END IF
C
01 FORMAT(3x, 100(i2,' '))
02 FORMAT(3x, 100(i2,' '))
03 FORMAT(3x,'Nds de ctno A: ', 100(i3,','))
04 FORMAT(3x,'Cdc de ctno A: ',1x, 100(i2,', '))
05 FORMAT(3x,'Elts de B a nds de A:', 100(i3,','))
06 FORMAT(3x,'Nds de ctno B: ', 100(i3,','))
07 FORMAT(3x,'Elts de A a nds de B:', 100(i3,','))
C
C FIN DE LA RUTINA
C
RETURN
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
