C Rutina 032
C----------------------------------------------------------COND_CONT_POT_NORMAL---
C
C SUBRUTINA COND_CONT_POT_NORMAL
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_NORMAL(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,8)
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 66,67,76,77. Para evitar indeterminaciones 1/0 en la
C matriz Gij procedemos como sigue:
C
SELECT CASE (NOD.CBC(1))
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
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 ,8
GIJ1(i,j)=0.d0
END DO
GIJ1(i,i)=1.d0
END DO
GIJ1(1,4) = 1.d0
GIJ1(1,5) = 1.d0
GIJ1(1,8) = 1.d0
GIJ1(2,4) = 1.d0/RA
GIJ1(2,6) =-1.d0/RA
GIJ1(2,8) = 1.d0/RA
GIJ1(3,5) = 1.d0/RD
GIJ1(3,7) =-1.d0/RD
GIJ1(3,8) = 1.d0/RD
C
C
C CONDICIONES DE CONTORNO
C
SELECT CASE(NOD.CBC(1))
C
CASE(66)
C T-T
SELECT CASE (NOD.CBC(2))
CASE (0)
NOD.NINC=2
NOD.VAR(1)=2
NOD.VAR(2)=3
NOD.NBC=1
NOD.BC(1)=1
CASE (1)
NOD.NINC=1
NOD.VAR(1)=2
NOD.NBC=1
NOD.BC(1)=1
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(67)
C T-Q
NOD.NINC=1
NOD.VAR(1)=2
NOD.NBC=2
NOD.BC(1)=1
NOD.BC(2)=3
C
CASE(68)
C T-R
NOD.NINC=1
NOD.VAR(1)=2
NOD.NBC=2
NOD.BC(1)=1
NOD.BC(2)=3
C Hay que calcular Qd
NOD.VBC(2)=(NOD.VBC(1)-NOD.VBC(2))/NOD.VBC(3)
CASE(76)
C T-Q
NOD.NINC=1
NOD.VAR(1)=3
NOD.NBC=2
NOD.BC(1)=1
NOD.BC(2)=2
CASE(77)
C Q-Q
SELECT CASE (NOD.CBC(2))
CASE (0)
NOD.NINC=1
NOD.VAR(1)=1
NOD.NBC=2
NOD.BC(1)=2
NOD.BC(2)=3
CASE (1)
NOD.NINC=1
NOD.VAR(1)=1
NOD.NBC=1
NOD.BC(1)=2
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
CASE(78)
C Q-R
NOD.NINC=1
NOD.VAR(1)=1
NOD.NBC=2
NOD.BC(1)=2
NOD.BC(2)=5
CASE(86)
C R-T
NOD.NINC=1
NOD.VAR(1)=3
NOD.NBC=2
NOD.BC(1)=1
NOD.BC(2)=2
C Hay que calcular Qa
NOD.VBC(2)=(NOD.VBC(1)-NOD.VBC(2))/NOD.VBC(3)
CASE(87)
C R-Q
NOD.NINC=1
NOD.VAR(1)=1
NOD.NBC=2
NOD.BC(1)=3
NOD.BC(2)=4
CASE(88)
C R-R
SELECT CASE (NOD.CBC(2))
CASE (0)
NOD.NINC=1
NOD.VAR(1)=1
NOD.NBC=2
NOD.BC(1)=4
NOD.BC(2)=5
CASE (1)
NOD.NINC=1
NOD.VAR(1)=1
NOD.NBC=1
NOD.BC(1)=4
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(casos 66,77,88)
C
IF(NOD.CBC(2).EQ.1)THEN
SELECT CASE(NOD.CBC(1))
CASE(66,77)
GIJ1(3,2)=1.d0
GIJ1(2,3)=1.d0
CASE(88)
GIJ1(3,6)=-1.d0/RD
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('no contacto')
C
DO i = 1 , 3
C
C Coeficientes que afectan a la matriz del sistema
C
SELECT CASE (NOD.CBC(1))
CASE(66,67,68,76,77,86)
DO j = 1 , NOD.NINC
NOD.Gij(i,j)=Gij1(i,NOD.VAR(j))
END DO
CASE(78)
NOD.Gij(i,1)=Gij1(i,5)
CASE(87)
NOD.Gij(i,1)=Gij1(i,4)
CASE(88)
NOD.Gij(i,1)=Gij1(i,8)
CASE DEFAULT
WRITE(F_W,04110) 3
WRITE (*,04110) 3
STOP
END SELECT
C
C Coeficientes que afectan al termino libre
C
C
SELECT CASE (NOD.CBC(1))
CASE(66,67,68,76,77,86)
DO j = 1 , NOD.NBC
NOD.Gij(i,NOD.NINC+j)=Gij1(i,NOD.BC(j))
END DO
CASE(78)
NOD.Gij(i,NOD.NINC+1)=Gij1(i,NOD.BC(1))
NOD.Gij(i,NOD.NINC+2)=Gij1(i,7)
CASE(87)
NOD.Gij(i,NOD.NINC+1)=Gij1(i,NOD.BC(1))
NOD.Gij(i,NOD.NINC+2)=Gij1(i,6)
CASE(88)
SELECT CASE(NOD.CBC(2))
CASE(0)
NOD.Gij(i,NOD.NINC+1)=Gij1(i,6)
NOD.Gij(i,NOD.NINC+2)=Gij1(i,7)
CASE(1)
NOD.Gij(i,NOD.NINC+1)=Gij1(i,6)
CASE DEFAULT
WRITE(F_W,04110) 4
WRITE (*,04110) 4
STOP
END SELECT
CASE DEFAULT
WRITE(F_W,04110) 3
WRITE (*,04110) 3
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_NORMAL - Error Programa (#',i1,'#)')
04111 FORMAT(/,2x,'ERROR 04111 - COND_CONT_POT_NORMAL',/,
@ ' Condicion de contorno (',i2,') no implementada.')
04112 FORMAT(/,2x,'ERROR 04112 - COND_CONT_POT_NORMAL',/,
@ ' Numero de incognitas del',
@ ' problema fuera del rango permitido.')
04113 FORMAT(/,2x,'ERROR 04113 - COND_CONT_POT_NORMAL',/,
@ ' Tipo de material ',i2,' no implementado.')
04114 FORMAT(/,2x,'ERROR 04114 - COND_CONT_POT_NORMAL - Nodo :',i4,/,
@ ' Codigo erroneo de cdc:',4(i2,' '))
04115 FORMAT(/,2x,'ERROR 04115 - COND_CONT_POT_NORMAL',/,
@ ' Condicion de contorno (',i2,2(',',i2),
@ ') no implementada para contornos no rectilineos.')
04116 FORMAT(/,2x,'ERROR 04116 - COND_CONT_POT_NORMAL - Nodo :',i4)
04117 FORMAT(/,2x,'ERROR 04117 - COND_CONT_POT_NORMAL - Nodo :',i4,/,
@ ' Codigo erroneo de cdc:',4(i2,' '))
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
