C Rutina 103
C----------------------------------------------COMPR_INCOMP_CIMP---
C
C SUBRUTINA COMPR_INCOMP_CIMP
C
C COMPROBACION DE INCOMPATIBILIDAD EN CONTACTO IMPERFECTO
C
SUBROUTINE COMPR_INCOMP_CIMP(CNOD,CBC1,FCALOR,D_FCALOR,D_DELTA,
@ LAMBDA,BC)
C
IMPLICIT NONE
C
INCLUDE '_param.for'
INCLUDE '_struct.for'
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES EXTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C CNOD : Nodo actual
INTEGER CNOD
C CBC1 : Condicion de contorno inicial
INTEGER CBC1
C FCALOR,D_FCALOR : Flujo de calor
REAL*8 FCALOR,D_FCALOR
C D_DELTA : diferencia de temperaturas entre sólidos A y B
REAL*8 D_DELTA
C LAMBDA : Coef. de pond. de la sol. del incr. de carga
REAL*8 LAMBDA
C BC : Condicion de contorno final
INTEGER BC
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C VARIABLES INTERNAS
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCC
C VALORES INICIALES
CCCCCCCCCCCCCCCCCCCCCCCCCC
C
CCCCCCCCCCCCCCC
C RUTINA
CCCCCCCCCCCCCCC
C
IF(FCALOR.EQ.0.d0)THEN
IF((D_DELTA*D_FCALOR).LT.0.d0)THEN
LAMBDA=0.d0
SELECT CASE(CBC1)
C
CASE(65,75,85)
BC=CBC1-1.d0
C
CASE(55)
BC=CBC1-11.d0
C
CASE(56,57,58)
BC=CBC1-10.d0
C
CASE DEFAULT
WRITE(F_W,11112) cnod,CBC1
WRITE (*,11112) cnod,CBC1
STOP
C
END SELECT
END IF
ELSE
SELECT CASE(CBC1)
C
CASE(65,75,85)
BC=CBC1-1.d0
C
CASE(55)
BC=CBC1-11.d0
C
CASE(56,57,58)
BC=CBC1-10.d0
C
CASE DEFAULT
WRITE(F_W,11112) cnod,CBC1
WRITE (*,11112) cnod,CBC1
STOP
C
END SELECT
END IF
C
C FIN DE LA RUTINA
C
RETURN
C
C FORMATOS DE ESCRITURA.
C
11110 FORMAT(/,2x,'ERROR 11110 - COMPR_INCOMP_CIMP - Error Programa',
@ ' (#',i1,'#)')
11112 FORMAT(/,2x,'ERROR 11002 - COMPR_INCOMP_CIMP',/,' Nodo: ',i4,
@ '. Cond. de contorno ',i2)
C
END
C
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
