1 : C PRGFM1 SOURCE BECC 11/05/18 21:15:34 6973 2 : SUBROUTINE PRGFM1(NESP, 3 : & IM1,IPHI,ICH1,ICH2,ICH3,ICH4,ICH5, 4 : & MLRMGA,MLRPGA,MLRMPI,MLRPPI, 5 : & IVIT,IPRES,IY, 6 : & LOGNEG,MESERR, 7 : & VALER) 8 : C************************************************************************ 9 : C 10 : C PROJET : CASTEM 2000 11 : C 12 : C NOM : PRGFM1 13 : C 14 : C DESCRIPTION : VOIR PRIGFM 15 : C 16 : C Gaz ideal mono-espece: 17 : C Calcul de vitesse, pression. 18 : C 19 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 20 : C 21 : C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF 22 : C 23 : C************************************************************************ 24 : C 25 : C APPELES (E/S) : LICHT 26 : C 27 : C************************************************************************ 28 : C 29 : C ENTREES : 30 : C 31 : C NESP : nombre d'especes dans les equation d'Euler. 32 : C 33 : C IM1 : MELEME contenant les centres des ELTs 34 : C 35 : C IPHI : CHPOINT contenant PHI 36 : C 37 : C ICH1 : CHPOINT contenant la masse volumique. 38 : C 39 : C ICH2 : CHPOINT contenant les dèbits 40 : C ( NDIM composantes); 41 : C 42 : C ICH3 : CHPOINT contenat l'énergie totale per 43 : C unité de volume (RHO Et); 44 : C 45 : C ICH4, ICH5 : CHPOINT contenants rhoy et alpha ; 46 : C 47 : C MLRMGA,MLRPGA,MLRMPI,MLRPPI: proprietés des gaz 1 48 : C 49 : C SORTIES : 50 : C 51 : C IY : CHPOINT contenany y 52 : C 53 : C IVIT : CHPOINT contenant la vitesse 54 : C 55 : C IPRES : CHPOINT contenant la pression du gaz; 56 : C 57 : C LOGNEG : (LOGICAL): si .TRUE. une pression ou une densité 58 : C negative a été detectée -> le programme s'arrete 59 : C (sa valeur stockée en MESERR(1) et VALER(1)) 60 : C 61 : C MESERR, 62 : C VALER : pour message d'erreur 63 : C 64 : C 65 : C************************************************************************ 66 : C 67 : C HISTORIQUE (Anomalies et modifications éventuelles) 68 : C 69 : C HISTORIQUE : Créée le 1.11.2010 70 : C 71 : C************************************************************************ 72 : C 73 : C 74 : C**** Variables de COOPTIO 75 : C 76 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 77 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 78 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 79 : C & ,IECHO, IIMPI, IOSPI 80 : C & ,IDIM 81 : C & ,MCOORD 82 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 83 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 84 : C & ,NORINC,NORVAL,NORIND,NORVAD 85 : C & ,NUCROU, IPSAUV 86 : C 87 : C**** Les variables 88 : C 89 : IMPLICIT INTEGER(I-N) 90 : INTEGER NESP, IESP, 91 : & IM1,ICH1,ICH2,ICH3,ICH4,ICH5 92 : & ,IVIT,IPRES,IPHI, IY 93 : & ,NLCE, N1, IGEOMC 94 : REAL*8 VALER(2) 95 : & ,RO,UX,UY,UZ,P 96 : & ,ROET, ROETH, CELL, PHI 97 : & ,GAMMA,PINF 98 : & ,ALP, RNUM, DEN, ALPI 99 : C 100 : CHARACTER*(8) TYPE 101 : CHARACTER*(40) MESERR(2) 102 : LOGICAL LOGNEG 103 : C 104 : C 105 : C**** Les includes 106 : C 107 : -INC CCOPTIO 108 : -INC SMCHPOI 109 : POINTEUR MPOVA7.MPOVAL, MPOVRY.MPOVAL, 110 : & MPOVAY.MPOVAL, MPOALP.MPOVAL 111 : -INC SMELEME 112 : -INC SMLREEL 113 : POINTEUR MLRMGA.MLREEL, MLRPGA.MLREEL, 114 : & MLRMPI.MLREEL, MLRPPI.MLREEL 115 : C 116 : C 117 : C**** Initialisation des variables pour la gestion des erreurs pas ici, 118 : C mais avant, i.e. 119 : C 120 : C LOGNEG = .FALSE. 121 : C MESERR(1) = ' ' 122 : C MESERR(2) = ' ' 123 : C 124 : C**** Activation du MELEME "CENTRE" 125 : C 126 : IPT1 = IM1 127 : SEGACT IPT1 128 : N1 = IPT1.NUM(/2) 129 : SEGDES IPT1 130 : C 131 : C**** Creation des CHPOINTs IVIT, IPRES 132 : C 133 : C ITEMP CHPOINT simile aux ICH1 134 : C Donc on lit ICH1 135 : C 136 : MCHPO1 = ICH1 137 : SEGACT MCHPO1 138 : MSOUP1 = MCHPO1.IPCHP(1) 139 : SEGDES MCHPO1 140 : SEGACT MSOUP1 141 : MPOVA1 = MSOUP1.IPOVAL 142 : SEGDES MSOUP1 143 : SEGACT MPOVA1 144 : C 145 : C*** MPOVA6 = IPOVAL de IPRES 146 : C 147 : SEGINI, MPOVA6 = MPOVA1 148 : SEGINI, MSOUP2 = MSOUP1 149 : MSOUP2.IPOVAL = MPOVA6 150 : SEGINI, MCHPO2 = MCHPO1 151 : MCHPO2.IPCHP(1)= MSOUP2 152 : SEGDES MSOUP2 153 : SEGDES MCHPO2 154 : IPRES = MCHPO2 155 : C 156 : C*** IVIT simil au CHPOINT ICH2 (DEBITs). 157 : C 158 : MCHPO1 = ICH2 159 : SEGACT MCHPO1 160 : MSOUP1 = MCHPO1.IPCHP(1) 161 : SEGDES MCHPO1 162 : SEGACT MSOUP1 163 : MPOVA2 = MSOUP1.IPOVAL 164 : SEGDES MSOUP1 165 : SEGACT MPOVA2 166 : C 167 : C**** IVIT 168 : C 169 : SEGINI, MPOVA5 = MPOVA2 170 : SEGINI, MSOUP2 = MSOUP1 171 : MSOUP2.IPOVAL = MPOVA5 172 : SEGINI, MCHPO2 = MCHPO1 173 : MCHPO2.IPCHP(1)= MSOUP2 174 : SEGDES MSOUP2 175 : SEGDES MCHPO2 176 : IVIT = MCHPO2 177 : C 178 : IF (NESP .GE. 1) THEN 179 : C 180 : C*** IY 181 : C 182 : C Ce CHPOINT ressemble à IROY 183 : C Donc on lit IROY 184 : C 185 : MCHPO1 = ICH4 186 : SEGACT MCHPO1 187 : MSOUP1 = MCHPO1.IPCHP(1) 188 : SEGDES MCHPO1 189 : SEGACT MSOUP1 190 : MPOVRY = MSOUP1.IPOVAL 191 : SEGDES MSOUP1 192 : SEGACT MPOVRY 193 : C 194 : SEGINI, MPOVAY = MPOVRY 195 : SEGINI, MSOUP2 = MSOUP1 196 : MSOUP2.IPOVAL = MPOVAY 197 : SEGINI, MCHPO2 = MCHPO1 198 : MCHPO2.IPCHP(1)= MSOUP2 199 : SEGDES MSOUP2 200 : SEGDES MCHPO2 201 : IY = MCHPO2 202 : C 202 : CALL LICHT(ICH5,MPOALP,TYPE,IGEOMC) 203 : C SEGACT MPOALP 204 : ELSE 205 : IY=0 206 : ENDIF 207 : C 208 : C**** Lecture de MPOVALs des autres MCHPOIs 209 : C 209 : CALL LICHT(ICH3,MPOVA3,TYPE,IGEOMC) 209 : CALL LICHT(IPHI,MPOVA7,TYPE,IGEOMC) 210 : C 211 : C**** LICHT active les MPOVALs en *MOD 212 : C 213 : C i.e. 214 : C 215 : C SEGACT MPOVA3*MOD 216 : C SEGACT MPOVA7*MOD 217 : C 218 : C 219 : C**** RICAPITOLATIF 220 : C 221 : C On a activé que les MPOVA1 - MPOVA7 222 : C 223 : C MPOVA1 = RO 224 : C MPOVA2 = DEBIT 225 : C MPOVA3 = ROET 226 : C MPOVA5 = VITESSE 227 : C MPOVA6 = PRES 228 : C MPOVA7 = IPHI 229 : C MPOVRY = RHO Y 230 : C MPOVAY = Y 231 : C MPOALP = ALPHA 232 : C 233 : C**** BOUCLE SUR LES CENTRES pour le calcul du FLUX. 234 : C 235 : DO NLCE = 1, N1 236 : C 237 : C******* Les differents variables a chaque centre 238 : C 239 : RO = MPOVA1.VPOCHA(NLCE,1) 240 : IF(RO .LE. 0.0D0)THEN 241 : VALER(1) = RO 242 : MESERR(1) = 'RO ' 243 : LOGNEG = .TRUE. 244 : C 245 : C********** RO < 0: le programme s'arrete mais apres le calcul des 246 : C CHPOINTs 247 : C 248 : ENDIF 249 : UX = MPOVA2.VPOCHA(NLCE,1)/RO 250 : UY = MPOVA2.VPOCHA(NLCE,2)/RO 251 : MPOVA5.VPOCHA(NLCE,1)=UX 252 : MPOVA5.VPOCHA(NLCE,2)=UY 253 : IF(IDIM .EQ. 3) THEN 254 : UZ = MPOVA2.VPOCHA(NLCE,3)/RO 255 : MPOVA5.VPOCHA(NLCE,3)=UZ 256 : ENDIF 257 : ROET = MPOVA3.VPOCHA(NLCE,1) 258 : PHI = MPOVA7.VPOCHA(NLCE,1) 259 : CELL = UX*UX + UY*UY 260 : IF(IDIM .EQ. 3) CELL = CELL +UZ*UZ 261 : CELL = 0.5D0 * CELL *RO 262 : ROETH = ROET - CELL 263 : C 264 : C******* We compute GAMMA and PINF 265 : C 266 : ALP = 1.0D0 267 : DEN = 0.0D0 268 : RNUM = 0.0D0 269 : DO IESP = 1, NESP, 1 270 : IF (PHI .LE. 0)THEN 271 : GAMMA = MLRMGA.PROG(IESP) 272 : PINF = MLRMPI.PROG(IESP) 273 : ELSE 274 : GAMMA = MLRPGA.PROG(IESP) 275 : PINF = MLRPPI.PROG(IESP) 276 : ENDIF 277 : ALPI = MPOALP.VPOCHA(NLCE,IESP) 278 : ALP = ALP - ALPI 279 : DEN = DEN + (ALPI / (GAMMA - 1.0D0)) 280 : RNUM = RNUM + ((ALPI * GAMMA * PINF) / (GAMMA - 1.0D0)) 281 : ENDDO 282 : IF (PHI .LE. 0)THEN 283 : GAMMA = MLRMGA.PROG(NESP + 1) 284 : PINF = MLRMPI.PROG(NESP + 1) 285 : ELSE 286 : GAMMA = MLRPGA.PROG(NESP + 1) 287 : PINF = MLRPPI.PROG(NESP + 1) 288 : ENDIF 289 : DEN = DEN + (ALP / (GAMMA - 1.0D0)) 290 : RNUM = RNUM + ((ALP * GAMMA * PINF) / (GAMMA - 1.0D0)) 291 : C 292 : PINF = RNUM / DEN 293 : GAMMA = 1.0D0 / DEN 294 : GAMMA = GAMMA + 1.0D0 295 : PINF = PINF / GAMMA 296 : C 297 : C write(*,*) 298 : C write(*,*) 'gamma, pinf ', gamma, pinf 299 : P = (GAMMA - 1.0D0) * ROETH 300 : P = P - (GAMMA * PINF) 301 : IF(P .LE. (-1.0D0 * PINF)) THEN 302 : VALER(1) = P 303 : MESERR(1) = 'P ' 304 : LOGNEG = .TRUE. 305 : C 306 : C********** P < 0: le programme s'arrete mais apres le calcul des 307 : C CHPOINTs 308 : C 309 : ENDIF 310 : MPOVA6.VPOCHA(NLCE,1) = P 311 : C 312 : DO IESP = 1, NESP 313 : MPOVAY.VPOCHA(NLCE,IESP) = MPOVRY.VPOCHA(NLCE,IESP) / RO 314 : ENDDO 315 : ENDDO 316 : C 317 : SEGDES MPOVA1 318 : SEGDES MPOVA2 319 : SEGDES MPOVA3 320 : SEGDES MPOVA5 321 : SEGDES MPOVA6 322 : SEGDES MPOVA7 323 : IF (NESP .GE. 1) THEN 324 : SEGDES MPOVRY 325 : SEGDES MPOALP 326 : SEGDES MPOVAY 327 : ENDIF 328 : C 329 : RETURN 330 : END 331 :
© Cast3M 2003 - All rights reserved.
Disclaimer