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