C Rutina 101
C-----------------------------------------------------------EQUIL_DEB---
C
C SUBRUTINA EQUIL_DEB
C
C MONTAJE DE LAS ECUACIONES DE EQUILIBRIO EN FORMA DEBIL
C CORRESPONDIENTES A UN FRAMENTO DE LA ZONA DE CONTACTO
C
C CONTACTO DEBIL
C
SUBROUTINE EQUIL_DEB(PRB,ELTA,ELTB,NOD,x1A,x2A,x1B,x2B,
@ alfa,SAij,SFi,ceq)
C
IMPLICIT NONE
C
INCLUDE '_param.for'
INCLUDE '_struct.for'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES EXTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C PRB : Variables globales del problema
RECORD /S_problema/ PRB
C ELTA,ELTB : Elemento de los solidos A y B corresp. al fragmento
RECORD /S_elemento/ ELTA,ELTB
C NOD : Nodos del problema
RECORD /S_nodo/ NOD(N_MAX_NOD)
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 ALFA : Indice de la funcion de forma de la tension virtual
INTEGER ALFA
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 I,J,K,M : Contador
INTEGER J,K,M
C Contador
INTEGER CINC
C n1B,n2B : Nodos extremos de ELTB
INTEGER n1B,n2B
C LB: Longitud de ELTA
REAL*8 LB
C Ho*H(,) : Matriz de Integrales de las funciones de forma
REAL*8 Ho,H(2,6)
C FFA1,FFA2,FFB1,FFB2 : Valor de las funciones de forma en x1A,x2A,x1B,x2B
REAL*8 FFA1(2),FFA2(2),FFB1(2),FFB2(2)
C nA,nB : Normales a ELTA y ELTB
REAL*8 nA(2),nB(2)
C CORDENADA r EN EL ORIGEN Y EL EXTREMO DE LOS ELEMENTOS (Probl. Axisim)
REAL*8 Y1r,Y2r
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
n1B=ELTB.NI(1)
n2B=ELTB.NI(2)
C
LB=(x2B-x1B)*DSQRT((NOD(n2B).XYZ(1)-NOD(n1B).XYZ(1))**2.d0+
@ (NOD(n2B).XYZ(2)-NOD(n1B).XYZ(2))**2.d0)/2.d0
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C ECUACIONES DE EQULIBRIO
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
CALL FUNC_FORM(x1A,FFA1,1)
CALL FUNC_FORM(x2A,FFA2,1)
CALL FUNC_FORM(x1B,FFB1,1)
CALL FUNC_FORM(x2B,FFB2,1)
C
Y1r=FFB1(1)*NOD(n1B).XYZ(1)+FFB1(2)*NOD(n2B).XYZ(1)
Y2r=FFB2(1)*NOD(n1B).XYZ(1)+FFB2(2)*NOD(n2B).XYZ(1)
C
CALL NOR_ELT(nB,ELTB,NOD)
nA(1)=-nB(1)
nA(2)=-nB(2)
C
C SOLIDO A
C
C Primer nodo
C
SELECT CASE(PRB.TP.TIP)
CASE(21,22,31,32,51,52)
C PROBLEMA PLANO
Ho=( FFB2(alfa)*(2.d0*FFA1(1)+FFA2(1))+
@ FFB1(alfa)*(FFA1(1)+2.d0*FFA2(1)) )*LB/6.d0
CASE(1)
C PROBLEMA AXISIMETRICO
Ho=( FFB2(alfa)*((3.d0*Y1r+Y2r)*FFA1(1)+(Y1r+Y2r)*FFA2(1))+
@ FFB1(alfa)*((Y1r+Y2r)*FFA1(1)+(Y1r+3.d0*Y2r)*FFA2(1)) )
@ *LB/12.d0
CASE DEFAULT
WRITE(F_W,10500) 1
WRITE( *,10500) 1
STOP
END SELECT
C
H(1,5)= nA(1)*Ho
H(1,6)= nA(2)*Ho
H(2,5)=-nA(2)*Ho
H(2,6)= nA(1)*Ho
C Terminos que afectan a la matriz del sistema
DO j=1,NOD(ELTA.NI(1)).NINC
cinc=NOD(ELTA.NI(1)).INC(j)
DO m=5,6
SAij(ceq,cinc) =SAij(ceq,cinc)+
@ H(1,m)*NOD(ELTA.NI(1)).Gij(m,j)
SAij(ceq+1,cinc)=SAij(ceq+1,cinc)+
@ H(2,m)*NOD(ELTA.NI(1)).Gij(m,j)
END DO
ENDDO
C Terminos que afectan al vector de carga
DO j=1,NOD(ELTA.NI(1)).NBC
k=j+NOD(ELTA.NI(1)).NINC
DO m=5,6
SFi(ceq) =SFi(ceq) -H(1,m)*NOD(ELTA.NI(1)).Gij(m,k)*
@ NOD(ELTA.NI(1)).VBC(j)
SFi(ceq+1)=SFi(ceq+1)-H(2,m)*NOD(ELTA.NI(1)).Gij(m,k)*
@ NOD(ELTA.NI(1)).VBC(j)
END DO
ENDDO
C
C Segundo nodo
C
SELECT CASE(PRB.TP.TIP)
CASE(21,22,31,32,51,52)
C PROBLEMA PLANO
Ho=( FFB2(alfa)*(2.d0*FFA1(2)+FFA2(2))+
@ FFB1(alfa)*(FFA1(2)+2.d0*FFA2(2)) )*LB/6.d0
CASE(1)
C PROBLEMA AXISIMETRICO
Ho=( FFB2(alfa)*((3.d0*Y1r+Y2r)*FFA1(2)+(Y1r+Y2r)*FFA2(2))+
@ FFB1(alfa)*((Y1r+Y2r)*FFA1(2)+(Y1r+3.d0*Y2r)*FFA2(2)) )
@ *LB/12.d0
CASE DEFAULT
WRITE(F_W,10500) 1
WRITE( *,10500) 1
STOP
END SELECT
C
H(1,3)= nA(1)*Ho
H(1,4)= nA(2)*Ho
H(2,3)=-nA(2)*Ho
H(2,4)= nA(1)*Ho
C Terminos que afectan a la matriz del sistema
DO j=1,NOD(ELTA.NI(2)).NINC
cinc=NOD(ELTA.NI(2)).INC(j)
DO m=3,4
SAij(ceq,cinc) =SAij(ceq,cinc)+
@ H(1,m)*NOD(ELTA.NI(2)).Gij(m,j)
SAij(ceq+1,cinc)=SAij(ceq+1,cinc)+
@ H(2,m)*NOD(ELTA.NI(2)).Gij(m,j)
END DO
ENDDO
C Terminos que afectan al vector de carga
DO j=1,NOD(ELTA.NI(2)).NBC
k=j+NOD(ELTA.NI(2)).NINC
DO m=3,4
SFi(ceq) =SFi(ceq) -H(1,m)*NOD(ELTA.NI(2)).Gij(m,k)*
@ NOD(ELTA.NI(2)).VBC(j)
SFi(ceq+1)=SFi(ceq+1)-H(2,m)*NOD(ELTA.NI(2)).Gij(m,k)*
@ NOD(ELTA.NI(2)).VBC(j)
END DO
ENDDO
C
C SOLIDO B
C
C Primer nodo
C
SELECT CASE(PRB.TP.TIP)
CASE(21,22,31,32,51,52)
C PROBLEMA PLANO
Ho=( FFB2(alfa)*(2.d0*FFB2(1)+FFB1(1))+
@ FFB1(alfa)*(FFB2(1)+2.d0*FFB1(1)) )*LB/6.d0
CASE(1)
C PROBLEMA AXISIMETRICO
Ho=( FFB2(alfa)*((3.d0*Y1r+Y2r)*FFB2(1)+(Y1r+Y2r)*FFB1(1))+
@ FFB1(alfa)*((Y1r+Y2r)*FFB2(1)+(Y1r+3.d0*Y2r)*FFB1(1)) )
@ *LB/12.d0
CASE DEFAULT
WRITE(F_W,10500) 1
WRITE( *,10500) 1
STOP
END SELECT
C
H(1,5)= nB(1)*Ho
H(1,6)= nB(2)*Ho
H(2,5)=-nB(2)*Ho
H(2,6)= nB(1)*Ho
C Terminos que afectan a la matriz del sistema
DO j=1,NOD(ELTB.NI(1)).NINC
cinc=NOD(ELTB.NI(1)).INC(j)
DO m=5,6
SAij(ceq,cinc) =SAij(ceq,cinc)+
@ H(1,m)*NOD(ELTB.NI(1)).Gij(m,j)
SAij(ceq+1,cinc)=SAij(ceq+1,cinc)+
@ H(2,m)*NOD(ELTB.NI(1)).Gij(m,j)
END DO
ENDDO
C Terminos que afectan al vector de carga
DO j=1,NOD(ELTB.NI(1)).NBC
k=j+NOD(ELTB.NI(1)).NINC
DO m=5,6
SFi(ceq) =SFi(ceq) -H(1,m)*NOD(ELTB.NI(1)).Gij(m,k)*
@ NOD(ELTB.NI(1)).VBC(j)
SFi(ceq+1)=SFi(ceq+1)-H(2,m)*NOD(ELTB.NI(1)).Gij(m,k)*
@ NOD(ELTB.NI(1)).VBC(j)
END DO
ENDDO
C
C Segundo nodo
C
SELECT CASE(PRB.TP.TIP)
CASE(21,22,31,32,51,52)
C PROBLEMA PLANO
Ho=( FFB2(alfa)*(2.d0*FFB2(2)+FFB1(2))+
@ FFB1(alfa)*(FFB2(2)+2.d0*FFB1(2)) )*LB/6.d0
CASE(1)
C PROBLEMA AXISIMETRICO
Ho=( FFB2(alfa)*((3.d0*Y1r+Y2r)*FFB2(2)+(Y1r+Y2r)*FFB1(2))+
@ FFB1(alfa)*((Y1r+Y2r)*FFB2(2)+(Y1r+3.d0*Y2r)*FFB1(2)) )
@ *LB/12.d0
CASE DEFAULT
WRITE(F_W,10500) 1
WRITE( *,10500) 1
STOP
END SELECT
C
H(1,3)= nB(1)*Ho
H(1,4)= nB(2)*Ho
H(2,3)=-nB(2)*Ho
H(2,4)= nB(1)*Ho
C Terminos que afectan a la matriz del sistema
DO j=1,NOD(ELTB.NI(2)).NINC
cinc=NOD(ELTB.NI(2)).INC(j)
DO m=3,4
SAij(ceq,cinc) =SAij(ceq,cinc)+
@ H(1,m)*NOD(ELTB.NI(2)).Gij(m,j)
SAij(ceq+1,cinc)=SAij(ceq+1,cinc)+
@ H(2,m)*NOD(ELTB.NI(2)).Gij(m,j)
END DO
ENDDO
C Terminos que afectan al vector de carga
DO j=1,NOD(ELTB.NI(2)).NBC
k=j+NOD(ELTB.NI(2)).NINC
DO m=3,4
SFi(ceq) =SFi(ceq) -H(1,m)*NOD(ELTB.NI(2)).Gij(m,k)*
@ NOD(ELTB.NI(2)).VBC(j)
SFi(ceq+1)=SFi(ceq+1)-H(2,m)*NOD(ELTB.NI(2)).Gij(m,k)*
@ NOD(ELTB.NI(2)).VBC(j)
END DO
ENDDO
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA.
C
10500 FORMAT(/,2x,'ERROR 10500 - EQUIL_DEB - Error Programa (#',
@ i1,'#)')
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
