1 : C PRIM2F SOURCE CHAT 06/03/29 21:30:16 5360 2 : SUBROUTINE PRIM2F() 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : PRIM 8 : C 9 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 10 : C 11 : C AUTEUR : Jose R. Garcia-Cascales, 12 : C Universidad Politecnica de Cartagena, 13 : C jr.garcia@upct.es 14 : C 15 : C************************************************************************ 16 : C 17 : C 18 : C APPELES (E/S) : 19 : C 20 : C APPELES (Calcul) : 21 : C 22 : C************************************************************************ 23 : C 24 : C PHRASE D'APPEL (GIBIANE) : 25 : C 26 : C**** Variables de COOPTIO 27 : C 28 : INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 29 : & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 30 : & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 31 : & ,IECHO, IIMPI, IOSPI 32 : & ,IDIM, IFICLE, IPREFI 33 : & ,MCOORD 34 : & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 35 : & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 36 : & ,NORINC,NORVAL,NORIND,NORVAD 37 : & ,NUCROU, IPSAUV 38 : C 39 : C**** Les variables 40 : C 41 : INTEGER ICOND, IRETOU, INDIC, NBCOMP, IERR0, 42 : & ICEN, ICH1, ICH2, ICH3, 43 : & ICH4, ICH5, ICH6, ICH7, 44 : & ICH8, ICH9, 45 : & OCH1, OCH2, OCH3, 46 : & OCH4, OCH5, OCH6, 47 : & OCH7, OCH8, OCH9, 48 : & JGN, JGM 49 : REAL*8 VALER(2),VAL1,VAL2, Cp, Cvm 50 : CHARACTER*(40) MESERR(2),MESCEL 51 : CHARACTER*(6) NOMTRI 52 : LOGICAL LOGNEG, LOGBOR, LOGTRI 53 : C 54 : C**** Les Includes 55 : C 56 : -INC CCOPTIO 57 : -INC SMCHPOI 58 : -INC SMLMOTS 59 : C 60 : C**** Initialisation des parametres d'erreur 61 : C 62 : LOGNEG = .FALSE. 63 : LOGBOR = .FALSE. 64 : LOGTRI = .FALSE. 65 : MESCEL = ' ' 66 : MESERR(1) = MESCEL 67 : MESERR(2) = MESCEL 68 : MOTERR(1:40) = MESCEL 69 : VALER(1) = 0.0D0 70 : VALER(2) = 0.0D0 71 : VAL1 = 0.0D0 72 : VAL2 = 0.0D0 73 : C 74 : C**** Lecture du CHPOINT ICH1 75 : C 76 : ICOND = 1 76 : CALL LIROBJ('CHPOINT',ICH1,ICOND,IRETOU) 77 : IF (IERR.NE.0) GOTO 9999 78 : C 79 : C**** On cherche le pointeur de son maillage et on l'impose sur les 80 : C autres CHPOINT 81 : C 82 : MCHPOI = ICH1 83 : SEGACT MCHPOI 84 : MSOUPO = MCHPOI.IPCHP(1) 85 : SEGACT MSOUPO 86 : ICEN = MSOUPO.IGEOC 87 : SEGDES MSOUPO 88 : SEGDES MCHPOI 89 : C 90 : C**** On recupere en QUEPO1 MLMOTS 91 : C 92 : JGN = 4 93 : JGM = 1 94 : SEGINI MLMOTS 95 : MLMOTS.MOTS(1) = 'SCAL' 95 : CALL QUEPO1(ICH1, ICEN, MLMOTS) 96 : C 97 : IF(IERR .NE. 0)THEN 98 : IERR0 = IERR 99 : 100 : C 101 : C******** Message d'erreur standard 102 : C -301 0 %m1:40 103 : C 104 : MOTERR = 'CHPO1 = ??? ' 105 : WRITE(IOIMP,*) MOTERR(1:40) 106 : 107 : GOTO 9999 108 : ENDIF 109 : SEGSUP MLMOTS 110 : C 111 : C**** Lecture du CHPOINT ICH2 112 : C 113 : ICOND = 1 113 : CALL LIROBJ('CHPOINT',ICH2,ICOND,IRETOU) 114 : IF (IERR.NE.0) GOTO 9999 115 : C 116 : C**** Control du CHPOINT ICH2 117 : C 118 : JGN = 4 119 : JGM = 1 120 : SEGINI MLMOTS 121 : MLMOTS.MOTS(1) = 'SCAL' 121 : CALL QUEPO1(ICH2, ICEN, MLMOTS) 122 : IF(IERR .NE. 0)THEN 123 : IERR0 = IERR 124 : 125 : C 126 : C******** Message d'erreur standard 127 : C -301 0 %m1:40 128 : C 129 : MOTERR = 'CHPO2 = ??? ' 130 : WRITE(IOIMP,*) MOTERR(1:40) 131 : 132 : GOTO 9999 133 : ENDIF 134 : SEGSUP MLMOTS 135 : C 136 : C**** Lecture du CHPOINT ICH3 137 : C 138 : ICOND = 1 138 : CALL LIROBJ('CHPOINT',ICH3,ICOND,IRETOU) 139 : IF (IERR.NE.0) GOTO 9999 140 : C 141 : C**** Control du CHPOINT ICH3 142 : C 143 : JGN = 4 144 : JGM = IDIM 145 : SEGINI MLMOTS 146 : MLMOTS.MOTS(1) = 'UVX' 147 : MLMOTS.MOTS(2) = 'UVY' 148 : IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'UVZ' 148 : CALL QUEPO1(ICH3, ICEN, MLMOTS) 149 : IF(IERR .NE. 0)THEN 150 : IERR0 = IERR 151 : 152 : C 153 : C******** Message d'erreur standard 154 : C -301 0 %m1:40 155 : C 156 : MOTERR = 'CHPO3 = ??? ' 157 : 158 : GOTO 9999 159 : ENDIF 160 : SEGSUP MLMOTS 161 : C 162 : C**** Lecture du CHPOINT ICH4 163 : C 164 : ICOND = 1 164 : CALL LIROBJ('CHPOINT',ICH4,ICOND,IRETOU) 165 : IF (IERR.NE.0) GOTO 9999 166 : C 167 : C**** Control du CHPOINT ICH4 168 : C 169 : JGN = 4 170 : JGM = IDIM 171 : SEGINI MLMOTS 172 : MLMOTS.MOTS(1) = 'ULX' 173 : MLMOTS.MOTS(2) = 'ULY' 174 : IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'ULZ' 174 : CALL QUEPO1(ICH4, ICEN, MLMOTS) 175 : IF(IERR .NE. 0)THEN 176 : IERR0 = IERR 177 : 178 : C 179 : C******** Message d'erreur standard 180 : C -301 0 %m1:40 181 : C 182 : MOTERR = 'CHPO4 = ??? ' 183 : WRITE(IOIMP,*) MOTERR(1:40) 184 : 185 : GOTO 9999 186 : ENDIF 187 : SEGSUP MLMOTS 188 : C 189 : C**** Lecture du CHPOINT ICH5 190 : C 191 : ICOND = 1 191 : CALL LIROBJ('CHPOINT',ICH5,ICOND,IRETOU) 192 : IF (IERR.NE.0) GOTO 9999 193 : C 194 : C**** Control du CHPOINT ICH5 195 : C 196 : JGN = 4 197 : JGM = 1 198 : SEGINI MLMOTS 199 : MLMOTS.MOTS(1) = 'SCAL' 199 : CALL QUEPO1(ICH5, ICEN, MLMOTS) 200 : IF(IERR .NE. 0)THEN 201 : IERR0 = IERR 202 : 203 : C 204 : C******** Message d'erreur standard 205 : C -301 0 %m1:40 206 : C 207 : MOTERR = 'CHPO5 = ??? ' 208 : WRITE(IOIMP,*) MOTERR(1:40) 209 : 210 : GOTO 9999 211 : ENDIF 212 : SEGSUP MLMOTS 213 : C 214 : C**** Lecture du CHPOINT ICH6 215 : C 216 : ICOND = 1 216 : CALL LIROBJ('CHPOINT',ICH6,ICOND,IRETOU) 217 : IF (IERR.NE.0) GOTO 9999 218 : C 219 : C**** Control du CHPOINT ICH6 220 : C 221 : JGN = 4 222 : JGM = 1 223 : SEGINI MLMOTS 224 : MLMOTS.MOTS(1) = 'SCAL' 224 : CALL QUEPO1(ICH6, ICEN, MLMOTS) 225 : IF(IERR .NE. 0)THEN 226 : IERR0 = IERR 227 : 228 : C 229 : C******** Message d'erreur standard 230 : C -301 0 %m1:40 231 : C 232 : MOTERR = 'CHPO6 = ??? ' 233 : WRITE(IOIMP,*) MOTERR(1:40) 234 : 235 : GOTO 9999 236 : ENDIF 237 : SEGSUP MLMOTS 238 : C 239 : C**** Lecture du CHPOINT ICH7 240 : C 241 : ICOND = 1 241 : CALL LIROBJ('CHPOINT',ICH7,ICOND,IRETOU) 242 : IF (IERR.NE.0) GOTO 9999 243 : C 244 : C**** Control du CHPOINT ICH7 245 : C 246 : JGN = 4 247 : JGM = 1 248 : SEGINI MLMOTS 249 : MLMOTS.MOTS(1) = 'SCAL' 249 : CALL QUEPO1(ICH7, ICEN, MLMOTS) 250 : IF(IERR .NE. 0)THEN 251 : IERR0 = IERR 252 : 253 : C 254 : C******** Message d'erreur standard 255 : C -301 0 %m1:40 256 : C 257 : MOTERR = 'CHPO7 = ??? ' 258 : WRITE(IOIMP,*) MOTERR(1:40) 259 : 260 : GOTO 9999 261 : ENDIF 262 : SEGSUP MLMOTS 263 : C 264 : C**** Lecture du CHPOINT ICH8 265 : C 266 : ICOND = 1 266 : CALL LIROBJ('CHPOINT',ICH8,ICOND,IRETOU) 267 : IF (IERR.NE.0) GOTO 9999 268 : C 269 : C**** Control du CHPOINT ICH8 270 : C 271 : JGN = 4 272 : JGM = 1 273 : SEGINI MLMOTS 274 : MLMOTS.MOTS(1) = 'SCAL' 274 : CALL QUEPO1(ICH8, ICEN, MLMOTS) 275 : IF(IERR .NE. 0)THEN 276 : IERR0 = IERR 277 : 278 : C 279 : C******** Message d'erreur standard 280 : C -301 0 %m1:40 281 : C 282 : MOTERR = 'CHPO8 = ??? ' 283 : WRITE(IOIMP,*) MOTERR(1:40) 284 : 285 : GOTO 9999 286 : ENDIF 287 : SEGSUP MLMOTS 288 : C 289 : C**** Lecture du CHPOINT ICH9 290 : C 291 : ICOND = 1 291 : CALL LIROBJ('CHPOINT',ICH9,ICOND,IRETOU) 292 : IF (IERR.NE.0) GOTO 9999 293 : C 294 : C**** Control du CHPOINT ICH9 295 : C 296 : JGN = 4 297 : JGM = 1 298 : SEGINI MLMOTS 299 : MLMOTS.MOTS(1) = 'SCAL' 299 : CALL QUEPO1(ICH9, ICEN, MLMOTS) 300 : IF(IERR .NE. 0)THEN 301 : IERR0 = IERR 302 : 303 : C 304 : C******** Message d'erreur standard 305 : C -301 0 %m1:40 306 : C 307 : MOTERR = 'CHPO9 = ??? ' 308 : WRITE(IOIMP,*) MOTERR(1:40) 309 : 310 : GOTO 9999 311 : ENDIF 312 : SEGSUP MLMOTS 313 : C 314 : C Lecture of the CATHARE pressure correction term 315 : C parameters 316 : C 317 : ICOND = 1 317 : CALL LIRREE(Cp,ICOND,IRETOU) 318 : IF(IERR .NE. 0) GOTO 9999 319 : IF((Cp .LT. 0) .OR. (Cp .GT. 7.d0))THEN 320 : C 321 : C******* Message d'erreur standard 322 : C -301 0 %m1:40 323 : C 324 : MOTERR(1:40) = 'Cp = ??? ' 324 : CALL ERREUR(-301) 325 : C 326 : C******* Message d'erreur standard 327 : C Entier valant: %i1 328 : C -2 0 329 : C 330 : C INTERR(1) = Cp 331 : ENDIF 332 : 333 : ICOND = 1 333 : CALL LIRREE(Cvm,ICOND,IRETOU) 334 : IF(IERR .NE. 0) GOTO 9999 335 : IF((Cvm .LT. 0) .OR. (Cvm .GT. 7.d0))THEN 336 : C 337 : C******* Message d'erreur standard 338 : C -301 0 %m1:40 339 : C 340 : MOTERR(1:40) = 'Cvm = ??? ' 340 : CALL ERREUR(-301) 341 : C 342 : C******* Message d'erreur standard 343 : C Entier valant: %i1 344 : C -2 0 345 : C 346 : C INTERR(1) = Cvm 347 : ENDIF 348 : C 349 : C 350 : C**** Calcul des sorties. 351 : C 351 : CALL PR12f(ICEN, ICH1, ICH2, ICH3, 352 : & ICH4, ICH5, ICH6, ICH7, 353 : & ICH8, ICH9, 354 : & Cp, Cvm, 355 : & OCH1, OCH2, OCH3, 356 : & OCH4, OCH5, OCH6, 357 : & OCH7, OCH8, OCH9, 358 : & LOGNEG, LOGBOR, MESERR, 359 : & VALER, VAL1, VAL2) 360 : C 361 : IERR0 = 0 362 : IF(LOGNEG)THEN 363 : C 364 : C******* Pression (energie thermique) ou densité negative 365 : C 366 : C******* Message d'erreur standard 367 : C 41 2 368 : C %m1:8 = %r1 inférieur à %r2 369 : C 370 : MESCEL = MESERR(1) 371 : MOTERR(1:8) = MESCEL(1:8) 372 : REAERR(1) = REAL(VALER(1)) 373 : REAERR(2) = 0.0 373 : CALL ERREUR(41) 374 : IF(LOGTRI)THEN 375 : * IERR = 0 376 : ELSE 377 : GOTO 9999 378 : ENDIF 379 : ENDIF 380 : IF(LOGBOR)THEN 381 : C 382 : C******* Message d'erreur standard 383 : C 42 2 384 : C %m1:8 = %r1 non compris entre %r2 et %r3 385 : C 386 : MESCEL = MESERR(2) 387 : MOTERR(1:8) = MESCEL(1:8) 388 : REAERR(1) = REAL(VALER(2)) 389 : REAERR(2) = REAL(VAL1) 390 : REAERR(3) = REAL(VAL2) 390 : CALL ERREUR(42) 391 : IF(LOGTRI)THEN 392 : * IERR = 0 393 : ELSE 394 : GOTO 9999 395 : ENDIF 396 : ENDIF 397 : C 398 : C**** Ecriture du CHPOINT contenant la SUMA 399 : C 399 : CALL ECROBJ('CHPOINT', OCH1) 399 : CALL ECROBJ('CHPOINT', OCH2) 399 : CALL ECROBJ('CHPOINT', OCH3) 399 : CALL ECROBJ('CHPOINT', OCH4) 399 : CALL ECROBJ('CHPOINT', OCH5) 399 : CALL ECROBJ('CHPOINT', OCH6) 399 : CALL ECROBJ('CHPOINT', OCH7) 399 : CALL ECROBJ('CHPOINT', OCH8) 399 : CALL ECROBJ('CHPOINT', OCH9) 400 : C 401 : C 402 : 9999 CONTINUE 403 : C 404 : RETURN 405 : END 406 : 407 : 408 : 409 : 410 : 411 : 412 : 413 :
© Cast3M 2003 - All rights reserved.
Disclaimer