1 : C PVAP SOURCE CHAT 05/01/13 02:39:49 5004 2 : SUBROUTINE PVAP 3 : C 4 : *--------------------------------------------------------------------- 5 : * Pression partielle de vapeur fonction de RO et de T (issue de RALOC) 6 : *--------------------------------------------------------------------- 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 = PVAP OBJ1 OBJ2 ; 16 : C 17 : C------------------------ 18 : C Opérandes et résultat : 19 : C------------------------ 20 : C 21 : C OBJ1 : Densité de vapeur (en kg/m3) 22 : C OBJ2 : Température (en K) 23 : C OBJ3 : Pression partielle de vapeur (p = ro R Z T) 24 : C 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 46 : CALL LIROBJ(TYPE,MCHPO2,1,IRETOU) 47 : IF (IRETOU.EQ.0) RETURN 48 : C 49 : SEGACT MCHPO1,MCHPO2 50 : NSOUP1 = MCHPO1.IPCHP(/1) 51 : NSOUP2 = MCHPO2.IPCHP(/1) 52 : MSOUP1 = MCHPO1.IPCHP(1) 53 : MSOUP2 = MCHPO2.IPCHP(1) 54 : SEGACT MSOUP1,MSOUP2 55 : NC1 = MSOUP1.NOHARM(/1) 56 : NC2 = MSOUP2.NOHARM(/1) 57 : IGEO1 = MSOUP1.IGEOC 58 : IGEO2 = MSOUP2.IGEOC 59 : INDIC = 1 60 : NBCOMP = -1 60 : CALL QUEPOI(MCHPO2,IGEO1,INDIC,NBCOMP,NOMTOT) 61 : SEGACT MCHPO2,MSOUP2 62 : MPOVA1 = MSOUP1.IPOVAL 63 : MPOVA2 = MSOUP2.IPOVAL 64 : SEGACT MPOVA1,MPOVA2 65 : N1 = MPOVA1.VPOCHA(/1) 66 : N2 = MPOVA2.VPOCHA(/1) 67 : C 68 : IF (NSOUP1.NE.NSOUP2) IFLAG=1 69 : IF (NSOUP1.NE.1) IFLAG=2 70 : IF (NC1.NE.NC2) IFLAG=3 71 : IF (NC1.NE.1) IFLAG=4 72 : IF (INDIC.LT.0) IFLAG=5 73 : C IF (IGEO1.NE.IGEO2) IFLAG=5 74 : C IF (N1.NE.N2) IFLAG=6 75 : IF (IFLAG.NE.0) THEN 75 : CALL ERREUR(21) 76 : RETURN 77 : ENDIF 78 : C 79 : SEGINI, MCHPO3=MCHPO1 80 : SEGINI, MSOUP3=MSOUP1 81 : SEGINI, MPOVA3=MPOVA1 82 : MCHPO3.IPCHP(1) = MSOUP3 83 : MSOUP3.IPOVAL = MPOVA3 84 : SEGDES MCHPO1,MCHPO2,MCHPO3,MSOUP1,MSOUP2,MSOUP3 84 : CALL PVAP1(MPOVA1,MPOVA2,MPOVA3) 85 : SEGDES MPOVA1,MPOVA2,MPOVA3 85 : CALL ECROBJ(TYPE,MCHPO3) 86 : RETURN 87 : C 88 : C FLOTTANT 89 : C 90 : 10 CONTINUE 90 : CALL LIRREE(X1,0,IRETOU) 91 : IF (IRETOU.EQ.0) GOTO 20 91 : CALL LIRREE(X2,1,IRETOU) 92 : IF (IRETOU.EQ.0) RETURN 93 : X3 = PVAP0(X1,X2) 93 : CALL ECRREE(X3) 94 : RETURN 95 : C 96 : C LISTREEL 97 : C 98 : 20 CONTINUE 99 : TYPE = 'LISTREEL' 99 : CALL LIROBJ(TYPE,MLREE1,0,IRETOU) 100 : IF (IRETOU.EQ.0) GOTO 30 100 : CALL LIROBJ(TYPE,MLREE2,1,IRETOU) 101 : IF (IRETOU.EQ.0) RETURN 102 : MLREE3 = 0 103 : IFLAG = 0 104 : SEGACT MLREE1,MLREE2 105 : JG1 = MLREE1.PROG(/1) 106 : JG2 = MLREE2.PROG(/1) 107 : IF (JG1.NE.JG2) IFLAG=1 108 : IF (IFLAG.NE.0) THEN 108 : CALL ERREUR(21) 109 : RETURN 110 : ENDIF 111 : SEGINI, MLREE3=MLREE1 111 : CALL PVAP3(MLREE1,MLREE2,MLREE3) 112 : SEGDES MLREE1,MLREE2,MLREE3 112 : CALL ECROBJ(TYPE,MLREE3) 113 : RETURN 114 : C 115 : C Autres 116 : C 117 : 30 CONTINUE 117 : CALL ERREUR(19) 118 : RETURN 119 : END 120 : 121 :
© Cast3M 2003 - All rights reserved.
Disclaimer