C Rutina 101
C------------------------------------------------------CONTACTO_DEBIL---
C
C SUBRUTINA CONTACTO_DEBIL
C
C MONTAJE DE LAS ECUACIONES DE CONTACTO EN FORMA DEBIL
C
SUBROUTINE CONTACTO_DEBIL(PRB,SOL,MAT,CNT,ELTP,ELT,
@ NOD,ZCTO,SAij,SFi)
C
IMPLICIT NONE
INCLUDE '_param.for'
INCLUDE '_struct.for'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES EXTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C PRB : Variables del problema
RECORD /S_problema/ PRB
C SOL : Solidos del problema
RECORD /S_solido/ Sol(N_MAX_SOL)
C MATA : Materiales del problema
RECORD /S_material/ Mat(N_MAX_SOL)
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 SAIJ(,) : Matriz del sistema.
REAL*8 SAij(N_MAX_INC,N_MAX_INC)
C SFi() : Termino independiente.
REAL*8 SFi(N_MAX_INC)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C I,J,K : Contadores
INTEGER J
C CNTA,CNTB : Contornos A y B de la zona de contacto
INTEGER CNTA,CNTB
C Contadores
INTEGER ANOD,CELTA,CELTB,PNOD,UELT,UNOD
C DIS : Distancia del nodo al elemento correspondiente
REAL*8 DIS
C MU : Coeficiente de friccion
REAL*8 MU
C n1A,n2A,n1B,n2B : Nodos extremos de los elementos A y B
INTEGER n1A,n2A,n1B,n2B
C ctbcA : Condicion de contacto en el nodo de A
INTEGER ctbcA
C CEQ : Contador de ecuaciones de contacto
INTEGER CEQ
C CDCaux : Variable auxiliar
INTEGER CDCaux
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
anod=0
ceq=PRB.NeBIE+PRB.NeINT+PRB.NeCTO+1
C
cntA=ZCTO.CNT(1)
cntB=ZCTO.CNT(2)
C
MU=ZCTO.MU
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C ECUACIONES DEL SOLIDO A
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Primer y ultimo nodo del contorno
C
pnod=ELT(CNT(cntA).ELT(1)).NI(1)
uelt=CNT(cntA).ELT(CNT(cntA).NELT)
unod=ELT(uelt).NI(ELTP(ELT(uelt).TIP).NNI)
C
C Bucle que recorre los elementos del contorno A
C
DO j=1 , CNT(cntA).NELT
C
celtA=CNT(cntA).ELT(j)
C
SELECT CASE(ELT(celtA).TIP)
C
CASE(1)
C
C ELEMENTO LINEAL CONTINUO
C Primer nodo del elemento
C
n1A=ELT(celtA).NI(1)
ctbcA=NOD(n1A).CBC(3)
C
C COMPATIBILIDAD
C
IF(ZCTO.NDA_ELB(n1A).NE.0)THEN
C
C Nodo dentro de la zona contacto
C Ecuaciones de compatibilidad
C
CALL COMPAT_ELTO_DEB(PRB,n1A,celtA,CNT(cntB),ELT,NOD,
@ ZCTO.NDB_ELA,ZCTO.POSA,ZCTO.NDA_ELB,
@ ZCTO.POSB,SAij,SFi,ceq)
C
IF((n1A.EQ.pnod).AND.((NOD(n1A).CBC(2)).NE.0))THEN
C
C HAY ECUACIONES DE COMPATIBILIDAD REDUNDANTES
C
CALL COLOC_EXTRA(PRB,SOL,MAT,CNT,ELT,NOD,ZCTO,
@ SAij,SFi,ceq,1)
C
END IF
C
ELSE
C
C Nodo fuera de la zona contacto
C
IF(ctbcA.EQ.1)THEN
C
C Nodo libre
C
IF(n1A.EQ.pnod)THEN
CALL NODO_LIBRE_DEL(NOD(n1A),SAij,ceq,1)
ELSE
CALL NODO_LIBRE_DEL(NOD(n1A),SAij,ceq,2)
END IF
C
ELSE
WRITE(F_W,10100) 3
WRITE( *,10100) 3
STOP
END IF
C
END IF
C
C Incrementa el contador de ecuaciones
C
ceq=ceq+2
IF(ceq.GT.N_MAX_INC)THEN
WRITE(F_W,10103) N_MAX_EC
WRITE( *,10103) N_MAX_EC
STOP
END IF
C
C FRICCION
C
IF(n1A.EQ.pnod)THEN
DIS=ZCTO.DISA(n1a)
CALL FRICC_DEB(PRB,NOD(n1A),MU,1,DIS,SAij,SFi,ceq)
ceq=ceq+2
ELSE
DIS=ZCTO.DISA(n1a)
CALL FRICC_DEB(PRB,NOD(n1A),MU,2,DIS,SAij,SFi,ceq)
ceq=ceq+2
END IF
C
IF(ceq.GT.N_MAX_EC)THEN
WRITE(F_W,10103) N_MAX_EC
WRITE( *,10103) N_MAX_EC
STOP
END IF
C
C ****** Segundo nodo del elemento *****
C
n2A=ELT(celtA).NI(2)
ctbcA=NOD(n2A).CBC(3)
C
C COMPATIBILIDAD
C
IF(ZCTO.NDA_ELB(n2A).NE.0)THEN
C
C Nodo dentro de la zona contacto
C Ecuaciones de compatibilidad
C
CALL COMPAT_ELTO_DEB(PRB,n2A,celtA,CNT(cntB),ELT,NOD,
@ ZCTO.NDB_ELA,ZCTO.POSA,ZCTO.NDA_ELB,
@ ZCTO.POSB,SAij,SFi,ceq)
C
ELSE
C
C Nodo fuera de la zona contacto
C
IF(ctbcA.EQ.1)THEN
C
C Nodo libre
C
IF(n2A.EQ.unod)THEN
CALL NODO_LIBRE_DEL(NOD(n2A),SAij,ceq,3)
ELSE
CALL NODO_LIBRE_DEL(NOD(n2A),SAij,ceq,2)
END IF
ELSE
WRITE(F_W,10100) 4
WRITE( *,10100) 4
STOP
END IF
C
END IF
C
CASE DEFAULT
WRITE(F_W,10101) ELT(celtA).TIP
WRITE( *,10101) ELT(celtA).TIP
STOP
END SELECT
C
C Fin bucle que recorre los elementos del contorno A
C
END DO
C
IF((NOD(n2A).CBC(2)).NE.0)THEN
C
C HAY ECUACIONES DE COMPATIBILIDAD REDUNDANTES
C
CALL COLOC_EXTRA(PRB,SOL,MAT,CNT,ELT,NOD,ZCTO,SAij,SFi,ceq,2)
C
END IF
C
ceq=ceq+2
IF(ceq.GT.N_MAX_EC)THEN
WRITE(F_W,10103) N_MAX_EC
WRITE( *,10103) N_MAX_EC
STOP
END IF
C
C Ecuación de fricción del ultimo nodo
C
DIS=ZCTO.DISA(n2a)
CALL FRICC_DEB(PRB,NOD(n2A),MU,3,DIS,SAij,SFi,ceq)
ceq=ceq+2
IF(ceq.GT.N_MAX_EC)THEN
WRITE(F_W,10103) N_MAX_EC
WRITE( *,10103) N_MAX_EC
STOP
END IF
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C ECUACIONES DEL SOLIDO B
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Bucle que recorre los elementos del contorno B
C
pnod=ELT(CNT(cntB).ELT(1)).NI(1)
uelt=CNT(cntB).ELT(CNT(cntB).NELT)
unod=ELT(uelt).NI(ELTP(ELT(uelt).TIP).NNI)
C
DO j=1 , CNT(cntB).NELT
celtB=CNT(cntB).ELT(j)
C
SELECT CASE(ELT(celtB).TIP)
C
CASE(1)
C
n1B=ELT(celtB).NI(1)
C
IF(ZCTO.NDB_ELA(n1B).NE.0)THEN
CALL EQUIL_ELTO_DEB(PRB,n1B,celtB,CNT(cntA),ELT,NOD,
@ ZCTO.NDB_ELA,ZCTO.POSA,ZCTO.NDA_ELB,
@ ZCTO.POSB,SAij,SFi,ceq)
ELSE IF(n1B.EQ.pnod)THEN
CDCaux=NOD(n1B).CBC(3)
NOD(n1B).CBC(3)=1
CALL FRICC_DEB(PRB,NOD(n1B),MU,1,0.d0,SAij,SFi,ceq)
NOD(n1B).CBC(3)=CDCaux
ELSE
CDCaux=NOD(n1B).CBC(3)
NOD(n1B).CBC(3)=1
CALL FRICC_DEB(PRB,NOD(n1B),MU,2,0.d0,SAij,SFi,ceq)
NOD(n1B).CBC(3)=CDCaux
END IF
C
ceq=ceq+2
IF(ceq.GT.N_MAX_EC)THEN
WRITE(F_W,10103) N_MAX_EC
WRITE( *,10103) N_MAX_EC
STOP
END IF
C
n2B=ELT(celtB).NI(2)
C
IF(ZCTO.NDB_ELA(n2B).NE.0)THEN
CALL EQUIL_ELTO_DEB(PRB,n2B,celtB,CNT(cntA),ELT,NOD,
@ ZCTO.NDB_ELA,ZCTO.POSA,ZCTO.NDA_ELB,
@ ZCTO.POSB,SAij,SFi,ceq)
ELSE IF(n2B.EQ.unod)THEN
CDCaux=NOD(n2B).CBC(3)
NOD(n2B).CBC(3)=1
CALL FRICC_DEB(PRB,NOD(n2B),MU,3,0.d0,SAij,SFi,ceq)
NOD(n2B).CBC(3)=CDCaux
ELSE
CDCaux=NOD(n2B).CBC(3)
NOD(n2B).CBC(3)=1
CALL FRICC_DEB(PRB,NOD(n2B),MU,2,0.d0,SAij,SFi,ceq)
NOD(n2B).CBC(3)=CDCaux
END IF
C
CASE DEFAULT
WRITE(F_W,10101) ELT(celtB).TIP
WRITE( *,10101) ELT(celtB).TIP
STOP
END SELECT
C
C Fin bucle que recorre los elementos del contorno B
C
END DO
C
ceq=ceq+2
IF(ceq.GT.N_MAX_EC)THEN
WRITE(F_W,10103) N_MAX_EC
WRITE( *,10103) N_MAX_EC
STOP
END IF
C
PRB.NeCTO=ceq-1-PRB.NeBIE-PRB.NeINT
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA.
C
10100 FORMAT(/,2x,'ERROR 10100 - CONTACTO_DEBIL - Error Programa (#',
@ i1,'#)')
10101 FORMAT(/,2x,'ERROR 10101 - CONTACTO_DEBIL',/,
@ ' Tipo de elemento (',i2,') no implementado.')
10102 FORMAT(/,2x,'WARNING 10102 - CONTACTO_DEBIL',/,
@ ' 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 - CONTACTO_DEBIL',/,
@ ' Numero de ecuaciones mayor de lo permitido (',i4,').')
10104 FORMAT(/,2x,'WARNING 10104 - CONTACTO_DEBIL',/,
@ ' 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 - CONTACTO_DEBIL',/,
@ ' 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 - CONTACTO_DEBIL',/,
@ ' 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,'.')
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
