C Rutina 101
C----------------------------------------------COMPAT_ELTO_DEB_POT---
C
C SUBRUTINA COMPAT_ELTO_DEB_POT
C
C MONTAJE DE LAS ECUACIONES DE COMPATIBILIDAD EN FORMA DEBIL
C CORRESPONDIENTES A UN ELEMENTO CONTIGUO AL NODO
C
C CONTACTO DEBIL
C
SUBROUTINE COMPAT_ELTO_DEB_POT(cnod,geltA,CNTB,ELT,NOD,
@ ELTA,POSA,ELTB,POSB,SAij,SFi,ceq)
C
IMPLICIT NONE
C
INCLUDE '_param.for'
INCLUDE '_struct.for'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES EXTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C CNOD : Nodo donde se aplican las tensiones virtuales
INTEGER CNOD
C geltA : Elemento contiguo a CNOD (antes o despues)
INTEGER geltA
C CNTB : Contornos A y B de la zona de contacto
RECORD /S_contorno/ CNTB
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 ELTA(),ELTB() : Elementos de los cont. A y B corresponidentes
C a los nodos de B y A respetivamente
INTEGER ELTA(N_MAX_NOD),ELTB(N_MAX_NOD)
C POSA(),POSB() : Posicion (coor. local) de las proyecciones de los
C nodos de A y B sobre los elementos correspondientes
REAL*8 POSA(N_MAX_NOD),POSB(N_MAX_NOD)
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 CEQ : Contador de ecuacuones de contacto
INTEGER CEQ
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Contador de elementos en el contorno
INTEGER ceB,ce1B,ce2B
C Contador global de elementos
INTEGER geB,ge1B,ge2B
C n1A,n2A : Nodos extremos de los elementos de A
INTEGER n1A,n2A
C n1B,n2B : Nodos extremos de los elementos de B
INTEGER n1B,n2B
C x1A,x2A,x1B,x2B : Posicion local de comienzo y fin de la integracion
C en cada fragemento de la zona de contacto
REAL*8 x1A,x2A,x1B,x2B
C Lt,L1,L2,Li,Ls : Longitudes de los eltos de B en contacto con geltA
REAL*8 Lt,L1,L2,Li,Ls
C ALFA : Indice de la funcion de forma de la tension virtual
INTEGER ALFA
C
CCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCC
C
n1A=ELT(geltA).NI(1)
n2A=ELT(geltA).NI(2)
C
ce1B=0
ce2B=0
ge1B=0
ge2B=0
C
IF(n1A.EQ.cnod)THEN
alfa=1
ELSE IF(n2A.EQ.cnod)THEN
alfa=2
ELSE
WRITE(F_W,10410) 1
WRITE( *,10410) 1
STOP
END IF
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C ECUACIONES DE COMPATIBILIDAD
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
DO ceB=1,CNTB.NELT
geB=CNTB.ELT(ceB)
IF(ELTB(n1A).EQ.geB)THEN
ge2B=geB
ce2B=ceB
END IF
IF(ELTB(n2A).EQ.geB)THEN
ge1B=geB
ce1B=ceB
END IF
END DO
C
IF((ce1B.EQ.0).AND.(ce2B.EQ.0))THEN
C
DO ceB=1,CNTB.NELT
geB=CNTB.ELT(ceB)
n1B=ELT(geB).NI(1)
n2B=ELT(geB).NI(2)
IF((ELTA(n1B).EQ.geltA).AND.(ELTA(n2B).EQ.geltA))THEN
x1A=POSA(n2B)
x2A=POSA(n1B)
x1B=-1.d0
x2B= 1.d0
CALL COMPAT_POT(ELT(geltA),ELT(geB),NOD,x1A,x2A,x1B,
@ x2B,alfa,SAij,SFi,ceq)
END IF
END DO
C
ELSE IF(ce1B.EQ.0)THEN
C
n1B=ELT(ge2B).NI(1)
IF(ELTB(n1B).EQ.geltA)THEN
geB=ge2B
x1A=-1.d0
x2B=POSB(n1A)
x2A=POSA(n1B)
x1B=-1.d0
CALL COMPAT_POT(ELT(geltA),ELT(geB),NOD,x1A,x2A,x1B,
@ x2B,alfa,SAij,SFi,ceq)
END IF
C
ceB=ce2B-1
DO WHILE(ceB.GT.0)
geB=CNTB.ELT(ceB)
n1B=ELT(geB).NI(1)
n2B=ELT(geB).NI(2)
IF((ELTA(n1B).EQ.geltA).AND.(ELTA(n2B).EQ.geltA))THEN
x1A=POSA(n2B)
x2A=POSA(n1B)
x1B=-1.d0
x2B= 1.d0
CALL COMPAT_POT(ELT(geltA),ELT(geB),NOD,x1A,x2A,x1B,
@ x2B,alfa,SAij,SFi,ceq)
ceB=ceB-1
ELSE
ceB=0
END IF
END DO
C
ELSE IF(ce2B.EQ.0)THEN
C
n2B=ELT(ge1B).NI(2)
IF(ELTA(n2B).EQ.geltA)THEN
geB=ge1B
x1A=POSA(n2B)
x2B=1.d0
x2A=1.d0
x1B=POSB(n2A)
CALL COMPAT_POT(ELT(geltA),ELT(geB),NOD,x1A,x2A,x1B,
@ x2B,alfa,SAij,SFi,ceq)
END IF
C
ceB=ce1B+1
DO WHILE(ceB.LE.(CNTB.NELT))
geB=CNTB.ELT(ceB)
n1B=ELT(geB).NI(1)
n2B=ELT(geB).NI(2)
IF((ELTA(n1B).EQ.geltA).AND.(ELTA(n2B).EQ.geltA))THEN
x1A=POSA(n2B)
x2A=POSA(n1B)
x1B=-1.d0
x2B= 1.d0
CALL COMPAT_POT(ELT(geltA),ELT(geB),NOD,x1A,x2A,x1B,
@ x2B,alfa,SAij,SFi,ceq)
ceB=ceB+1
ELSE
ceB=CNTB.NELT+1
END IF
END DO
C
ELSE
C
IF(ce1B.EQ.ce2B)THEN
C
geB=ge1B
x1A=-1.d0
x2A= 1.d0
x1B=POSB(n2A)
x2B=POSB(n1A)
CALL COMPAT_POT(ELT(geltA),ELT(geB),NOD,x1A,x2A,x1B,
@ x2B,alfa,SAij,SFi,ceq)
C
ELSE IF(ce1B.LT.ce2B)THEN
C
Lt=0.d0
CALL LNG_ELT(ELT(ge2B),NOD,L1)
L1=(1.d0+POSB(n1A))*L1/2.d0
Lt=Lt+L1
DO ceB=1,(ce2B-ce1B-1)
geB=CNTB.ELT(ce2B-ceB)
CALL LNG_ELT(ELT(geB),NOD,Li)
Lt=Lt+Li
END DO
CALL LNG_ELT(ELT(ge1B),NOD,L2)
L2=(1.d0-POSB(n2A))*L2/2.d0
Lt=Lt+L2
C
geB=ELTB(n1A)
Ls=L1
x1A=-1.d0
x2A=2.d0*Ls/Lt-1.d0
x1B=-1.d0
x2B=POSB(n1A)
CALL COMPAT_POT(ELT(geltA),ELT(geB),NOD,x1A,x2A,x1B,
@ x2B,alfa,SAij,SFi,ceq)
C
DO ceB=1,(ce2B-ce1B-1)
geB=CNTB.ELT(ce2B-ceB)
CALL LNG_ELT(ELT(geB),NOD,Li)
Ls=Ls+Li
x1A=x2A
x2A=2.d0*Ls/Lt-1.d0
x1B=-1.d0
x2B= 1.d0
CALL COMPAT_POT(ELT(geltA),ELT(geB),NOD,x1A,x2A,x1B,
@ x2B,alfa,SAij,SFi,ceq)
END DO
C
geB=ELTB(n2A)
x1A=x2A
x2A=1.d0
x1B=POSB(n2A)
x2B=1.d0
CALL COMPAT_POT(ELT(geltA),ELT(geB),NOD,x1A,x2A,x1B,
@ x2B,alfa,SAij,SFi,ceq)
C
ELSE IF(ce1B.GT.ce2B)THEN
WRITE(F_W,10410) 2
WRITE( *,10410) 2
STOP
END IF
C
END IF
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA.
C
10410 FORMAT(/,2x,'ERROR 10410 - COMPAT_ELTO_DEB_POT - Error Programa
@ (#',i1,'#)')
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
