C Rutina 032
C-------------------------------------------------------------COND_CONT2---
C
C SUBRUTINA COND_CONT2
C
C CALCULO DE LAS GIJ (Condicion de contorno) EN EL NODO k
C (NODO 2D EXTREMO DE UN ELEMENTO LINEAL CONTINUO)
C PROBLEMA PLANO
C
SUBROUTINE COND_CONT2(NOD,Na,Nd,CINC,MAT)
C
IMPLICIT NONE
INCLUDE '_param.for'
INCLUDE '_struct.for'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C NOD.VARIABLES EXTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C NOD : Nodo actual (k)
RECORD /S_nodo/ NOD
C Na(),Nd() : Normal antes y despues del nodo
REAL*8 Na(MAX_DIM),Nd(MAX_DIM)
C CINC : Contador del numero de incognitas
INTEGER CINC
C MAT : Material
RECORD /S_material/ MAT
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C NOD.VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C I,J :Contadores
INTEGER I,J
C PI : Pi
REAL*8 PI
C A1,A2,TETA : Angulos auxiliares
REAL*8 A1,A2,TETA
C D : Variable auxiliar en el giro de despl.
REAL*8 D
C GIJ : Matriz de condicion de contorno del nodo k
REAL*8 GIJ(6,11)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
PI=DACOS(-1.d0)
A1=0.d0
A2=0.d0
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C APLICACION DE LA CDC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Calculo del factor de escala de las tensiones !MT000225-1
C !MT000225-1
C SELECT CASE (MAT.TIP) !MT000225-1
C CASE(1) !MT000225-1
C MAT.E=MAT.PRP(1) !MT000225-1
C MAT.D=MAT.PRP(3) !MT000225-1
C CASE(2) !MT000225-1
C MAT.E=MAT.PRP(1) !MT000225-1
C MAT.D=MAT.PRP(9) !MT000225-1
C CASE DEFAULT !MT000225-1
C WRITE(F_W,04113) MAT.TIP !MT000225-1
C WRITE (*,04113) MAT.TIP !MT000225-1
C STOP !MT000225-1
C END SELECT !MT000225-1
C
C Calculo del angulo interior
C
CALL ANGULO(A1,Na(1),Na(2))
CALL ANGULO(A2,Nd(1),Nd(2))
IF(A2.LT.A1) THEN
A2=A2+2.d0*PI
END IF
TETA=A2-A1
C
C Calculo de la matriz GIJ basica
C Incognitas del nodo: u1,u2,t1a(*D/E),t2a(*D/E),t1d(*D/E),t2d(*D/E)
C Variables del nodo: u1a,u2a,u1d,u2d,t1a,t2a,t1d,t2d,u1,u2
C
DO i = 1 , 6
DO j = 1 ,10
GIJ(i,j)=0.d0
END DO
END DO
GIJ(1,1) = Na(1)
GIJ(1,2) =-Na(2)
GIJ(1,3) = Nd(1)
GIJ(1,4) =-Nd(2)
GIJ(2,1) = Na(2)
GIJ(2,2) = Na(1)
GIJ(2,3) = Nd(2)
GIJ(2,4) = Nd(1)
GIJ(1,9) = 1.d0
GIJ(2,10)= 1.d0
GIJ(3,5) = 1.d0
GIJ(4,6) = 1.d0
GIJ(5,7) = 1.d0
GIJ(6,8) = 1.d0
C
C CONDICIONES DE CONTORNO
C
SELECT CASE(NOD.CBC(1))
C
CASE(11)
C tt-tt
NOD.NBC=4
NOD.NINC=2
NOD.VAR(1)=9
NOD.VAR(2)=10
NOD.BC(1)=5
NOD.BC(2)=6
NOD.BC(3)=7
NOD.BC(4)=8
C
CASE(12)
C tt-uu
NOD.NBC=4
NOD.NINC=2
NOD.VAR(1)=7
NOD.VAR(2)=8
NOD.BC(1)=3
NOD.BC(2)=4
NOD.BC(3)=5
NOD.BC(4)=6
C
CASE(13)
C tt-ut
NOD.NBC=4
NOD.NINC=2
NOD.VAR(1)=4
NOD.VAR(2)=7
NOD.BC(1)=3
NOD.BC(2)=5
NOD.BC(3)=6
NOD.BC(4)=8
C
CASE(14)
C tt-tu
NOD.NBC=4
NOD.NINC=2
NOD.VAR(1)=3
NOD.VAR(2)=8
NOD.BC(1)=4
NOD.BC(2)=5
NOD.BC(3)=6
NOD.BC(4)=7
C
CASE(21)
C uu-tt
NOD.NBC=4
NOD.NINC=2
NOD.VAR(1)=5
NOD.VAR(2)=6
NOD.BC(1)=1
NOD.BC(2)=2
NOD.BC(3)=7
NOD.BC(4)=8
C
CASE(22)
C uu-uu
SELECT CASE(NOD.CBC(2))
CASE(0)
NOD.NBC=2
NOD.NINC=4
NOD.VAR(1)=5
NOD.VAR(2)=6
NOD.VAR(3)=7
NOD.VAR(4)=8
NOD.BC(1)=1
NOD.BC(2)=2
CASE(1)
NOD.NBC=2
NOD.NINC=2
NOD.VAR(1)=5
NOD.VAR(2)=6
NOD.BC(1)=1
NOD.BC(2)=2
CASE DEFAULT
WRITE(F_W,04114) NOD.NUM,(NOD.CBC(i),i=1,N_MAX_CODBC)
WRITE (*,04114) NOD.NUM,(NOD.CBC(i),i=1,N_MAX_CODBC)
STOP
END SELECT
C
CASE(23)
C uu-ut
NOD.NBC=3
NOD.NINC=3
NOD.VAR(1)=5
NOD.VAR(2)=6
NOD.VAR(3)=7
NOD.BC(1)=1
NOD.BC(2)=2
NOD.BC(3)=8
C Hay que eliminar u1d de las cdc
NOD.VBC(3)=NOD.VBC(4)
C
CASE(24)
C uu-tu
NOD.NBC=3
NOD.NINC=3
NOD.VAR(1)=5
NOD.VAR(2)=6
NOD.VAR(3)=8
NOD.BC(1)=1
NOD.BC(2)=2
NOD.BC(3)=7
C Hay que eliminar u2d de las cdc
NOD.VBC(3)=NOD.VBC(4)
C
CASE(31)
C ut-tt
NOD.NBC=4
NOD.NINC=2
NOD.VAR(1)=2
NOD.VAR(2)=5
NOD.BC(1)=1
NOD.BC(2)=6
NOD.BC(3)=7
NOD.BC(4)=8
C
CASE(32)
C ut-uu
NOD.NBC=3
NOD.NINC=3
NOD.VAR(1)=5
NOD.VAR(2)=7
NOD.VAR(3)=8
NOD.BC(1)=3
NOD.BC(2)=4
NOD.BC(3)=6
C Hay que eliminar u1a de las cdc
NOD.VBC(1)=NOD.VBC(2)
NOD.VBC(2)=NOD.VBC(3)
NOD.VBC(3)=NOD.VBC(4)
C
CASE(33)
C ut-ut
D=Na(2)*Nd(1)-Na(1)*Nd(2)
C
SELECT CASE(NOD.CBC(2))
CASE(0)
IF(DABS(D).LT.1E-15)THEN
NOD.NBC=3
NOD.NINC=3
NOD.VAR(1)=2
NOD.VAR(2)=5
NOD.VAR(3)=7
NOD.BC(1)=1
NOD.BC(2)=6
NOD.BC(3)=8
C Hay que eliminar u1d de las cdc
NOD.VBC(2)=NOD.VBC(3)
NOD.VBC(3)=NOD.VBC(4)
ELSE
C Elementos no alineados
NOD.NBC=4
NOD.NINC=2
NOD.VAR(1)=5
NOD.VAR(2)=7
NOD.BC(1)=1
NOD.BC(2)=2
NOD.BC(3)=6
NOD.BC(4)=8
C Hay que calcular u2a
NOD.VBC(2)=(( Nd(1)*Na(1)+Nd(2)*Na(2))*NOD.VBC(1)+
@ (-Nd(1)*Nd(1)-Nd(2)*Nd(2))*NOD.VBC(2))/D
END IF
CASE(1)
C Elementos alineados
NOD.NBC=2
NOD.NINC=2
NOD.VAR(1)=2
NOD.VAR(2)=5
NOD.BC(1)=1
NOD.BC(2)=6
C Hay que eliminar u1d de las cdc
NOD.VBC(2)=NOD.VBC(3)
CASE DEFAULT
WRITE(F_W,04114) NOD.NUM,(NOD.CBC(i),i=1,N_MAX_CODBC)
WRITE (*,04114) NOD.NUM,(NOD.CBC(i),i=1,N_MAX_CODBC)
STOP
END SELECT
C
CASE(34)
C ut-tu
D=Na(1)*Nd(1)+Na(2)*Nd(2)
C
IF(DABS(D).LT.1E-15)THEN
C Elementos en angulo recto
NOD.NBC=3
NOD.NINC=3
NOD.VAR(1)=2
NOD.VAR(2)=5
NOD.VAR(3)=8
NOD.BC(1)=1
NOD.BC(2)=6
NOD.BC(3)=7
C Hay que eliminar u2d de las cdc
NOD.VBC(2)=NOD.VBC(3)
NOD.VBC(3)=NOD.VBC(4)
ELSE
C Elementos en angulo no recto
NOD.NBC=4
NOD.NINC=2
NOD.VAR(1)=5
NOD.VAR(2)=8
NOD.BC(1)=1
NOD.BC(2)=2
NOD.BC(3)=6
NOD.BC(4)=7
C Hay que calcular u2a
NOD.VBC(2)=(( Nd(2)*Na(1)-Nd(1)*Na(2))*NOD.VBC(1)+
@ ( Nd(2)*Nd(2)+Nd(1)*Nd(1))*NOD.VBC(2))/D
END IF
C
CASE(41)
C tu-tt
NOD.NBC=4
NOD.NINC=2
NOD.VAR(1)=1
NOD.VAR(2)=6
NOD.BC(1)=2
NOD.BC(2)=5
NOD.BC(3)=7
NOD.BC(4)=8
C
CASE(42)
C tu-uu
NOD.NBC=3
NOD.NINC=3
NOD.VAR(1)=6
NOD.VAR(2)=7
NOD.VAR(3)=8
NOD.BC(1)=3
NOD.BC(2)=4
NOD.BC(3)=5
C Hay que eliminar u2a de las cdc
NOD.VBC(1)=NOD.VBC(2)
NOD.VBC(2)=NOD.VBC(3)
NOD.VBC(3)=NOD.VBC(4)
C
CASE(43)
C tu-ut
D=-Na(1)*Nd(1)-Na(2)*Nd(2)
C
IF(DABS(D).LT.1E-15)THEN
C Elementos en angulo recto
NOD.NBC=3
NOD.NINC=3
NOD.VAR(1)=1
NOD.VAR(2)=6
NOD.VAR(3)=7
NOD.BC(1)=2
NOD.BC(2)=5
NOD.BC(3)=8
C Hay que eliminar u1d de las cdc
NOD.VBC(2)=NOD.VBC(3)
NOD.VBC(3)=NOD.VBC(4)
ELSE
C Elementos en angulo no recto
NOD.NBC=4
NOD.NINC=2
NOD.VAR(1)=6
NOD.VAR(2)=7
NOD.BC(1)=1
NOD.BC(2)=2
NOD.BC(3)=5
NOD.BC(4)=8
C Hay que calcular u1a
D=((-Nd(1)*Na(2)+Nd(2)*Na(1))*NOD.VBC(1)+
@ (-Nd(1)*Nd(1)-Nd(2)*Nd(2))*NOD.VBC(2))/D
NOD.VBC(2)=NOD.VBC(1)
NOD.VBC(1)=D
END IF
C
CASE(44)
C tu-tu (codigos -> 2 4 5 7)
D=-Na(1)*Nd(2)+Na(2)*Nd(1)
C
SELECT CASE(NOD.CBC(2))
CASE(0)
IF(DABS(D).LT.1E-15)THEN
C Elementos alineados
NOD.NBC=3
NOD.NINC=3
NOD.VAR(1)=1
NOD.VAR(2)=6
NOD.VAR(3)=8
NOD.BC(1)=2
NOD.BC(2)=5
NOD.BC(3)=7
C Hay que eliminar u2d de las cdc
NOD.VBC(2)=NOD.VBC(3)
NOD.VBC(3)=NOD.VBC(4)
ELSE
C Elementos no alineados
NOD.NBC=4
NOD.NINC=2
NOD.VAR(1)=6
NOD.VAR(2)=8
NOD.BC(1)=1
NOD.BC(2)=2
NOD.BC(3)=5
NOD.BC(4)=7
C Hay que calcular u1a
D=((-Nd(2)*Na(2)-Nd(1)*Na(1))*NOD.VBC(1)+
@ (+Nd(2)*Nd(2)+Nd(1)*Nd(1))*NOD.VBC(2))/D
NOD.VBC(2)=NOD.VBC(1)
NOD.VBC(1)=D
END IF
CASE(1)
C Elementos alineados
NOD.NBC=2
NOD.NINC=2
NOD.VAR(1)=1
NOD.VAR(2)=6
NOD.BC(1)=2
NOD.BC(2)=5
C Hay que eliminar u2d de las cdc
NOD.VBC(2)=NOD.VBC(3)
CASE DEFAULT
WRITE(F_W,04114) NOD.NUM,(NOD.CBC(i),i=1,N_MAX_CODBC)
WRITE (*,04114) NOD.NUM,(NOD.CBC(i),i=1,N_MAX_CODBC)
STOP
END SELECT
C
xxxx CASE(15,55,51) !xx_muelle
C !xx_muelle
xxxx NOD.NBC=1 !xx_muelle
xxxx NOD.NINC=2 !xx_muelle
xxxx NOD.VAR(1)=9 !xx_muelle
xxxx NOD.VAR(2)=10 !xx_muelle
xxxx NOD.BC(1)=11 !xx_muelle
C Condiciones de apriete !xx_muelle
xxxx CALL CDC_MUELLE(Na,Nd,NOD.VBC,NOD.SOLU,NOD.CBC(1),GIJ) !xx_muelle
C
CASE DEFAULT
WRITE(F_W,04111) NOD.CBC(1)
WRITE (*,04111) NOD.CBC(1)
STOP
END SELECT
C
C CASOS DE CONTORNO SUAVE
C
IF(NOD.CBC(2).EQ.1)THEN
SELECT CASE(NOD.CBC(1))
CASE(11)
CONTINUE
CASE(22,33,44)
GIJ(5,5)=1.d0
GIJ(6,6)=1.d0
CASE DEFAULT
WRITE(F_W,04114) NOD.NUM,(NOD.CBC(i),i=1,N_MAX_CODBC)
WRITE (*,04114) NOD.NUM,(NOD.CBC(i),i=1,N_MAX_CODBC)
STOP
END SELECT
END IF
C
C ASIGNACION DE LAS INCOGNITAS DEL NODO
C
DO i = 1 , NOD.NINC
IF(I.LT.N_MAX_INC) THEN
NOD.INC(i)=cinc
cinc=cinc+1
ELSE
WRITE(F_W,04112)
WRITE(*,04112)
STOP
END IF
END DO
C
C CALCULO DE GIJ
C
DO i = 1 , 6
DO j = 1 , NOD.NINC
C
C Coeficientes que afectan a la matriz del sistema
C
SELECT CASE (NOD.VAR(j))
CASE(1,2,3,4,9,10)
NOD.Gij(i,j)=Gij(i,NOD.VAR(j))*MAT.D
CASE(5,6,7,8)
NOD.Gij(i,j)=Gij(i,NOD.VAR(j))*MAT.E
CASE DEFAULT
WRITE(F_W,04110) 3
WRITE (*,04110) 3
STOP
END SELECT
END DO
C
C Coeficientes que afectan al termino libre
C
C
DO j = 1 , NOD.NBC
SELECT CASE (NOD.BC(j))
CASE(1,2,3,4,5,6,7,8,9,10,11)
NOD.Gij(i,NOD.NINC+j)=Gij(i,NOD.BC(j))
CASE DEFAULT
WRITE(F_W,04110) 4
WRITE (*,04110) 4
STOP
END SELECT
END DO
END DO
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA
C
04110 FORMAT(/,2x,'ERROR 04110 - COND_CONT2 - Error Programa (#',
@ i1,'#)')
04111 FORMAT(/,2x,'ERROR 04111 - COND_CONT2',/,
@ ' Condicion de contorno (',i2,') no implementada.')
04112 FORMAT(/,2x,'ERROR 04112 - COND_CONT2',/,
@ ' Numero de incognitas del',
@ ' problema fuera del rango permitido.')
04113 FORMAT(/,2x,'ERROR 04113 - COND_CONT2',/,
@ ' Tipo de material ',i2,' no implementado.')
04114 FORMAT(/,2x,'ERROR 04114 - COND_CONT2 - Nodo :',i4,/,
@ ' Codigo erroneo de cdc:',4(i2,' '))
04115 FORMAT(/,2x,'ERROR 04115 - COND_CONT2',/,
@ ' Condicion de contorno (',i2,2(',',i2),
@ ') no implementada para contornos no rectilineos.')
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
