C
C-----------------------------------------------------------POS_REL_B---
C
C SUBRUTINA POS_REL_B
C
C CALCULO DE LA POSICION DEL CONTORNO A CON LA QUE CONTACTAN
C LOS NODOS DEL CONTORNO B
C
SUBROUTINE POS_REL_B(CNT,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 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 CNTA,CNTB : Contornos A y B de la zona de contacto
INTEGER CNTA,CNTB
C Contadores
INTEGER cnodA0,cnodB0
INTEGER cnodA1,cnodB2
INTEGER ieltA0,celtA0,ieltB0,celtB0
INTEGER ieltA1,celtA1,ieltB1,celtB1,ieltB2,celtB2
INTEGER celtpA,celtpB
C Longitudes LA,LB,L1A,L1B,L2A,L2B
REAL*8 LA,LB,L1B,L2B
REAL*8 POSA,POSB
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
cntA=ZCTO.CNT(1)
cntB=ZCTO.CNT(2)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C CALCULO DE LAS POSICIONES RELATIVAS ENTRE
C LOS NODOS DE UN SOLIDO Y LOS ELEMENTOS DEL OTRO
C Y RECUENTO DE VARIABLES EN DESPLAZAMIENTOS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Comprueba que todos los elementos son lineales
C
DO ieltA0=1,CNT(cntA).NELT
celtA0=CNT(cntA).ELT(ieltA0)
celtpA=ELT(celtA0).TIP
IF(celtpA.NE.1)THEN
WRITE(F_W,10100) 3
WRITE( *,10100) 3
STOP
END IF
END DO
C
DO ieltB0=1,CNT(cntB).NELT
celtB0=CNT(cntB).ELT(ieltB0)
celtpB=ELT(celtB0).TIP
IF(celtpB.NE.1)THEN
WRITE(F_W,10100) 0
WRITE( *,10100) 0
STOP
END IF
END DO
C
C Localizo el primer nodo de A que contacta con B (empezando por el final)
C
ieltA0=CNT(cntA).NELT
celtA0=CNT(cntA).ELT(ieltA0)
cnodA0=ELT(celtA0).NI(2)
C
DO WHILE((ZCTO.NDA_ELB(cnodA0)).EQ.0)
ieltA0=ieltA0-1
IF(ieltA0.EQ.0)THEN
WRITE(F_W,10100) 1
WRITE( *,10100) 1
STOP
END IF
celtA0=CNT(cntA).ELT(ieltA0)
cnodA0=ELT(celtA0).NI(2)
END DO
C
C Los nodos de los elementos del contorno B anteriores a ZCTO.ELTB(nodA)
C no tienen elemento correspondiente en A
C
ieltB0=1
celtB0=CNT(cntB).ELT(ieltB0)
DO WHILE(celtB0.NE.(ZCTO.NDA_ELB(cnodA0)))
C
cnodB0=ELT(celtB0).NI(1)
ZCTO.NDB_ELA(cnodB0)=0
ZCTO.NDB_iELA(cnodB0)=0
C
ieltB0=ieltB0+1
IF(ieltB0.EQ.(CNT(cntB).NELT))THEN
WRITE(F_W,10100) 2
WRITE( *,10100) 2
STOP
END IF
celtB0=CNT(cntB).ELT(ieltB0)
C
END DO
C
C Punto de contA con el cual contacta el primer nodo de celtB0
C
cnodB0=ELT(celtB0).NI(1)
IF(ieltA0.EQ.(CNT(cntA).NELT))THEN
C
IF(ZCTO.POSB(cnodA0).EQ.(-1.d0))THEN
ZCTO.NDB_ELA(cnodB0) =celtA0
ZCTO.NDB_iELA(cnodB0)=ieltA0
ZCTO.POSA(cnodB0)=1.d0
ELSE IF(ZCTO.POSB(cnodA0).LT.(-1.d0+1.d-3))THEN
ZCTO.POSB(cnodA0)=-1.d0
ZCTO.NDB_ELA(cnodB0) =celtA0
ZCTO.NDB_iELA(cnodB0)=ieltA0
ZCTO.POSA(cnodB0)=1.d0
ELSE
ZCTO.NDB_ELA(cnodB0) =0
ZCTO.NDB_iELA(cnodB0)=0
END IF
C
ELSE
C
CALL LNG_ELT(ELT(celtB0),NOD,LB)
POSB=ZCTO.POSB(cnodA0)
L1B=LB*(POSB+1.d0)/2.d0
C
ieltA1=ieltA0+1
DO WHILE(ieltA1.LE.(CNT(cntA).NELT))
celtA1=CNT(cntA).ELT(ieltA1)
CALL LNG_ELT(ELT(celtA1),NOD,LA)
IF(LA.LT.L1B)THEN
L1B=L1B-LA
ieltA1=ieltA1+1
ELSE
ZCTO.NDB_iELA(cnodB0)=ieltA1
ZCTO.NDB_ELA(cnodB0)=NOD(ieltA1).NUM
POSA=L1B*2.d0/LA-1.d0
IF((POSA.LT.1.d0).AND.(POSA.GT.-1.d0))THEN
ZCTO.POSA(cnodB0)=POSA
ELSE
WRITE(F_W,10100) 4
WRITE( *,10100) 4
STOP
END IF
END IF
END DO
C
END IF
C
C Nodos de B que contactan con celtA0
C
DO WHILE(ieltA0.GT.0)
celtA0=CNT(cntA).ELT(ieltA0)
cnodA0=ELT(celtA0).NI(2)
cnodA1=ELT(celtA0).NI(1)
ieltB1=ZCTO.NDA_iELB(cnodA1)
IF(ieltB1.EQ.0)THEN
C
C Si cnodA1 no contacta con B los siguientes tampoco
C si alguno contacta habria que dividir la zona de contacto en dos
C
ieltA1=ieltA0
DO WHILE(ieltA1.GT.1)
ieltA1=ielta1-1
celtA1=CNT(cntA).ELT(ielta1)
IF((ZCTO.NDA_ELB(celtA1)).NE.0)THEN
WRITE(F_W,10100) 5
WRITE( *,10100) 5
STOP
END IF
END DO
C
C Hay que asignar la posicion a los nodos B intermedios
C
CALL LNG_ELT(ELT(celtA0),NOD,LA)
celtB0=CNT(cntB).ELT(ieltB0)
cnodB0=ELT(celtB0).NI(2)
CALL LNG_ELT(ELT(celtB0),NOD,LB)
POSB=ZCTO.POSB(cnodA0)
L2B=LB*(1.d0-POSB)/2.d0
ieltB2=ieltb0
celtB2=CNT(cntB).ELT(ieltB2)
cnodB2=ELT(celtB2).NI(2)
DO WHILE(L2B.LT.LA)
ZCTO.POSA(cnodB2)=1.d0-L2B*2.d0/LA
ZCTO.NDB_ELA(cnodB2)=celtA0
ZCTO.NDB_iELA(cnodB2)=ieltA0
IF(((ZCTO.POSA(cnodB2)).LT.-1.d0).OR.
@ ((ZCTO.POSA(cnodB2)).GT.1.d0))THEN
WRITE(F_W,10100) 7
WRITE( *,10100) 7
STOP
END IF
ieltB2=ieltB2+1
IF(ieltB2.LE.(CNT(cntB).NELT))THEN
celtB2=CNT(cntB).ELT(ieltB2)
cnodB2=ELT(celtB2).NI(2)
CALL LNG_ELT(ELT(celtb2),NOD,LB)
L2B=L2B+LB
ELSE
L2B=LA
ENDIF
END DO
C
ieltA0=0
C
ELSE IF(ieltB1.NE.ieltB0)THEN
C
C Hay que asignar la posicion a los nodos B intermedios
C
celtB0=CNT(cntB).ELT(ieltB0)
cnodB0=ELT(celtB0).NI(2)
CALL LNG_ELT(ELT(celtB0),NOD,LB)
POSB=ZCTO.POSB(cnodA0)
L2B=LB*(1.d0-POSB)/2.d0
LA=L2B
ZCTO.POSA(cnodB0)=LA
ieltB2=ieltB0+1
DO WHILE(ieltB2.LT.ieltB1)
celtB2=CNT(cntB).ELT(ieltB2)
cnodB2=ELT(celtB2).NI(2)
CALL LNG_ELT(ELT(celtB2),NOD,LB)
LA=LA+LB
ZCTO.POSA(cnodB2)=LA
ieltB2=ieltB2+1
END DO
celtB1=CNT(cntB).ELT(ieltB1)
CALL LNG_ELT(ELT(celtB1),NOD,LB)
POSB=ZCTO.POSB(cnodA1)
L1B=LB*(POSB+1.d0)/2.d0
LA=LA+L1B
C
ieltB2=ieltB0
DO WHILE(ieltB2.LT.ieltB1)
celtB2=CNT(cntB).ELT(ieltB2)
cnodB2=ELT(celtB2).NI(2)
ZCTO.POSA(cnodB2)=1.d0-ZCTO.POSA(cnodB2)*2.d0/LA
ZCTO.NDB_ELA(cnodB2)=celtA0
ZCTO.NDB_iELA(cnodB2)=ieltA0
IF(((ZCTO.POSA(cnodB2)).LT.-1.d0).OR.
@ ((ZCTO.POSA(cnodB2)).GT.1.d0))THEN
WRITE(F_W,10100) 6
WRITE( *,10100) 6
STOP
END IF
ieltB2=ieltB2+1
END DO
C
ieltB0=ieltB2
C
END IF
C
ieltA0=ieltA0-1
C
IF(ieltA0.EQ.0)THEN
IF((ZCTO.NDA_iELB(cnodA1).EQ.ieltB0).AND.
@ (ZCTO.POSB(cnodA1).EQ.1.d0))THEN
cnodB0=ELT(CNT(cntB).ELT(ieltB0)).NI(2)
ZCTO.NDB_ELA(cnodB0) =celtA0
ZCTO.NDB_iELA(cnodB0)=1
ZCTO.POSA(cnodB0) =-1.d0
END IF
END IF
C
END DO
C
C Comprueba que todos los nodos contactan
C y da un WARNING o un ERROR si no lo hacen
C
DO ieltA0=1,CNT(cntA).NELT
celtA0=CNT(cntA).ELT(ieltA0)
celtpA=ELT(celtA0).TIP
DO ieltA1=1,2
cnodA0=ELT(celtA0).NI(ieltA1)
IF(ZCTO.NDA_ELB(cnodA0).EQ.0)THEN
SELECT CASE(ZCTO.TIP)
CASE(11)
WRITE(F_W,10107) NOD(cnodA0).NUM
WRITE( * ,10107) NOD(cnodA0).NUM
STOP
CASE(21)
WRITE(F_W,10109) NOD(cnodA0).NUM
WRITE( * ,10109) NOD(cnodA0).NUM
CASE DEFAULT
WRITE(F_W,10100) 8
WRITE( * ,10100) 8
STOP
END SELECT
END IF
END DO
END DO
C
DO ieltB0=1,CNT(cntB).NELT
celtB0=CNT(cntB).ELT(ieltB0)
celtpB=ELT(celtB0).TIP
DO ieltB1=1,2
cnodB0=ELT(celtB0).NI(ieltB1)
IF(ZCTO.NDB_ELA(cnodB0).EQ.0)THEN
SELECT CASE(ZCTO.TIP)
CASE(11)
WRITE(F_W,10108) NOD(cnodB0).NUM
WRITE( * ,10108) NOD(cnodB0).NUM
STOP
CASE(21)
WRITE(F_W,10110) NOD(cnodB0).NUM
WRITE( * ,10110) NOD(cnodB0).NUM
CASE DEFAULT
WRITE(F_W,10100) 9
WRITE( * ,10100) 9
STOP
END SELECT
END IF
END DO
END DO
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA.
C
10100 FORMAT(/,2x,'ERROR 10100 - POS_REL_B - Error Programa (#',
@ i1,'#)')
10101 FORMAT(/,2x,'ERROR 10101 - POS_REL_B',/,
@ ' Tipo de elemento (',i2,') no implementado.')
10102 FORMAT(/,2x,'WARNING 10102 - POS_REL_B',/,
@ ' El nodo (',i4,') pertenece al contorno A de una zona',
@ ' de contacto',/,' y esta en el interior del solido B.',
@ /,' Penetracion: ',e8.2,'.')
10103 FORMAT(/,2x,'ERROR 10103 - POS_REL_B',/,
@ ' Numero de ecuaciones mayor de lo permitido (',i4,').')
10104 FORMAT(/,2x,'WARNING 10104 - POS_REL_B',/,
@ ' Puede no haber suficientes incognitas en',
@ ' desplazamientos para plantear',/,' las ecuaciones de',
@ ' compatibilidad en el contorno ',i2,'.',/,' Se sugiere',
@ ' refinar la discretizacion del contorno ',i2,'.')
10105 FORMAT(/,2x,'WARNING 10105 - POS_REL_B',/,
@ ' El nodo (',i4,') pertenece al contorno A de una zona',
@ ' de contacto',/,' y esta en puesto en contacto, pero',
@ ' esta separado del solido B.',/,' Distancia: ',e8.2,'.')
10106 FORMAT(/,2x,'ERROR 10106 - POS_REL_B',/,
@ ' El nodo (',i4,') pertenece a la zona libre del ',
@ 'contorno A de una zona de contacto',/,' y esta en el ',
@ 'interior del solido B.',/,' Penetracion: ',e8.2,'.')
10107 FORMAT(/,2x,'ERROR 10107 - POS_REL_B',/,
@ ' El nodo (',i4,') del contorno A de una interfase ',/,
@ ' no contacta con ningun elemento ',
@ 'del solido B.',/)
10108 FORMAT(/,2x,'ERROR 10108 - POS_REL_B',/,
@ ' El nodo (',i4,') del contorno B de una interfase ',/,
@ ' no contacta con ningun elemento ',
@ 'del solido A.',/)
10109 FORMAT(/,2x,'WARNING 10109 - POS_REL_B',/,
@ ' El nodo (',i4,') del contorno A de una zona de ',
@ 'contacto',/,' no contacta con ningun elemento ',
@ 'del solido B.',/)
10110 FORMAT(/,2x,'WARNING 10110 - POS_REL_B',/,
@ ' El nodo (',i4,') del contorno B de una zona de ',
@ 'contacto',/,' no contacta con ningun elemento ',
@ 'del solido A.',/)
10111 FORMAT(/,2x,'ERROR 10111 - POS_REL_B',/,
@ ' El nodo (',i4,') del contorno A (definido como ',
@ 'libre) de una zona de contacto',/,' no contacta con ',
@ 'ningun elemento del solido B.',/)
10112 FORMAT(/,2x,'ERROR 10112 - POS_REL_B',/,
@ ' El nodo (',i4,') del contorno B (definido como ',
@ 'libre) de una zona de contacto',/,' no contacta con ',
@ 'ningun elemento del solido A.',/)
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
