C Rutina
C------------------------------------------------------CALCULAL---
C
SUBROUTINE CALCULAL(MAT)
C
C ESTA RUTINA ASIGNA LAS CONSTANTES Ki (CONDUCTIVIDADES) A LA
C ESTRUCTURA DE PROPIEDADES DEL MATERIAL
C
IMPLICIT NONE
INCLUDE '_PARAM.FOR'
INCLUDE '_STRUCT.FOR'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES EXTERNAS (ENTRADA)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C MAT : Material
RECORD /S_material/ MAT
C
CCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C RADCDO : Radicando
REAL*8 RADCDO
C
CCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCC
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCC
C RUTINA
CCCCCCCCCCCCCCCCCCCCCCCCCC
C
C Deteccion de error en el material:
C Combinacion incorrecta de K11,K12=K21 y K22
C
RADCDO=(MAT.PRP(1)-MAT.PRP(3))**2.d0+4.d0*MAT.PRP(2)**2.d0
IF (RADCDO.LT.0.d0) THEN
WRITE(F_W,09111)
WRITE(*,09111)
STOP
END IF
C
C Fin de detección de error
C
MAT.MAPOT.K1=(MAT.PRP(1)+MAT.PRP(3) + DSQRT(RADCDO))/2.d0
IF (MAT.MAPOT.K1.LT.0.d0) THEN
WRITE(F_W,09112)
WRITE(*,09112)
STOP
END IF
MAT.MAPOT.K2=(MAT.PRP(1)+MAT.PRP(3) - DSQRT(RADCDO))/2.d0
IF (MAT.MAPOT.K2.LT.0.d0) THEN
WRITE(F_W,09112)
WRITE(*,09112)
STOP
END IF
IF (MAT.PRP(2).NE.0.d0) THEN
MAT.MAPOT.ALFA=datan((MAT.PRP(1)-MAT.PRP(3)-DSQRT(RADCDO))
@ /(-2.d0*MAT.PRP(2)))
MAT.MAPOT.L(1,1)= DCOS(MAT.MAPOT.ALFA)/DSQRT(MAT.MAPOT.K1)
MAT.MAPOT.L(2,2)= DCOS(MAT.MAPOT.ALFA)/DSQRT(MAT.MAPOT.K2)
MAT.MAPOT.L(1,2)= DSIN(MAT.MAPOT.ALFA)/DSQRT(MAT.MAPOT.K1)
MAT.MAPOT.L(2,1)= -DSIN(MAT.MAPOT.ALFA)/DSQRT(MAT.MAPOT.K2)
MAT.MAPOT.DETL=1/(DSQRT(MAT.MAPOT.K1*MAT.MAPOT.K2))
MAT.MAPOT.DETK=MAT.MAPOT.K1*MAT.MAPOT.K2
ELSE
MAT.MAPOT.L(1,1)= 1.d0/DSQRT(MAT.MAPOT.K1)
MAT.MAPOT.L(2,2)= 1.d0/DSQRT(MAT.MAPOT.K2)
MAT.MAPOT.L(1,2)= 0.d0
MAT.MAPOT.L(2,1)= 0.d0
MAT.MAPOT.DETL=1/(DSQRT(MAT.MAPOT.K1*MAT.MAPOT.K2))
MAT.MAPOT.DETK=MAT.MAPOT.K1*MAT.MAPOT.K2
END IF
C
C FORMATOS DE ESCRITURA
C
09111 FORMAT(/,2x,'ERROR 09111 - CALCULAL - Combinación incorrecta '
@ 'de K11,K12=K21 y K22. ')
09112 FORMAT(/,2x,'ERROR 09111 - CALCULAL - Las conductividades ppales '
@ 'salen negativas. ')
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
