C Rutina 032
C-------------------------------------------------------------COND_CONT1---
C
C SUBRUTINA COND_CONT1
C
C CALCULO DE LAS GIJ (Condicion de contorno) EN EL NODO k
C (NODO 2D EXTREMO DE UN ELEMENTO LINEAL CONTINUO)
C PROBLEMA AXISMETRICO 2D
C
SUBROUTINE COND_CONT1(NOD,Na,Nd,COD,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 COD : Cod=1 - Nodo normal
C Cod=2 - Nodo inicial (No existe k-1 => k nodo(1) del elto k)
C Cod=3 - Nodo final (No existe k+1 => k nodo(2) del elto k)
INTEGER COD
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
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
PI=DACOS(-1.d0)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C APLICACION DE LA CDC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Calculo de las "normales" anterior y posterior
C en nodos pertenecientes al eje de simetria.
C
IF(COD.EQ.2) THEN
Na(1)=-1.d0
Na(2)=0.d0
ELSE IF(COD.EQ.3) THEN
Nd(1)=-1.d0
Nd(2)=0.d0
END IF
C
CALL COND_CONT2(NOD,Na,Nd,CINC,MAT)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C CASO DE PUNTO PERTENECIENTE AL EJE
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Si el nodo es inicial o final forzosamente tiene que estar en R=0
C
IF(COD.EQ.2.OR.COD.EQ.3) THEN
C
C El nodo debe pertenecer al eje (R=0)
IF(NOD.XYZ(1).NE.0.d0) THEN
WRITE(F_W,04110) 1
WRITE (*,04110) 1
STOP
END IF
END IF
C
C NODO INICIAL. Hay que eliminar t2a de las incognitas
C Nota: No hace falta meter t2a en las
C cdc porque es nula
C
IF(COD.EQ.2) THEN
IF(NOD.CBC(1).NE.31.AND.NOD.CBC(1).NE.32.AND.
@ NOD.CBC(1).NE.33.AND.NOD.CBC(1).NE.34) THEN
WRITE(F_W,04114) NOD.NUM, (NOD.CBC(j),j=1,N_MAX_CODBC)
WRITE (*,04114) NOD.NUM, (NOD.CBC(j),j=1,N_MAX_CODBC)
STOP
END IF
c? IF(NOD.CBC(2).NE.0) THEN
c? WRITE(F_W,04114) NOD.NUM, (NOD.CBC(j),j=1,N_MAX_CODBC)
c? WRITE (*,04114) NOD.NUM, (NOD.CBC(j),j=1,N_MAX_CODBC)
c? STOP
c? END IF
i=1
DO WHILE(NOD.VAR(i).NE.5)
IF(i.EQ.NOD.NINC) THEN
WRITE(F_W,04110) 3
WRITE (*,04110) 3
STOP
END IF
i=i+1
END DO
NOD.INC(NOD.NINC)=0
NOD.NINC=NOD.NINC-1
cinc=cinc-1
DO WHILE(i.LE.NOD.NINC)
NOD.VAR(i)=NOD.VAR(i+1)
DO j=1,6
NOD.Gij(j,i)=NOD.Gij(j,i+1)
END DO
i=i+1
END DO
NOD.VAR(i)=0
DO WHILE(i.LE.(NOD.NINC+NOD.NBC))
DO j=1,6
NOD.Gij(j,i)=NOD.Gij(j,i+1)
END DO
i=i+1
END DO
END IF
C
C NODO FINAL. Hay que eliminar t2d de las incognitas
C Nota: No hace falta meter t2d en las
C cdc porque es nula
C
IF(COD.EQ.3) THEN
IF(NOD.CBC(1).NE.13.AND.NOD.CBC(1).NE.23.AND.
@ NOD.CBC(1).NE.33.AND.NOD.CBC(1).NE.43) THEN
WRITE(F_W,04114) NOD.NUM, (NOD.CBC(j),j=1,N_MAX_CODBC)
WRITE (*,04114) NOD.NUM, (NOD.CBC(j),j=1,N_MAX_CODBC)
STOP
END IF
x IF(NOD.CBC(2).NE.0) THEN
x WRITE(F_W,04114) NOD.NUM, (NOD.CBC(j),j=1,N_MAX_CODBC)
x WRITE (*,04114) NOD.NUM, (NOD.CBC(j),j=1,N_MAX_CODBC)
x STOP
x END IF
i=1
DO WHILE(NOD.VAR(i).NE.7)
IF(i.EQ.NOD.NINC) THEN
WRITE(F_W,04110) 3
WRITE (*,04110) 3
STOP
END IF
i=i+1
END DO
NOD.INC(NOD.NINC)=0
NOD.NINC=NOD.NINC-1
cinc=cinc-1
DO WHILE(i.LE.NOD.NINC)
NOD.VAR(i)=NOD.VAR(i+1)
DO j=1,6
NOD.Gij(j,i)=NOD.Gij(j,i+1)
END DO
i=i+1
END DO
NOD.VAR(i)=0
DO WHILE(i.LE.(NOD.NINC+NOD.NBC))
DO j=1,6
NOD.Gij(j,i)=NOD.Gij(j,i+1)
END DO
i=i+1
END DO
END IF
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA
C
04110 FORMAT(/,2x,'ERROR 04110 - COND_CONT1 - Error Programa (#',
@ i1,'#)')
04111 FORMAT(/,2x,'ERROR 04111 - COND_CONT1',/,
@ ' Condicion de contorno (',i2,') no implementada.')
04112 FORMAT(/,2x,'ERROR 04112 - COND_CONT1',/,
@ ' Numero de incognitas del',
@ ' problema fuera del rango permitido.')
04113 FORMAT(/,2x,'ERROR 04113 - COND_CONT1',/,
@ ' Tipo de material ',i2,' no implementado.')
04114 FORMAT(/,2x,'ERROR 04114 - COND_CONT1 - Nodo : ',i4,'.',/,
@ ' Codigo erroneo de cdc: ',3(i2,' '),'.')
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
