C PSATT     SOURCE    CB215821  20/11/25    13:37:48     10792          
      SUBROUTINE PSATT
C
C--------------------------------------------------------------------
C Pression partielle de vapeur à saturation pour une température donnée
C--------------------------------------------------------------------
C Les données d'entrée sont des CHPOINT, des FLOTTANT ou des LISTREEL
C Le résultat est du meme type que les input.
C--------------------------------------------------------------------
C
C---------------------------
C Phrase d'appel (GIBIANE) :
C---------------------------
C
C OBJ3 = PSATT OBJ1 ;
C
C------------------------
C Opérandes et résultat :
C------------------------
C
C  OBJ1 : Temperature à saturation (en K)
C  OBJ3 : Pression partielle de vapeur à saturation (en Pa)
C
C-----------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      CHARACTER*8 TYPE
      CHARACTER*4 NOMTOT(1)
C
-INC SMCHPOI
-INC SMLREEL
C
      IFLAG = 0
C
C- Lecture et controles des données d'entrée,
C- Création de la structure chapeau pour la donnée de sortie
C
C- Gestion des ERREURS
C  21 -> Données incompatibles
C  19 -> Option indisponible
C
C CHPOINT
C
      TYPE  = 'CHPOINT '
      CALL LIROBJ(TYPE,MCHPO1,0,IRETOU)
      IF (IRETOU.EQ.0) GOTO 10
C
      SEGACT MCHPO1
      NSOUP1 = MCHPO1.IPCHP(/1)
      MSOUP1 = MCHPO1.IPCHP(1)
      SEGACT MSOUP1
      NC1    = MSOUP1.NOHARM(/1)
C
      IF (NSOUP1.NE.1) IFLAG=2
      IF (NC1.NE.1) IFLAG=4
      IF (IFLAG.NE.0) THEN
         CALL ERREUR(21)
         RETURN
      ENDIF
C
      MPOVA1 = MSOUP1.IPOVAL
      SEGACT MPOVA1
      SEGINI, MCHPO3=MCHPO1
      SEGINI, MSOUP3=MSOUP1
      SEGINI, MPOVA3=MPOVA1
      MCHPO3.IPCHP(1) = MSOUP3
      MSOUP3.IPOVAL   = MPOVA3
      SEGDES MCHPO1,MCHPO3,MSOUP1,MSOUP3
      CALL PSATT1(MPOVA1,MPOVA3)
      SEGDES MPOVA1,MPOVA3
      CALL ECROBJ(TYPE,MCHPO3)
      RETURN
C
C FLOTTANT
C
 10   CONTINUE
      CALL LIRREE(X1,0,IRETOU)
      IF (IRETOU.EQ.0) GOTO 20
      X3 = PSATT0(X1)
      CALL ECRREE(X3)
      RETURN
C
C LISTREEL
C
 20   CONTINUE
      TYPE  = 'LISTREEL'
      CALL LIROBJ(TYPE,MLREE1,0,IRETOU)
      IF (IRETOU.EQ.0) GOTO 30
      SEGACT MLREE1
      SEGINI, MLREE3=MLREE1
      CALL PSATT3(MLREE1,MLREE3)
      SEGDES MLREE1,MLREE3
      CALL ECROBJ(TYPE,MLREE3)
      RETURN
C
C Autres
C
 30   CONTINUE
      CALL ERREUR(19)
      RETURN
      END