Download dpsat.eso

Back to the list

   1 : C DPSAT     SOURCE    CHAT      05/01/12    22:55:01     5004           
   2 :       SUBROUTINE DPSAT
   3 : C
   4 : C--------------------------------------------------------------------
   5 : C Fonction derivee de la pression partielle de vapeur à saturation
   6 : C par rapport a la temperature
   7 : C--------------------------------------------------------------------
   8 : C Les données d'entrée sont des CHPOINT, des FLOTTANT ou des LISTREEL
   9 : C Le résultat est du meme type que les input.
  10 : C--------------------------------------------------------------------
  11 : C
  12 : C---------------------------
  13 : C Phrase d'appel (GIBIANE) :
  14 : C---------------------------
  15 : C
  16 : C OBJ3 = VARI 'DPSAT' OBJ1 ;
  17 : C
  18 : C------------------------
  19 : C Opérandes et résultat :
  20 : C------------------------
  21 : C
  22 : C  OBJ1 : Temperature à saturation (en K)
  23 : C  OBJ3 : Derivee de la pression partielle de vapeur à saturation
  24 : C         par rapport a la temperature (Pa/K)
  25 : C------------------------------------------------------------------
  26 :       IMPLICIT INTEGER(I-N)
  27 :       IMPLICIT REAL*8 (A-H,O-Z)                 
  28 :       CHARACTER*8 TYPE
  29 :       CHARACTER*4 NOMTOT(1)
  30 : C
  31 : -INC SMCHPOI
  32 : -INC SMLREEL
  33 : C
  34 :       IFLAG = 0
  35 : C
  36 : C- Lecture et controles des données d'entrée,
  37 : C- Création de la structure chapeau pour la donnée de sortie
  38 : C
  39 : C- Gestion des ERREURS
  40 : C  21 -> Données incompatibles
  41 : C  19 -> Option indisponible
  42 : C
  43 : C CHPOINT
  44 : C
  45 :       TYPE  = 'CHPOINT '
  45 :       CALL LIROBJ(TYPE,MCHPO1,0,IRETOU)
  46 :       IF (IRETOU.EQ.0) GOTO 10
  47 : C
  48 :       SEGACT MCHPO1
  49 :       NSOUP1 = MCHPO1.IPCHP(/1)
  50 :       MSOUP1 = MCHPO1.IPCHP(1)
  51 :       SEGACT MSOUP1
  52 :       NC1    = MSOUP1.NOHARM(/1)
  53 : C
  54 :       IF (NSOUP1.NE.1) IFLAG=2
  55 :       IF (NC1.NE.1) IFLAG=4
  56 :       IF (IFLAG.NE.0) THEN
  56 :          CALL ERREUR(21)
  57 :          RETURN
  58 :       ENDIF
  59 : C
  60 :       MPOVA1 = MSOUP1.IPOVAL
  61 :       SEGACT MPOVA1
  62 :       SEGINI, MCHPO3=MCHPO1
  63 :       SEGINI, MSOUP3=MSOUP1
  64 :       SEGINI, MPOVA3=MPOVA1
  65 :       MCHPO3.IPCHP(1) = MSOUP3
  66 :       MSOUP3.IPOVAL   = MPOVA3
  67 :       SEGDES MCHPO1,MCHPO3,MSOUP1,MSOUP3
  67 :       CALL DPSAT1(MPOVA1,MPOVA3)
  68 :       SEGDES MPOVA1,MPOVA3
  68 :       CALL ECROBJ(TYPE,MCHPO3)
  69 :       RETURN
  70 : C
  71 : C FLOTTANT
  72 : C
  73 :  10   CONTINUE
  73 :       CALL LIRREE(X1,0,IRETOU)
  74 :       IF (IRETOU.EQ.0) GOTO 20
  75 :       X3 = DPSAT0(X1)
  75 :       CALL ECRREE(X3)
  76 :       RETURN
  77 : C
  78 : C LISTREEL
  79 : C
  80 :  20   CONTINUE
  81 :       TYPE  = 'LISTREEL'
  81 :       CALL LIROBJ(TYPE,MLREE1,0,IRETOU)
  82 :       IF (IRETOU.EQ.0) GOTO 30
  83 :       SEGACT MLREE1
  84 :       SEGINI, MLREE3=MLREE1
  84 :       CALL DPSAT3(MLREE1,MLREE3)
  85 :       SEGDES MLREE1,MLREE3
  85 :       CALL ECROBJ(TYPE,MLREE3)
  86 :       RETURN
  87 : C
  88 : C Autres
  89 : C
  90 :  30   CONTINUE
  90 :       CALL ERREUR(19)
  91 :       RETURN
  92 :       END
  93 :  
  94 :  
  95 :  

© Cast3M 2003 - All rights reserved.
Disclaimer