1 : C FISS SOURCE CHAT 11/03/16 21:22:34 6902 2 : SUBROUTINE FISS 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C__________________________________________________________________ 6 : C operateur FUITE: 7 : C Calcul du debit air-vapeur dans une fissure plane 8 : C 9 : C 10 : C__________________________________________________________________ 11 : -INC CCOPTIO 12 : -INC SMELEME 13 : -INC SMCHAML 14 : -INC SMCOORD 15 : -INC SMCHPOI 16 : -INC SMLENTI 17 : -INC SMMODEL 18 : -INC SMTABLE 19 : C 20 : SEGMENT MAVAL 21 : REAL*8 VAL(NVAL) 22 : ENDSEGMENT 23 : C 24 : SEGMENT PTRAV1 25 : INTEGER KASN(NNPT),KG(NNPT) 26 : REAL*8 XNC(NNPT),TP(NNPT),EP(NNPT),BP(NNPT) 27 : ENDSEGMENT 28 : SEGMENT PTRAV2 29 : REAL*8 XX(NMX) 30 : REAL*8 XP(NMX),XPV(NMX),XT(NMX),XY(NMX),XU(NMX) 31 : REAL*8 XQ(NMX),XQA(NMX),XQW(NMX),XHF(NMX),XRE(NMX),XDH(NMX) 32 : REAL*8 ZP(NNPT),ZPV(NNPT),ZT(NNPT),ZY(NNPT),ZU(NNPT) 33 : REAL*8 ZQ(NNPT),ZQA(NNPT),ZQW(NNPT),ZHF(NNPT),ZRE(NNPT),ZDH(NMX) 34 : REAL*8 ZTRA(NNPT) 35 : ENDSEGMENT 36 : C 37 : INTEGER GPARF 38 : CHARACTER*8 CMATE 39 : CHARACTER*12 CMAT1,CMAT2,CMAT3 40 : CHARACTER*(NCONCH) CONM 41 : CHARACTER*8 MOTCLE,MCO1,MCO2,MCO3,MCO4,NOM 42 : CHARACTER*8 MOT 43 : REAL*8 VALCL(5) 44 : POINTEUR MCHMAT.MCHELM 45 : POINTEUR PCHMAT.MCHAML 46 : POINTEUR DCHMAT.MELVAL 47 : POINTEUR PCOMP.MAVAL 48 : C 49 : CHARACTER*10 MOALIR 50 : CHARACTER*8 TYPOBJ 51 : CHARACTER*28 MOTTAB 52 : CHARACTER*72 CHARRE 53 : LOGICAL LOGIN,LOGRE 54 : REAL*8 XVALIN,XVALRE 55 : C 56 : TYPOBJ=' ' 57 : KIMP=IIMPI 58 : QINI = -1. 59 : C*********************************************************************** 60 : C lecture obligatoire de l objet modele 61 : C 62 : IPMODL=0 62 : CALL LIROBJ('MMODEL',IPMODL,1,IRET) 63 : C 64 : C*********************************************************************** 65 : C lecture obligatoire du champ de proprietes materielles 66 : C 67 : IPCHA1 = 0 67 : CALL LIROBJ('MCHAML',IPCHA1,1,IRET1) 68 : IF (IERR.NE.0) RETURN 69 : C verification de l egalite des supports du modele et du ch prop mat 69 : call rayn1(IPMODL,IPCHA1) 70 : C 71 : C*********************************************************************** 72 : C lecture obligatoire de la table des conditions aux limites 73 : C 74 : XLARG = 1.D0 75 : IPCHE3 = 0 76 : IPCHA2 = 0 77 : IPCHA3 = 0 78 : IPCHA4 = 0 78 : CALL LIROBJ('TABLE ',IPTAB,1,IRETOU) 79 : IF(IERR.NE.0) RETURN 80 : MTABLE = IPTAB 81 : SEGACT MTABLE 82 : NDIMTAB = MLOTAB 83 : C 84 : MOTTAB='PRESSION_TOTALE_AMONT' 84 : CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN,IOBIN, 85 : . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHE3) 86 : PE = XVALRE 87 : MOTTAB='PRESSION_VAPEUR_AMONT' 87 : CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN,IOBIN, 88 : . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHE3) 89 : PVE = XVALRE 90 : MOTTAB='TEMPERATURE_AMONT' 90 : CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN,IOBIN, 91 : . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHE3) 92 : TE = XVALRE 93 : MOTTAB='PRESSION_TOTALE_AVAL' 93 : CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN,IOBIN, 94 : . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHE3) 95 : PS = XVALRE 96 : MOTTAB='TEMPERATURE_PAROI' 97 : TYPOBJ=' ' 97 : CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN,IOBIN, 98 : . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHA2) 99 : MOTTAB='OUVERTURE' 100 : TYPOBJ=' ' 100 : CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN,IOBIN, 101 : . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHA3) 102 : * 103 : IF(NDIMTAB.EQ.7) THEN 104 : MOTTAB='DEBIT_INITIAL' 105 : TYPOBJ=' ' 105 : CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN, 106 : . IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHE3) 107 : IF(TYPOBJ.EQ.'FLOTTANT') THEN 108 : QINI = XVALRE 109 : ELSE 110 : MOTTAB='ETENDUE' 111 : TYPOBJ=' ' 111 : CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN, 112 : . IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHA4) 113 : ENDIF 114 : ENDIF 115 : * 116 : IF(NDIMTAB.EQ.8) THEN 117 : MOTTAB='DEBIT_INITIAL' 118 : TYPOBJ=' ' 118 : CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN, 119 : . IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHE3) 120 : QINI = XVALRE 121 : MOTTAB='ETENDUE' 122 : TYPOBJ=' ' 122 : CALL ACCTAB(IPTAB,'MOT ',IVALIN,XVALIN,MOTTAB,LOGIN, 123 : . IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IPCHA4) 124 : ENDIF 125 : SEGDES MTABLE 126 : C*********************************************************************** 127 : C ACTIVATION DU MODELE 128 : C -------------------- 129 : MMODEL = IPMODL 130 : SEGACT MMODEL 131 : NSOUS = KMODEL(/1) 132 : 133 : IMODEL=KMODEL(1) 134 : SEGACT IMODEL 135 : C 136 : C initialisations 137 : IPMAIL= IMAMOD 138 : NFOR = FORMOD(/2) 139 : NMAT = MATMOD(/2) 140 : C 141 : C verification de la formulation 141 : CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT) 142 : IF (CMATE.EQ.' ')THEN 142 : CALL ERREUR(251) 143 : SEGDES IMODEL,MMODEL 144 : IRET=0 145 : RETURN 146 : ENDIF 147 : C lecture de la formulation 148 : CMAT1 = CMATE(1:2) 149 : CMAT2 = CMATE(3:4) 150 : CMAT3 = CMATE(5:8) 151 : IF (CMAT1.EQ.'MA')THEN 152 : XW = 0.D0 153 : ELSE 154 : XW = 1.D0 155 : ENDIF 156 : IF (CMAT2.EQ.'PA')THEN 157 : GPARF = 1 158 : ELSE 159 : GPARF = 0 160 : ENDIF 161 : C 162 : C*********************************************************************** 163 : C ACTIVATION DU MCHELM ch prop mat 164 : C -------------------- 165 : MCHMAT = IPCHA1 166 : SEGACT MCHMAT 167 : NBS = MCHMAT.IMACHE(/1) 168 : C pas de boucle sur les modeles elementaires car NSOUS=1 169 : C pas de boucle sur les maillages elementaires car NBS=1 170 : C initialilsations 171 : RUG = 0. 172 : C lecture des prop materielles 173 : PCHMAT = MCHMAT.ICHAML(1) 174 : SEGACT PCHMAT 175 : NBS2 = PCHMAT.IELVAL(/1) 176 : NVAL = NBS2 177 : SEGINI PCOMP 178 : C boucle sur le nb de composantes du ch prop mat 179 : DO 10 I =1,NBS2 180 : MOT = PCHMAT.NOMCHE(I) 181 : DCHMAT = PCHMAT.IELVAL(I) 182 : SEGACT DCHMAT 183 : N1PTEL = DCHMAT.VELCHE(/1) 184 : N1EL = DCHMAT.VELCHE(/2) 185 : PCOMP.VAL(I) = DCHMAT.VELCHE(1,1) 186 : IF(MOT.EQ.'RUGO') RUG = PCOMP.VAL(I) 187 : IF(MOT.EQ.'REC') RECU = PCOMP.VAL(I) 188 : IF(MOT.EQ.'FK') XKUL = PCOMP.VAL(I) 189 : IF(MOT.EQ.'FA') XKUT1 = PCOMP.VAL(I) 190 : IF(MOT.EQ.'FB') XKUT2 = PCOMP.VAL(I) 191 : IF(MOT.EQ.'FC') XKUT3 = PCOMP.VAL(I) 192 : IF(MOT.EQ.'FD') XKUT4 = PCOMP.VAL(I) 193 : SEGDES DCHMAT 194 : 10 CONTINUE 195 : 196 : IF (CMAT3.EQ.'BLAS') THEN 197 : RECU = -1D5 198 : XKUL = 0. 199 : XKUT1 = 0. 200 : XKUT2 = 0. 201 : XKUT3 = 0. 202 : XKUT4 = 0. 203 : ELSE IF (CMAT3.EQ.'COLE')THEN 204 : RECU = -1D5 205 : XKUL = 0. 206 : XKUT1 = 0. 207 : XKUT2 = 0. 208 : XKUT3 = 0. 209 : XKUT4 = 0. 210 : * ELSE IF (CMAT3.EQ.'ENT1')THEN 211 : * RECU = PCOMP.VAL(2) 212 : ELSE IF (CMAT3.EQ.'ENT2')THEN 213 : RECU =-1D0*RECU 214 : ELSE IF (CMAT3.EQ.'ENT3')THEN 215 : RECU = -1D6 216 : XKUT1 = 0. 217 : XKUT2 = 0. 218 : XKUT3 = 0. 219 : XKUT4 = 0. 220 : ELSE IF (CMAT3.EQ.'ENT4')THEN 221 : RECU = -1D7 222 : XKUT1 = 0. 223 : XKUT2 = 0. 224 : XKUT3 = 0. 225 : XKUT4 = 0. 226 : ENDIF 227 : SEGSUP PCOMP 228 : SEGDES PCHMAT 229 : SEGDES MCHMAT 230 : C 231 : C********************************************************************* 232 : C TRAITEMENT des 2 champs ep et tp 233 : C -------------------------------- 234 : IPT2=IPMAIL 235 : 236 : SEGACT IPT2 237 : NBSO = IPT2.LISOUS(/1) 238 : IF (NBSO.NE.0) THEN 238 : CALL ERREUR(25) 239 : RETURN 240 : ENDIF 241 : NEL = IPT2.NUM(/2) 242 : 243 : NPT2 = IPT2.NUM(/1) 244 : IF (NPT2.NE.2) THEN 244 : CALL ERREUR(16) 245 : RETURN 246 : ENDIF 247 : 248 : C segment de travail 1 249 : 250 : NNPT = NEL + 1 251 : SEGINI PTRAV1 252 : 253 : XNC(1)=0.D0 254 : KG(1)= IPT2.NUM(1,1) 255 : 256 : C calcul des abscisses curvilignes 257 : 258 : IF (IDIM.EQ.1) THEN 259 : DO I =1,NEL 260 : KG(I+1) = IPT2.NUM(2,I) 261 : IREF1 = (IDIM+1)*(IPT2.NUM(1,I)-1) 262 : IREF2 = (IDIM+1)*(IPT2.NUM(2,I)-1) 263 : DX1 = XCOOR(IREF2+1)-XCOOR(IREF1+1) 264 : XNC(I+1) = XNC(I) + DX1 265 : ENDDO 266 : ENDIF 267 : IF (IDIM.EQ.2) THEN 268 : DO I =1,NEL 269 : KG(I+1) = IPT2.NUM(2,I) 270 : IREF1 = (IDIM+1)*(IPT2.NUM(1,I)-1) 271 : IREF2 = (IDIM+1)*(IPT2.NUM(2,I)-1) 272 : DX1 = XCOOR(IREF2+1)-XCOOR(IREF1+1) 273 : DX2 = XCOOR(IREF2+2)-XCOOR(IREF1+2) 274 : DXC = DSQRT(DX1*DX1+DX2*DX2) 275 : XNC(I+1) = XNC(I) + DXC 276 : ENDDO 277 : ENDIF 278 : IF (IDIM.EQ.3) THEN 279 : DO I =1,NEL 280 : KG(I+1) = IPT2.NUM(2,I) 281 : IREF1 = (IDIM+1)*(IPT2.NUM(1,I)-1) 282 : IREF2 = (IDIM+1)*(IPT2.NUM(2,I)-1) 283 : DX1 = XCOOR(IREF2+1)-XCOOR(IREF1+1) 284 : DX2 = XCOOR(IREF2+2)-XCOOR(IREF1+2) 285 : DX3 = XCOOR(IREF2+3)-XCOOR(IREF1+3) 286 : DXC = DSQRT(DX1*DX1+DX2*DX2+DX3*DX3) 287 : XNC(I+1) = XNC(I) + DXC 288 : ENDDO 289 : ENDIF 290 : XL = XNC(NNPT) 291 : DO I =1,NNPT 292 : XNC(I)=XNC(I)/XL 293 : ENDDO 294 : * recherche du plus petit DX 295 : DXMINAV = 0.01 296 : DO I =1,NNPT-1 297 : DXNC = XNC(I+1)-XNC(I) 298 : DXMIN = MIN(DXNC,DXMINAV) 299 : DXMINAV = DXMIN 300 : ENDDO 301 : DX = DXMIN/5.D0 302 : IF(KIMP.GE.1) THEN 303 : WRITE(6,*) 'fiss : taille relative de maille fluide= ',DX 304 : ENDIF 305 : 306 : * segment de travail 2 307 : NMX=3*IDINT(1.D0/DX) 308 : SEGINI PTRAV2 309 : 310 : IF (KIMP.EQ.2) THEN 311 : WRITE(6,*) 'fiss : XL ',XL 312 : WRITE(6,*) (XNC(I),I=1,NNPT) 313 : WRITE(6,*) 'fiss : KG(I) = ',(KG(I),I=1,NNPT) 314 : ENDIF 315 : 316 : SEGDES IPT2 317 : 318 : C activation segment MCHPO1 (chpoint Temperature et ouverture) 318 : CALL FUCHPO(IPCHA2,IPCHA3,IRETOU) 319 : MCHPO1=IRETOU 320 : SEGACT MCHPO1 321 : NSOUPO = MCHPO1.IPCHP(/1) 322 : 323 : IF(NSOUPO.NE.1) THEN 323 : CALL ERREUR(25) 324 : RETURN 325 : ENDIF 326 : 327 : MSOUP1 = MCHPO1.IPCHP(1) 328 : SEGACT MSOUP1 329 : NC = MSOUP1.NOHARM(/1) 330 : 331 : IF(NC.NE.2) THEN 331 : CALL ERREUR(21) 332 : RETURN 333 : ENDIF 334 : 335 : IPT1 = MSOUP1.IGEOC 335 : CALL KRIPAD(IPT1,MLENT1) 336 : SEGACT IPT1, MLENT1 337 : NTOT = MLENT1.LECT(/1) 338 : 339 : MPOVA1 = MSOUP1.IPOVAL 340 : 341 : SEGACT MPOVA1 342 : NNPT1 = MPOVA1.VPOCHA(/1) 343 : C 344 : IF (NNPT1.NE.NNPT) THEN 344 : CALL ERREUR(21) 345 : RETURN 346 : ENDIF 347 : 348 : DO I = 1,NNPT 349 : KASN(I) = MLENT1.LECT(KG(I)) 350 : ENDDO 351 : 352 : SEGDES MLENT1 353 : 354 : C remplissage des tableaux classes 355 : 356 : MCO1=MSOUP1.NOCOMP(1) 357 : MCO2=MSOUP1.NOCOMP(2) 358 : IF (MCO1.EQ.'T ') THEN 359 : IF (MCO2.EQ.'OUV ') THEN 360 : DO I=1,NNPT 361 : TP(I) = MPOVA1.VPOCHA(KASN(I),1) 362 : EP(I) = MPOVA1.VPOCHA(KASN(I),2) 363 : ENDDO 364 : ELSE 365 : MOTERR(1:4)= MCO2 365 : CALL ERREUR(197) 366 : RETURN 367 : ENDIF 368 : ELSEIF (MCO1.EQ.'OUV ') THEN 369 : IF (MCO2.EQ.'T ') THEN 370 : DO I=1,NNPT 371 : TP(I) = MPOVA1.VPOCHA(KASN(I),2) 372 : EP(I) = MPOVA1.VPOCHA(KASN(I),1) 373 : ENDDO 374 : ELSE 375 : MOTERR(1:4)= MCO2 375 : CALL ERREUR(197) 376 : RETURN 377 : ENDIF 378 : ELSE 379 : MOTERR(1:4)= MCO1 379 : CALL ERREUR(197) 380 : RETURN 381 : ENDIF 382 : IF (IIMPI.EQ.2) THEN 383 : write(6,*) 'fiss : TP= ',(TP(I),I=1,NNPT) 384 : write(6,*) 'fiss : EP= ',(EP(I),I=1,NNPT) 385 : ENDIF 386 : C cas etendue unite (champ d etendue non defini par utilisateur) 387 : IF (IPCHA4.EQ.0) THEN 388 : DO I=1,NNPT 389 : BP(I) = 1. 390 : ENDDO 391 : ENDIF 392 : SEGDES MPOVA1 393 : C activation segment MCHPO2 (chpoint Temperature et étendue) 394 : IF (IPCHA4.GT.0) THEN 394 : CALL FUCHPO(IPCHA2,IPCHA4,IRETOU) 395 : MCHPO2=IRETOU 396 : SEGACT MCHPO2 397 : NSOUPO = MCHPO2.IPCHP(/1) 398 : 399 : IF(NSOUPO.NE.1) THEN 399 : CALL ERREUR(25) 400 : RETURN 401 : ENDIF 402 : 403 : MSOUP2 = MCHPO2.IPCHP(1) 404 : SEGACT MSOUP2 405 : NC = MSOUP2.NOHARM(/1) 406 : 407 : IF(NC.NE.2) THEN 407 : CALL ERREUR(21) 408 : RETURN 409 : ENDIF 410 : 411 : IPT2 = MSOUP2.IGEOC 411 : CALL KRIPAD(IPT2,MLENT1) 412 : SEGACT IPT2, MLENT1 413 : NTOT = MLENT1.LECT(/1) 414 : 415 : MPOVA2 = MSOUP2.IPOVAL 416 : 417 : SEGACT MPOVA2 418 : NNPT1 = MPOVA2.VPOCHA(/1) 419 : C 420 : IF (NNPT1.NE.NNPT) THEN 420 : CALL ERREUR(21) 421 : RETURN 422 : ENDIF 423 : 424 : DO I = 1,NNPT 425 : KASN(I) = MLENT1.LECT(KG(I)) 426 : ENDDO 427 : 428 : SEGDES MLENT1 429 : 430 : C remplissage des tableaux classes 431 : 432 : MCO1=MSOUP2.NOCOMP(1) 433 : MCO2=MSOUP2.NOCOMP(2) 434 : IF (MCO1.EQ.'T ') THEN 435 : IF (MCO2.EQ.'ETEN') THEN 436 : DO I=1,NNPT 437 : TP(I) = MPOVA2.VPOCHA(KASN(I),1) 438 : BP(I) = MPOVA2.VPOCHA(KASN(I),2) 439 : ENDDO 440 : ELSE 441 : MOTERR(1:4)= MCO2 441 : CALL ERREUR(197) 442 : RETURN 443 : ENDIF 444 : ELSEIF (MCO1.EQ.'ETEN') THEN 445 : IF (MCO2.EQ.'T ') THEN 446 : DO I=1,NNPT 447 : TP(I) = MPOVA2.VPOCHA(KASN(I),2) 448 : BP(I) = MPOVA2.VPOCHA(KASN(I),1) 449 : ENDDO 450 : ELSE 451 : MOTERR(1:4)= MCO2 451 : CALL ERREUR(197) 452 : RETURN 453 : ENDIF 454 : ELSE 455 : MOTERR(1:4)= MCO1 455 : CALL ERREUR(197) 456 : RETURN 457 : ENDIF 458 : IF (IIMPI.EQ.2) THEN 459 : write(6,*) 'fiss : BP= ',(BP(I),I=1,NNPT) 460 : ENDIF 461 : SEGDES MPOVA2 462 : SEGDES MSOUP2 463 : SEGDES MCHPO2 464 : ENDIF 465 : 466 : C compatibilité de la loi de frottement avec la valeur de rugosité 467 : DO I=1,NNPT 468 : RUGD = RUG/(2.*EP(I)) 469 : IF (RUGD.GE.1e-4.AND.MATMOD(3).EQ.'POISEU_BLASIUS') THEN 470 : MOTERR(1:12)= 'RUGO/2e' 471 : REAERR(1) = RUGD 472 : REAERR(2) = 0.0001 473 : C %m1:18 = %r1 supérieur à %r2 473 : CALL ERREUR(43) 474 : RETURN 475 : ENDIF 476 : IF (RUGD.LT.1e-4.AND.MATMOD(3).EQ.'POISEU_COLEBROOK') THEN 477 : MOTERR(1:18)= 'RUGO/2e' 478 : REAERR(1) = RUGD 479 : REAERR(2) = 0.0001 480 : C %m1:18 = %r1 inférieur à %r2 480 : CALL ERREUR(41) 481 : RETURN 482 : ENDIF 483 : ENDDO 484 : C 485 : C*********************************************************************** 486 : C CALCUL 487 : C ------ 488 : 489 : IF (GPARF.EQ.1) THEN 490 : 490 : CALL BECALC(PE,PVE,TE,PS,XL,DX,RUG,QINI,XW,NNPT,XNC,TP,EP,BP, 491 : $ KIMP,NMX,NX,XX,XP,XPV,XT,XY,XU,XHF,XQ,XQW,XQA,XRE,XDH,RECU, 492 : $ XKUL,XKUT1,XKUT2,XKUT3,XKUT4) 493 : IF (IERR.NE.0) RETURN 494 : 495 : ELSE 495 : CALL BECALC2(PE,PVE,TE,PS,XL,DX,RUG,QINI,XW,NNPT,XNC,TP,EP,BP, 496 : $ KIMP,NMX,NX,XX,XP,XPV,XT,XY,XU,XHF,XQ,XQW,XQA,XRE,XDH,RECU, 497 : $ XKUL,XKUT1,XKUT2,XKUT3,XKUT4) 498 : IF (IERR.NE.0) RETURN 499 : 500 : ENDIF 501 : 502 : C creation des champs nodaux resultats 503 : 503 : CALL BYRETO(XX,XP,NX,ZP,XNC,NNPT,KASN,ZTRA) 503 : CALL BYRETO(XX,XPV,NX,ZPV,XNC,NNPT,KASN,ZTRA) 503 : CALL BYRETO(XX,XT,NX,ZT,XNC,NNPT,KASN,ZTRA) 503 : CALL BYRETO(XX,XY,NX,ZY,XNC,NNPT,KASN,ZTRA) 503 : CALL BYRETO(XX,XU,NX,ZU,XNC,NNPT,KASN,ZTRA) 503 : CALL BYRETO(XX,XHF,NX,ZHF,XNC,NNPT,KASN,ZTRA) 503 : CALL BYRETO(XX,XQ,NX,ZQ,XNC,NNPT,KASN,ZTRA) 503 : CALL BYRETO(XX,XQA,NX,ZQA,XNC,NNPT,KASN,ZTRA) 503 : CALL BYRETO(XX,XQW,NX,ZQW,XNC,NNPT,KASN,ZTRA) 503 : CALL BYRETO(XX,XRE,NX,ZRE,XNC,NNPT,KASN,ZTRA) 503 : CALL BYRETO(XX,XDH,NX,ZDH,XNC,NNPT,KASN,ZTRA) 504 : 505 : C ecriture du champoint multicomposante 506 : 507 : NC = 11 508 : N = NNPT 509 : SEGINI MPOVAL 510 : DO I=1,NNPT 511 : VPOCHA(I,1) = ZP(I) 512 : VPOCHA(I,2) = ZPV(I) 513 : VPOCHA(I,3) = ZT(I) 514 : VPOCHA(I,4) = ZY(I) 515 : VPOCHA(I,5) = ZU(I) 516 : VPOCHA(I,6) = ZHF(I) 517 : VPOCHA(I,7) = ZQ(I) 518 : VPOCHA(I,8) = ZQA(I) 519 : VPOCHA(I,9) = ZQW(I) 520 : VPOCHA(I,10) = ZRE(I) 521 : VPOCHA(I,11) = ZDH(I) 522 : ENDDO 523 : 524 : SEGSUP PTRAV1 525 : SEGSUP PTRAV2 526 : SEGINI MSOUPO 527 : 528 : NOCOMP(1) = 'P ' 529 : NOCOMP(2) = 'PV ' 530 : NOCOMP(3) = 'TF ' 531 : NOCOMP(4) = 'X ' 532 : NOCOMP(5) = 'U ' 533 : NOCOMP(6) = 'H ' 534 : NOCOMP(7) = 'Q ' 535 : NOCOMP(8) = 'QA ' 536 : NOCOMP(9) = 'QE ' 537 : NOCOMP(10) = 'RE ' 538 : NOCOMP(11) = 'F ' 539 : 540 : IGEOC = IPT1 541 : IPOVAL = MPOVAL 542 : 543 : DO I=1,NC 544 : NOHARM(I) = MSOUP1.NOHARM(1) 545 : ENDDO 546 : 547 : SEGDES MPOVAL 548 : SEGDES IPT1 549 : SEGDES IPT2 550 : SEGDES MSOUP1 551 : 552 : NSOUPO = 1 553 : NAT = MCHPO1.JATTRI(/1) 554 : SEGINI MCHPOI 555 : 556 : MTYPOI = MCHPO1.MTYPOI 557 : MOCHDE = MCHPO1.MOCHDE 558 : DO I=1,NAT 559 : JATTRI(I) = MCHPO1.JATTRI(1) 560 : ENDDO 561 : IPCHP(1) = MSOUPO 562 : IFOPOI = MCHPO1.IFOPOI 563 : 563 : CALL ECROBJ('CHPOINT',MCHPOI) 564 : 565 : SEGDES MSOUPO, MCHPOI 566 : SEGDES MCHPO1 567 : 568 : RETURN 569 : END 570 : 571 : 572 : 573 : 574 : 575 : 576 :
© Cast3M 2003 - All rights reserved.
Disclaimer