C Rutina 101
C------------------------------------------------------EQUIL_ELTO_DEB---
C
C SUBRUTINA EQUIL_ELTO_DEB
C
C MONTAJE DE LAS ECUACIONES DE EQUILIBRIO EN FORMA DEBIL
C CORRESPONDIENTES A UN ELEMENTO CONTIGUO AL NODO
C
C CONTACTO DEBIL
C
SUBROUTINE EQUIL_ELTO_DEB(PRB,cnod,geltB,CNTA,ELT,NOD,
@ ELTA,POSA,ELTB,POSB,SAij,SFi,ceq)
C
IMPLICIT NONE
INCLUDE '_param.for'
INCLUDE '_struct.for'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES EXTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C PRB : Variables globales del problema
RECORD /S_problema/ PRB
C CNOD : Nodo donde se aplican las tensiones virtuales
INTEGER CNOD
C geltB : Elemento contiguo a CNOD (antes o despues)
INTEGER geltB
C CNTA : Contorno A de la zona de contacto
RECORD /S_contorno/ CNTA
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 ceA,ce1A,ce2A
C Contador global de elementos
INTEGER geA,ge1A,ge2A
C n1B,n2B : Nodos extremos de los elementos de B
INTEGER n1B,n2B
C n1A,n2A : Nodos extremos de los elementos de A
INTEGER n1A,n2A
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 celtA
REAL*8 Lt,L1,L2,Li,Ls
C ALFA : Indice de la funcion de forma de la tension virtual
INTEGER ALFA
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
n1B=ELT(geltB).NI(1)
n2B=ELT(geltB).NI(2)
C
ce1A=0
ce2A=0
ge1A=0
ge2A=0
C
IF(n1B.EQ.cnod)THEN
alfa=1
ELSE IF(n2B.EQ.cnod)THEN
alfa=2
ELSE
WRITE(F_W,10510) 1
WRITE( *,10510) 1
STOP
END IF
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C ECUACIONES DE EQUILIBRIO
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
DO ceA=1,CNTA.NELT
geA=CNTA.ELT(ceA)
IF(ELTA(n1b).EQ.geA)THEN
ge2A=geA
ce2A=ceA
END IF
IF(ELTA(n2b).EQ.geA)THEN
ge1A=geA
ce1A=ceA
END IF
END DO
C
IF((ce1A.EQ.0).AND.(ce2A.EQ.0))THEN
C
DO ceA=1,CNTA.NELT
geA=CNTA.ELT(ceA)
n1A=ELT(geA).NI(1)
n2A=ELT(geA).NI(2)
IF((ELTB(n1A).EQ.geltB).AND.(ELTB(n2A).EQ.geltB))THEN
x1B=POSB(n2A)
x2B=POSB(n1A)
x1A=-1.d0
x2A= 1.d0
CALL EQUIL_DEB(PRB,ELT(geA),ELT(geltB),NOD,x1A,x2A,x1B,x2B,
@ alfa,SAij,SFi,ceq)
END IF
END DO
C
ELSE IF(ce1A.EQ.0)THEN
C
n1A=ELT(ge2A).NI(1)
IF(ELTB(n1A).EQ.geltB)THEN
geA=ge2A
x1B=-1.d0
x2A=POSA(n1B)
x2B=POSB(n1A)
x1A=-1.d0
CALL EQUIL_DEB(PRB,ELT(geA),ELT(geltB),NOD,x1A,x2A,x1B,x2B,
@ alfa,SAij,SFi,ceq)
END IF
C
ceA=ce2A-1
DO WHILE(ceA.GT.0)
geA=CNTA.ELT(ceA)
n1A=ELT(geA).NI(1)
n2A=ELT(geA).NI(2)
IF((ELTB(n1A).EQ.geltB).AND.(ELTB(n2A).EQ.geltB))THEN
x1B=POSB(n2A)
x2B=POSB(n1A)
x1A=-1.d0
x2A= 1.d0
CALL EQUIL_DEB(PRB,ELT(geA),ELT(geltB),NOD,x1A,x2A,x1B,x2B,
@ alfa,SAij,SFi,ceq)
ceA=ceA-1
ELSE
ceA=0
END IF
END DO
C
ELSE IF(ce2A.EQ.0)THEN
C
n2A=ELT(ge1A).NI(2)
IF(ELTB(n2A).EQ.geltB)THEN
geA=ge1A
x1B=POSB(n2A)
x2A=1.d0
x2B=1.d0
x1A=POSA(n2B)
CALL EQUIL_DEB(PRB,ELT(geA),ELT(geltB),NOD,x1A,x2A,x1B,x2B,
@ alfa,SAij,SFi,ceq)
END IF
C
ceA=ce1A+1
DO WHILE(ceA.LE.(CNTA.NELT))
geA=CNTA.ELT(ceA)
n1A=ELT(geA).NI(1)
n2A=ELT(geA).NI(2)
IF((ELTB(n1A).EQ.geltB).AND.(ELTB(n2A).EQ.geltB))THEN
x1B=POSB(n2A)
x2B=POSB(n1A)
x1A=-1.d0
x2A= 1.d0
CALL EQUIL_DEB(PRB,ELT(geA),ELT(geltB),NOD,x1A,x2A,x1B,x2B,
@ alfa,SAij,SFi,ceq)
ceA=ceA+1
ELSE
ceA=CNTA.NELT+1
END IF
END DO
C
ELSE
C
IF(ce1A.EQ.ce2A)THEN
C
geA=ge1A
x1B=-1.d0
x2B= 1.d0
x1A=POSA(n2B)
x2A=POSA(n1B)
CALL EQUIL_DEB(PRB,ELT(geA),ELT(geltB),NOD,x1A,x2A,x1B,x2B,
@ alfa,SAij,SFi,ceq)
C
ELSE IF(ce1A.LT.ce2A)THEN
C
Lt=0.d0
CALL LNG_ELT(ELT(ge2A),NOD,L1)
L1=(1.d0+POSA(n1B))*L1/2.d0
Lt=Lt+L1
DO ceA=1,(ce2A-ce1A-1)
geA=CNTA.ELT(ce2A-ceA)
CALL LNG_ELT(ELT(geA),NOD,Li)
Lt=Lt+Li
END DO
CALL LNG_ELT(ELT(ge1A),NOD,L2)
L2=(1.d0-POSA(n2B))*L2/2.d0
Lt=Lt+L2
C
geA=ELTA(n1B)
Ls=L1
x1B=-1.d0
x2B=2.d0*Ls/Lt-1.d0
x1A=-1.d0
x2A=POSA(n1B)
CALL EQUIL_DEB(PRB,ELT(geA),ELT(geltB),NOD,x1A,x2A,x1B,x2B,
@ alfa,SAij,SFi,ceq)
C
DO ceA=1,(ce2A-ce1A-1)
geA=CNTA.ELT(ce2A-ceA)
CALL LNG_ELT(ELT(geA),NOD,Li)
Ls=Ls+Li
x1B=x2B
x2B=2.d0*Ls/Lt-1.d0
x1A=-1.d0
x2A= 1.d0
CALL EQUIL_DEB(PRB,ELT(geA),ELT(geltB),NOD,x1A,x2A,x1B,x2B,
@ alfa,SAij,SFi,ceq)
END DO
C
geA=ELTA(n2B)
x1B=x2B
x2B=1.d0
x1A=POSA(n2B)
x2A=1.d0
CALL EQUIL_DEB(PRB,ELT(geA),ELT(geltB),NOD,x1A,x2A,x1B,x2B,
@ alfa,SAij,SFi,ceq)
C
ELSE IF(ce1A.GT.ce2A)THEN
WRITE(F_W,10510) 2
WRITE( *,10510) 2
STOP
END IF
C
END IF
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA.
C
10510 FORMAT(/,2x,'ERROR 10510 - EQUIL_ELTO_DEB - Error Programa (#',
@ i1,'#)')
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
