C Rutina 032POT
C--------------------------------------------------COND_CONT_POT_A---
C
C SUBRUTINA COND_CONT_POT_A
C
C Esta subrutina se encarga de calcular la matriz GIJ,
C para cada nodo de los contornos 'a' de las distintas
C zonas de contacto.
C
SUBROUTINE COND_CONT_POT_A(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 GIJ2:Matriz para nodos de la zona de contacto
REAL*8 GIJ2(5,7)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C APLICACION DE LA CDC
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Para construir GIJ2 necesitamos RA y RD
C . 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 (65,75,48)
RA=1
RD=NOD.VBC(2)
CASE (56,57,84)
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
END SELECT
NOD.RT(1).R=RA
NOD.RT(2).R=RD
NOD.RT(1).TXT='Ra'
NOD.RT(2).TXT='Rd'
C
C Incognitas del nodo: T,Qa,Qd,da.dd
C Variables del nodo: T,Qa,Qd,Toa,Tod,da,dd
C
DO i = 1 , 5
DO j = 1 ,7
GIJ2(i,j)=0.d0
END DO
END DO
GIJ2(1,1) = 1.d0
GIJ2(2,2) = 1.d0
GIJ2(3,3) = 1.d0
GIJ2(4,6) = 1
GIJ2(5,7) = 1
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)
NOD.NINC=5
NOD.VAR(1)=1
NOD.VAR(2)=2
NOD.VAR(3)=3
NOD.VAR(4)=6
NOD.VAR(5)=7
NOD.NBC=0
CASE(44,55,66,77,88)
C cont-cont
SELECT CASE (NOD.CBC(2))
CASE (1)
NOD.NINC=3
NOD.VAR(1)=1
NOD.VAR(2)=2
NOD.VAR(3)=6
NOD.NBC=0
CASE (0)
NOD.NINC=5
NOD.VAR(1)=1
NOD.VAR(2)=2
NOD.VAR(3)=3
NOD.VAR(4)=6
NOD.VAR(5)=7
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(casos (44/55/66/77/88))
C (para los casos 44,55 continuidad de q y de d)
C
IF(NOD.CBC(2).EQ.1)THEN
SELECT CASE(NOD.CBC(1))
CASE(44,55,66,77,88)
GIJ2(3,2)=1.d0
GIJ2(5,6)=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
C CALCULO DE LA MATRIZ GIJ2
C
DO i = 1 , 5
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)=Gij2(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_A - Error Programa
@ (#',i1,'#)')
04111 FORMAT(/,2x,'ERROR 04111 - COND_CONT_POT_A',/,
@ ' Condicion de contorno (',i2,') no implementada.')
04112 FORMAT(/,2x,'ERROR 04112 - COND_CONT_POT_A',/,
@ ' Numero de incognitas del',
@ ' problema fuera del rango permitido.')
04113 FORMAT(/,2x,'ERROR 04113 - COND_CONT_POT_A',/,
@ ' Tipo de material ',i2,' no implementado.')
04114 FORMAT(/,2x,'ERROR 04114 - COND_CONT_POT_A - Nodo :',i4,/,
@ ' Codigo erroneo de cdc:',4(i2,' '))
04115 FORMAT(/,2x,'ERROR 04115 - COND_CONT_POT_A',/,
@ ' Condicion de contorno (',i2,2(',',i2),
@ ') no implementada para contornos no rectilineos.')
04116 FORMAT(/,2x,'ERROR 04116 - COND_CONT_POT_A - Nodo :',i4)
04117 FORMAT(/,2x,'ERROR 04117 - COND_CONT_POT_A - Nodo :',i4,/,
@ ' Codigo erroneo de cdc:',4(i2,' '))
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
