1 : C CAAVCT SOURCE MAGN 09/07/30 21:15:17 6458 2 : SUBROUTINE CAAVCT 3 : C************************************************************************ 4 : C 5 : C MODIFICATIONS : IZDD -> IZD2 (chgt de diago) 6 : C TEST SUR MTABD 7 : C SIMPLIFICATION DES PARAMETRES DE PF500 (on passe 8 : C MTABD) 9 : C 10 : C************************************************************************ 11 : C 12 : C .Rajout de commentaires et de nouveaux messages d'erreurs en utilisant 13 : C la routine ERREUR de K2000 : F.D Juillet 96 14 : C .Correction d'erreurs dans le cas des CHPO Centre : on teste le nom 15 : C des inconnues et on effectue le calcul pour toutes les composantes 16 : C des inconnues : P.G Aout 96 17 : C************************************************************************ 18 : IMPLICIT INTEGER(I-N) 19 : IMPLICIT REAL*8 (A-H,O-Z) 20 : CHARACTER*8 NOMI,TYPE,TYPE1,NOM,NOMZ,TYPC,TYP0,TYPINC 21 : CHARACTER*8 NOMIX(10) 22 : CHARACTER*9 NOMI1 23 : CHARACTER*4 NOC,KOMP(4) 24 : C 25 : -INC CCOPTIO 26 : -INC SMLENTI 27 : POINTEUR IZIPAD.MLENTI,MLH.MLENTI 28 : -INC SMCHAML 29 : -INC SMMATRIK 30 : -INC SMCHPOI 31 : POINTEUR CLIM.MCHPOI 32 : POINTEUR IPHI.MPOVAL,IPHR.MPOVAL,IPHH.MPOVAL 33 : POINTEUR IZD.MCHPOI ,IZD0.MCHPOI ,IZG.MCHPOI ,IZGD.MCHPOI 34 : POINTEUR IZDD.MPOVAL,IZDD0.MPOVAL,IZGG.MPOVAL,IZGDD.MPOVAL 35 : POINTEUR IZD2.MPOVAL,IZSS.MPOVAL,IZS.MCHPOI,IZH.MCHPOI 36 : POINTEUR IZPHI.MCHPOI 37 : -INC SMLMOTS 38 : POINTEUR MINCOG.MLMOTS 39 : -INC SMELEME 40 : POINTEUR MAH.MELEME 41 : POINTEUR MELEMI.MELEME 42 : POINTEUR IGEOM0.MELEME 43 : -INC SMLREEL 44 : -INC SMEVOLL 45 : PARAMETER (NTB=1) 46 : DIMENSION KTAB(NTB) 47 : CHARACTER*8 LTAB(NTB) 48 : DATA KOMP/'UX ','UY ','UZ ','SCAL'/ 49 : DATA LTAB /'EQEX '/ 50 : C 51 : C- Lecture des tables transmises en arguments 52 : C ------------------------------------------ 52 : CALL LITABS(LTAB,KTAB,NTB,1,IRET) 53 : IF (IRET.EQ.0)THEN 54 : WRITE(6,*)' Opérateur AVCT :' 55 : WRITE(6,*)' On attend un ensemble de table soustypes' 56 : RETURN 57 : ENDIF 58 : KIZC = KTAB(1) 59 : C 60 : C- Lecture facultative de la "cfl" 61 : C ------------------------------ 61 : CALL LIRREE(ALFA,0,IRET) 62 : IF (IRET.EQ.0) ALFA=1.D0 63 : C 64 : C- Lecture facultative des paramètres pour les impressions de controle 65 : C ------------------------------------------------------------------- 65 : CALL LIRCHA(NOM,0,IRET) 66 : IMPR = 0 67 : IF (IRET.EQ.0) THEN 68 : IMPR = 0 69 : ELSEIF (NOM.EQ.'IMPR ') THEN 69 : CALL LIRENT(IMPR,1,IRET) 70 : IF (IRET.EQ.0) RETURN 71 : ENDIF 72 : C 73 : C- Récuperation des pointeurs des tables INCO et EQEX !! 74 : C- BUG dans LITABS puisque EQEX etait facultatif --> à corriger 75 : C 76 : TYPE=' ' 76 : CALL ACMO(KIZC,'INCO',TYPE,INCO) 77 : IF(IERR.NE.0) RETURN 78 : 79 : C 80 : C- Récupération des noms d'inconnues 81 : C --------------------------------- 82 : TYPE = 'LISTMOTS' 82 : CALL ACMO(KIZC,'LISTINCO',TYPE,MLMOT2) 83 : IF (IERR.NE.0) RETURN 84 : SEGACT MLMOT2 85 : NBINC1 = MLMOT2.MOTS(/2) 86 : C 87 : C- Récupérations des pointeurs associés aux tables KIZD et KIZG 88 : C ------------------------------------------------------------ 89 : C (contenant la matrice "masse" diagonale et l'"incrément".) 90 : C 91 : TYPE=' ' 91 : CALL ACMO(KIZC,'KIZD ',TYPE,KIZD) 92 : TYPE=' ' 92 : CALL ACMO(KIZC,'KIZK ',TYPE,KIZK) 93 : TYPE=' ' 93 : CALL ACMO(KIZC,'KIZG ',TYPE,KIZG) 94 : 95 : C 96 : C- Initialisation des données temporelles 97 : C -------------------------------------- 97 : CALL ACMF(KIZC,'TFINAL',TFINAL) 98 : 99 : TYPE=' ' 99 : CALL ACMO(KIZC,'PASDETPS',TYPE,MTABT) 100 : 101 : IF (MTABT.NE.0) THEN 101 : CALL ACMF(MTABT,'DELTAT',DT) 102 : IF (IERR.NE.0) RETURN 102 : CALL ACMF(MTABT,'TPS',TPS) 103 : IF (IERR.NE.0) RETURN 103 : CALL ACME(MTABT,'NUPASDT',IPT) 104 : IF (IERR.NE.0) RETURN 105 : ELSE 106 : DT = 1.D0 107 : TPS = 0.D0 108 : IPT = 1 109 : ENDIF 110 : DT = DT * ALFA 111 : 112 : IFINAL=0 113 : TPS1 = TPS + DT 114 : C write(6,*)' TPS=',tps,' TFINAL=',tfinal,' DT=',dt 115 : IF(TPS.GT.TFINAL)THEN 116 : IFINAL=1 117 : GO TO 800 118 : ELSEIF(TPS1.GT.TFINAL)THEN 119 : DT=TFINAL-TPS 120 : IFINAL=1 121 : ENDIF 122 : TPS = TPS + DT 123 : C 124 : C- Récupération des pointeurs associés aux tables KIZG1 et KIZS 125 : C ------------------------------------------------------------ 126 : C 127 : TYPE=' ' 127 : CALL ACMO(KIZC,'KIZG1 ',TYPE,KIZG1) 128 : TYPE=' ' 128 : CALL ACMO(KIZC,'KIZS ',TYPE,KIZS) 129 : C 130 : C============================================================== 131 : C Boucle principale : Traitement de chaque inconnue de LISTINCO 132 : C============================================================== 133 : C 134 : DO 1 L=1,NBINC1 135 : C 136 : C- NOMI est l'identifiant de l'inconnue dans chaque table 137 : C 138 : NOMI = MLMOT2.MOTS(L) 139 : C 140 : C- Activation du MPOVAL de l'inconnue au temps précédant 141 : C ----------------------------------------------------- 142 : TYPE = 'CHPOINT ' 142 : CALL ACMO(INCO,NOMI,TYPE,IZPHI) 143 : IF (IERR.NE.0) RETURN 143 : CALL LICHT(IZPHI,IPHI,TYP0,IGEOM0) 144 : NPT = IPHI.VPOCHA(/1) 145 : NC = IPHI.VPOCHA(/2) 146 : C 147 : C- Activation du terme source éventuel associé à l'inconnue NOMI 148 : C ------------------------------------------------------------- 149 : IZSS = 0 150 : IGEOMS = 0 151 : IF (KIZS.NE.0) THEN 152 : TYPE = 'CHPOINT ' 152 : CALL ACMO(KIZS,NOMI,TYPE,IZS) 153 : IF (IERR.NE.0) RETURN 153 : CALL LICHT(IZS,IZSS,TYP0,IGEOMS) 154 : IF (IGEOMS.NE.IGEOM0) THEN 155 : MOTERR(1: 8) = NOMI(1:4)//'KIZS' 156 : MOTERR(9:16) = NOMI(1:4)//'INCO' 157 : INTERR(1) = 1 157 : CALL ERREUR(698) 158 : RETURN 159 : ENDIF 160 : ENDIF 161 : C 162 : C- Identification du MPOVAL de l'inconnue au nouveau pas de temps 163 : C -------------------------------------------------------------- 164 : C (pour écrasement éventuel des valeurs du pas précédant) 165 : C 166 : IPHR = IPHI 167 : C 168 : C- Correspondance entre numérotation globale et locale 169 : C --------------------------------------------------- 169 : CALL KRIPAD(IGEOM0,IZIPAD) 170 : SEGACT IGEOM0 171 : C 172 : C- Cas ou il y a des matrices masses non diagonales 173 : C ------------------------------------------------ 174 : IF(KIZK.NE.0)THEN 175 : TYPE=' ' 176 : MATRIK=KIZK 177 : SEGACT MATRIK 178 : NBK=IRIGEL(/2) 179 : DO 411 K=1,NBK 180 : 181 : IMATRI=IRIGEL(4,K) 182 : SEGACT IMATRI 183 : NBME=LISPRI(/2) 184 : WRITE(6,*)' INCO : ',(LISPRI(ii),ii=1,nbme) 185 : 411 CONTINUE 186 : ENDIF 187 : C 188 : C- Cas où les tables KIZD et KIZG sont données 189 : C ------------------------------------------- 190 : IF (KIZD.NE.0.AND.KIZG.NE.0) THEN 191 : C 192 : C- Recherche de la matrice "masse" diagonale associée à l'inconnue NOMI 193 : C -------------------------------------------------------------------- 194 : TYPE = ' ' 194 : CALL ACMO(KIZD,NOMI,TYPE,IZD) 195 : IF (TYPE.NE.'CHPOINT ') THEN 196 : WRITE(6,*)'pas de matrice diagonale pour ',NOMI 197 : GOTO 1 198 : ENDIF 198 : CALL LICHT(IZD,IZDD,TYPC,IGEOM) 199 : C 200 : C- Recherche de l'"incrément" associé à l'inconnue NOMI 201 : C ---------------------------------------------------- 202 : TYPE = ' ' 202 : CALL ACMO(KIZG,NOMI,TYPE,IZG) 203 : IF (TYPE.NE.'CHPOINT ') THEN 204 : GOTO 1 205 : ENDIF 205 : CALL LICHT(IZG,IZGG,TYPC,IGEOM) 206 : C 207 : C- Imposition des conditions aux limites sur l'"incrément" 208 : C ------------------------------------------------------ 209 : TYPE=' ' 209 : CALL ACMO(KIZC,'KIZI ',TYPE,KIZI) 210 : IF (KIZI.NE.0) THEN 211 : DO 211 I=1,NC 212 : NOC = KOMP(I) 213 : IF (NC.EQ.1) NOC=KOMP(4) 214 : TYPE = ' ' 214 : CALL ACMO(KIZI,NOMI,TYPE,MCHPOI) 215 : IF (TYPE.EQ.'CHPOINT') THEN 215 : CALL LACHT(MCHPOI,MPOVAL,NOC,MELEMI) 216 : IF (MPOVAL.NE.0) THEN 217 : SEGACT MELEMI 218 : LONG = MELEMI.NUM(/2) 218 : CALL RSETX2(IZGG.VPOCHA(1,I),MELEMI.NUM, 219 : & LONG,VPOCHA,IZIPAD.LECT) 220 : SEGDES MELEMI,MPOVAL 221 : ENDIF 222 : ENDIF 223 : 211 CONTINUE 224 : ENDIF 225 : C 226 : C- Calcul de l'inconnue au nouveau pas de temps 227 : C -------------------------------------------- 228 : C- En EF 229 : C- En VF 230 : C 231 : DO 11 I=1,NC 232 : C 233 : C -------------------- Cas de des inconnues situées au Centre 234 : C -------------------------------------- 235 : IF (TYPC.EQ.'FACE') THEN 236 : TYPE=' ' 236 : CALL ACMO(KIZC,'DOMAINE',TYPE,MTABD) 237 : IF (MTABD.EQ.0) THEN 238 : MOTERR(1: 8) = 'TABLE ' 239 : MOTERR(9:16) = 'DOMAINE ' 239 : CALL ERREUR(79) 240 : RETURN 241 : ENDIF 242 : TYPE = 'CHPOINT ' 242 : cccc CALL ACMO(KIZD,'DIAC0',TYPE,MCHPO4) 242 : CALL ACMO(KIZD,NOMI,TYPE,MCHPO4) 243 : IF (IERR.NE.0) RETURN 243 : CALL LICHT(MCHPO4,IZD2,TYPINC,IGEOM2) 243 : CALL PF500(IZD2,IPHI,IZSS,IZGG,IPHR,DT,MTABD,I) 244 : C 245 : if(I .EQ. NC) SEGDES MCHPO4,IZD2 246 : C 247 : C -------------------- Cas de des inconnues situées au Sommet 248 : C -------------------------------------- 249 : ELSEIF (TYPC.EQ.'SOMMET') THEN 250 : IF (KIZG1.EQ.0) THEN 251 : LONG=IZDD.VPOCHA(/1) 251 : CALL P500(IZDD.VPOCHA(1,I),IPHI.VPOCHA(1,I), 252 : & IZGG.VPOCHA(1,I),IPHR.VPOCHA(1,I),LONG,DT) 253 : ELSE 254 : TYPE = ' ' 254 : CALL ACMO(KIZG1,NOMI,TYPE,IZGD) 255 : IF (TYPE.NE.'CHPOINT ') THEN 256 : LONG = IZDD.VPOCHA(/1) 256 : CALL P500(IZDD.VPOCHA(1,I),IPHI.VPOCHA(1,I), 257 : & IZGG.VPOCHA(1,I),IPHR.VPOCHA(1,I),LONG,DT) 258 : ELSE 258 : CALL LICHT(IZGD,IZGDD,TYPC,IGEOM) 259 : LONG=IZDD.VPOCHA(/1) 259 : CALL P501(IZDD.VPOCHA(1,I),IPHI.VPOCHA(1,I), 260 : & IZGG.VPOCHA(1,I),IPHR.VPOCHA(1,I), 261 : & LONG,DT,IZGDD.VPOCHA(1,I)) 262 : ENDIF 263 : ENDIF 264 : ENDIF 265 : 11 CONTINUE 266 : C 267 : C- Imposition des conditions aux limites 268 : C ------------------------------------- 269 : TYPE = ' ' 269 : CALL ACMO(KIZC,'CLIM',TYPE,MCHPOI) 270 : IF (TYPE.EQ.'CHPOINT')THEN 271 : DO 111 I=1,NC 272 : IF (NC.EQ.1) THEN 273 : NOC=NOMI(1:4) 274 : ELSE 275 : WRITE(NOC,FMT='(I1,A3)')I,NOMI(1:3) 276 : ENDIF 277 : SEGACT MCHPOI 278 : NSOUPO = IPCHP(/1) 279 : DO 10111 NSP=1,NSOUPO 280 : MSOUPO = IPCHP(NSP) 281 : SEGACT MSOUPO 282 : NCOMP = NOCOMP(/2) 283 : DO 10112 NCP=1,NCOMP 284 : IF (NOCOMP(NCP).EQ.NOC) THEN 285 : MELEMI = IGEOC 286 : MPOVAL = IPOVAL 287 : SEGACT MELEMI,MPOVAL 288 : LONG = MELEMI.NUM(/2) 288 : CALL RSETX2(IPHR.VPOCHA(1,I),MELEMI.NUM, 289 : & LONG,VPOCHA(1,NCP),IZIPAD.LECT) 290 : SEGDES MELEMI,MPOVAL 291 : ENDIF 292 : 10112 CONTINUE 293 : SEGDES MSOUPO 294 : 10111 CONTINUE 295 : SEGDES MCHPOI 296 : 111 CONTINUE 297 : ENDIF 298 : C 299 : C- Mise à zero de l'ensemble des données et ménage 300 : C ----------------------------------------------- 301 : LONG = IZGG.VPOCHA(/1)*IZGG.VPOCHA(/2) 301 : CALL INITD(IZGG.VPOCHA,LONG,0.D0) 302 : SEGDES IZG,IZGG 303 : SEGDES IZD,IZDD 304 : IF (KIZG1.NE.0.AND.IZGD.NE.0) THEN 304 : CALL INITD(IZGDD.VPOCHA,LONG,0.D0) 305 : SEGDES IZGD,IZGDD 306 : ENDIF 307 : IF (KIZS.NE.0.AND.IZSS.NE.0) THEN 307 : CALL INITD(IZSS.VPOCHA,LONG,0.D0) 308 : ENDIF 309 : C -------------------------------------------------- 310 : C- Fin du cas ou les tables KIZD et KIZG sont données 311 : C -------------------------------------------------- 312 : ENDIF 313 : C 314 : C- Traitement des historiques 315 : C -------------------------- 316 : IF (MTABT.NE.0) THEN 317 : TYPE=' ' 317 : CALL ACMO(KIZC,'HIST',TYPE,KHIS) 318 : IF (KHIS.NE.0)THEN 319 : NUCOMP = IPHR.VPOCHA(/2) 320 : NOMIX(1) = NOMI 321 : NOMIX(2) = '1'//NOMI(1:7) 322 : NOMIX(3) = '2'//NOMI(1:7) 323 : NOMIX(4) = '3'//NOMI(1:7) 324 : DO 82 NUC=1,NUCOMP+1 325 : NUCR = 1 326 : IF (NUC.GT.1) NUCR=NUC-1 327 : TYPE = ' ' 327 : CALL ACMO(KHIS,NOMIX(NUC),TYPE,MEVOLL) 328 : IF (TYPE.EQ.'EVOLUTIO')THEN 329 : TYPE1=' ' 330 : NOMI1='$'//NOMIX(NUC) 330 : CALL ACMO(KHIS,NOMI1,TYPE1,MAH) 331 : IF (TYPE1.EQ.'MAILLAGE') THEN 332 : SEGACT MAH 333 : ENDIF 333 : CALL ECROBJ('CHPOINT',IZPHI) 333 : CALL ECROBJ('MAILLAGE',MAH) 333 : CALL REDU 333 : CALL LIROBJ('CHPOINT',IZH,1,IRET) 333 : CALL LICHT(IZH,IPHH,TYPC,IGEOM) 334 : TYPE1=' ' 334 : CALL ACMO(KHIS,'KFIH',TYPE1,KFIH) 335 : IF (TYPE1.EQ.'ENTIER') THEN 335 : CALL ACME(KHIS,'KFIH',KFIH) 336 : ELSE 337 : KFIH = 20 338 : ENDIF 339 : INDH = IPT - IPT/KFIH * KFIH 340 : IF (INDH.NE.0) GOTO 80 341 : 342 : SEGACT MEVOLL 343 : NH=IEVOLL(/1) 344 : DO 81 IH=1,NH 345 : KEVOLL=IEVOLL(IH) 346 : SEGACT KEVOLL 347 : MLREE1=IPROGX 348 : IF (IH.EQ.1)THEN 349 : SEGACT MLREE1 350 : JG=MLREE1.PROG(/1)+1 351 : SEGADJ MLREE1 352 : MLREE1.PROG(JG)=TPS 353 : SEGDES MLREE1 354 : ENDIF 355 : 356 : MLREE2=IPROGY 357 : SEGACT MLREE2 358 : SEGADJ MLREE2 359 : if(ih.le.iphh.vpocha(/1)) then 360 : MLREE2.PROG(JG)=IPHH.VPOCHA(IH,NUCR) 361 : else 362 : MLREE2.PROG(JG)=0 363 : endif 364 : SEGDES MLREE2,KEVOLL 365 : 81 CONTINUE 366 : SEGDES MEVOLL 367 : 80 CONTINUE 368 : SEGDES MAH 369 : ENDIF 370 : 82 CONTINUE 371 : ENDIF 372 : ELSE 373 : WRITE(6,*)' Pour des historiques il faut une table PASDETPS' 374 : ENDIF 375 : C 376 : SEGDES IPHI,IPHR 377 : SEGDES IGEOM0 378 : SEGSUP IZIPAD 379 : 1 CONTINUE 380 : C 381 : SEGDES MLMOT2 382 : C 383 : C- Impressions de controle 384 : C ----------------------- 385 : IF (IMPR.NE.0) THEN 386 : KFIDT = IMPR 387 : IF (MTABT.NE.0) THEN 387 : CALL ACMM(MTABT,'OPER',NOMI) 387 : CALL ACMM(MTABT,'ZONE',NOMZ) 387 : CALL ACMF(MTABT,'DTCONV',DTT1) 387 : CALL ACMF(MTABT,'DTDIFU',DTT2) 387 : CALL ACMF(MTABT,'DIAEL',DIAEL) 387 : CALL ACME(MTABT,'NUEL',NUEL) 387 : CALL ACME(MTABT,'NUPASDT',IPT) 388 : ELSE 389 : IPT=1 390 : ENDIF 391 : IND = IPT - IPT/KFIDT * KFIDT 392 : 393 : IF (IPT.EQ.1) THEN 394 : WRITE(6,*) 395 : & ' IPT : NUMERO DU PAS DE TEMPS , NUEL : NUMERO DE L ELEMENT , ' 396 : &,' DIAEL : DIAMETRE MOYEN DE L ELEMENT ' 397 : WRITE(6,*) 398 : &' ALFA : TOLERANCE SUR LE PAS DE TEMPS , DTMAX : PAS DE TEMPS MAX' 399 : &,' DTT1 : PAS DE TEMPS DE CONVECTION , DTT2 PAS DE TEMPS DE' 400 : &,' DIFFUSION' 401 : ENDIF 402 : IF (IND.EQ.0)THEN 403 : WRITE(6,1011)NOMZ,NOMI 404 : WRITE(6,1010)IPT,NUEL,DIAEL,ALFA,DT,DTT1,DTT2 405 : ENDIF 406 : ENDIF 407 : C 408 : C- Mise à jour de la table PASDETPS 409 : C -------------------------------- 410 : 800 CONTINUE 411 : IF (KIZD.NE.0.AND.KIZG.NE.0) THEN 412 : IF (MTABT.NE.0) THEN 412 : CALL ECMF(MTABT,'DELTAT-1',DT) 412 : CALL ECMF(MTABT,'TPS',TPS) 413 : DT=1.E30 413 : CALL ECMF(MTABT,'DELTAT',DT) 414 : IPT = IPT + 1 414 : CALL ECME(MTABT,'NUPASDT',IPT) 415 : ENDIF 416 : ENDIF 417 : 417 : CALL ECRENT(IFINAL) 418 : 419 : RETURN 420 : C 421 : C- Formats associés aux impression de controle 422 : C ------------------------------------------- 423 : 1010 FORMAT(2X,'N.DT',I5,' NU.EL',I5,' DIAEL=',1PE11.4,' ALFA=', 424 : & 1PE11.4,' DTMAX=',1PE11.4, 425 : & ' DT1=',1PE11.4,' DT2=',1PE11.4) 426 : 1011 FORMAT(2X,' ZONE :',A8,' OPERATEUR :',A8) 427 : END 428 : 429 : 430 : 431 : 432 : 433 : 434 : 435 : 436 :
© Cast3M 2003 - All rights reserved.
Disclaimer