1 : C TCNM SOURCE GOUNAND 13/01/22 21:15:06 7679 2 : SUBROUTINE TCNM 3 : C----------------------------------------------------------------------- 4 : C Mise à jour des CHPOINTs à l'occasion du changement de pas de temps. 5 : C----------------------------------------------------------------------- 6 : C Les tables de sous type KIZX associées à l'opérateur DFDT permettent 7 : C d'effectuer la mise à jour. Pour chaque opérateur DFDT, selon la 8 : C syntaxe ayant été utilisée 9 : C 1) si l'objet pointé à l'indice ARG2 de la table associée à 10 : C l'opérateur DFDT considéré est un CHPOINT on l'update ou 11 : C 2) on récupere à l'indice ARG2 de la table associée à DFDT le nom 12 : C associé à l'inconnue à updater dans la table INCO et on update le 13 : C CHPOINT dans INCO. 14 : C 15 : C--------------------------- 16 : C Phrase d'appel (GIBIANE) : 17 : C--------------------------- 18 : C 19 : C IRT = TCNM TAB1 ; 20 : C 21 : C------------------------ 22 : C Opérandes et résultat : 23 : C------------------------ 24 : C 25 : C TAB1 : TABLE de sous type EQEX contenant l'ensemble des données pour 26 : C la modélisation. 27 : C 28 : C IRT : = 1 Temps final atteint = 0 sinon 29 : C 30 : C---------------------------- 31 : C Indices de table modifiés : 32 : C---------------------------- 33 : C 34 : C Indice ARG2 des tables DFDT si ISYNT=1. 35 : C Indices de la table INCO alias du nom des inconnues à traiter sinon. 36 : C 37 : C---------------------- 38 : C Variables principales 39 : C---------------------- 40 : C 41 : C ISYNT : Flag indiquant le type de syntaxe utilisé 42 : C MTAB1 : Pointeur vers la table de sous type EQEX 43 : C MTAB2 : Pointeur vers la table INCO 44 : C MTABLE : Pointeur vers une table associée à un opérateur (DFDT...) 45 : C 46 : C----------------------------------------------------------------------- 47 : IMPLICIT INTEGER(I-N) 48 : IMPLICIT REAL*8 (A-H,O-Z) 49 : CHARACTER*8 NOMZ,TYPE,NOMINC,TYP2,NOM,NOMA,NOMA2,TYPE1 50 : CHARACTER*8 NOMIX(10),NOMI1,TYP0 51 : C 52 : -INC CCOPTIO 53 : -INC SMLMOTS 54 : -INC SMCHPOI 55 : POINTEUR IPHI.MPOVAL,IPHH.MPOVAL 56 : -INC SMELEME 57 : POINTEUR MAH.MELEME 58 : POINTEUR IGEOM0.MELEME 59 : -INC SMLREEL 60 : -INC SMLENTI 61 : -INC SMEVOLL 62 : C 63 : PARAMETER (NTB=1) 64 : DIMENSION KTAB(NTB) 65 : CHARACTER*8 LTAB(NTB) 66 : DATA LTAB /'EQEX '/ 67 : C 68 : C- Lecture de la table de sous type EQEX 69 : C 70 : NTO = 1 70 : CALL LITABS(LTAB,KTAB,NTB,NTO,IRET) 71 : IF (IRET.EQ.0) RETURN 72 : MTAB1 = KTAB(1) 73 : IUPDT=1 73 : CALL LIRCHA(NOM,0,LCHAR) 74 : IF(LCHAR.NE.0.AND.NOM.EQ.'NOUP')THEN 75 : IUPDT=0 76 : ENDIF 77 : C 78 : C- Appel ancien TCNM 79 : C 79 : CALL ACME(MTAB1,'NAVISTOK',NASTOK) 80 : IF(NASTOK.EQ.0)THEN 80 : CALL TCNMA(MTAB1) 81 : RETURN 82 : ENDIF 83 : C 84 : C- Lecture de la table INCO 85 : C 86 : TYPE = 'TABLE ' 86 : CALL ACMO(MTAB1,'INCO',TYPE,MTAB2) 87 : IF (IERR.NE.0) RETURN 88 : C 89 : C- Récupération du LISTMOTS à l'indice 'LISTOPER' de la table EQEX 90 : C 91 : TYPE = 'LISTMOTS' 91 : CALL ACMO(MTAB1,'LISTOPER',TYPE,MLMOTS) 92 : IF (IERR.NE.0) RETURN 93 : SEGACT MLMOTS 94 : NBIND = MOTS(/2) 95 : IF (NBIND.GE.1000) THEN 96 : INTERR(1) = 1000 96 : CALL ERREUR(762) 97 : ENDIF 98 : C 99 : C- Initialisation des données temporelles 100 : C -------------------------------------- 100 : CALL ACMF(MTAB1,'TFINAL',TFINAL) 100 : CALL ACMF(MTAB1,'ALFA',ALFA) 100 : CALL ACME(MTAB1,'FIDT',IMPR) 101 : 102 : TYPE=' ' 102 : CALL ACMO(MTAB1,'PASDETPS',TYPE,MTABT) 103 : 104 : IF (MTABT.NE.0) THEN 104 : CALL ACMF(MTABT,'DELTAT',DT) 105 : IF (IERR.NE.0) RETURN 105 : CALL ACMF(MTABT,'TPS',TPS) 106 : IF (IERR.NE.0) RETURN 106 : CALL ACME(MTABT,'NUPASDT',IPT) 107 : IF (IERR.NE.0) RETURN 108 : ELSE 109 : C? DT = 1.D0 110 : C? TPS = 0.D0 111 : C? IPT = 1 112 : ENDIF 113 : DT = DT * ALFA 114 : 115 : IFINAL=0 116 : TPS1 = TPS + DT 117 : C write(6,*)' TPS=',tps,' TFINAL=',tfinal,' DT=',dt 118 : IF(TPS.GT.TFINAL)THEN 119 : IFINAL=1 120 : GO TO 800 121 : ELSEIF(TPS1.GT.TFINAL)THEN 122 : DT=TFINAL-TPS 123 : IFINAL=1 124 : ENDIF 125 : TPS = TPS + DT 126 : 127 : C 128 : C- Recherche de l'ensemble des champs à mettre à jour via DFDT 129 : C 130 : DO 10 K=1,NBIND 131 : NOMA = MOTS(K) 132 : IF (NOMA(1:4).EQ.'DFDT') THEN 133 : IF (K.LT.10) THEN 134 : WRITE(NOMA2,FMT='(I1,A7)') K,NOMA(1:7) 135 : ELSE 136 : WRITE(NOMA2,FMT='(I2,A6)') K,NOMA(1:6) 137 : ENDIF 138 : TYPE = ' ' 138 : CALL ACMO(MTAB1,NOMA2,TYPE,MTABLE) 139 : IF (TYPE.EQ.'TABLE') THEN 140 : C 141 : C- Caractérisation de la syntaxe de DFDT : le champoint contenant 142 : C- les valeurs de l'inconnue au pas de temps précédant se trouve 143 : C- ISYNT =1 -> Dans la table DFDT MTABLE 144 : C- ISYNT =2 -> Dans la table INCO MTAB2 145 : C 146 : TYPE = ' ' 146 : CALL ACMO(MTABLE,'KOPT ',TYPE,KOPT) 146 : CALL ACME(KOPT,'ISCHT',ISCHT) 147 : IF(ISCHT.EQ.1.OR.ISCHT.EQ.2)THEN 148 : C 149 : C- Récupération du nom de l'indice de la table INCO contenant 150 : C- le CHPOINT au temps précédent N. 151 : C 152 : TYPE = ' ' 152 : CALL ACMO(MTABLE,'ARG2',TYPE,MCHPI) 153 : IF (IERR.NE.0) RETURN 154 : IF (TYPE.EQ.'CHPOINT ') THEN 155 : ISYNT = 1 156 : ELSEIF (TYPE.EQ.'MOT ') THEN 157 : ISYNT = 2 157 : CALL ACMM(MTABLE,'ARG2',NOM) 158 : IF (IERR.NE.0) RETURN 159 : TYP2 = 'CHPOINT ' 159 : CALL ACMO(MTAB2,NOM,TYP2,MCHPI) 160 : IF (IERR.NE.0) RETURN 161 : ELSE 162 : MOTERR( 1: 8) = NOMA 163 : MOTERR( 9:16) = 'ARG2 ' 164 : MOTERR(17:30) = 'CHPOINT ou MOT' 164 : CALL ERREUR(763) 165 : RETURN 166 : ENDIF 167 : C 168 : C Récupération du nom de l'indice de la table INCO contenant le 169 : C point au 2eme temps précédent N-1. 170 : C 171 : TYPE = ' ' 171 : CALL ACMO(MTABLE,'ARG3',TYPE,MCHPN) 172 : IF (IERR.NE.0) RETURN 173 : IF (TYPE.EQ.'CHPOINT ') THEN 174 : ISYNT = 1 175 : ELSEIF (TYPE.EQ.'MOT ') THEN 176 : ISYNT = 2 176 : CALL ACMM(MTABLE,'ARG3',NOM) 177 : IF (IERR.NE.0) RETURN 178 : TYP2 = 'CHPOINT ' 178 : CALL ACMO(MTAB2,NOM,TYP2,MCHPN) 179 : IF (IERR.NE.0) RETURN 180 : ELSE 181 : MOTERR( 1: 8) = NOMA 182 : MOTERR( 9:16) = 'ARG3 ' 183 : MOTERR(17:30) = 'CHPOINT ou MOT' 183 : CALL ERREUR(763) 184 : RETURN 185 : ENDIF 186 : C 187 : C- Duplication du CHPOINT contenant l'inconnue au temps N vers N-1 188 : C 189 : IF(IUPDT.EQ.1)THEN 190 : * gounand 07/12/2012 : dans TCRR, on change de stratégie et on crée un 191 : * chpoint tout neuf, cela permet d'éviter les appels à COPIER dans TCNM 192 : * et dans les procédures utilisateurs. On pourra aussi se référer au 193 : * pointeur pour préconditionner. 193 : * CALL ECROBJ('CHPOINT',MCHPI) 193 : * CALL COPIER 193 : * CALL LIROBJ('CHPOINT',MCHPOI,1,IRET) 194 : MCHPOI=MCHPI 195 : 196 : C 197 : C- Update du CHPOINT contenant l'inconnue au temps précédant 198 : C 199 : IF (ISYNT.EQ.1) THEN 199 : CALL ECMO(MTABLE,'ARG3',TYPE,MCHPOI) 200 : ELSE 200 : CALL ECMO(MTAB2,NOM,TYP2,MCHPOI) 201 : ENDIF 202 : 203 : ENDIF 204 : ENDIF 205 : C 206 : C- Récupération du nom de l'indice de la table INCO contenant 207 : C- le CHPOINT au temps courant N+1 (donc près calcul). 208 : C 209 : TYPE = 'LISTMOTS' 209 : CALL ACMO(MTABLE,'LISTINCO',TYPE,MLMOT1) 210 : IF (IERR.NE.0) RETURN 211 : SEGACT MLMOT1 212 : NOMINC = MLMOT1.MOTS(1) 213 : SEGDES MLMOT1 214 : C 215 : C- Récupération du pointeur du CHPOINT dans la table INCO à l'instant N. 216 : C 217 : TYPE = 'CHPOINT ' 217 : CALL ACMO(MTAB2,NOMINC,TYPE,MCHPI) 218 : IF (IERR.NE.0) RETURN 219 : TYPE = ' ' 219 : CALL ACMO(MTABLE,'ARG2',TYPE,MCHPN) 220 : IF (IERR.NE.0) RETURN 221 : IF (TYPE.EQ.'CHPOINT ') THEN 222 : ISYNT = 1 223 : ELSEIF (TYPE.EQ.'MOT ') THEN 224 : ISYNT = 2 224 : CALL ACMM(MTABLE,'ARG2',NOM) 225 : IF (IERR.NE.0) RETURN 226 : TYP2 = 'CHPOINT ' 226 : CALL ACMO(MTAB2,NOM,TYP2,MCHPN) 227 : IF (IERR.NE.0) RETURN 228 : ELSE 229 : MOTERR( 1: 8) = NOMA 230 : MOTERR( 9:16) = 'ARG2 ' 231 : MOTERR(17:30) = 'CHPOINT ou MOT' 231 : CALL ERREUR(763) 232 : RETURN 233 : ENDIF 234 : C 235 : C- Duplication du CHPOINT contenant l'inconnue au temps courant N+1 vers N 236 : C 237 : IF(IUPDT.EQ.1)THEN 238 : * gounand 07/12/2012 : dans TCRR, on change de stratégie et on crée un 239 : * chpoint tout neuf, cela permet d'éviter les appels à COPIER dans TCNM 240 : * et dans les procédures utilisateurs. On pourra aussi se référer au 241 : * pointeur pour préconditionner. 241 : * CALL ECROBJ('CHPOINT',MCHPI) 241 : * CALL COPIER 241 : * CALL LIROBJ('CHPOINT',MCHPOI,1,IRET) 242 : MCHPOI=MCHPI 243 : C 244 : C- Update du CHPOINT contenant l'inconnue au temps précédant 245 : C 246 : IF (ISYNT.EQ.1) THEN 246 : CALL ECMO(MTABLE,'ARG2',TYPE,MCHPOI) 247 : ELSE 247 : CALL ECMO(MTAB2,NOM,TYP2,MCHPOI) 248 : ENDIF 249 : ENDIF 250 : ENDIF 251 : C 252 : C- Activation du MPOVAL de l'inconnue au temps précédant 253 : C ----------------------------------------------------- 253 : CALL LICHT(MCHPI,IPHI,TYP0,IGEOM0) 254 : C 255 : C- Traitement des historiques 256 : C -------------------------- 257 : IF (MTABT.NE.0) THEN 258 : TYPE=' ' 258 : CALL ACMO(MTAB1,'HIST',TYPE,KHIS) 259 : IF (KHIS.NE.0)THEN 260 : NUCOMP = IPHI.VPOCHA(/2) 261 : NOMIX(1) = NOMINC 262 : NOMIX(2) = '1'//NOMINC(1:7) 263 : NOMIX(3) = '2'//NOMINC(1:7) 264 : NOMIX(4) = '3'//NOMINC(1:7) 265 : DO 82 NUC=1,NUCOMP+1 266 : NUCR = 1 267 : IF (NUC.GT.1) NUCR=NUC-1 268 : TYPE = ' ' 268 : CALL ACMO(KHIS,NOMIX(NUC),TYPE,MEVOLL) 269 : IF (TYPE.EQ.'EVOLUTIO')THEN 270 : TYPE1=' ' 271 : NOMI1='$'//NOMIX(NUC) 271 : CALL ACMO(KHIS,NOMI1,TYPE1,MAH) 272 : IF (TYPE1.EQ.'MAILLAGE') THEN 273 : SEGACT MAH 274 : ELSE 274 : CALL ERREUR(503) 275 : RETURN 276 : ENDIF 276 : CALL ECROBJ('CHPOINT',MCHPI) 276 : CALL ECROBJ('MAILLAGE',MAH) 276 : CALL REDU 276 : CALL LIROBJ('CHPOINT',IZH,1,IRET) 276 : CALL LICHT(IZH,IPHH,TYP0,IGEOM) 276 : CALL KRIPAD(IGEOM,MLENTI) 277 : TYPE1=' ' 277 : CALL ACMO(KHIS,'KFIH',TYPE1,KFIH) 278 : IF (TYPE1.EQ.'ENTIER') THEN 278 : CALL ACME(KHIS,'KFIH',KFIH) 279 : ELSE 280 : KFIH = 20 281 : ENDIF 282 : INDH = IPT - IPT/KFIH * KFIH 283 : IF (INDH.NE.0) GOTO 80 284 : 285 : SEGACT MEVOLL,MAH 286 : NH=MAH.NUM(/2) 287 : DO 81 IH=1,NH 288 : KEVOLL=IEVOLL(IH) 289 : SEGACT KEVOLL 290 : MLREE1=IPROGX 291 : IF (IH.EQ.1)THEN 292 : SEGACT MLREE1 293 : JG=MLREE1.PROG(/1)+1 294 : SEGADJ MLREE1 295 : MLREE1.PROG(JG)=TPS 296 : SEGDES MLREE1 297 : ENDIF 298 : 299 : MLREE2=IPROGY 300 : SEGACT MLREE2 301 : SEGADJ MLREE2 302 : IH1=LECT(MAH.NUM(1,IH)) 303 : C write(6,*)' IH,IH1,NUCR=',IH,IH1,NUCR,JG 304 : IF(IH1.EQ.0)THEN 305 : MLREE2.PROG(JG)=0.D0 306 : ELSE 307 : MLREE2.PROG(JG)=IPHH.VPOCHA(IH1,NUCR) 308 : ENDIF 309 : SEGDES MLREE2,KEVOLL 310 : 81 CONTINUE 311 : SEGDES MEVOLL,MAH 312 : 80 CONTINUE 313 : SEGDES MAH 314 : SEGSUP MLENTI 315 : ENDIF 316 : 317 : 82 CONTINUE 318 : ENDIF 319 : ELSE 320 : WRITE(IOIMP,*)' Pour des historiques il faut une table PASDETPS' 321 : ENDIF 322 : C 323 : SEGDES IPHI 324 : SEGDES IGEOM0 325 : ENDIF 326 : 10 CONTINUE 327 : C 328 : C 329 : C- Impressions de controle 330 : C ----------------------- 331 : IF (IMPR.NE.0) THEN 332 : KFIDT = IMPR 333 : IF (MTABT.NE.0) THEN 333 : CALL ACMM(MTABT,'OPER',NOMINC) 333 : CALL ACMM(MTABT,'ZONE',NOMZ) 333 : CALL ACMF(MTABT,'DTCONV',DTT1) 333 : CALL ACMF(MTABT,'DTDIFU',DTT2) 333 : CALL ACMF(MTABT,'DIAEL',DIAEL) 333 : CALL ACME(MTABT,'NUEL',NUEL) 333 : CALL ACME(MTABT,'NUPASDT',IPT) 334 : ELSE 335 : IPT=1 336 : ENDIF 337 : IND = IPT - IPT/KFIDT * KFIDT 338 : 339 : C write(6,*)' TCNM NOMZ=',NOMZ 340 : IF(NOMZ(1:4).NE.'EQEX')THEN 341 : IF (IPT.EQ.1) THEN 342 : WRITE(IOIMP,*) 343 : & ' IPT : NUMERO DU PAS DE TEMPS , NUEL : NUMERO DE L ELEMENT , ' 344 : &,' DIAEL : DIAMETRE MOYEN DE L ELEMENT ' 345 : WRITE(IOIMP,*) 346 : &' ALFA : TOLERANCE SUR LE PAS DE TEMPS , DTMAX : PAS DE TEMPS MAX' 347 : &,' DTT1 : PAS DE TEMPS DE CONVECTION , DTT2 : PAS DE TEMPS DE' 348 : &,' DIFFUSION ' 349 : WRITE(IOIMP,*) ' TPS : TEMPS CUMULE' 350 : ENDIF 351 : IF (IND.EQ.0)THEN 352 : WRITE(IOIMP,1011)NOMZ,NOMINC 353 : WRITE(IOIMP,1010)IPT,NUEL,DIAEL,ALFA,DT,DTT1,DTT2,TPS 354 : ENDIF 355 : ELSE 356 : 357 : IF (IPT.EQ.1) THEN 358 : WRITE(IOIMP,*) ' PAS DE TEMPS IMPOSE : DT , ', 359 : & ' IPT : NUMERO DU PAS DE TEMPS , TPS : TEMPS CUMULE' 360 : ENDIF 361 : IF (IND.EQ.0)THEN 362 : WRITE(IOIMP,1012)IPT,DT,TPS 363 : ENDIF 364 : ENDIF 365 : 366 : ENDIF 367 : C 368 : C- Mise à jour de la table PASDETPS 369 : C -------------------------------- 370 : 800 CONTINUE 371 : C??? IF (KIZD.NE.0.AND.KIZG.NE.0) THEN 372 : IF (MTABT.NE.0) THEN 373 : IF(IUPDT.EQ.1)THEN 373 : CALL ECMF(MTABT,'DELTAT-1',DT) 373 : CALL ECMF(MTABT,'TPS',TPS) 374 : DT=1.D30 374 : CALL ECMF(MTABT,'DELTAT',DT) 375 : IPT = IPT + 1 375 : CALL ECME(MTABT,'NUPASDT',IPT) 376 : ENDIF 377 : ENDIF 378 : C??? ENDIF 379 : 379 : CALL ECRENT(IFINAL) 380 : 381 : C 382 : C- Désactivation et ménage 383 : C 384 : SEGDES MLMOTS 385 : RETURN 386 : C 387 : C- Formats associés aux impression de controle 388 : C ------------------------------------------- 389 : 1010 FORMAT(2X,'N.DT',I5,' NU.EL',I5,' DIAEL=',1PE11.4,' ALFA=', 390 : & 1PE11.4,' DTMAX=',1PE11.4, 391 : & ' DT1=',1PE11.4,' DT2=',1PE11.4,' TPS=',1PE11.4) 392 : 1011 FORMAT(2X,' ZONE :',A8,' OPERATEUR :',A8) 393 : 1012 FORMAT(2X,'N.DT',I5,' DT=',1PE11.4,' TPS=',1PE11.4) 394 : END 395 : 396 : 397 : 398 : 399 : 400 : 401 : 402 :
© Cast3M 2003 - All rights reserved.
Disclaimer