Télécharger la plaquette Cast3M


fr en

Télécharger dpsat.eso

Retour à la liste

Numérotation des lignes : 

dpsat

  1. C DPSAT     SOURCE    CB215821  20/11/25    13:25:55     10792          
  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 '
  46.       CALL LIROBJ(TYPE,MCHPO1,0,IRETOU)
  47.       IF (IRETOU.EQ.0) GOTO 10
  48. C
  49.       SEGACT MCHPO1
  50.       NSOUP1 = MCHPO1.IPCHP(/1)
  51.       MSOUP1 = MCHPO1.IPCHP(1)
  52.       SEGACT MSOUP1
  53.       NC1    = MSOUP1.NOHARM(/1)
  54. C
  55.       IF (NSOUP1.NE.1) IFLAG=2
  56.       IF (NC1.NE.1) IFLAG=4
  57.       IF (IFLAG.NE.0) THEN
  58.          CALL ERREUR(21)
  59.          RETURN
  60.       ENDIF
  61. C
  62.       MPOVA1 = MSOUP1.IPOVAL
  63.       SEGACT MPOVA1
  64.       SEGINI, MCHPO3=MCHPO1
  65.       SEGINI, MSOUP3=MSOUP1
  66.       SEGINI, MPOVA3=MPOVA1
  67.       MCHPO3.IPCHP(1) = MSOUP3
  68.       MSOUP3.IPOVAL   = MPOVA3
  69.       SEGDES MCHPO1,MCHPO3,MSOUP1,MSOUP3
  70.       CALL DPSAT1(MPOVA1,MPOVA3)
  71.       SEGDES MPOVA1,MPOVA3
  72.       CALL ECROBJ(TYPE,MCHPO3)
  73.       RETURN
  74. C
  75. C FLOTTANT
  76. C
  77.  10   CONTINUE
  78.       CALL LIRREE(X1,0,IRETOU)
  79.       IF (IRETOU.EQ.0) GOTO 20
  80.       X3 = DPSAT0(X1)
  81.       CALL ECRREE(X3)
  82.       RETURN
  83. C
  84. C LISTREEL
  85. C
  86.  20   CONTINUE
  87.       TYPE  = 'LISTREEL'
  88.       CALL LIROBJ(TYPE,MLREE1,0,IRETOU)
  89.       IF (IRETOU.EQ.0) GOTO 30
  90.       SEGACT MLREE1
  91.       SEGINI, MLREE3=MLREE1
  92.       CALL DPSAT3(MLREE1,MLREE3)
  93.       SEGDES MLREE1,MLREE3
  94.       CALL ECROBJ(TYPE,MLREE3)
  95.       RETURN
  96. C
  97. C Autres
  98. C
  99.  30   CONTINUE
  100.       CALL ERREUR(19)
  101.       RETURN
  102.       END
  103.  
  104.  
  105.  
  106.  
  107.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales