1 : C EQEX SOURCE GOUNAND 13/01/22 21:15:00 7679 2 : SUBROUTINE EQEX 3 : C*********************************************************************** 4 : C VERSION : ???? 5 : C HISTORIQUE : 22/03/00: gounand 6 : C Rajout des préconditionneurs ILUT (ILU with dual truncation) et d'une 7 : C variante (ILUT2) qui remplit mieux la mémoire et des paramètres 8 : C associés : ILUTLFIL (ILUT level of fill) et ILUTDTOL (ILUT drop 9 : C tolerance) 10 : C HISTORIQUE : 20/12/99: gounand 11 : C Ajout des indices 'TYRENU' (type de renumérotation) et 'PCMLAG' 12 : C (placement des multiplicateurs de Lagrange à la table d'indice 13 : C 'METHINV'. 14 : C HISTORIQUE : 08/04/04 : ajout ILUTP 15 : C HISTORIQUE : 27/10/10: JCARDO: correction bug lié à IARG, qui pouvait 16 : C parfois valoir zéro à tort (label 110) 17 : C HISTORIQUE : 18 : C*********************************************************************** 19 : IMPLICIT REAL*8 (A-H,O-Z) 20 : IMPLICIT INTEGER (I-N) 21 : PARAMETER (NBM=21,NBL=4,NOPT=75) 22 : PARAMETER (NTB=2,NBH=7) 23 : -INC CCOPTIO 24 : -INC SMLREEL 25 : -INC SMLENTI 26 : POINTEUR MLENT4.MLENTI 27 : -INC SMLMOTS 28 : POINTEUR MINCO.MLMOTS 29 : -INC SMELEME 30 : POINTEUR IGEOM.MELEME 31 : -INC SMMODEL 32 : -INC SMCHPOI 33 : POINTEUR MCHINI.MCHPOI 34 : 35 : LOGICAL XEQUA,TTRAN,TPROJ,LOG1 36 : INTEGER RESTRT 37 : CHARACTER*8 LMOTS(NBM),NOM,CHAI,NOMZ,MTYP,NOMI,NOML,NMACO 38 : CHARACTER*8 LSCHE(NBH) 39 : CHARACTER*20 NOMO,MEQUA,MNEFMD 40 : CHARACTER*8 TYPE,TYPC,TYPS 41 : CHARACTER*8 LOPTI(NOPT) 42 : CHARACTER*8 MOIMP(NBL) 43 : DIMENSION KINCD(100) 44 : CHARACTER*8 TINCD(100) 45 : 46 : CHARACTER*8 LTAB(NTB) 47 : DIMENSION KTAB(NTB) 48 : 49 : DATA LMOTS /'ZONE ','OPER ','INCO ','CLIM ', 50 : & 'ITMA ','ALFA ','DTI ','IIMP ', 51 : & 'DUMP ','OPTI ','NOMVI ','DOMINC ', 52 : & 'TPSI ','TFINAL ','FIDT ','NISTO ', 53 : & 'NITER ','OMEGA ','EPS ','IMPR ', 54 : & 'EQUA '/ 55 : DATA MOIMP /'UIMP ','VIMP ','WIMP ','TIMP '/ 56 : 57 : DATA LOPTI / 58 : C indice KFORM 0 à 3 59 : & 'EFM1 ','EF ','VF ','EFMC ','????????', 60 : & 'LINE ','MACRO ','QUAF ','LINB ','ISOQ ', 61 : C indice IDCEN 62 : & 'CENTREE ','SUPGDC ','SUPG ','TVISQUEU','CNG ', 63 : & 'PSI ','JOHNSON ','UPWIND ','GODUNOV ','VANLEER ', 64 : & 'VLH ','HUSVL ','HUSVLH ','AUSM ','CG ', 65 : & 'VSM ','VSMCC ','SUPGDCH ','SUPGH ','????????', 66 : C indice KPOIN 67 : & 'SOMMET ','FACE ','CENTRE ','CENTREP0','CENTREP1', 68 : & 'MSOMMET ','????????','????????','????????','????????', 69 : C indice KIMPL ---------------------->|indice ISCHT 70 : & 'IMPL ','EXPL ','SEMI ','BDF2 ','BDF4 ', 71 : & 'DIV2 ','CMD ','RIGIDITE','LIMITE ','NODIV ', 72 : C indice IKOMP-------------->| RNG KMACO ALE 73 : & 'CONS ','NOCONS ','CONS2 ','RNG ','ALE ', 74 : C indice MTRMASS---------------------->| 75 : & 'MMPLEINE','MMDIAGO ','MMPG ','MATCONS ','????????', 76 : C indice IDEUL ------------------------->| 77 : & 'EULER ','EULERMS ','EULERMST','????????','????????', 78 : C indice KPOIND->| 79 : & 'INCOD ','INCOP ','STABP ','MUCONS ','FTAU ', 80 : C 81 : & 'MUVARI ','????????','????????','????????','????????'/ 82 : 83 : DATA LSCHE /'EUL_EXPL','EUL_IMPL','TVISQ ','SEMI ', 84 : & 'CN ','CNG ','BDF2 '/ 85 : 86 : DATA LTAB/'DOMAINE ','EQEX '/ 87 : C*** 88 : C WRITE(IOIMP,*) ' DEBUT EQEX ' 89 : NBIK=0 90 : IDP=0 91 : MTABD=0 91 : CALL INITI(KTAB,NTB,0) 92 : 93 : C Définition des options par défaut 93 : CALL CRTABL(KOPT) 93 : CALL ECMM(KOPT,'SOUSTYPE','KOPT') 93 : CALL ECME(KOPT,'IDCEN',2) 93 : CALL ECME(KOPT,'RNG ',1) 93 : CALL ECME(KOPT,'IKOMP',0) 93 : CALL ECME(KOPT,'KMACO',0) 93 : CALL ECMM(KOPT,'NMACO','xxxxxxxx') 93 : CALL ECME(KOPT,'KIMPL',0) 93 : CALL ECME(KOPT,'KFORM',0) 93 : CALL ECMF(KOPT,'AIMPL',1.D0) 93 : CALL ECME(KOPT,'ALE',0) 93 : CALL ECME(KOPT,'KMU',0) 93 : CALL ECME(KOPT,'KPOIND',99) 93 : CALL ECME(KOPT,'KPOIN',2) 93 : CALL ECME(KOPT,'MTRMASS ',1) 93 : CALL ECME(KOPT,'IDEUL ',1) 93 : CALL ECME(KOPT,'ISCHT',0) 93 : CALL ECME(KOPT,'IDIV',0) 93 : CALL ECMF(KOPT,'CMD',0.2D0) 93 : CALL ECMF(KOPT,'STABP',1.D-2) 93 : CALL ECME(KOPT,'RIGIDITE',0) 93 : CALL ECME(KOPT,'LIMITE',0) 93 : c CALL ECMM(KOPT,'INEFMD','xxxxxxxx') 94 : 95 : 95 : CALL QUETYP(TYPE,0,IRET) 96 : 97 : MATABL=0 98 : MMODEL=0 99 : IF(TYPE.EQ.'MMODEL')THEN 99 : CALL LIROBJ('MMODEL',MMODEL,0,IRET) 99 : CALL LEKMOD(MMODEL,MTBLE,INEFMD) 100 : IF(MTBLE.EQ.0)RETURN 101 : KTAB(1)=MTBLE 102 : KTAB(2)=0 102 : CALL ECMM(KOPT,'INEFMD',LOPTI(5+INEFMD)) 103 : 104 : ELSEIF(TYPE.EQ.'MOT')THEN 105 : C Nouvelle directive EQUA 106 : c write(6,*)' Nouvelle directive EQUA' 106 : CALL LIRCHA(CHAI,1,LCHAR) 107 : KTAB(1)=-1 108 : KTAB(2)=0 109 : IF(CHAI(1:4).NE.'EQUA')THEN 109 : CALL ECRCHA(CHAI) 110 : GO TO 6 111 : ENDIF 112 : 112 : CALL CRTABL(MATABL) 112 : CALL ECMM(MATABL,'SOUSTYPE','EQEX') 113 : XEQUA=.TRUE. 113 : CALL ECML(MATABL,'XEQUA',XEQUA) 113 : CALL ECML(MATABL,'XRIG',.FALSE.) 114 : C Lecture du nom de l'equation/inconnue 115 : NBIC=0 116 : JGN=4 117 : JGM=0 118 : NINCT=0 119 : SEGINI MLMOT2 119 : CALL ECMO(MATABL,'LISTINCO','LISTMOTS',MLMOT2) 120 : SEGDES MLMOT2 121 : 3 CONTINUE 121 : CALL QUETYP(MTYP,0,IRET) 122 : IF(MTYP.EQ.'MMODEL ')THEN 123 : GO TO 4 124 : ELSEIF(MTYP.EQ.'MOT ')THEN 124 : CALL LIRCHA(CHAI,1,LCHAR) 125 : IF(CHAI.EQ.'RIGIDITE')THEN 125 : CALL ECML(MATABL,'XRIG',.TRUE.) 126 : GO TO 3 127 : ENDIF 128 : 129 : NBIC=NBIC+1 130 : SEGACT MLMOT2 131 : JGM=NBIC 132 : SEGADJ MLMOT2 133 : MLMOT2.MOTS(NBIC)=CHAI 134 : SEGDES MLMOT2 135 : GO TO 3 136 : ELSE 137 : C On ne trouve pas d'objet de type %m1:8 138 : MOTERR( 1: 8) = ' ' 138 : CALL ERREUR(38) 139 : RETURN 140 : ENDIF 141 : 142 : 143 : 4 CONTINUE 144 : IF(NBIC.EQ.0)THEN 145 : C On ne trouve pas d'objet de type %m1:8 146 : MOTERR( 1: 8) = 'MOT ' 146 : CALL ERREUR(38) 147 : RETURN 148 : ENDIF 149 : 149 : CALL LIROBJ('MMODEL',MMODEL,0,IRET) 149 : CALL ECMO(MATABL,'MODELE','MMODEL ',MMODEL) 150 : SEGACT MMODEL 151 : * Détermination de MACRO et INEFMD 152 : IMODEL = KMODEL(1) 153 : SEGACT IMODEL 154 : IF(NEFMOD.GE.129.AND.NEFMOD.LE.135)THEN 155 : INEFMD=1 156 : ELSEIF(NEFMOD.GE.136.AND.NEFMOD.LE.141)THEN 157 : INEFMD=2 158 : ELSEIF(NEFMOD.GE.143.AND.NEFMOD.LE.149)THEN 159 : INEFMD=3 160 : ELSEIF(NEFMOD.GE.158.AND.NEFMOD.LE.164)THEN 161 : INEFMD=4 162 : ELSE 163 : C% Le type d'élément fini %m1:8 ne convient pas. 164 : WRITE(NOM,FMT='(I8)')NEFMOD 165 : MOTERR( 1: 8) = NOM 165 : CALL ERREUR(926) 166 : RETURN 167 : ENDIF 168 : SEGDES MMODEL,IMODEL 168 : CALL ECMM(KOPT,'INEFMD',LOPTI(5+INEFMD)) 168 : CALL ECMM(MATABL,'INEFMD',LOPTI(5+INEFMD)) 169 : 170 : JGN=8 171 : JGM=NBIC 172 : NINCT=0 173 : SEGINI MLMOT3 173 : CALL ECMO(MATABL,'TYPEINCO','LISTMOTS',MLMOT3) 174 : DO 5 I=1,NBIC 174 : CALL LIRCHA(CHAI,1,LCHAR) 175 : IF(LCHAR.EQ.0)THEN 176 : C On ne trouve pas d'objet de type %m1:8 177 : MOTERR( 1: 8) = 'MOT ' 177 : CALL ERREUR(38) 178 : RETURN 179 : ENDIF 180 : 180 : CALL ECMM(MATABL,'TYPPRESS','MSOMMET ') 181 : IF(CHAI.EQ.'PRESSION')THEN 181 : CALL LIRCHA(NOM,1,LCHAR) 181 : CALL OPTLI(IPRE,LOPTI(33),NOM,4) 182 : IF(IPRE.EQ.0)THEN 183 : C% On a lu : %m1:8 : , alors qu'on attend un des mots clés suivant : 184 : C% %m9:16 %m17:24 %m25:32 %m33:40 185 : MOTERR( 1: 8) = NOM 186 : MOTERR( 9:16) = LOPTI(33) 187 : MOTERR(17:24) = LOPTI(35) 188 : MOTERR(25:32) = LOPTI(36) 188 : CALL ERREUR(930) 189 : RETURN 190 : ENDIF 190 : CALL ECMM(MATABL,'TYPPRESS',NOM) 191 : ENDIF 192 : 193 : IF(CHAI.NE.'TEMPERAT'.AND.CHAI.NE.'VITESSE'.AND. 194 : & CHAI.NE.'PRESSION')THEN 195 : C Option %m1:8 incompatible avec les données 196 : MOTERR( 1: 8) =CHAI 196 : CALL ERREUR(803) 197 : RETURN 198 : ENDIF 199 : MLMOT3.MOTS(I)=CHAI 200 : 5 CONTINUE 201 : SEGDES MLMOT3 202 : 203 : C Lecture du Schema en temps 204 : 204 : CALL LIRCHA(CHAI,1,LCHAR) 205 : IF(LCHAR.EQ.0)THEN 206 : C On ne trouve pas d'objet de type %m1:8 207 : MOTERR( 1: 8) = 'MOT ' 207 : CALL ERREUR(38) 208 : RETURN 209 : ENDIF 210 : 211 : IF(CHAI.NE.'PERM'.AND.CHAI.NE.'TRAN'.AND.CHAI.NE.'PROJ')THEN 212 : C% On a lu : %m1:8 : , alors qu'on attend un des mots clés suivant : 213 : C% %m9:16 %m17:24 %m25:32 %m33:40 214 : MOTERR( 1: 8) = CHAI 215 : MOTERR( 9:16) = 'PERM' 216 : MOTERR(17:24) = 'TRAN' 217 : MOTERR(25:32) = 'PROJ' 217 : CALL ERREUR(930) 218 : RETURN 219 : ENDIF 220 : 221 : TPROJ=.FALSE. 222 : IF(CHAI.EQ.'PERM')TTRAN=.FALSE. 223 : IF(CHAI.EQ.'TRAN')TTRAN=.TRUE. 224 : IF(CHAI.EQ.'PROJ')THEN 225 : TTRAN=.TRUE. 226 : TPROJ=.TRUE. 227 : ENDIF 227 : CALL ECML(MATABL,'TRAN',TTRAN) 227 : CALL ECML(MATABL,'PROJ',TPROJ) 228 : 229 : IP=0 230 : 231 : IF(TTRAN)THEN 232 : C Lecture des parametres du transitoire 232 : CALL QUETYP(MTYP,0,IRET) 233 : IF(IRET.EQ.0)THEN 234 : C On ne trouve pas d'objet de type %m1:8 235 : MOTERR( 1: 8) = 'MOT ou R' 235 : CALL ERREUR(38) 236 : RETURN 237 : ENDIF 238 : IF(MTYP.EQ.'MOT')THEN 238 : CALL LIRCHA(CHAI,1,LCHAR) 238 : CALL ECMM(MATABL,'DELTAT',CHAI) 239 : ELSEIF(MTYP.EQ.'FLOTTANT')THEN 239 : CALL LIRREE(XVAL,1,IRET) 239 : CALL ECMF(MATABL,'DELTAT',XVAL) 240 : ELSE 241 : C On ne trouve pas d'objet de type %m1:8 242 : MOTERR( 1: 8) = 'MOT ou R' 242 : CALL ERREUR(38) 243 : RETURN 244 : ENDIF 245 : 245 : CALL LIRCHA(NOM,1,IRET) 246 : IF(IRET.EQ.0)THEN 247 : C On ne trouve pas d'objet de type %m1:8 248 : MOTERR( 1: 8) = 'MOT ' 248 : CALL ERREUR(38) 249 : RETURN 250 : ENDIF 251 : 251 : CALL OPTLI(IPST,LSCHE,NOM,NBH) 252 : 253 : IF(IPST.EQ.0)THEN 254 : WRITE(IOIMP,*)'Directive : ',NOM 255 : WRITE(IOIMP,*)'non trouvée dans la liste ->',LSCHE 256 : RETURN 257 : ENDIF 257 : CALL ECMM(MATABL,'SCHEMAT',LSCHE(IPST)) 258 : IF(IPST.EQ.4)THEN 258 : CALL LIRREE(XVAL,1,IRET) 259 : IF(IRET.EQ.0)THEN 260 : C On ne trouve pas d'objet de type %m1:8 261 : MOTERR( 1: 8) = 'FLOTTANT' 261 : CALL ERREUR(38) 262 : RETURN 263 : ENDIF 263 : CALL ECMF(MATABL,'Betat',XVAL) 264 : ENDIF 265 : 265 : CALL ECML(MATABL,'XDIAG',.FALSE.) 266 : 267 : ENDIF 268 : 269 : DO 51 I=1,NBIC 270 : 270 : CALL LIRCHA(CHAI,1,IRET) 271 : IF(IRET.EQ.0)THEN 272 : C On ne trouve pas d'objet de type %m1:8 273 : MOTERR( 1: 8) = 'MOT ' 273 : CALL ERREUR(38) 274 : RETURN 275 : ENDIF 276 : 276 : CALL OPTLI(IP,LMOTS,CHAI,NBM) 277 : IF(IP.NE.0)THEN 278 : write(6,*)' OPTI et ZONE sont des mots cles ' 279 : write(6,*)' Choix mal venu pour un nom de variable' 280 : C On ne trouve pas d'objet de type %m1:8 281 : MOTERR( 1: 8) = 'MOT ' 281 : CALL ERREUR(38) 282 : RETURN 283 : ENDIF 284 : 285 : WRITE(NOM,FMT='(A3,I1)')'INC',I 285 : CALL ECMM(MATABL,NOM,CHAI) 286 : 287 : 51 CONTINUE 288 : 289 : IF(IPST.EQ.7.AND.TTRAN)THEN 290 : DO 52 I=1,NBIC 291 : 291 : CALL LIRCHA(CHAI,1,IRET) 292 : IF(IRET.EQ.0)THEN 293 : C On ne trouve pas d'objet de type %m1:8 294 : MOTERR( 1: 8) = 'MOT ' 294 : CALL ERREUR(38) 295 : RETURN 296 : ENDIF 297 : 298 : WRITE(NOM,FMT='(A3,I1)')'IMC',I 299 : c write(6,*)' NOM,CHAI=',NOM,CHAI 299 : CALL ECMM(MATABL,NOM,CHAI) 300 : 301 : 52 CONTINUE 302 : ENDIF 303 : 304 : 305 : ELSEIF(TYPE.EQ.'TABLE')THEN 305 : CALL LIROBJ(TYPE,MTBLE,0,IRET) 306 : TYPC=' ' 306 : CALL ACMO(MTBLE,'SOUSTYPE',TYPC,IRET) 307 : IF(TYPC.EQ.'MOT ')THEN 307 : CALL ACMM(MTBLE,'SOUSTYPE',TYPS) 308 : IF(TYPS.EQ.'DOMAINE')THEN 309 : KTAB(1)=MTBLE 310 : KTAB(2)=0 311 : XEQUA=.FALSE. 311 : CALL ECML(MTBLE,'XEQUA',XEQUA) 311 : CALL ECMM(MTBLE,'INEFMD',' ') 311 : CALL ECMM(KOPT,'INEFMD',' ') 312 : ELSEIF(TYPS.EQ.'EQEX')THEN 313 : KTAB(1)=0 314 : KTAB(2)=MTBLE 314 : CALL ACML(MTBLE,'XEQUA',XEQUA) 314 : CALL ACMM(MTBLE,'INEFMD',MNEFMD) 314 : CALL ECMM(KOPT,'INEFMD',MNEFMD) 315 : ELSE 316 : WRITE(IOIMP,*)' On attend une table soustype DOMAINE ou EQEX' 317 : RETURN 318 : ENDIF 319 : ENDIF 320 : ELSE 321 : KTAB(1)=-1 322 : KTAB(2)=0 323 : ENDIF 324 : 325 : 6 CONTINUE 326 : 327 : IF(KTAB(2).NE.0)THEN 328 : MTABLE=KTAB(2) 329 : TYPE='LISTMOTS' 329 : CALL ACMO(MTABLE,'LISTOPER',TYPE,MLMOT1) 330 : SEGACT MLMOT1 331 : NEQUA=MLMOT1.MOTS(/2) 332 : ELSEIF(KTAB(1).NE.0)THEN 333 : MTABD=KTAB(1) 334 : 335 : IF(MATABL.EQ.0)THEN 335 : CALL CRTABL(MTABLE) 335 : CALL ECMM(MTABLE,'SOUSTYPE','EQEX') 336 : XEQUA=.FALSE. 336 : CALL ECML(MTABLE,'XEQUA',XEQUA) 336 : CALL ECMM(MTABLE,'INEFMD',' ') 336 : CALL ECMM(KOPT,'INEFMD',MNEFMD) 337 : ELSE 338 : MTABLE=MATABL 339 : ENDIF 339 : CALL CRTABL(MINCO) 339 : CALL ECMM(MINCO,'SOUSTYPE','INCO') 340 : NEQUA=0 340 : CALL ECME(MTABLE,'DISCPRES',0) 341 : IF(KTAB(1).GT.0)THEN 341 : IF(MMODEL.EQ.0)CALL ECMO(MTABLE,'DOMAINE','TABLE ',MTABD) 341 : CALL ECME(MTABLE,'NAVISTOK',MMODEL) 342 : ELSE 342 : CALL ECME(MTABLE,'NAVISTOK',-1) 343 : ENDIF 344 : C? IF(MMODEL.NE.0)THEN 344 : C CALL ECMO(MTABLE,'DOMAINE','MMODEL ',MMODEL) 344 : C CALL ECMO(MTABLE,'TDOMAINE','TABLE ',MTABD) 344 : C? CALL ECMO(MTABLE,'DOMAINE','TABLE ',MTABD) 345 : C? ENDIF 345 : CALL ECMO(MTABLE,'INCO','TABLE ',MINCO) 345 : CALL ECMM(MTABLE,'NOMVI','UN') 346 : JGN=8 347 : JGM=0 348 : SEGINI MLMOT1 348 : CALL ECMO(MTABLE,'LISTOPER','LISTMOTS',MLMOT1) 348 : CALL ECME(MTABLE,'ITMA',0) 348 : CALL ECMF(MTABLE,'ALFA',1.D0) 348 : CALL ECME(MTABLE,'FIDT',20) 348 : CALL ECME(MTABLE,'NISTO',20) 348 : CALL ECME(MTABLE,'NITER',1) 348 : CALL ECME(MTABLE,'IPP',0) 348 : CALL ECME(MTABLE,'IMPR',0) 348 : CALL ECMF(MTABLE,'OMEGA',1.D0) 348 : CALL ECMF(MTABLE,'EPS',1.D-2) 348 : CALL ECMF(MTABLE,'TFINAL',1.D30) 349 : NAT=2 350 : NSOUPO=0 351 : SEGINI MCHPOI 352 : JATTRI(1)=2 352 : CALL ECMO(MTABLE,'CLIM','CHPOINT',MCHPOI) 353 : 353 : CALL CRTABL(MTABT) 353 : CALL ECMM(MTABT,'SOUSTYPE','PASDETPS') 353 : CALL ECMO(MTABLE,'PASDETPS','TABLE ',MTABT) 354 : IPAT=1 354 : CALL ECME(MTABT,'NUPASDT',IPAT) 355 : DT=1.D30 355 : CALL ECMF(MTABT,'DELTAT',DT) 355 : CALL ECMF(MTABT,'DELTAT-1',DT) 356 : TPS=0.D0 356 : CALL ECMF(MTABT,'TPS',TPS) 356 : CALL ECMM(MTABT,'OPER','EQEX') 356 : CALL ECMM(MTABT,'ZONE','EQEX') 356 : CALL ECMF(MTABT,'DTCONV',0.D0) 356 : CALL ECMF(MTABT,'DTDIFU',0.D0) 356 : CALL ECMF(MTABT,'DIAEL',0.D0) 356 : CALL ECME(MTABT,'NUEL',0) 357 : 358 : C Définition de la méthode d'inversion et des paramètres 359 : C éventuels associés 359 : CALL CRTABL(MTINV) 359 : CALL ECMM(MTINV,'SOUSTYPE','METHINV') 359 : CALL ECMO(MTABLE,'METHINV ','TABLE ',MTINV) 360 : C Méthode d'inversion du système 361 : C 1 : résolution directe (Choleski) 362 : C 2 : Gradient Conjugué 363 : C 3 : Bi-Gradient Conjugué Stabilisé (BiCGSTAB) 364 : C 4 : BiCGSTAB(2) 365 : KTYPI=1 365 : CALL ECME(MTINV,'TYPINV',KTYPI) 366 : C Niveau d'impression pour la partie résolution itérative 367 : IMPINV=0 367 : CALL ECME(MTINV,'IMPINV',IMPINV) 368 : C Options spécifiques aux méthodes itératives : 369 : C 370 : C - Pour l'assemblage : type de renumérotation 371 : C * 'RIEN' : pas de renumérotation 372 : C * 'SLOA' : algorithme de chez Sloan 373 : C * 'GIPR' : Gibbs-King (profile reduction) 374 : C * 'GIBA' : Gibbs-Poole-Stockmeyer (bandwidth reduction) 374 : CALL ECMM(MTINV,'TYRENU','SLOA') 374 : * CALL ECMM(MTINV,'TYRENU','RIEN') 375 : C - Pour l'assemblage : prise en compte des mult.lag 376 : C * 'RIEN' 377 : C * 'APR2' 377 : CALL ECMM(MTINV,'PCMLAG','APR2') 378 : C - Pour l'assemblage : SCALING (type ENTIER) : 379 : C Scaling de la matrice : 380 : C - 0 : pas de scaling 381 : C - 1 : scaling par les normes L2 des lignes et des colonnes 382 : C Par défaut : 0 383 : ISCAL=0 383 : CALL ECME(MTINV,'SCALING',ISCAL) 384 : C - Pour l'assemblage : OUBMAT (type ENTIER) : 385 : C Oublie les matrices élémentaires : 386 : C - 0 : non 387 : C - 1 : oui 388 : C Par défaut : 0 389 : IOUBL=0 389 : CALL ECME(MTINV,'OUBMAT',IOUBL) 390 : C - Champoint d'initialisation de la méthode 391 : C (i.e. estimation de l'inconnue) 392 : ***** MCHINI=0 393 : NAT=0 394 : NSOUPO=0 395 : SEGINI MCHINI 396 : SEGDES MCHINI 396 : CALL ECMO(MTINV,'XINIT','CHPOINT ',MCHINI) 397 : C - Nombre maxi d'itérations à effectuer 398 : ITER=2000 398 : CALL ECME(MTINV,'NITMAX',ITER) 399 : C - Norme maxi (L2 normé par le second membre) du résidu 400 : RESID=1.D-10 400 : CALL ECMF(MTINV,'RESID',RESID) 401 : C - Type de préconditionnement : 402 : C 0 : pas de préconditionnement 403 : C 1 : préconditionnement par la diagonale 404 : C 2 : préconditionnement D-ILU 405 : C 3 : préconditionnement ILU(0) (Choleski) 406 : C 4 : préconditionnement MILU(0) (Choleski modifié) 407 : C 5 : préconditionnement ILUT (dual truncation) 408 : C 6 : préconditionnement ILUT2 (une variante du 409 : C précédent qui remplit mieux la mémoire et 410 : C fonctionne mieux quelquefois) 411 : C 7 : préconditionnement ILUTP (avec pivoting) 412 : C 8 : préconditionnement ILUTPG (avec pivoting) 413 : C ILUTP version gounand 414 : C On traite de manière spéciale les termes 415 : C qui sont dans ILU(0) 416 : C 9 : préconditionnement ILUTPG2 (avec pivoting) 417 : C ILUTP version gounand 2 418 : C On garde tous les termes qui sont dans ILU(0) 419 : KPREC=3 419 : CALL ECME(MTINV,'PRECOND',KPREC) 420 : C - Pour une méthode ILUT, on a les deux indices suivant : 421 : C * ILUTLFIL : encombrement maximal (approximatif) du 422 : C préconditionneur, par rapport à la matrice. 423 : C * ILUTDTOL : "drop tolerance" pour le préconditionneur. 424 : C i.e. en-dessous de cette valeur relative, les 425 : C termes de la factorisation incomplète seront 426 : C oubliés. 427 : XLFIL=2.D0 427 : CALL ECMF(MTINV,'ILUTLFIL',XLFIL) 428 : * -1. sinon, oubli possible des 0.D0 dans le préconditionneur 429 : XDTOL=-1.D0 429 : CALL ECMF(MTINV,'ILUTDTOL',XDTOL) 430 : C - Pour une méthode ILUTP, on a les deux indices suivant : 431 : C * ILUTPPIV (type REEL) (compris entre 0.D0 et 1.D0) : 432 : C 0.D0 : on ne pivote pas 433 : C 1.D0 : on pivote tout le temps 434 : C (recommandation : entre 0.1D0 et 0.01D0) 435 : C Par défaut : 0.1D0 436 : XSPIV=0.1D0 436 : CALL ECMF(MTINV,'ILUTPPIV',XSPIV) 437 : C - Fréquence de recalcul du préconditionneur en fonction 438 : C des deux indices de boucle suivant : 439 : C * indice de boucle sur les pas de temps 440 : C * indice de boucle sur la boucle d'itérations utilisée 441 : C pour résoudre les non-linéarités 442 : C Par défaut, on recalcule tout le temps le préconditionneur 443 : IFCPRT=1 444 : IFCPRI=1 444 : CALL ECME(MTINV,'FCPRECT',IFCPRT) 444 : CALL ECME(MTINV,'FCPRECI',IFCPRI) 445 : C - 'Breakdown tolerance' pour les méthodes de type 446 : C BiCGSTAB. Si un certain produit scalaire de vecteurs 447 : C "direction" est inférieur à cette tolérance, la 448 : C méthode s'arrete. 449 : BRTOL=1.D-40 449 : CALL ECMF(MTINV,'BCGSBTOL',BRTOL) 450 : C - Paramètre de relaxation pour le préconditionnement 451 : C MILU(0) compris entre 0. et 1. 452 : C S'il est égal à 0, on se ramène à ILU(0) 453 : C S'il est égal à 1, MILU(0) est dit non relaxé 454 : RXMILU=1.D0 454 : CALL ECMF(MTINV,'MILURELX',RXMILU) 455 : C - Paramètre de redémarrage pour GMRES(m) 456 : RESTRT=50 456 : CALL ECME(MTINV,'GMRESTRT',RESTRT) 457 : ENDIF 458 : 459 : 1 CONTINUE 459 : CALL LIRCHA(NOM,0,IRET) 460 : IF(IRET.EQ.0)GO TO 90 461 : 2 CONTINUE 462 : 463 : IF(IDP.NE.0)WRITE(IOIMP,*) ' Directive en cours :',NOM 464 : C WRITE(IOIMP,*) ' Directive en cours :',NOM 464 : CALL OPTLI(IP,LMOTS,NOM,NBM) 465 : C WRITE(IOIMP,*)' EQEX, IP=',ip,' NOM=',nom 466 : IF(IP.EQ.0)THEN 467 : WRITE(IOIMP,*)'Directive : ',NOM 468 : WRITE(IOIMP,*)'non trouvée dans la liste ->',LMOTS 469 : RETURN 470 : ENDIF 471 : 472 : 473 : GO TO (10,11,12,13,14,15,16,17,18,19,20,21,22,23,24, 474 : & 25,26,27,28,29),IP 475 : 476 : C ZONE 477 : 478 : 10 CONTINUE 479 : 479 : CALL LITABS(LTAB,KTAB,1,0,IRET) 480 : 481 : MMODEL=0 482 : IF(KTAB(1).EQ.0)THEN 482 : CALL LIROBJ('MMODEL',MMODEL,0,IRET2) 483 : IF(IRET2.EQ.0)THEN 484 : WRITE(IOIMP,*)' On attend un objet TABLE DOMAINE ou MODELE' 485 : RETURN 486 : ENDIF 486 : CALL LEKMOD(MMODEL,MTBLE,INEFMD) 487 : IF(MTBLE.EQ.0)RETURN 488 : KTAB(1)=MTBLE 488 : CALL ECMM(KOPT,'INEFMD',LOPTI(5+INEFMD)) 489 : ENDIF 490 : 490 : CALL QUENOM(NOMZ) 491 : GO TO 1 492 : 493 : C OPER 494 : 495 : 11 CONTINUE 496 : 496 : CALL LIRCHA(NOMO,1,LNOMO) 497 : IF(LNOMO.EQ.0)THEN 498 : WRITE(IOIMP,*)' ON ATTEND LE NOM DE L OPERATEUR' 499 : RETURN 500 : ENDIF 501 : 502 : * ECRITURE DU NOM DE L'OPERATEUR 503 : 504 : NEQUA=NEQUA+1 505 : IF(NEQUA.LT.10)THEN 506 : LNOMOT=LNOMO+1 507 : WRITE(MEQUA,FMT='(I1,19A1)')NEQUA,(NOMO(I:I),I=1,LNOMO) 508 : C WRITE(IOIMP,*)' MEQUA=',MEQUA 509 : ELSEIF(NEQUA.LT.100.AND.NEQUA.GE.10)THEN 510 : LNOMOT=LNOMO+2 511 : WRITE(MEQUA,FMT='(I2,18A1)')NEQUA,(NOMO(I:I),I=1,LNOMO) 512 : ELSEIF(NEQUA.LT.1000.AND.NEQUA.GE.100)THEN 513 : LNOMOT=LNOMO+3 514 : WRITE(MEQUA,FMT='(I3,17A1)')NEQUA,(NOMO(I:I),I=1,LNOMO) 515 : C WRITE(IOIMP,*)' MEQUA=',MEQUA 516 : ELSE 517 : WRITE(IOIMP,*)'PLUS DE 999 OPERATEURS : CAS NON PREVU' 518 : RETURN 519 : ENDIF 520 : JGN=8 521 : JGM=MLMOT1.MOTS(/2)+1 522 : SEGADJ MLMOT1 523 : MLMOT1.MOTS(JGM)=NOMO(1:LNOMO) 523 : C CALL LENCHA(MEQUA,LC1) 523 : CALL CRTABL(MTABX) 523 : CALL ECMM(MTABX,'SOUSTYPE','KIZX') 523 : C CALL ECMO(MTABLE,MEQUA(1:8),'TABLE',MTABX) 523 : CALL ECCTAB(MTABLE,'MOT',0,0.D0,MEQUA(1:LNOMOT),.TRUE.,0, 524 : & 'TABLE',0,0.D0,CHAI,.TRUE.,MTABX) 525 : * ECRITURE DE LA TABLE DE REFERENCE 525 : CALL ECMO(MTABX,'EQEX','TABLE',MTABLE) 526 : * ECRITURE DU NOM DE LA ZONE 526 : CALL ECMM(MTABX,'NOMZONE',NOMZ) 527 : * ECRITURE DE MELEMZ 527 : CALL ECMO(MTABX,'DOMZ','TABLE',KTAB(1)) 528 : IF(MMODEL.NE.0)THEN 528 : CALL ECMO(MTABX,'DOMZ','MMODEL',MMODEL) 528 : CALL ECMO(MTABX,'TDOMZ','TABLE',KTAB(1)) 529 : ENDIF 530 : 530 : CALL ECMM(MTABX,'NOMOPER',NOMO(1:8)) 530 : CALL ECMO(MTABX,'KOPT','TABLE',KOPT) 531 : * ECRITURE DE LA LISTE DES ARGUMENTS 532 : * 1) on initialise la variable IARG à 0 533 : * 2) chaque fois que l'on trouve un argument pour l'opérateur courant, 534 : * on incrémente cette variable et on boucle (=> GOTO 110) 535 : * 3) on met à jour 'IARG' dans MTABX dès qu'il n'y a plus d'argument: 536 : * - soit il n'y a plus d'objet passé à EQEX (=> GOTO 90) 537 : * - soit on est tombé sur un autre mot-clé (=> GOTO 2 ) 538 : IARG=0 539 : 540 : 110 CONTINUE 540 : CALL QUETYP(MTYP,0,IRET) 541 : C WRITE(IOIMP,*)' MTYP=',mtyp,' iret=',iret 542 : IF(IRET.EQ.0)THEN 543 : * PLUS AUCUN MOT DANS EQEX => ON MET À JOUR 'IARG' 543 : CALL ECME(MTABX,'IARG',IARG) 544 : GO TO 90 545 : ENDIF 546 : 547 : IF(MTYP.EQ.'MOT ')THEN 548 : 548 : CALL LIRCHA(NOM,1,IRET) 548 : CALL OPTLI(IP,LMOTS,NOM,NBM) 549 : IF(IP.EQ.0)THEN 550 : IARG=IARG+1 550 : IF(IARG.GT.9)CALL ARRET(0) 551 : CHAI=NOM 552 : WRITE(NOM,FMT='(A3,I1)')'ARG',IARG 552 : CALL ECMM(MTABX,NOM(1:4),CHAI) 553 : GO TO 110 554 : ELSE 555 : * MOT-CLÉ TROUVÉ => PLUS D'ARGUMENTS => ON MET À JOUR 'IARG' 555 : CALL ECME(MTABX,'IARG',IARG) 556 : C WRITE(IOIMP,*)' 1er gt2 nom=',nom 557 : GO TO 2 558 : ENDIF 559 : 560 : ELSEIF(MTYP.EQ.'FLOTTANT')THEN 560 : CALL LIRREE(XVAL,1,IRET) 561 : IARG=IARG+1 561 : IF(IARG.GT.9)CALL ARRET(0) 562 : WRITE(NOM,FMT='(A3,I1)')'ARG',IARG 562 : CALL ECMF(MTABX,NOM(1:4),XVAL) 563 : GO TO 110 564 : 565 : ELSEIF(MTYP.EQ.'ENTIER')THEN 565 : CALL LIRENT(IENT,1,IRET) 566 : IARG=IARG+1 566 : IF(IARG.GT.9)CALL ARRET(0) 567 : WRITE(NOM,FMT='(A3,I1)')'ARG',IARG 568 : CC XVAL=DBLE(IENT) 568 : CC CALL ECMF(MTABX,NOM(1:4),XVAL) 568 : CALL ECME(MTABX,NOM(1:4),IENT) 569 : GO TO 110 570 : 571 : ELSEIF(MTYP.EQ.'POINT')THEN 571 : CALL LIROBJ('POINT',IZTAB,1,IRET) 572 : IARG=IARG+1 572 : IF(IARG.GT.9)CALL ARRET(0) 573 : WRITE(NOM,FMT='(A3,I1)')'ARG',IARG 573 : CALL ECMO(MTABX,NOM(1:4),'POINT',IZTAB) 574 : GO TO 110 575 : 576 : ELSEIF(MTYP.EQ.'LOGIQUE ')THEN 576 : CALL LIRLOG(LOG1,1,IRET) 577 : IARG=IARG+1 577 : IF(IARG.GT.9)CALL ARRET(0) 578 : WRITE(NOM,FMT='(A3,I1)')'ARG',IARG 578 : CALL ECML(MTABX,NOM(1:4),LOG1) 579 : GO TO 110 580 : 581 : ELSE 581 : CALL LIROBJ(MTYP,IZTAB,1,IRET) 582 : IARG=IARG+1 583 : IF(IARG.GT.9)RETURN 584 : WRITE(NOM,FMT='(A3,I1)')'ARG',IARG 584 : CALL ECMO(MTABX,NOM(1:4),MTYP,IZTAB) 585 : GO TO 110 586 : 587 : ENDIF 588 : 589 : C INCO 590 : 591 : 12 CONTINUE 592 : C On crée si ce n'est pas déja fait la liste totale des inconnues 593 : C et on la complète 594 : TYPE=' ' 594 : CALL ACMO(MTABLE,'LISTINCO',TYPE,MLMOT2) 595 : IF(TYPE.NE.'LISTMOTS')THEN 596 : JGN=4 597 : JGM=0 598 : NINCT=0 599 : SEGINI MLMOT2 599 : CALL ECMO(MTABLE,'LISTINCO','LISTMOTS',MLMOT2) 600 : SEGDES MLMOT2 601 : ENDIF 602 : SEGACT MLMOT2 603 : NINCT=MLMOT2.MOTS(/2) 604 : NINCT0=0 605 : SEGDES MLMOT2 606 : 607 : C on crée la liste des inconnues associées à l'opérateur 608 : JGN=4 609 : JGM=0 610 : JG =0 611 : SEGINI MLMOTS,MLENT4 612 : * ECRITURE DE LA LISTE DES INCONNUES 612 : CALL ECMO(MTABX,'LISTINCO','LISTMOTS',MLMOTS) 612 : CALL ECMO(MTABX,'NUMEINCO','LISTENTI',MLENT4) 613 : SEGDES MLMOTS,MLENT4 614 : C on crée la liste des types d'inconnues associés à l'opérateur 615 : JGN=8 616 : JGM=0 617 : SEGINI MLMOT4 618 : * ECRITURE DE LA LISTE DES TYPES D'INCONNUES 618 : CALL ECMO(MTABX,'TYPEINCO','LISTMOTS',MLMOT4) 619 : SEGDES MLMOT4 620 : 621 : 120 CONTINUE 622 : SEGDES MLMOTS,MLMOT2 622 : CALL LIRCHA(NOM,0,IRET) 623 : IF(IRET.EQ.0)THEN 624 : GO TO 90 625 : ENDIF 626 : 626 : CALL OPTLI(IP,LMOTS,NOM,NBM) 627 : 628 : IF(IP.EQ.2.OR.IP.EQ.3)THEN 629 : WRITE(IOIMP,*)' Il faut recommencer a la directive ZONE ' 630 : RETURN 631 : ENDIF 632 : C WRITE(IOIMP,*)' EQEX : ',NOM,IP 633 : 634 : IF(IP.EQ.0)THEN 635 : 636 : NINCT0=NINCT0+1 637 : IF(NINCT0.GT.5)THEN 638 : WRITE(IOIMP,*)' Opérateur EQEX :' 639 : WRITE(IOIMP,*)' Le nombre d''inconnues semble important ', 640 : & NINCT0,' ? ',NOM 641 : ENDIF 642 : 643 : JGN=4 644 : SEGACT MLMOTS 645 : JGM=MOTS(/2)+1 646 : SEGADJ MLMOTS 647 : C WRITE(IOIMP,*)' EQEX : ',NOM,' NINCT=',ninct 648 : MOTS(JGM)=NOM 649 : 650 : C Cas directive EQUA 651 : IF(XEQUA)THEN 652 : TYPE=' ' 652 : CALL ACMO(MTABLE,'TYPEINCO',TYPE,MLMOT3) 653 : IF(TYPE.NE.'LISTMOTS')THEN 654 : write(6,*)' Petit probleme Non prevu ' 655 : RETURN 656 : ENDIF 657 : SEGACT MLMOT2,MLMOT3,MLMOT4,MLENT4 658 : NBIC=MLMOT2.MOTS(/2) 659 : DO 122 I=1,NBIC 660 : 661 : IF(NOM.EQ.MLMOT2.MOTS(I))THEN 662 : JGN=8 663 : JG=JGM 664 : SEGADJ MLMOT4,MLENT4 665 : MLMOT4.MOTS(JGM)=MLMOT3.MOTS(I) 666 : MLENT4.LECT(JGM)=I 667 : GO TO 123 668 : ENDIF 669 : 122 CONTINUE 670 : C% L'inconnue : %m1:8 : n'apparait pas dans la liste des inconnues. 671 : MOTERR( 1: 8) = NOM 671 : CALL ERREUR(931) 672 : RETURN 673 : 674 : 123 CONTINUE 675 : SEGDES MLMOT2,MLMOT3,MLMOT4,MLENT4 676 : 677 : 678 : ENDIF 679 : C On ecrit aussi directement dans MTABX NBINCO,INC1 INC2 680 : C etc comme pour les arguments 681 : C? NBINCO=JGM 682 : C? WRITE(CHAI,FMT='(A3,I1)')'INC',NBINCO 682 : C? CALL ECMM(MTABX,CHAI(1:4),NOM) 682 : C? CALL ECME(MTABX,'NBINCO',NBINCO) 683 : 684 : SEGACT MLMOT2 685 : DO 121 I=1,NINCT 686 : C WRITE(IOIMP,*)' On cherche : ',MLMOT2.MOTS(I),NOM 687 : IF(MLMOT2.MOTS(I).EQ.NOM)GO TO 120 688 : 121 CONTINUE 689 : JGM=NINCT+1 690 : NINCT=NINCT+1 691 : 692 : JGN=4 693 : SEGADJ MLMOT2 694 : MLMOT2.MOTS(JGM)=NOM 695 : GO TO 120 696 : ELSE 697 : SEGDES MLMOTS,MLMOT2 698 : C WRITE(IOIMP,*)' 2eme gt2 nom=',nom 699 : GO TO 2 700 : ENDIF 701 : 702 : C CLIM 703 : 704 : 13 CONTINUE 705 : 706 : TYPE=' ' 706 : CALL ACMO(MTABLE,'CLIM',TYPE,MCHPO1) 707 : IF(TYPE.NE.'CHPOINT')MCHPO1=0 708 : 708 : CALL LIRCHA(NOMI,0,IRET) 709 : C WRITE(IOIMP,*)' MCHPO1=',mchpo1,' NOMI=',nomi 710 : IF(IRET.EQ.0)THEN 711 : GO TO 90 712 : ENDIF 712 : CALL OPTLI(IP,LMOTS,NOMI,NBM) 713 : IF(IP.NE.0)THEN 714 : NOM=NOMI 715 : C WRITE(IOIMP,*)' 3eme gt2 nom=',nom 716 : GO TO 2 717 : ENDIF 718 : 718 : CALL LENCHA(NOMI,LCI) 719 : 719 : CALL LIRMOT(MOIMP,NBL,IP,1) 720 : IF(IP.EQ.0)THEN 721 : WRITE(IOIMP,*)' Directive CLIM : ' 722 : WRITE(IOIMP,*)' On attend un mot cle de la liste suivante :' 723 : $ ,MOIMP 724 : RETURN 725 : ENDIF 726 : 727 : WRITE(NOML,FMT='(I1,A4)')IP,NOMI 728 : IF(IP.EQ.4)NOML=NOMI 728 : CALL LIROBJ('MAILLAGE',MELEME,1,IRET) 729 : IF(IRET.EQ.0)THEN 730 : GO TO 90 731 : ENDIF 732 : 732 : CALL ECRCHA('POI1') 732 : CALL ECROBJ('MAILLAGE',MELEME) 732 : CALL PRCHAN 732 : CALL LIROBJ('MAILLAGE',MELEME,1,IRET) 733 : SEGACT MELEME 734 : N=NUM(/2) 735 : NAT=2 736 : NSOUPO=1 737 : NC=1 738 : SEGINI MCHPOI,MSOUPO,MPOVAL 739 : IFOPOI=IFOMOD 740 : MOCHDE=TITREE 741 : MTYPOI='CLIM' 742 : JATTRI(1)=2 743 : IPCHP(1)=MSOUPO 744 : C WRITE(IOIMP,*)' EQEX 1 : IPCHP,mchpoi=',IPCHP(1),mchpoi 745 : NOCOMP(1)=NOML(1:4) 746 : IGEOC=MELEME 747 : IPOVAL=MPOVAL 748 : 748 : CALL QUETYP(MTYP,1,IRET) 749 : 750 : if(mtyp.eq.'TABLE')THEN 751 : ikkt=0 752 : 1234 continue 753 : ikkt=ikkt+1 754 : WRITE(IOIMP,*)' ikkt=',ikkt 755 : if(ikkt.gt.100)return 755 : CALL LIROBJ('TABLE',IP,1,IRET) 756 : WRITE(IOIMP,*)' Petit incident ' 757 : if(ip.ne.ktab(2))then 758 : WRITE(IOIMP,*)' Gros incident ',ip,ktab 759 : endif 759 : CALL QUETYP(MTYP,0,IRET) 760 : if(mtyp.eq.'TABLE')go to 1234 761 : endif 762 : 763 : C WRITE(IOIMP,*)' MTYP a=',mtyp,iret,' N=',N 764 : 765 : IF(MTYP.EQ.'FLOTTANT')THEN 765 : CALL LIRREE(XVAL,1,IRET) 765 : CALL INITD(VPOCHA,N,XVAL) 766 : SEGDES MPOVAL 767 : ELSEIF(MTYP.EQ.'ENTIER')THEN 767 : CALL LIRENT(IENT,1,IRET) 768 : XVAL=DBLE(IENT) 768 : CALL INITD(VPOCHA,N,XVAL) 769 : SEGDES MPOVAL 770 : ELSEIF(MTYP.EQ.'CHPOINT')THEN 770 : CALL LIROBJ('CHPOINT',MCHPO2,1,IRET) 771 : SEGACT MCHPO2 772 : NSP=MCHPO2.IPCHP(/1) 772 : CALL KRIPAD(MELEME,MLENTI) 773 : SEGACT MELEME 774 : DO 3569 L=1,NSP 775 : MSOUP2=MCHPO2.IPCHP(L) 776 : SEGACT MSOUP2 777 : IGEOM=MSOUP2.IGEOC 778 : MPOVA2=MSOUP2.IPOVAL 779 : SEGACT IGEOM,MPOVA2 780 : NBEL=IGEOM.NUM(/2) 781 : DO 3568 I=1,NBEL 782 : I1=IGEOM.NUM(1,I) 783 : II1=LECT(I1) 784 : IF(II1.EQ.0)GO TO 3568 785 : VPOCHA(II1,1)=MPOVA2.VPOCHA(I,1) 786 : 3568 CONTINUE 787 : SEGDES MSOUP2,IGEOM,MPOVA2 788 : 3569 CONTINUE 789 : SEGSUP MLENTI 790 : SEGDES MCHPO2 791 : 792 : ELSE 793 : WRITE(IOIMP,*)' TYPE NON ENCORE TRAITE' 794 : RETURN 795 : ENDIF 796 : SEGDES MCHPOI,MSOUPO,MPOVAL 797 : 798 : IF(MCHPO1.NE.0)THEN 798 : CALL ECROBJ('CHPOINT',MCHPOI) 798 : CALL ECROBJ('CHPOINT',MCHPO1) 798 : CALL PRFUSE 798 : CALL LIROBJ('CHPOINT',MCHPOI,1,IRET) 799 : ENDIF 799 : CALL ECMO(MTABLE,'CLIM','CHPOINT',MCHPOI) 800 : 801 : GO TO 13 802 : 803 : C ITMA 804 : 805 : 14 CONTINUE 805 : CALL LIRENT(IENT,1,IRET) 806 : IF(IRET.EQ.0)THEN 807 : WRITE(IOIMP,*)' MOT CLE ITMA (Nb maximum de pas de temps) :' 808 : WRITE(IOIMP,*)' On attend un entier ' 809 : RETURN 810 : ENDIF 810 : CALL ECME(MTABLE,'ITMA',IENT) 811 : GO TO 1 812 : 813 : C ALFA 814 : 815 : 15 CONTINUE 815 : CALL LIRREE(XVAL,1,IRET) 816 : IF(IRET.EQ.0)THEN 817 : WRITE(IOIMP,*)' MOT CLE ALFA (Tolerance sur le pas de temps) :' 818 : WRITE(IOIMP,*)' doit etre compris entre 0 et 1 (1 par defaut)' 819 : WRITE(IOIMP,*)' On attend un flottant ' 820 : RETURN 821 : ENDIF 821 : CALL ECMF(MTABLE,'ALFA',XVAL) 822 : GO TO 1 823 : 824 : C DTI 825 : 826 : 16 CONTINUE 826 : CALL LIRREE(XVAL,1,IRET) 827 : IF(IRET.EQ.0)THEN 828 : WRITE(IOIMP,*)' MOT CLE DTI (Pas de temps iinitial) :' 829 : WRITE(IOIMP,*)' On attend un flottant ' 830 : RETURN 831 : ENDIF 832 : DT=XVAL 832 : CALL ECMF(MTABT,'DELTAT',DT) 832 : CALL ECMF(MTABT,'DELTAT-1',DT) 833 : GO TO 1 834 : 835 : C IIMP 836 : 837 : 17 CONTINUE 838 : 839 : TYPE=' ' 839 : CALL ACMO(MTABLE,'IIMP',TYPE,MCHPO1) 840 : IF(TYPE.NE.'CHPOINT')MCHPO1=0 841 : 841 : CALL LIRCHA(NOMI,0,IRET) 842 : IF(IRET.EQ.0)THEN 843 : GO TO 90 844 : ENDIF 844 : CALL OPTLI(IP,LMOTS,NOMI,NBM) 845 : IF(IP.NE.0)THEN 846 : NOM=NOMI 847 : C WRITE(IOIMP,*)' 4eme gt2 nom=',nom 848 : GO TO 2 849 : ENDIF 850 : 850 : CALL LENCHA(NOMI,LCI) 851 : 851 : CALL LIRMOT(MOIMP,NBL,IP,1) 852 : IF(IP.EQ.0)THEN 853 : WRITE(IOIMP,*)' Directive IIMP : ' 854 : WRITE(IOIMP,*)' On attend un mot cle de la liste suivante :' 855 : $ ,MOIMP 856 : RETURN 857 : ENDIF 858 : C WRITE(IOIMP,*)' MOIMP=',moimp(ip) 859 : 860 : WRITE(NOML,FMT='(I1,A4)')IP,NOMI 861 : IF(IP.EQ.4)NOML=NOMI 862 : 862 : CALL LIROBJ('MAILLAGE',MELEME,1,IRET) 863 : IF(IRET.EQ.0)THEN 864 : GO TO 90 865 : ENDIF 866 : 866 : CALL ECRCHA('POI1') 866 : CALL ECROBJ('MAILLAGE',MELEME) 866 : CALL PRCHAN 866 : CALL LIROBJ('MAILLAGE',MELEME,1,IRET) 867 : SEGACT MELEME 868 : N=NUM(/2) 869 : NAT=2 870 : NSOUPO=1 871 : NC=1 872 : SEGINI MCHPOI,MSOUPO,MPOVAL 873 : IFOPOI=IFOMOD 874 : MOCHDE=TITREE 875 : MTYPOI='IIMP' 876 : JATTRI(1)=2 877 : IPCHP(1)=MSOUPO 878 : C WRITE(IOIMP,*)' EQEX 2 : IPCHP,mchpoi=',IPCHP(1),mchpoi 879 : NOCOMP(1)=NOML(1:4) 880 : IGEOC=MELEME 881 : IPOVAL=MPOVAL 882 : 882 : CALL QUETYP(MTYP,1,IRET) 883 : C WRITE(IOIMP,*)' MTYP=',mtyp 884 : 885 : IF(MTYP.EQ.'FLOTTANT')THEN 885 : CALL LIRREE(XVAL,1,IRET) 885 : CALL INITD(VPOCHA,N,XVAL) 886 : SEGDES MPOVAL 887 : ELSEIF(MTYP.EQ.'ENTIER')THEN 887 : CALL LIRENT(IENT,1,IRET) 888 : XVAL=DBLE(IENT) 888 : CALL INITD(VPOCHA,N,XVAL) 889 : SEGDES MPOVAL 890 : ELSE 891 : WRITE(IOIMP,*)' TYPE NON ENCORE TRAITE' 892 : RETURN 893 : ENDIF 894 : SEGDES MCHPOI,MSOUPO,MPOVAL 895 : 896 : IF(MCHPO1.NE.0)THEN 896 : CALL ECROBJ('CHPOINT',MCHPOI) 896 : CALL ECROBJ('CHPOINT',MCHPO1) 896 : CALL PRFUSE 896 : CALL LIROBJ('CHPOINT',MCHPOI,1,IRET) 897 : ENDIF 897 : CALL ECMO(MTABLE,'IIMP','CHPOINT',MCHPOI) 898 : 899 : GO TO 17 900 : 901 : C DUMP 902 : 903 : 18 CONTINUE 904 : IDP=1 905 : GO TO 1 906 : 907 : C OPTI 908 : 909 : 19 CONTINUE 910 : C Définition des options par défaut 910 : CALL CRTABL(KOPT1) 910 : CALL ECMM(KOPT1,'SOUSTYPE','KOPT') 911 : 911 : CALL ACME(KOPT,'IDCEN',IDCEN) 911 : CALL ACME(KOPT,'RNG ',KRNG) 911 : CALL ACME(KOPT,'IKOMP',IKOMP) 911 : CALL ACME(KOPT,'KMACO',KMACO) 911 : CALL ACMM(KOPT,'NMACO',NMACO) 911 : CALL ACME(KOPT,'KIMPL',KIMPL) 911 : CALL ACME(KOPT,'KFORM',KFORM) 911 : CALL ACMF(KOPT,'AIMPL',AIMPL) 911 : CALL ACME(KOPT,'ALE ',KALE) 911 : CALL ACME(KOPT,'KMU',KMU) 911 : CALL ACME(KOPT,'KPOIND',KPOIND) 911 : CALL ACME(KOPT,'KPOIN',KPOIN) 911 : CALL ACME(KOPT,'MTRMASS ',MTRMAS) 911 : CALL ACME(KOPT,'IDEUL ',IDEUL) 911 : CALL ACME(KOPT,'ISCHT',ISCHT) 911 : CALL ACME(KOPT,'IDIV',IDIV) 911 : CALL ACMF(KOPT,'CMD',CMD) 911 : CALL ACMF(KOPT,'STABP',STAB) 911 : CALL ACME(KOPT,'RIGIDITE',IRIG) 911 : CALL ACME(KOPT,'LIMITE',LIMITE) 911 : CALL ACMM(KOPT,'INEFMD',MNEFMD) 912 : 912 : CALL ECME(KOPT1,'IDCEN',IDCEN) 912 : CALL ECME(KOPT1,'RNG ',KRNG) 912 : CALL ECME(KOPT1,'IKOMP',IKOMP) 912 : CALL ECME(KOPT1,'KMACO',KMACO) 912 : CALL ECMM(KOPT1,'NMACO',NMACO) 912 : CALL ECME(KOPT1,'KIMPL',KIMPL) 912 : CALL ECME(KOPT1,'KFORM',KFORM) 913 : IF(KIMPL.EQ.1)AIMPL=1.D0 914 : IF(KIMPL.EQ.0)AIMPL=0.D0 914 : CALL ECMF(KOPT1,'AIMPL',AIMPL) 914 : CALL ECME(KOPT1,'ALE',KALE) 914 : CALL ECME(KOPT1,'KMU',KMU) 914 : C? CALL ECME(KOPT1,'KPOIND',99) 914 : CALL ECME(KOPT1,'KPOIND',KPOIND) 914 : CALL ECME(KOPT1,'KPOIN',KPOIN) 914 : CALL ECME(KOPT1,'MTRMASS ',MTRMAS) 914 : CALL ECME(KOPT1,'IDEUL ',IDEUL) 914 : CALL ECME(KOPT1,'ISCHT',ISCHT) 914 : CALL ECME(KOPT1,'IDIV',IDIV) 914 : CALL ECMF(KOPT1,'CMD',CMD) 914 : CALL ECMF(KOPT1,'STABP',STAB) 914 : CALL ECME(KOPT1,'RIGIDITE',IRIG) 914 : CALL ECME(KOPT1,'LIMITE',LIMITE) 914 : CALL ECMM(KOPT1,'INEFMD',MNEFMD) 915 : 916 : KOPT=KOPT1 917 : 918 : 191 CONTINUE 918 : CALL LIRCHA(NOM,0,IRET) 919 : IF(IRET.EQ.0)THEN 920 : GO TO 90 921 : ENDIF 921 : CALL OPTLI(IP,LOPTI,NOM,NOPT) 922 : IF(IP.EQ.0)THEN 922 : CALL ECRCHA(NOM) 923 : GO TO 1 924 : ENDIF 925 : C write(6,*)' NOM=',NOM,IP 926 : 927 : GO TO (1901,1902,1903,1904,1905,1906,1907,1908,1909,1910, 928 : & 1911,1912,1913,1914,1915,1916,1917,1918,1919,1920, 929 : & 1921,1922,1923,1924,1925,1926,1927,1928,1929,1930, 930 : & 1931,1932,1933,1934,1935,1936,1937,1938,1939,1940, 931 : & 1941,1942,1943,1944,1945,1946,1947,1948,1949,1950, 932 : & 1951,1952,1953,1954,1955,1956,1957,1958,1959,1960, 933 : & 1961,1962,1963,1964,1965,1966,1967,1968,1969,1970, 934 : & 1971,1972,1973,1974,1975 ),IP 935 : 936 : C Formulation EFM1 936 : 1901 CALL ECME(KOPT,'KFORM',0) 937 : GO TO 191 938 : C Formulation EF 938 : 1902 CALL ECME(KOPT,'KFORM',1) 939 : GO TO 191 940 : C Formulation VF 940 : 1903 CALL ECME(KOPT,'KFORM',2) 941 : GO TO 191 942 : C Formulation EFMC 942 : 1904 CALL ECME(KOPT,'KFORM',3) 943 : GO TO 191 944 : 945 : C Emplacements libres pour une nouvelle formulation 946 : 1905 CONTINUE 947 : GO TO 191 948 : 949 : C Formulation EF LINE 949 : 1906 CALL ECMM(KOPT,'INEFMD','LINE') 950 : GO TO 191 951 : C Formulation EF MACRO 951 : 1907 CALL ECMM(KOPT,'INEFMD','MACRO') 952 : GO TO 191 953 : C Formulation EF QUAF 953 : 1908 CALL ECMM(KOPT,'INEFMD','QUAF') 954 : GO TO 191 955 : C Formulation EF LINB 955 : 1909 CALL ECMM(KOPT,'INEFMD','LINB') 956 : GO TO 191 957 : C Formulation EF LINB 957 : 1910 CALL ECMM(KOPT,'INEFMD','ISOQ') 958 : GO TO 191 959 : 960 : C CENTREE 960 : 1911 CALL ECME(KOPT,'IDCEN',1) 961 : GO TO 191 962 : C SUPGDC 962 : 1912 CALL ECME(KOPT,'IDCEN',2) 963 : GO TO 191 964 : C SUPG 964 : 1913 CALL ECME(KOPT,'IDCEN',3) 965 : GO TO 191 966 : C Tenseur visqueux 966 : 1914 CALL ECME(KOPT,'IDCEN',4) 967 : GO TO 191 968 : C Crank Nicholson généralisé 968 : 1915 CALL ECME(KOPT,'IDCEN',5) 969 : GO TO 191 970 : C PSI 970 : 1916 CALL ECME(KOPT,'IDCEN',6) 971 : GO TO 191 972 : C JOHNSON 972 : 1917 CALL ECME(KOPT,'IDCEN',7) 973 : GO TO 191 974 : C UPWIND 974 : 1918 CALL ECME(KOPT,'IDCEN',8) 975 : GO TO 191 976 : C GODUNOV 976 : 1919 CALL ECME(KOPT,'IDCEN',9) 977 : GO TO 191 978 : C VANLEER 978 : 1920 CALL ECME(KOPT,'IDCEN',10) 979 : GO TO 191 980 : C VLH (VAN LEER - HANEL) 980 : 1921 CALL ECME(KOPT,'IDCEN',11) 981 : GO TO 191 982 : C HUSVL (VAN LEER + OSHER) 982 : 1922 CALL ECME(KOPT,'IDCEN',12) 983 : GOTO 191 984 : C HUSVLH (VAN LEER - HANEL + OSHER) 984 : 1923 CALL ECME(KOPT,'IDCEN',13) 985 : GOTO 191 986 : C AUSM (AUSM+) 986 : 1924 CALL ECME(KOPT,'IDCEN',14) 987 : GOTO 191 988 : C CG Colella-Glaz 988 : 1925 CALL ECME(KOPT,'IDCEN',15) 989 : GOTO 191 990 : C VSM Viscosité de sous-maille 990 : 1926 CALL ECME(KOPT,'IDCEN',16) 991 : GOTO 191 992 : C VSMCC Viscosité de sous-maille Capture de choc 992 : 1927 CALL ECME(KOPT,'IDCEN',17) 993 : GOTO 191 994 : C SUPGDCH 994 : 1928 CALL ECME(KOPT,'IDCEN',18) 995 : GOTO 191 996 : C SUPGH 996 : 1929 CALL ECME(KOPT,'IDCEN',19) 997 : GOTO 191 998 : C emplacements libres pour nouveaux schema 999 : 1930 CONTINUE 1000 : GO TO 191 1001 : 1002 : C sommet 1002 : 1931 CALL ECME(KOPT,'KPOIN',0) 1003 : GO TO 191 1004 : C face 1004 : 1932 CALL ECME(KOPT,'KPOIN',1) 1005 : GO TO 191 1006 : C centre 1006 : 1933 CALL ECME(KOPT,'KPOIN',2) 1007 : GO TO 191 1008 : C centrep0 1008 : 1934 CALL ECME(KOPT,'KPOIN',3) 1009 : GO TO 191 1010 : C centrep1 1010 : 1935 CALL ECME(KOPT,'KPOIN',4) 1011 : GO TO 191 1012 : C msommet 1012 : 1936 CALL ECME(KOPT,'KPOIN',5) 1013 : GO TO 191 1014 : C Emplacements libres pour de nouveaux points 1015 : 1937 CONTINUE 1016 : 1938 CONTINUE 1017 : 1939 CONTINUE 1018 : 1940 CONTINUE 1019 : GO TO 191 1020 : 1021 : C Implicite 1021 : 1941 CALL ECME(KOPT,'KIMPL',1) 1021 : CALL ECMF(KOPT,'AIMPL',1.D0) 1022 : GO TO 191 1023 : C Explicite 1023 : 1942 CALL ECME(KOPT,'KIMPL',0) 1023 : CALL ECMF(KOPT,'AIMPL',0.D0) 1024 : GO TO 191 1025 : C Semi implicite 1025 : 1943 CALL ECME(KOPT,'KIMPL',2) 1026 : C? WRITE(IOIMP,*)' EQEX KIMPL mis a 2 ' 1026 : CALL QUETYP(MTYP,0,IRET) 1027 : IF(MTYP.EQ.'FLOTTANT')THEN 1027 : CALL LIRREE(AIMPL,0,IRET) 1027 : CALL ECMF(KOPT,'AIMPL',AIMPL) 1028 : ELSE 1028 : CALL ECMF(KOPT,'AIMPL',0.5D0) 1029 : ENDIF 1030 : GO TO 191 1031 : C Schema en temps implicite 2eme ordre BDF2 1031 : 1944 CALL ECME(KOPT,'ISCHT',1) 1032 : GO TO 191 1033 : C Schema en temps implicite 4eme ordre BDF4 1033 : 1945 CALL ECME(KOPT,'ISCHT',2) 1034 : GO TO 191 1035 : C Rajout du terme 1/2 T Div U pour stabiliser (par defaut 0) 1035 : 1946 CALL ECME(KOPT,'IDIV',1) 1036 : GO TO 191 1037 : C Coefficient multiplicateur du decentrement (par defaut 1.) 1038 : 1947 CONTINUE 1038 : CALL QUETYP(MTYP,0,IRET) 1039 : IF(MTYP.EQ.'FLOTTANT')THEN 1039 : CALL LIRREE(CMD,0,IRET) 1040 : IF(IRET.EQ.0)THEN 1041 : GO TO 90 1042 : ENDIF 1042 : CALL ECMF(KOPT,'CMD',CMD) 1043 : ELSE 1044 : RETURN 1045 : ENDIF 1046 : GO TO 191 1047 : C Format des matrices RIGIDITE IRIG = 1 MATRIK IRIG = 0 defaut 1048 : 1948 CONTINUE 1048 : CALL ECME(KOPT,'RIGIDITE',1) 1049 : GO TO 191 1050 : C LIMITE Limiteur divers active (Kepsilon ou autre) 1051 : 1949 CONTINUE 1051 : CALL ECME(KOPT,'LIMITE',1) 1052 : GO TO 191 1053 : C NODIV 1054 : 1950 CONTINUE 1054 : CALL ECME(KOPT,'IDIV',0) 1055 : GO TO 191 1056 : C Emplacements libres pour de nouveaux Schéma 1057 : 1058 : C Formulation conservative 1058 : 1951 CALL ECME(KOPT,'IKOMP',1) 1059 : C Formulation non conservative 1060 : GO TO 191 1060 : 1952 CALL ECME(KOPT,'IKOMP',0) 1061 : GO TO 191 1061 : 1953 CALL ECME(KOPT,'IKOMP',2) 1062 : GO TO 191 1062 : 1954 CALL ECME(KOPT,'RNG ',2) 1063 : GO TO 191 1063 : 1955 CALL ECME(KOPT,'ALE',1) 1064 : GO TO 191 1065 : C Matrice masse pleine 1065 : 1956 CALL ECME(KOPT,'MTRMASS ',1) 1066 : GO TO 191 1067 : C Matrice masse diagonale 1067 : 1957 CALL ECME(KOPT,'MTRMASS ',2) 1068 : GO TO 191 1069 : C Matrice masse consistante (Petrov Galerkin) pour le terme source 1069 : 1958 CALL ECME(KOPT,'MTRMASS ',3) 1070 : GO TO 191 1071 : C Matrice CONSTANTE 1071 : 1959 CALL ECME(KOPT,'KMACO',1) 1071 : CALL LIRCHA(CHAI,1,LCHAR) 1072 : IF(LCHAR.EQ.0)THEN 1073 : C On ne trouve pas d'objet de type %m1:8 1074 : MOTERR( 1: 8) = 'MOT' 1074 : CALL ERREUR(38) 1075 : RETURN 1076 : ENDIF 1077 : NMACO=CHAI(1:LCHAR) 1077 : CALL ECMM(KOPT,'NMACO',NMACO) 1078 : GO TO 191 1079 : C Emplacement libre pour de nouvelles idées (il faudra etre concis) 1080 : 1960 CONTINUE 1081 : GO TO 191 1082 : 1083 : C Indices IDEUL 1084 : C EULER 1084 : 1961 CALL ECME(KOPT,'IDEUL',1) 1085 : GO TO 191 1086 : C EULERMS 1086 : 1962 CALL ECME(KOPT,'IDEUL',2) 1087 : GO TO 191 1088 : C EULERMST 1088 : 1963 CALL ECME(KOPT,'IDEUL',3) 1089 : GO TO 191 1090 : C Emplacements libres pour de nouveaux Schéma 1091 : 1964 CONTINUE 1092 : 1965 CONTINUE 1093 : GO TO 191 1094 : C Indices KPOIND 1095 : 1966 CONTINUE 1095 : CALL LIRCHA(NOM,0,IRET) 1096 : IF(IRET.EQ.0)THEN 1097 : GO TO 90 1098 : ENDIF 1098 : CALL OPTLI(IP,LOPTI(31),NOM,6) 1099 : IF(IP.EQ.0)THEN 1100 : GO TO 90 1101 : ELSE 1101 : CALL ECME(KOPT,'KPOIND',IP-1) 1102 : ENDIF 1103 : GO TO 191 1104 : 1105 : C Emplacements libres 1106 : 1967 CONTINUE 1107 : GO TO 191 1108 : 1109 : 1968 CONTINUE 1110 : C Indice STABP 1110 : CALL LIRREE(STAB,0,IRET) 1111 : IF(IRET.EQ.0)THEN 1112 : GO TO 90 1113 : ENDIF 1113 : CALL ECMF(KOPT,'STABP',STAB) 1114 : GO TO 191 1115 : 1116 : C MUCONS mu constant par élément 1116 : 1969 CALL ECME(KOPT,'KMU',0) 1117 : GO TO 191 1118 : 1119 : C FTAU mu variable par élément (formulation en grad mu) 1119 : 1970 CALL ECME(KOPT,'KMU',1) 1120 : GO TO 191 1121 : 1122 : C MUVARI Formulation en Tau 1122 : 1971 CALL ECME(KOPT,'KMU',2) 1123 : GO TO 191 1124 : 1125 : C Emplacements libres 1126 : 1972 CONTINUE 1127 : 1973 CONTINUE 1128 : 1974 CONTINUE 1129 : 1975 CONTINUE 1130 : GO TO 191 1131 : 1132 : 1133 : C OPTI 1134 : 1135 : 20 CONTINUE 1135 : CALL LIRCHA(NOM,0,IRET) 1136 : IF(IRET.EQ.0)GO TO 90 1136 : CALL ECMM(MTABLE,'NOMVI',NOM) 1137 : GO TO 1 1138 : 1139 : C ' ' 1140 : 1141 : 21 CONTINUE 1142 : C WRITE(IOIMP,*)' nbik=',nbik 1143 : NBIK=NBIK+1 1143 : CALL LIRCHA(NOM,0,IRET) 1144 : C WRITE(IOIMP,*)' NOM=',nom,iret 1145 : IF(IRET.EQ.0)GO TO 90 1146 : TINCD(NBIK)=NOM 1146 : CALL LITABS(LTAB,KTAB,1,1,IRET) 1147 : C WRITE(IOIMP,*)' iret=',iret 1148 : IF(IRET.EQ.0)THEN 1149 : WRITE(IOIMP,*)' On attend un objet TABLE DOMAINE' 1150 : RETURN 1151 : ENDIF 1152 : KINCD(NBIK)=KTAB(1) 1153 : 1154 : GO TO 1 1155 : 1156 : C TPSI 1157 : 1158 : 22 CONTINUE 1158 : CALL LIRREE(XVAL,1,IRET) 1159 : IF(IRET.EQ.0)THEN 1160 : WRITE(IOIMP,*)' MOT CLE TPSI (Instant initial) :' 1161 : WRITE(IOIMP,*)' On attend un flottant ' 1162 : RETURN 1163 : ENDIF 1163 : CALL ECMF(MTABLE,'TPSI',XVAL) 1164 : GO TO 1 1165 : 1166 : C TFINAL 1167 : 1168 : 23 CONTINUE 1168 : CALL LIRREE(XVAL,1,IRET) 1169 : IF(IRET.EQ.0)THEN 1170 : WRITE(IOIMP,*)' MOT CLE TFINAL (Temps final) :' 1171 : WRITE(IOIMP,*)' On attend un flottant ' 1172 : RETURN 1173 : ENDIF 1173 : CALL ECMF(MTABLE,'TFINAL',XVAL) 1174 : GO TO 1 1175 : 1176 : C FIDT 1177 : 1178 : 24 CONTINUE 1178 : CALL LIRENT(IENT,1,IRET) 1179 : IF(IRET.EQ.0)THEN 1180 : WRITE(IOIMP,*)' MOT CLE FIDT (Frequence impression temps) :' 1181 : WRITE(IOIMP,*)' On attend un entier ' 1182 : RETURN 1183 : ENDIF 1183 : CALL ECME(MTABLE,'FIDT',IENT) 1184 : GO TO 1 1185 : 1186 : C NISTO 1187 : 1188 : 25 CONTINUE 1188 : CALL LIRENT(IENT,1,IRET) 1189 : IF(IRET.EQ.0)THEN 1190 : WRITE(IOIMP,*)' MOT CLE NISTO (Frequence saisie historique) :' 1191 : WRITE(IOIMP,*)' On attend un entier ' 1192 : RETURN 1193 : ENDIF 1193 : CALL ECME(MTABLE,'NISTO',IENT) 1194 : GO TO 1 1195 : 1196 : C NITER 1197 : 1198 : 26 CONTINUE 1198 : CALL LIRENT(IENT,1,IRET) 1199 : IF(IRET.EQ.0)THEN 1200 : WRITE(IOIMP,*)' MOT CLE NITER (Nombre iterations internes) :' 1201 : WRITE(IOIMP,*)' On attend un entier ' 1202 : RETURN 1203 : ENDIF 1203 : CALL ECME(MTABLE,'NITER',IENT) 1204 : GO TO 1 1205 : 1206 : C OMEGA 1207 : 1208 : 27 CONTINUE 1208 : CALL LIRREE(XVAL,1,IRET) 1209 : IF(IRET.EQ.0)THEN 1210 : WRITE(IOIMP,*)' MOT CLE OMEGA (Facteur de relaxation) :' 1211 : WRITE(IOIMP,*)' On attend un flottant ' 1212 : RETURN 1213 : ENDIF 1213 : CALL ECMF(MTABLE,'OMEGA',XVAL) 1214 : GO TO 1 1215 : 1216 : C EPS 1217 : 1218 : 28 CONTINUE 1218 : CALL LIRREE(XVAL,1,IRET) 1219 : IF(IRET.EQ.0)THEN 1220 : WRITE(IOIMP,*)' MOT CLE EPS (Tolerance sur le residu) :' 1221 : WRITE(IOIMP,*)' On attend un flottant ' 1222 : RETURN 1223 : ENDIF 1223 : CALL ECMF(MTABLE,'EPS',XVAL) 1224 : GO TO 1 1225 : 1226 : C IMPR 1227 : 1228 : 29 CONTINUE 1228 : CALL LIRENT(IENT,1,IRET) 1229 : IF(IRET.EQ.0)THEN 1230 : WRITE(IOIMP,*)' MOT CLE IMPR (Niveau d impression) :' 1231 : WRITE(IOIMP,*)' On attend un entier ' 1232 : RETURN 1233 : ENDIF 1233 : CALL ECME(MTABLE,'IMPR',IENT) 1234 : GO TO 1 1235 : 1236 : 90 CONTINUE 1237 : 1238 : TYPE=' ' 1238 : CALL ACMO(MTABLE,'DOMAINE',TYPE,MTABD) 1239 : IF(TYPE.NE.'TABLE')GO TO 900 1240 : TYPE=' ' 1240 : CALL ACMO(MTABLE,'LISTINCO',TYPE,MLMOT2) 1241 : 1242 : IF(MLMOT2.NE.0)THEN 1243 : 1244 : SEGACT MLMOT2 1245 : NINCT=MLMOT2.MOTS(/2) 1246 : 1247 : TYPE=' ' 1247 : CALL ACMO(MTABLE,'DOMINC',TYPE,MTABI) 1248 : IF(TYPE.EQ.'TABLE')THEN 1249 : 1250 : DO 93 I=1,NINCT 1251 : NOMI=MLMOT2.MOTS(I) 1252 : TYPE=' ' 1252 : CALL ACMO(MTABI,NOMI,TYPE,IPT) 1252 : IF(TYPE.NE.'TABLE')CALL ECMO(MTABI,NOMI,'TABLE',MTABD) 1253 : 93 CONTINUE 1254 : DO 94 I=1,NBIK 1255 : NOMI=TINCD(NBIK) 1255 : CALL ECMO(MTABI,NOMI,'TABLE',KINCD(NBIK)) 1256 : 94 CONTINUE 1257 : 1258 : ELSE 1259 : 1259 : CALL CRTABL(MTABI) 1259 : CALL ECMO(MTABLE,'DOMINC','TABLE',MTABI) 1260 : DO 91 I=1,NINCT 1261 : NOMI=MLMOT2.MOTS(I) 1261 : CALL ECMO(MTABI,NOMI,'TABLE',MTABD) 1262 : 91 CONTINUE 1263 : DO 92 I=1,NBIK 1264 : NOMI=TINCD(NBIK) 1264 : CALL ECMO(MTABI,NOMI,'TABLE',KINCD(NBIK)) 1265 : 92 CONTINUE 1266 : 1267 : ENDIF 1268 : SEGDES MLMOT2 1269 : ENDIF 1270 : 1271 : 900 CONTINUE 1271 : CALL ECROBJ('TABLE',MTABLE) 1272 : C write(6,*)' RETOUR EQEX ' 1273 : RETURN 1274 : END 1275 : 1276 : 1277 : 1278 : 1279 : 1280 : 1281 : 1282 : 1283 : 1284 : 1285 : 1286 : 1287 : 1288 : 1289 : 1290 : 1291 : 1292 : 1293 : 1294 : 1295 :
© Cast3M 2003 - All rights reserved.
Disclaimer