1 : C PRE21 SOURCE CHAT 06/08/24 21:58:53 5529 2 : SUBROUTINE PRE21() 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : PRE21 8 : C 9 : C DESCRIPTION : Voir PRE2 10 : C 11 : C Cas gaz parfait multiespeces 12 : C 13 : C 1er ordre en espace, 1er ordre en temps 14 : C 15 : C Creations des object MCHAML IROF, IVITF, IPF, IYF 16 : C IGAMF 17 : C 18 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 19 : C 20 : C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF 21 : C 22 : C************************************************************************ 23 : C 24 : C 25 : C APPELES (Outils) : LIRTAB, ACMO, LEKTAB, QUETYP, ERREUR, LIROBJ, 26 : C QUEPOI, ECROBJ 27 : C 28 : C APPELES (Calcul) : PRE211 (2D) 29 : C 30 : C 31 : C************************************************************************ 32 : C 33 : C HISTORIQUE (Anomalies et modifications éventuelles) 34 : C 35 : C HISTORIQUE : Créée le 11.6.98. 36 : C 37 : C************************************************************************ 38 : C 39 : C 40 : C**** Variables de COOPTIO 41 : C 42 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 43 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 44 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 45 : C & ,IECHO, IIMPI, IOSPI 46 : C & ,IDIM 47 : C & ,MCOORD 48 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 49 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 50 : C & ,NORINC,NORVAL,NORIND,NORVAD 51 : C & ,NUCROU, IPSAUV, IFICLE, IPREFI 52 : C 53 : C**** Les variables 54 : C 55 : IMPLICIT INTEGER(I-N) 56 : INTEGER ICOND, IRETOU, IERR0, INDIC, NBCOMP 57 : & ,IDOMA, ICEN, IFACE, IFACEL, INORM, IROC, IVITC, IPC 58 : & ,IYC, IGAMC, IROF, IVITF, IPF, IYF, IGAMF, INEFMD 59 : & ,JGM,JGN,MMODEL 60 : C 61 : REAL*8 VALER, VAL1, VAL2 62 : CHARACTER*(4) NOMTOT(3) 63 : CHARACTER*(8) MTYPR, TYPE 64 : CHARACTER*(40) MESERR 65 : LOGICAL LOGAN,LOGNEG, LOGBOR 66 : C 67 : C**** Les Includes 68 : C 69 : -INC CCOPTIO 70 : -INC SMLMOTS 71 : POINTEUR MLMVIT.MLMOTS 72 : C 73 : C**** Initialisation des parametres d'erreur 74 : C 75 : LOGAN = .FALSE. 76 : LOGNEG = .FALSE. 77 : LOGBOR = .FALSE. 78 : MESERR = ' ' 79 : MOTERR(1:40) = MESERR(1:40) 80 : VALER = 0.0D0 81 : VAL1 = 0.0D0 82 : VAL2 = 0.0D0 83 : C 84 : C**** Initialisation des NOMTOT 85 : C 86 : NOMTOT(1) = ' ' 87 : NOMTOT(2) = ' ' 88 : NOMTOT(3) = ' ' 89 : C 90 : C**** Lecture de l'objet MODELE 91 : C 92 : ICOND = 1 92 : CALL QUETYP(TYPE,ICOND,IRETOU) 93 : 94 : IF(IRETOU.EQ.0.AND.TYPE.NE.'MMODEL')THEN 95 : WRITE(6,*)' On attend un objet MMODEL' 96 : RETURN 97 : ENDIF 97 : CALL LIROBJ('MMODEL',MMODEL,ICOND,IRETOU) 98 : IF(IERR.NE.0)GOTO 9999 98 : CALL LEKMOD(MMODEL,IDOMA,INEFMD) 99 : IF(IERR.NE.0)GOTO 9999 100 : C 101 : C**** Lecture du MELEME SPG des points CENTRE. 102 : C 103 : C 103 : C CALL LEKTAB(IDOMA,'CENTRE',IP) 104 : C 105 : C**** Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas, 106 : C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL' 107 : C -> la correspondance global des noeuds saut! 108 : C 109 : C On peut utilizer ACCTAB ou ACMO 110 : C 111 : MTYPR = 'MAILLAGE' 111 : CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN) 112 : IF(IERR.NE.0)GOTO 9999 113 : C 114 : C**** Lecture du MELEME 'FACE' 115 : C 116 : MTYPR = 'MAILLAGE' 116 : CALL ACMO(IDOMA,'FACE',MTYPR,IFACE) 117 : IF(IERR.NE.0)GOTO 9999 118 : C 119 : C**** Lecture du MELEME 'FACEL' 120 : C 121 : MTYPR = 'MAILLAGE' 121 : CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL) 122 : IF(IERR.NE.0)GOTO 9999 123 : C 124 : C**** Lecture du CHPOINT contenant les normales aux faces 125 : C 126 : IF(IDIM .EQ. 2)THEN 127 : C Que les normales 127 : CALL LEKTAB(IDOMA,'XXNORMAF',INORM) 128 : IF(IERR .NE. 0) GOTO 9999 129 : JGN = 4 130 : JGM = 2 131 : SEGINI MLMVIT 132 : MLMVIT.MOTS(1) = 'UX ' 133 : MLMVIT.MOTS(2) = 'UY ' 133 : CALL QUEPO1(INORM, IFACE, MLMVIT) 134 : SEGSUP MLMVIT 135 : IF(IERR.NE.0)GOTO 9999 136 : ELSE 137 : C Les normales et les tangentes 138 : MTYPR = ' ' 138 : CALL ACMO(IDOMA,'MATROT',MTYPR,INORM) 139 : IF (MTYPR .NE. 'CHPOINT ') THEN 139 : CALL MATRAN(IDOMA,INORM) 140 : IF(IERR .NE. 0) GOTO 9999 141 : ENDIF 142 : C UX UY UZ RX RY RZ MX MY MZ 143 : JGN = 4 144 : JGM = 9 145 : SEGINI MLMVIT 146 : MLMVIT.MOTS(1) = 'UX ' 147 : MLMVIT.MOTS(2) = 'UY ' 148 : MLMVIT.MOTS(3) = 'UZ ' 149 : MLMVIT.MOTS(4) = 'RX ' 150 : MLMVIT.MOTS(5) = 'RY ' 151 : MLMVIT.MOTS(6) = 'RZ ' 152 : MLMVIT.MOTS(7) = 'MX ' 153 : MLMVIT.MOTS(8) = 'MY ' 154 : MLMVIT.MOTS(9) = 'MZ ' 154 : CALL QUEPO1(INORM, IFACE, MLMVIT) 155 : SEGSUP MLMVIT 156 : IF(IERR.NE.0)GOTO 9999 157 : ENDIF 158 : C 159 : C**** Lecture du CHPOINT ROC 160 : C 161 : ICOND = 1 161 : CALL QUETYP(MTYPR,ICOND,IRETOU) 162 : IF(IERR .NE. 0)GOTO 9999 163 : IF(MTYPR .NE. 'CHPOINT ')THEN 164 : C 165 : C******* Message d'erreur standard 166 : C 37 2 167 : C On ne trouve pas d'objet de type %m1:8 168 : C 169 : MOTERR(1:8) = 'CHPOINT ' 169 : CALL ERREUR(37) 170 : GOTO 9999 171 : ELSE 172 : ICOND = 1 172 : CALL LIROBJ(MTYPR,IROC,ICOND,IRETOU) 173 : IF (IERR.NE.0) GOTO 9999 174 : ENDIF 175 : C 176 : C**** Control du CHPOINT: QUEPOI 177 : C 178 : C INDIC = 1 -> on impose le pointeur du support geometrique (IM1) 179 : C INDIC = 0 -> on ne fait que verifier le support geometrique (IM1) 180 : C 181 : C NBCOMP > 0 -> numero des composantes 182 : C 183 : C NOMTOT(1) = ' ' obligatoire s'on connais pas les noms des composantes 184 : C 185 : INDIC = 1 186 : NBCOMP = 1 187 : NOMTOT(1) = 'SCAL' 187 : CALL QUEPOI(IROC, ICEN, INDIC, NBCOMP, NOMTOT) 188 : IF(IERR .NE. 0)THEN 189 : IERR0 = IERR 190 : 191 : C 192 : C******* Message d'erreur standard 193 : C -301 0 %m1:40 194 : C 195 : MOTERR(1:40) = 'CHPO1 = ??? ' 195 : CALL ERREUR(-301) 196 : 197 : GOTO 9999 198 : ENDIF 199 : C 200 : C**** Lecture du CHPOINT VITC 201 : C 202 : ICOND = 1 202 : CALL QUETYP(MTYPR,ICOND,IRETOU) 203 : IF(IERR .NE. 0)GOTO 9999 204 : IF(MTYPR .NE. 'CHPOINT ')THEN 205 : C 206 : C******* Message d'erreur standard 207 : C 37 2 208 : C On ne trouve pas d'objet de type %m1:8 209 : C 210 : MOTERR(1:8) = 'CHPOINT ' 210 : CALL ERREUR(37) 211 : GOTO 9999 212 : ELSE 213 : ICOND = 1 213 : CALL LIROBJ('CHPOINT',IVITC,ICOND,IRETOU) 214 : IF (IERR.NE.0) GOTO 9999 215 : ENDIF 216 : C 217 : C**** Control du CHPOINT 218 : C 219 : INDIC = 1 220 : NBCOMP = IDIM 221 : NOMTOT(1) = 'UX ' 222 : NOMTOT(2) = 'UY ' 223 : IF(IDIM .EQ. 3) NOMTOT(3) = 'UZ ' 223 : CALL QUEPOI(IVITC, ICEN, INDIC, NBCOMP, NOMTOT) 224 : IF(IERR .NE. 0)THEN 225 : IERR0 = IERR 226 : 227 : C 228 : C******* Message d'erreur standard 229 : C -301 0 %m1:40 230 : C 231 : MOTERR(1:40) = 'CHPO2 = ??? ' 231 : CALL ERREUR(-301) 232 : 233 : GOTO 9999 234 : ENDIF 235 : C 236 : C**** Lecture du CHPOINT PC 237 : C 238 : ICOND = 1 238 : CALL QUETYP(MTYPR,ICOND,IRETOU) 239 : IF(IERR .NE. 0)GOTO 9999 240 : IF(MTYPR .NE. 'CHPOINT ')THEN 241 : C 242 : C******* Message d'erreur standard 243 : C 37 2 244 : C On ne trouve pas d'objet de type %m1:8 245 : C 246 : MOTERR(1:8) = 'CHPOINT ' 246 : CALL ERREUR(37) 247 : GOTO 9999 248 : ELSE 249 : ICOND = 1 249 : CALL LIROBJ('CHPOINT',IPC,ICOND,IRETOU) 250 : IF (IERR.NE.0) GOTO 9999 251 : ENDIF 252 : C 253 : C**** Control du CHPOINT 254 : C 255 : INDIC = 1 256 : NBCOMP = 1 257 : NOMTOT(1) = 'SCAL' 257 : CALL QUEPOI(IPC, ICEN, INDIC, NBCOMP, NOMTOT) 258 : IF(IERR .NE. 0)THEN 259 : IERR0 = IERR 260 : 261 : C 262 : C******* Message d'erreur standard 263 : C -301 0 %m1:40 264 : C 265 : MOTERR(1:40) = 'CHPO3 = ??? ' 265 : CALL ERREUR(-301) 266 : 267 : GOTO 9999 268 : ENDIF 269 : C 270 : C**** Lecture du CHPOINT YC 271 : C 272 : ICOND = 1 272 : CALL QUETYP(MTYPR,ICOND,IRETOU) 273 : IF(IERR .NE. 0)GOTO 9999 274 : IF(MTYPR .NE. 'CHPOINT ')THEN 275 : C 276 : C******* Message d'erreur standard 277 : C 37 2 278 : C On ne trouve pas d'objet de type %m1:8 279 : C 280 : MOTERR(1:8) = 'CHPOINT ' 280 : CALL ERREUR(37) 281 : GOTO 9999 282 : ELSE 283 : ICOND = 1 283 : CALL LIROBJ('CHPOINT',IYC,ICOND,IRETOU) 284 : IF (IERR.NE.0) GOTO 9999 285 : ENDIF 286 : C 287 : C**** Control du CHPOINT (on ne controlle que le maillage) 288 : C 289 : INDIC = 1 290 : NBCOMP = -1 291 : NOMTOT(1) = ' ' 291 : CALL QUEPOI(IYC, ICEN, INDIC, NBCOMP, NOMTOT) 292 : IF(IERR .NE. 0)THEN 293 : IERR0 = IERR 294 : 295 : C 296 : C******* Message d'erreur standard 297 : C -301 0 %m1:40 298 : C 299 : MOTERR(1:40) = 'CHPO4 = ??? ' 299 : CALL ERREUR(-301) 300 : 301 : GOTO 9999 302 : ENDIF 303 : C 304 : C**** Lecture du CHPOINT GAMC 305 : C 306 : ICOND = 1 306 : CALL QUETYP(MTYPR,ICOND,IRETOU) 307 : IF(IERR .NE. 0)GOTO 9999 308 : IF(MTYPR .NE. 'CHPOINT ')THEN 309 : C 310 : C******* Message d'erreur standard 311 : C 37 2 312 : C On ne trouve pas d'objet de type %m1:8 313 : C 314 : MOTERR(1:8) = 'CHPOINT ' 314 : CALL ERREUR(37) 315 : GOTO 9999 316 : ELSE 317 : ICOND = 1 317 : CALL LIROBJ('CHPOINT',IGAMC,ICOND,IRETOU) 318 : IF (IERR.NE.0) GOTO 9999 319 : ENDIF 320 : C 321 : C**** Control du CHPOINT 322 : C 323 : INDIC = 1 324 : NBCOMP = 1 325 : NOMTOT(1) = 'SCAL' 325 : CALL QUEPOI(IGAMC, ICEN, INDIC, NBCOMP, NOMTOT) 326 : IF(IERR .NE. 0)THEN 327 : IERR0 = IERR 328 : 329 : C 330 : C******* Message d'erreur standard 331 : C -301 0 %m1:40 332 : C 333 : MOTERR(1:40) = 'CHPO5 = ??? ' 333 : CALL ERREUR(-301) 334 : 335 : GOTO 9999 336 : ENDIF 337 : C 338 : C**** Centre -> Face 339 : C 340 : IF(IDIM .EQ. 2)THEN 341 : C 342 : C******* Deux Dimensions, Une Espece, 1er ordre en espace, 1er ordre en 343 : C temps 344 : C 344 : CALL PRE211(ICEN,IFACE,IFACEL,INORM,IROC,IVITC,IPC,IYC,IGAMC, 345 : & IROF,IVITF,IPF,IYF,IGAMF, 346 : & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2) 347 : ELSE 348 : C 349 : C******* Trois Dimensions, Une Espece, 1er ordre en espace, 1er ordre en 350 : C temps 351 : C 351 : CALL PRE212(ICEN,IFACE,IFACEL,INORM,IROC,IVITC,IPC,IYC,IGAMC, 352 : & IROF,IVITF,IPF,IYF,IGAMF, 353 : & LOGAN,LOGNEG,LOGBOR,MESERR,VALER,VAL1,VAL2) 354 : ENDIF 355 : C 356 : C**** Messages d'erreur 357 : C 358 : IF(LOGAN)THEN 359 : C 360 : C******* Anomalie detectée 361 : C 362 : C 363 : C******* Message d'erreur standard 364 : C -301 0 365 : C %m1:40 366 : C 367 : MOTERR(1:40) = MESERR(1:40) 367 : CALL ERREUR(-301) 368 : C 369 : C******* Message d'erreur standard 370 : C 5 3 371 : C Erreur anormale.contactez votre support 372 : C 372 : CALL ERREUR(5) 373 : GOTO 9999 374 : C 375 : ELSEIF(LOGNEG)THEN 376 : C 377 : C******* Message d'erreur standard 378 : C 41 2 379 : C %m1:8 = %r1 inférieur à %r2 380 : C 381 : MOTERR(1:8) = MESERR(1:8) 382 : REAERR(1) = REAL(VALER) 383 : REAERR(2) = 0.0 383 : CALL ERREUR(41) 384 : GOTO 9999 385 : ELSEIF(LOGBOR)THEN 386 : C 387 : C******* Message d'erreur standard 388 : C 42 2 389 : C %m1:8 = %r1 non compris entre %r2 et %r3 390 : C 391 : MOTERR(1:8) = MESERR(1:8) 392 : REAERR(1) = REAL(VALER) 393 : REAERR(2) = REAL(VAL1) 394 : REAERR(3) = REAL(VAL2) 394 : CALL ERREUR(42) 395 : GOTO 9999 396 : ELSE 397 : C 398 : C******* Ecriture de ROF, VITF, PF, YF, GAMMAF 399 : C 400 : MTYPR = 'MCHAML' 400 : CALL ECROBJ(MTYPR,IGAMF) 400 : CALL ECROBJ(MTYPR,IYF) 400 : CALL ECROBJ(MTYPR,IPF) 400 : CALL ECROBJ(MTYPR,IVITF) 400 : CALL ECROBJ(MTYPR,IROF) 401 : ENDIF 402 : C 403 : 9999 CONTINUE 404 : C 405 : RETURN 406 : END 407 : 408 : 409 : 410 : 411 : 412 : 413 : 414 : 415 : 416 : 417 :
© Cast3M 2003 - All rights reserved.
Disclaimer