C Rutina 032
C-------------------------------------------------------------CDC_MUELLE---
C
C SUBRUTINA CDC_MUELLE
C
C CALCULO DE LOS ELEMENTOS DE GIJ CORRESPONDIENTES
C A LA CDC DE MUELLE
C
SUBROUTINE CDC_MUELLE(Na,Nd,VBC,SOLU,BC,G)
C
IMPLICIT NONE
INCLUDE '_param.for'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C NOD.VARIABLES EXTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Na(),Nd() : Normal a los elementos anterior y posterior
REAL*8 Na(2),Nd(2)
C BC() : Datos de la cdc
REAL*8 VBC(N_MAX_CDCNOD)
C SOLU(): Solución de los pasos anteriores (U1,U2,Sa,Ta,Sd,Td)
REAL*8 SOLU(N_MAX_INCNOD)
C BC: Codigo de la condicion de contorno (15,55,51)
INTEGER BC
C G(,): Coeficientes de la matriz Gij
REAL*8 G(6,11)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C NOD.VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C D() : Direccion del muelle
REAL*8 D(2)
C K: Constante del muelle
REAL*8 K
C Dn,Dt,Ud: Variables auxiliares
REAL*8 Dn,Dt,Ud
C U1,U2,Sa,Ta,Sd,Td: Solucion de los pasos anteriores
REAL*8 U1,U2,Sa,Ta,Sd,Td
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
K=VBC(2)
D(1)=VBC(3)
D(2)=VBC(4)
C
U1=SOLU(1)
U2=SOLU(2)
Sa=SOLU(3)
Ta=SOLU(4)
Sd=SOLU(5)
Td=SOLU(6)
C
Ud=U1*D(1)+U2*D(2)
C
CCC
C NOTA: Uo (VBC(1)) Hay que actualizarlo tambien para cada paso dentro del
C incremento de carga. Se hace en la rutina INCR_APRIETE
CCC
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C APLICACION DE LA CDC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
SELECT CASE(BC)
CASE(15)
C
Dn=Nd(1)*D(1)+Nd(2)*D(2)
Dt=-Nd(2)*D(1)+Nd(1)*D(2)
C
IF(DABS(Dn).GT.DABS(Dt))THEN
VBC(1)=VBC(1)-Sd/Dn/K-Ud
ELSE
VBC(1)=VBC(1)-Td/Dt/K-Ud
ENDIF
C
G(3,9) =0.d0
G(3,10)=0.d0
G(3,11)=0.d0
C
G(4,9) =0.d0
G(4,10)=0.d0
G(4,11)=0.d0
C
G(5,9) =-K*D(1)*Dn
G(5,10)=-K*D(2)*Dn
G(5,11)=K*Dn
C
G(6,9) =-K*D(1)*Dt
G(6,10)=-K*D(2)*Dt
G(6,11)=K*Dt
C
CASE(55)
C
Dn=Nd(1)*D(1)+Nd(2)*D(2)
Dt=-Nd(2)*D(1)+Nd(1)*D(2)
C
IF(DABS(Dn).GT.DABS(Dt))THEN
VBC(1)=VBC(1)-Sd/Dn/K-Ud
ELSE
VBC(1)=VBC(1)-Td/Dt/K-Ud
ENDIF
C
G(3,9) =-K*D(1)*Dn
G(3,10)=-K*D(2)*Dn
G(3,11)=K*Dn
C
G(4,9) =-K*D(1)*Dt
G(4,10)=-K*D(2)*Dt
G(4,11)=K*Dt
C
Dn=Na(1)*D(1)+Na(2)*D(2)
Dt=-Na(2)*D(1)+Na(1)*D(2)
C
G(5,9) =-K*D(1)*Dn
G(5,10)=-K*D(2)*Dn
G(5,11)=K*Dn
C
G(6,9) =-K*D(1)*Dt
G(6,10)=-K*D(2)*Dt
G(6,11)=K*Dt
C
CASE(51)
C
Dn=Na(1)*D(1)+Na(2)*D(2)
Dt=-Na(2)*D(1)+Na(1)*D(2)
C
IF(DABS(Dn).GT.DABS(Dt))THEN
VBC(1)=VBC(1)-Sa/K/Dn-Ud
ELSE
VBC(1)=VBC(1)-Ta/Dt/K-Ud
ENDIF
C
G(3,9) =-K*D(1)*Dn
G(3,10)=-K*D(2)*Dn
G(3,11)=K*Dn
C
G(4,9) =-K*D(1)*Dt
G(4,10)=-K*D(2)*Dt
G(4,11)=K*Dt
C
G(5,9) =0.d0
G(5,10)=0.d0
G(5,11)=0.d0
C
G(6,9) =0.d0
G(6,10)=0.d0
G(6,11)=0.d0
C
CASE DEFAULT
WRITE(F_W,04120) 5
WRITE (*,04120) 5
STOP
END SELECT
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA
C
04120 FORMAT(/,2x,'ERROR 04120 - CDC_MUELLE - Error Programa (#',
@ i1,'#)')
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
