Sources Esope | Cast3M

ccgtau
C CCGTAU    SOURCE    GOUNAND   21/06/02    21:15:22     11022          
      SUBROUTINE CCGTAU(LCOF,
     $     FC,IKAS,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : CCGTAU
C DESCRIPTION : Calcul de la loi de comportement aux points de Gauss :
C               T(H) (enthalpie(temperature)+ chaleur latente
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          :
C APPELE PAR       :
C***********************************************************************
C ENTREES            :
C ENTREES/SORTIES    :
C SORTIES            : -
C TRAVAIL            :
C***********************************************************************
C VERSION    : v1, 02/12/04, version initiale
C HISTORIQUE : v1, 02/12/04, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
 
-INC PPARAM
-INC CCOPTIO
-INC TNLIN
*-INC SMCHAEL
      INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1
      POINTEUR FC.MCHEVA
      POINTEUR LCOF.LCHEVA
      POINTEUR T1.MCHEVA
      POINTEUR T2.MCHEVA
      POINTEUR T3.MCHEVA
      POINTEUR T4.MCHEVA
      POINTEUR T5.MCHEVA
*
      INTEGER IMPR,IRET
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ccgtau'
      NLFC=FC.WELCHE(/6)
      NPFC=FC.WELCHE(/5)
      T1=LCOF.LISCHE(1)
      T2=LCOF.LISCHE(2)
      T3=LCOF.LISCHE(3)
      T4=LCOF.LISCHE(4)
      T5=LCOF.LISCHE(5)
      NLC1=T1.WELCHE(/6)
      NPC1=T1.WELCHE(/5)
      NLC2=T2.WELCHE(/6)
      NPC2=T2.WELCHE(/5)
      NLC3=T3.WELCHE(/6)
      NPC3=T3.WELCHE(/5)
      NLC4=T4.WELCHE(/6)
      NPC4=T4.WELCHE(/5)
      NLC5=T5.WELCHE(/6)
      NPC5=T5.WELCHE(/5)
      DO ILFC=1,NLFC
         IF (NLC1.EQ.1) THEN
            ILC1=1
         ELSE
            ILC1=ILFC
         ENDIF
         IF (NLC2.EQ.1) THEN
            ILC2=1
         ELSE
            ILC2=ILFC
         ENDIF
         IF (NLC3.EQ.1) THEN
            ILC3=1
         ELSE
            ILC3=ILFC
         ENDIF
         IF (NLC4.EQ.1) THEN
            ILC4=1
         ELSE
            ILC4=ILFC
         ENDIF
         IF (NLC5.EQ.1) THEN
            ILC5=1
         ELSE
            ILC5=ILFC
         ENDIF
         DO IPFC=1,NPFC
            IF (NPC1.EQ.1) THEN
               IPC1=1
            ELSE
               IPC1=IPFC
            ENDIF
            IF (NPC2.EQ.1) THEN
               IPC2=1
            ELSE
               IPC2=IPFC
            ENDIF
            IF (NPC3.EQ.1) THEN
               IPC3=1
            ELSE
               IPC3=IPFC
            ENDIF
            IF (NPC4.EQ.1) THEN
               IPC4=1
            ELSE
               IPC4=IPFC
            ENDIF
            IF (NPC5.EQ.1) THEN
               IPC5=1
            ELSE
               IPC5=IPFC
            ENDIF
            XT1=T1.WELCHE(1,1,1,1,IPC1,ILC1)
            XT2=T2.WELCHE(1,1,1,1,IPC2,ILC2)
            XT3=T3.WELCHE(1,1,1,1,IPC3,ILC3)
            XT4=T4.WELCHE(1,1,1,1,IPC4,ILC4)
            XT5=T5.WELCHE(1,1,1,1,IPC5,ILC5)
            IF (IKAS.EQ.1) THEN
               H=XT1
               CS=XT2
               CL=XT3
               TM=XT4
               XL=XT5
               HS=CS*TM
               HL=HS+XL
               IF (H.LT.HS) THEN
                  XVAL=H/CS
               ELSEIF (H.GT.HL) THEN
                  XVAL=TM+((H-HS-XL)/CL)
               ELSE
                  XVAL=TM
               ENDIF
            ELSEIF (IKAS.EQ.2) THEN
               T=XT1
               CS=XT2
               CL=XT3
               TM=XT4
               XL=XT5
               IF (T.LT.TM) THEN
                  XVAL=T*CS
               ELSE
                  XVAL=(TM*CS)+XL+((T-TM)*CL)
               ENDIF
            ELSE
               WRITE(IOIMP,*) 'Erreur : IKAS=',IKAS
               GOTO 9999
            ENDIF
            FC.WELCHE(1,1,1,1,IPFC,ILFC)=XVAL
         ENDDO
      ENDDO
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine ccgtau'
      RETURN
*
* End of subroutine CCGTAU
*
      END