C Rutina 032
C----------------------------------------------------------COND_CONT_POT_B---
C
C SUBRUTINA COND_CONT_POT_B
C
C CALCULO DE LAS GIJ (Condicion de contorno) EN EL NODO k
C (NODO 2D EXTREMO DE UN ELEMENTO LINEAL CONTINUO)
C PROBLEMA POTENCIAL PLANO(INCLUYE EL CONTACTO)
C
SUBROUTINE COND_CONT_POT_B(NOD,CINC)
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 CINC : Contador del numero de incognitas
INTEGER CINC
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C NOD.VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C I,J :Contadores
INTEGER I,J
C RA,RD : Resistencia antes y resistencia después
REAL*8 RA,RD
C GIJ1:Matriz si el nodo no es de contacto,
C (tambien sirve para los contornos'b').
REAL*8 GIJ1(3,3)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C APLICACION DE LA CDC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Para construir GIJ necesitamos RA y RD en el nodo
C que valen 0(porque ni siquiera se leen) en los casos
C 64,46,74,47,44. Para evitar indeterminaciones 1/0 en la
C matriz Gij procedemos como sigue:
C
SELECT CASE (NOD.CBC(1))
CASE (64,46,74,47,44)
RA=1
RD=1
CASE (48)
RA=1
RD=NOD.VBC(2)
CASE (84)
RA=NOD.VBC(2)
RD=1
C
C ********************************************************
C Casos de contacto imperfecto: 65,75,56,57,55,58,85.
C Si el contorno es de contacto tipo "B" no influirán en
C la solución pues es el contorno de contacto tipo "A"
C el que gobierna el contacto.
C ********************************************************
C
CASE (65,75)
RA=1
RD=NOD.VBC(2)
CASE (56,57)
RA=NOD.VBC(2)
RD=1
CASE (55)
SELECT CASE (NOD.CBC(2))
CASE (1)
RA=NOD.VBC(1)
RD=NOD.VBC(1)
CASE (0)
RA=NOD.VBC(1)
RD=NOD.VBC(2)
CASE DEFAULT
WRITE(F_W,04114) NOD.CBC(2)
WRITE (*,04114) NOD.CBC(2)
STOP
END SELECT
CASE (85,58)
RA=NOD.VBC(2)
RD=NOD.VBC(3)
CASE (66,67,76,77)
RA=1
RD=1
CASE (68,78)
RA=1
RD=NOD.VBC(3)
CASE (86,87)
RA=NOD.VBC(3)
RD=1
CASE (88)
SELECT CASE (NOD.CBC(2))
CASE (0)
RA=NOD.VBC(3)
RD=NOD.VBC(4)
CASE (1)
RA=NOD.VBC(3)
RD=NOD.VBC(3)
END SELECT
CASE DEFAULT
WRITE(F_W,04111) NOD.CBC(1)
WRITE (*,04111) NOD.CBC(1)
STOP
C
C ********************************************************
C
END SELECT
NOD.RT(1).R=RA
NOD.RT(2).R=RD
NOD.RT(1).TXT='Ra'
NOD.RT(2).TXT='Rd'
C
C Calculo de la matriz GIJ1 basica
C Incognitas del nodo: T,Qa,Qd
C Variables del nodo: T,Qa,Qd,Toa,Tod
C
DO i = 1 , 3
DO j = 1 ,3
GIJ1(i,j)=0.d0
END DO
GIJ1(i,i)=1.d0
END DO
C
C
C CONDICIONES DE CONTORNO
C
SELECT CASE(NOD.CBC(1))
C
CASE(64,65,74,75,84,85,46,56,47,57,48,58,67,68,76,78,86,87)
C T-cont
NOD.NINC=3
NOD.VAR(1)=1
NOD.VAR(2)=2
NOD.VAR(3)=3
NOD.NBC=0
CASE(44,55,66,77,88)
C cont-cont
SELECT CASE (NOD.CBC(2))
CASE (1)
NOD.NINC=2
NOD.VAR(1)=1
NOD.VAR(2)=2
NOD.NBC=0
CASE (0)
NOD.NINC=3
NOD.VAR(1)=1
NOD.VAR(2)=2
NOD.VAR(3)=3
NOD.NBC=0
CASE DEFAULT
WRITE(F_W,04114) NOD.NUM,(NOD.CBC(i),i=1,N_MAX_CODBCPOT)
WRITE (*,04114) NOD.NUM,(NOD.CBC(i),i=1,N_MAX_CODBCPOT)
STOP
END SELECT
C
CASE DEFAULT
WRITE(F_W,04111) NOD.CBC(1)
WRITE (*,04111) NOD.CBC(1)
STOP
END SELECT
C
C CASOS DE CONTORNO SUAVE 44,55,66,77,88
C
IF(NOD.CBC(2).EQ.1)THEN
SELECT CASE(NOD.CBC(1))
CASE(44,55,66,77,88)
GIJ1(3,2)=1.d0
CASE(64,65,74,75,84,85,46,56,47,57,48,58,67,68,76,78,86,87)
CONTINUE
CASE DEFAULT
WRITE(F_W,04114) NOD.NUM,(NOD.CBC(i),i=1,N_MAX_CODBCPOT)
WRITE (*,04114) NOD.NUM,(NOD.CBC(i),i=1,N_MAX_CODBCPOT)
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 LA MATRIZ GIJ1
C
DO i = 1 , 3
C
C Coeficientes que afectan a la matriz del sistema
C
SELECT CASE (NOD.CBC(1))
CASE(64,65,74,75,84,85,46,56,47,57,48,58,67,68,76,78,
@ 86,87,44,55,66,77,88)
DO j = 1 , NOD.NINC
NOD.Gij(i,j)=Gij1(i,NOD.VAR(j))
END DO
CASE DEFAULT
WRITE(F_W,04110) 5
WRITE (*,04110) 5
STOP
END SELECT
END DO
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA
C
04110 FORMAT(/,2x,
@ 'ERROR 04110 - COND_CONT_POT_B - Error Programa (#',i1,'#)')
04111 FORMAT(/,2x,'ERROR 04111 - COND_CONT_POT_B',/,
@ ' Condicion de contorno (',i2,') no implementada.')
04112 FORMAT(/,2x,'ERROR 04112 - COND_CONT_POT_B',/,
@ ' Numero de incognitas del',
@ ' problema fuera del rango permitido.')
04113 FORMAT(/,2x,'ERROR 04113 - COND_CONT_POT_B',/,
@ ' Tipo de material ',i2,' no implementado.')
04114 FORMAT(/,2x,'ERROR 04114 - COND_CONT_POT_B - Nodo :',i4,/,
@ ' Codigo erroneo de cdc:',4(i2,' '))
04115 FORMAT(/,2x,'ERROR 04115 - COND_CONT_POT_B',/,
@ ' Condicion de contorno (',i2,2(',',i2),
@ ') no implementada para contornos no rectilineos.')
04116 FORMAT(/,2x,'ERROR 04116 - COND_CONT_POT_B - Nodo :',i4)
04117 FORMAT(/,2x,'ERROR 04117 - COND_CONT_POT_B - Nodo :',i4,/,
@ ' Codigo erroneo de cdc:',4(i2,' '))
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
