1 : C VARINU SOURCE FANDEUR 13/03/15 21:15:01 7714 2 : SUBROUTINE VARINU(IPOI1,IPOI2,IPMODL,IRET,MICHE,JEMIL,CHARP) 3 : *____________________________________________________________________ 4 : * 5 : * OBJET : Variation d'un champ/élément ayant une ou des composante(s) 6 : * °°°°°°° de type EVOLUTION ou NUAGE (FLOTTANT-EVOLUTION 7 : * ou FLOTTANT-FLOTTANT-EVOLUTION) en fonction 8 : * d'un champ/point ou d'un champ/élément.Ce champ peut 9 : * avoir plusieurs composantes si necessaire. Dans ce cas il 10 : * est possible d'instancier un champ/element dont les 11 : * composantes dependent de parametres differents en 12 : * chaque point. 13 : * 14 : * ENTREES : 15 : * °°°°°°°°° 16 : * 17 : * IPOI1 Pointeur sur un MCHAML 18 : * IPOI2 Pointeur sur un CHPOINT ou MCHAML 19 : * IPMODL Pointeur sur un MMODEL 20 : * JEMIL 1 A 5 selon le support choisi 21 : * MICHE = 1 IPOI2 est un objet de type CHPOINT 22 : * = 0 IPOI2 est un objet de type MCHAML 23 : * CHARP Chaine definissant le sous type (facultatif) 24 : * 25 : * 26 : * SORTIE : 27 : * °°°°°°°° 28 : * 29 : * IRET Pointeur sur le MCHAML resultat 30 : * =0 si operation impossible 31 : * 32 : *_____________________________________________________________________ 33 : * 34 : IMPLICIT INTEGER(I-N) 35 : IMPLICIT REAL*8(A-H,O-Z) 36 : * 37 : -INC SMCHAML 38 : -INC SMCHPOI 39 : -INC SMMODEL 40 : -INC CCOPTIO 41 : -INC SMEVOLL 42 : -INC SMLREEL 43 : -INC SMELEME 44 : -INC SMINTE 45 : -INC SMCOORD 46 : -INC SMNUAGE 47 : -INC DECHE 48 : -INC SMLMOTS 49 : -INC SMTABLE 50 : -INC CCNOYAU 51 : -INC CCASSIS 52 : 53 : external long 54 : * 55 : CHARACTER*(*) CHARP 56 : CHARACTER*16 CHA1,TYPV,CMNAME 57 : CHARACTER*72 SOUTYP,MMOD,MLIB,MPRO,lacomm,laco2 58 : CHARACTER*8 TYP3,NOMTMP 59 : CHARACTER*8 NOMCO,NOM2,NOM3,NOM4,NOM5,NOMTT 60 : CHARACTER*4 NOMCO4,NOMSIM 61 : LOGICAL COQ,KNUAG,KREAL,KFLOT,lsupma,dstati,drev21,drev22 62 : C 63 : C Creation des segments 64 : SEGMENT SWORK 65 : REAL*8 VAL1(NBPGA1),VAL2(NBPGAU),VALN(NBN1) 66 : REAL*8 SHP(6,NBN1) ,XE(3,NBN1) 67 : ENDSEGMENT 68 : SEGMENT IAMOI 69 : REAL*8 VEL1(MG1,N1EL2),VEL2(MG2,MXNBE) 70 : ENDSEGMENT 71 : SEGMENT IAMO2 72 : REAL*8 FLO1(NFLO),FLO2(NFLO,NFLO) 73 : INTEGER IFLO2(NFLO) 74 : ENDSEGMENT 75 : SEGMENT WRKEXT 76 : CHARACTER*4 NOMPAR(NPARA) 77 : INTEGER IVAPAR(NPARA) 78 : REAL*8 VALPAR(NPARA) 79 : REAL*8 VALPAP(N2,N2) 80 : ENDSEGMENT 81 : SEGMENT WRKRES 82 : CHARACTER*4 NOMVAL(N2) 83 : INTEGER IVALIS(N2) 84 : REAL*8 XVAL(N2) 85 : ENDSEGMENT 86 : SEGMENT INFO 87 : integer INFELL(IU) 88 : ENDSEGMENT 89 : C 90 : DATA NOMTT/'T '/ 91 : DATA NOMSIM/'SIMU'/ 92 : C 93 : JEMIL1 = JEMIL 94 : dstati = .false. 95 : C 96 : C CONVERSION DU CHPOINT OU MCHAML EN MCHAML AU SUPORT DEMANDE 97 : IF (MICHE.EQ.1) THEN 97 : CALL CHAME1(0,IPMODL,IPOI2,' ',IPOI3,JEMIL1) 98 : IF (IERR.NE.0) RETURN 99 : ELSE 100 : * 101 : * AM 14/6/07 102 : * ON PASSE UN INDICATEUR DE SUPPORT NEGATIF A CHASUP 103 : * POUR EVITER DES PROBLEMES DE CHANGEMENT DE SUPPORT 104 : * DE VARIABLES INTERNES NON SCALAIRES, DANS CHASUP 105 : * 106 : JEMIL2 = - JEMIL1 106 : CALL CHASUP(IPMODL,IPOI2,IPOI3,IRT2,JEMIL2) 107 : IF (IRT2.NE.0) THEN 107 : CALL ERREUR(IRT2) 108 : RETURN 109 : ENDIF 110 : ENDIF 111 : C 112 : C ACTIVATION DU MODELE 113 : MMODEL=IPMODL 114 : SEGACT MMODEL 115 : NSOUS1=KMODEL(/1) 116 : C 117 : C ACTIVATION DES MCHELM 118 : MCHEL1=IPOI1 119 : SEGACT MCHEL1 120 : NSOUS=MCHEL1.ICHAML(/1) 121 : IF (NSOUS.GT.NSOUS1) THEN 121 : CALL ERREUR(553) 122 : SEGDES MMODEL,MCHEL1 123 : RETURN 124 : ENDIF 125 : NINF=MCHEL1.INFCHE(/2) 126 : C 127 : C Creation du MCHAML 128 : N1=NSOUS 129 : N3=6 130 : IF (CHARP.EQ.' ') THEN 131 : L1=MCHEL1.TITCHE(/1) 132 : SOUTYP=MCHEL1.TITCHE 133 : ELSE 134 : L1=LEN(CHARP) 135 : SOUTYP=CHARP 136 : ENDIF 137 : SEGINI MCHELM 138 : IRET=MCHELM 139 : IFOCHE=IFOUR 140 : TITCHE=SOUTYP 141 : C 142 : C Boucle sur les sous zone du MCHAML 143 : DO 10 ISOUS=1,NSOUS 144 : C 145 : JEMIL1 = JEMIL 146 : C 147 : C VALEURS INITIALES 148 : MCHEL2=0 149 : IYOUN=0 150 : IMACHE(ISOUS)=MCHEL1.IMACHE(ISOUS) 151 : CONCHE(ISOUS)=MCHEL1.CONCHE(ISOUS) 152 : DO 20 IP=1,NINF 153 : INFCHE(ISOUS,IP)=MCHEL1.INFCHE(ISOUS,IP) 154 : 20 CONTINUE 155 : C 156 : C Mise en concordance des pointeurs de maillage 157 : C 158 : MELEME=IMACHE(ISOUS) 159 : C* DO 30 IO=1,kmodel(/1) 160 : DO 30 IO=1, NSOUS1 161 : IMODEL=KMODEL(IO) 162 : SEGACT IMODEL 163 : if (cmatee.eq.'STATIQUE') dstati = .true. 164 : IF (IMAMOD.EQ.MELEME.AND.CONMOD.EQ.CONCHE(ISOUS)) GOTO 40 165 : SEGDES IMODEL 166 : 30 CONTINUE 166 : CALL ERREUR(472) 167 : GOTO 9930 168 : 40 CONTINUE 169 : C* SEGACT MELEME <-- Redondant avec ligne 231 170 : IMELE=NEFMOD 171 : C 172 : C Le modèle est-il appuye sur des elements coques. 173 : C MF1 = 3 ---> coque 174 : C MF1 = 5 ---> coque epaisse 175 : C MF1 = 9 ---> coque avec cisaillement transverse 176 : C 177 : MF1 = NUMMFR(NEFMOD) 178 : COQ = (MF1 .EQ. 3).OR.(MF1 .EQ. 5).OR.(MF1 .EQ. 9) 179 : C 180 : C le modele contient t il de la thermique 181 : C 182 : NFORQ = FORMOD(/2) 183 : ither = 0 183 : CALL PLACE(FORMOD,NFORQ,ither,'THERMIQUE') 184 : C 185 : C si il y a de la thermique le segment d'integration est particulier 186 : C 187 : IF (ither.NE.0) THEN 188 : IF ( JEMIL1 .NE. 1 ) JEMIL1 = 6 189 : ENDIF 190 : C 191 : IPTR3=0 192 : IF (NINF.LT.4.OR.MCHEL1.INFCHE(ISOUS,4).EQ.0) THEN 193 : C 194 : C La sous zone est aux noeuds 195 : IF (JEMIL1 .EQ. 6) THEN 195 : CALL TSHAPE(IMELE,'NOEUD',MINTE1) 196 : IF (IERR.NE.0) GOTO 9930 197 : C#MC 08/04/98 198 : SEGACT MINTE1 199 : ELSE 200 : IF(INFMOD(/1).lt.3) then 200 : CALL ELQUOI(IMELE,0,1,IPTR3,IMODEL) 201 : IF (IERR.NE.0) GOTO 9930 202 : INFO=IPTR3 203 : MINTE1=INFELL(11) 204 : ELSE 205 : MINTE1=INFMOD(3) 206 : SEGACT MINTE1 207 : ENDIF 208 : ENDIF 209 : ELSE 210 : MINTE1=MCHEL1.INFCHE(ISOUS,4) 211 : SEGACT MINTE1 212 : ENDIF 213 : C 214 : C Information sur l'element fini 215 : IF (JEMIL1 .EQ. 6) THEN 215 : CALL TSHAPE(IMELE,'GAUSS',MINTE) 216 : IF (IERR.NE.0) GOTO 9920 217 : MELGEO = NUMGEO(IMELE) 218 : ELSE 219 : IF(INFMOD(/1).lt.2+JEMIL1) then 219 : CALL ELQUOI(IMELE,0,JEMIL1,IPTR2,IMODEL) 220 : IF (IERR.NE.0) GOTO 9920 221 : INFO=IPTR2 222 : MINTE=INFELL(11) 223 : MELGEO=INFELL(14) 224 : ELSE 225 : MINTE=INFMOD(2+JEMIL1) 226 : MELGEO=INFELE(14) 227 : ENDIF 228 : ENDIF 229 : SEGACT MINTE 230 : INFCHE(ISOUS,4)=MINTE 231 : IF (JEMIL1.EQ.1) INFCHE(ISOUS,4)=0 232 : INFCHE(ISOUS,6)=JEMIL1 233 : C 234 : C On recupere le nombre de points support NBPGA1 pour 235 : C pour l'ancien chamelem NBPGAU pour le nouveau mchaml 236 : NBPGA1 = MINTE1.SHPTOT(/3) 237 : NBPGAU = SHPTOT(/3) 238 : C 239 : C On recupere le nombre d'elements 240 : SEGACT MELEME 241 : NBN1=NUM(/1) 242 : NEL0=NUM(/2) 243 : SEGINI SWORK 244 : C 245 : C CREATION DU MCHAML 246 : MCHAM1=MCHEL1.ICHAML(ISOUS) 247 : SEGACT MCHAM1 248 : N2=MCHAM1.NOMCHE(/2) 249 : SEGINI MCHAML 250 : ICHAML(ISOUS)=MCHAML 251 : 252 : NMATQ =MATMOD(/2) 253 : iuser = 0 253 : CALL PLACE(MATMOD,NMATQ,iuser,'UTILISATEUR') 254 : CMNAME=' ' 255 : IF (iuser.GT.0) THEN 256 : IF (iuser.LT.NMATQ) CMNAME = MATMOD(iuser+1) 257 : ENDIF 258 : * 259 : KNUAG = .FALSE. 260 : IF (TITCHE.EQ.'CARACTERISTIQUES') THEN 261 : DO 60 IC1=1,N2 262 : IF (MCHAM1.NOMCHE(IC1).EQ.'YOUN ') IYOUN=IC1 263 : CHA1=MCHAM1.TYPCHE(IC1) 264 : IF (CHA1(9:16).EQ.'NUAGE ') KNUAG = .TRUE. 265 : 60 CONTINUE 266 : IF (KNUAG) THEN 267 : SEGINI WRK53 268 : wrk53.MFR = MF1 269 : wrk53.NFOR = NFORQ 270 : wrk53.NMAT = NMATQ 271 : wrk53.CMATE = CMATEE 272 : wrk53.MATE = IMATEE 273 : wrk53.INPLAS = INATUU 274 : if(lnomid(6).ne.0) then 275 : nomid=lnomid(6) 276 : segact nomid 277 : ipnomc=nomid 278 : nbrobl=lesobl(/2) 279 : nbrfac=lesfac(/2) 280 : lsupma=.false. 281 : else 282 : lsupma=.true. 282 : CALL IDMATR(MF1,IMODEL,IPNOMC,NBROBL,NBRFAC) 283 : endif 284 : IQMOD=IMODEL 285 : IWRK53=WRK53 286 : NMATT=NBROBL+NBRFAC 286 : CALL COTYPE(IQMOD,13,MOTYPE,IWRK53,NBROBL,NBRFAC) 287 : NOTYPE=MOTYPE 288 : SEGACT NOTYPE 289 : NBTYPE=TYPE(/2) 290 : KREAL = .TRUE. 291 : DO 65 ITYPE=1,NBTYPE 292 : TYPV=TYPE(ITYPE) 293 : IF (TYPV(1:6).NE.'REAL*8') KREAL = .FALSE. 294 : 65 CONTINUE 295 : SEGDES NOTYPE 296 : SEGSUP WRK53 297 : ENDIF 298 : ENDIF 299 : C 300 : SEGINI WRK53 301 : SEGINI WRKRES 302 : JESIMU = 0 303 : C 304 : C''''''''''''''''''''''''''''''''''''' 305 : C BOUCLE SUR LES COMPOSANTES 306 : C 307 : C''''''''''''''''''''''''''''''''''''' 308 : DO 70 ICOMP=1,N2 309 : IAMOI=0 310 : iptamo = 0 311 : C 312 : C traitement des composantes de type FLOTTANT ou MCHAML 313 : C 314 : CHA1=MCHAM1.TYPCHE(ICOMP) 315 : NOMCHE(ICOMP)=MCHAM1.NOMCHE(ICOMP) 316 : NOMCO = MCHAM1.NOMCHE(ICOMP) 317 : NOMVAL(ICOMP) = MCHAM1.NOMCHE(ICOMP)(1:4) 318 : MELVA1=MCHAM1.IELVAL(ICOMP) 319 : SEGACT MELVA1 320 : C 321 : C--------------------------------------------------------- 322 : C Composante de type reel 323 : C--------------------------------------------------------- 324 : C 325 : IF (CHA1(1:8).EQ.'REAL*8 ') THEN 326 : TYPCHE(ICOMP)='REAL*8' 327 : N1PTE1=MELVA1.VELCHE(/1) 328 : IF (N1PTE1.EQ.1) THEN 329 : N1PTEL=1 330 : ELSE 331 : N1PTEL=NBPGAU 332 : ENDIF 333 : N1EL =MELVA1.VELCHE(/2) 334 : N2PTEL=0 335 : N2EL =0 336 : C 337 : C test de compatibilite des nombres d'elements 338 : C 339 : IF (N1EL.NE.NEL0.AND.N1EL.NE.1.AND.NEL0.NE.1) THEN 340 : MOTERR(1:8)='VARINU ' 340 : CALL ERREUR(146) 341 : GOTO 9910 342 : ENDIF 343 : N1PAUX=N1PTE1 344 : C 345 : C Pour les COQ4, le nb de pt de GAUSS vaut 5, mais on 346 : C ne prend que les 4 premiers (le 5ieme sert uniquement 347 : C au cisaillement) 348 : IF (IMELE.EQ.49.AND.N1PAUX.EQ.5) N1PAUX=4 349 : SEGINI MELVAL 350 : IELVAL(ICOMP)=MELVAL 351 : C 352 : C Traitement immediat si champ constant 353 : IF (N1PTE1.EQ.1) THEN 354 : DO 80 IEL=1,N1EL 355 : VELCHE(1,IEL)=MELVA1.VELCHE(1,IEL) 356 : 80 CONTINUE 357 : ELSE 358 : DO 90 IEL=1,NEL0 359 : DO 100 IGAU=1,N1PTE1 360 : VAL1(IGAU)=MELVA1.VELCHE(IGAU,IEL) 361 : 100 CONTINUE 362 : C 363 : C LE CHAMELEM N'EST PAS AUX NOEUDS 364 : IF (MINTE1.NE.0) THEN 365 : C Meme support 366 : IF (MINTE.EQ.MINTE1) THEN 367 : DO 110 IGAU=1,N1PTE1 368 : VELCHE(IGAU,IEL)=VAL1(IGAU) 369 : 110 CONTINUE 370 : GOTO 90 371 : C Support different 372 : ELSE 372 : CALL DOXE(XCOOR,IDIM,NBN1,NUM,IEL,XE) 372 : CALL QUEDIM(MELGEO,KERRE1) 372 : CALL CH1CH2(IMELE,MINTE,MINTE1,N1PTEL,N1PAUX,NBN1, 373 : & SWORK,KERRE1) 374 : IF (KERRE1.NE.0) THEN 374 : CALL ERREUR(KERRE1) 375 : GOTO 9900 376 : ENDIF 377 : DO 120 IGAU=1,N1PTEL 378 : VELCHE(IGAU,IEL)=VAL2(IGAU) 379 : 120 CONTINUE 380 : ENDIF 381 : ELSE 382 : DO 130 IGAU=1,N1PTEL 383 : VALG=0.D0 384 : DO 140 INO=1,NBN1 385 : VALG=VALG+SHPTOT(1,INO,IGAU)*VAL1(INO) 386 : 140 CONTINUE 387 : VELCHE(IGAU,IEL)=VALG 388 : 130 CONTINUE 389 : ENDIF 390 : 90 CONTINUE 391 : ENDIF 392 : SEGDES MELVAL,MELVA1 393 : C 394 : C--------------------------------------------------------- 395 : C Composante de type evolution 396 : C--------------------------------------------------------- 397 : C 398 : ELSE IF (CHA1(9:16).EQ.'EVOLUTIO') THEN 399 : N1PTE3=MELVA1.IELCHE(/1) 400 : N1EL3 =MELVA1.IELCHE(/2) 401 : IF (N1EL3.NE.NEL0.AND.N1EL3.NE.1.AND.NEL0.NE.1) THEN 402 : MOTERR(1:8)='VARINU ' 402 : CALL ERREUR(146) 403 : GOTO 9910 404 : ENDIF 405 : C 406 : C S'il s'agit d'une courbe de traction d'un matériau 407 : C constant, on garde l'objet EVOLUTIO sans rien changer. 408 : C 409 : NOMTMP=NOMCHE(ICOMP) 410 : IF (TITCHE.EQ.'CARACTERISTIQUES'.AND. 411 : & N1PTE3.EQ.1.AND.N1EL3.EQ.1) THEN 412 : IF (NOMTMP.EQ.'TRAC '.OR.NOMTMP.EQ.'EVOL '.OR. 413 : & NOMTMP.EQ.'COMP '.OR.NOMTMP.EQ.'FLXY '.OR. 414 : & NOMTMP.EQ.'FLXZ '.OR.NOMTMP.EQ.'CISY '.OR. 415 : & NOMTMP.EQ.'CISZ '.OR.NOMTMP.EQ.'JDA '.OR. 416 : & NOMTMP.EQ.'EM0 '.OR.NOMTMP.EQ.'EM1 '.OR. 417 : & NOMTMP.EQ.'EM2 '.OR.NOMTMP.EQ.'EM3 '.OR. 418 : & NOMTMP.EQ.'EM4 '.OR.NOMTMP.EQ.'EM5 '.OR. 419 : & NOMTMP.EQ.'EM6 '.OR.NOMTMP.EQ.'EM7 '.OR. 420 : & NOMTMP.EQ.'EM8 '.OR.NOMTMP.EQ.'SFFS '.OR. 421 : & NOMTMP.EQ.'EFFS ') THEN 422 : TYPCHE(ICOMP)='POINTEUREVOLUTIO' 423 : N1PTEL=0 424 : N1EL =0 425 : N2PTEL=1 426 : N2EL =1 427 : SEGINI MELVAL 428 : IELVAL(ICOMP)=MELVAL 429 : IELCHE(N2PTEL,N2EL)=MELVA1.IELCHE(1,1) 430 : SEGDES MELVAL,MELVA1 431 : GOTO 70 432 : ENDIF 433 : ENDIF 434 : C 435 : C S'il s'agit d'autres composantes que la courbe de 436 : C traction d'un matériau constant on fait l'interpolation 437 : C selon la loi de variation 438 : C 439 : TYPCHE(ICOMP)='REAL*8' 440 : MCHEL2=IPOI3 441 : SEGACT MCHEL2 442 : IF (MCHEL2.ICHAML(/1).LT.NSOUS) THEN 442 : CALL ERREUR(553) 443 : SEGDES MCHEL2 444 : GOTO 9910 445 : ENDIF 446 : IF (IMAMOD.NE.MCHEL2.IMACHE(ISOUS).OR. 447 : & CONMOD.NE.MCHEL2.CONCHE(ISOUS)) THEN 448 : do is = 1,mchel2.imache(/1) 449 : if (imamod.eq.mchel2.imache(is).and. 450 : & conmod.eq.mchel2.conche(is)) then 451 : icham2 = mchel2.ichaml(is) 452 : goto 149 453 : endif 454 : enddo 454 : CALL ERREUR(472) 455 : SEGDES MCHEL2 456 : GOTO 9910 457 : ELSE 458 : ICHAM2=MCHEL2.ICHAML(ISOUS) 459 : ENDIF 460 : C 461 : 149 CONTINUE 462 : iptamo = 0 463 : if (imatee.eq.34.and.NOMTMP.eq.'MOCO') then 464 : N=1 465 : segini mevol1,mevol2 466 : segini,melva2=melva1 467 : segini,melva3=melva1 468 : drev21 = .false. 469 : drev22 = .true. 470 : do iel = 1,melva2.ielche(/2) 471 : do ipg = 1,melva2.ielche(/1) 472 : IEVOL = MELVA2.IELCHE(ipg,iel) 473 : MEVOLL = IEVOL 474 : SEGACT MEVOLL 475 : KEVOLL = IEVOLL(1) 476 : mevol1.ievoll(1) = ievoll(1) 477 : melva2.ielche(ipg,iel) = mevol1 478 : if (ievoll(/1).gt.1) then 479 : mevol2.ievoll(1) = ievoll(2) 480 : melva3.ielche(ipg,iel) = mevol2 481 : drev21 = .true. 482 : else 483 : drev22 = .false. 484 : endif 485 : enddo 486 : enddo 486 : CALL VARIN2(ICHAM2,melva2,COQ,MELEME,SWORK,NOMCO,IMELE, 487 : & MELGEO,MINTE,MINTE1,MELVAL,KERRE1) 488 : iptrai = melval 489 : if (drev21.and.drev22) then 489 : CALL VARIN2(ICHAM2,melva3,COQ,MELEME,SWORK,NOMCO,IMELE, 490 : & MELGEO,MINTE,MINTE1,MELVAL,KERRE1) 491 : iptamo = melval 492 : endif 493 : if (.not.drev22) write(6,*) 'calcul AMOR problématique' 494 : nomche(icomp) = 'RAID' 495 : melval = iptrai 496 : else 496 : CALL VARIN2(ICHAM2,MELVA1,COQ,MELEME,SWORK,NOMCO,IMELE, 497 : & MELGEO,MINTE,MINTE1,MELVAL,KERRE1) 498 : endif 499 : C 500 : IF (KERRE1.NE.0) THEN 501 : IF (KERRE1.EQ.146) MOTERR(1:8)='VARINU ' 502 : SEGDES MCHEL2 502 : CALL ERREUR(KERRE1) 503 : GOTO 9910 504 : ENDIF 505 : IELVAL(ICOMP)=MELVAL 506 : SEGDES MELVA1 507 : SEGDES MCHEL2 508 : C 509 : C--------------------------------------------------------- 510 : C Composante de type nuage 511 : C--------------------------------------------------------- 512 : C 513 : ELSE IF (CHA1(9:16).EQ.'NUAGE ') THEN 514 : TYPCHE(ICOMP)='POINTEUREVOLUTIO' 515 : MCHEL2=IPOI3 516 : SEGACT MCHEL2 517 : NSOUS2=MCHEL2.ICHAML(/1) 518 : IF (NSOUS2.GT.NSOUS1.OR.NSOUS2.LT.NSOUS) THEN 518 : CALL ERREUR(553) 519 : SEGDES MCHEL2 520 : GOTO 9910 521 : ENDIF 522 : C Mise en concordance des pointeurs de maillage 523 : DO 150 IP=1,NSOUS 524 : IF (MCHEL2.IMACHE(IP).EQ.MELEME.AND. 525 : & MCHEL2.CONCHE(IP).EQ.CONCHE(ISOUS)) GOTO 160 526 : 150 CONTINUE 526 : CALL ERREUR(472) 527 : SEGDES MCHEL2 528 : GOTO 9930 529 : 160 CONTINUE 530 : MCHAM2=MCHEL2.ICHAML(IP) 531 : SEGACT MCHAM2 532 : C 533 : NCO1 = MCHAM2.IELVAL(/1) 534 : INU = MELVA1.IELCHE(1,1) 535 : MNUAGE = INU 536 : SEGACT MNUAGE 537 : NVAR = NUANOM(/2) 538 : IF (NVAR.LE.1) THEN 539 : SEGDES MCHEL2,MCHAM2,MNUAGE 540 : INTERR(1)=MNUAGE 541 : INTERR(2)=2 542 : INTERR(3)=2 542 : CALL ERREUR(628) 543 : GOTO 9910 544 : ENDIF 545 : C 546 : NOM4 = ' ' 547 : NOM5 = ' ' 548 : IA1 = 0 549 : IA2 = 0 550 : IVAR = 0 551 : DO 170 INO2=1,NVAR 552 : TYP3 = NUATYP(INO2) 553 : IF (TYP3.EQ.'FLOTTANT') THEN 554 : IF (IVAR.EQ.0) THEN 555 : NOM4 = NUANOM(INO2) 556 : IA1 = INO2 557 : ENDIF 558 : IF (IVAR.EQ.1) THEN 559 : NOM5 = NUANOM(INO2) 560 : IA2 = INO2 561 : ENDIF 562 : IVAR = IVAR + 1 563 : ENDIF 564 : 170 CONTINUE 565 : IF (IVAR.LT.1) THEN 566 : SEGDES MCHEL2,MCHAM2,MNUAGE 567 : INTERR(1)=MNUAGE 568 : MOTERR(1:8)='FLOTTANT' 568 : CALL ERREUR(629) 569 : GOTO 9910 570 : ENDIF 571 : IF (IVAR.GT.2) THEN 572 : SEGDES MCHEL2,MCHAM2,MNUAGE 573 : INTERR(1)=MNUAGE 574 : INTERR(2)=2 574 : CALL ERREUR(938) 575 : GOTO 9910 576 : ENDIF 577 : IF (NOM4.EQ.NOM5) THEN 578 : SEGDES MCHEL2,MCHAM2,MNUAGE 579 : INTERR(1)=MNUAGE 580 : MOTERR(1:8)='FLOTTANT' 580 : CALL ERREUR(939) 581 : GOTO 9910 582 : ENDIF 583 : C 584 : DO 180 IBBON=1,NVAR 585 : IF (NUATYP(IBBON).EQ.'EVOLUTIO') GOTO 190 586 : 180 CONTINUE 587 : SEGDES MCHEL2,MCHAM2,MNUAGE 588 : INTERR(1)=MNUAGE 589 : MOTERR(1:8)='EVOLUTIO' 589 : CALL ERREUR(629) 590 : GOTO 9910 591 : 190 CONTINUE 592 : C 593 : C Cas des coques dont les caracteristiques dependent de T 594 : C 595 : IF (COQ.AND. 596 : & ((NOM4.EQ.NOMTT).OR.(NOM5.EQ.NOMTT))) THEN 597 : INO2 = 0 598 : INO1 = 0 599 : INO3 = 0 600 : DO 200 INO = 1,NCO1 601 : NOM2 = MCHAM2.NOMCHE(INO) 602 : IF (NOM2.EQ.NOMTT) INO2=INO 603 : IF (NOM2.EQ.'TINF ') INO1=INO 604 : IF (NOM2.EQ.'TSUP ') INO3=INO 605 : 200 CONTINUE 606 : IF (INO1.NE.0.AND.INO2.NE.0.AND.INO3.NE.0) THEN 607 : MELVA3=MCHAM2.IELVAL(INO1) 608 : MELVA4=MCHAM2.IELVAL(INO3) 609 : SEGACT MELVA3,MELVA4 610 : C 611 : NBP2=MELVA4.VELCHE(/1) 612 : NBP1=MELVA3.VELCHE(/1) 613 : NEL1=MELVA3.VELCHE(/2) 614 : NEL2=MELVA4.VELCHE(/2) 615 : N1PTEL=MAX(NBP1,NBP2) 616 : N1EL =MAX(NEL1,NEL2) 617 : N2PTEL=0 618 : N2EL =0 619 : SEGINI MELVA5 620 : DO 210 IGAU=1,N1PTEL 621 : IGMN1=MIN(IGAU,MELVA3.VELCHE(/1)) 622 : IGMN2=MIN(IGAU,MELVA4.VELCHE(/1)) 623 : DO 220 IB=1,N1EL 624 : IBMN1=MIN(IB ,MELVA3.VELCHE(/2)) 625 : IBMN2=MIN(IB ,MELVA4.VELCHE(/2)) 626 : MELVA5.VELCHE(IGAU,IB)=MELVA3.VELCHE(IGMN1,IBMN1)+ 627 : & MELVA4.VELCHE(IGMN2,IBMN2) 628 : 220 CONTINUE 629 : 210 CONTINUE 630 : C 631 : SEGDES MELVA3,MELVA4 632 : MELVA3=MCHAM2.IELVAL(INO2) 633 : SEGACT MELVA3 634 : C 635 : N1PTEL = MELVA3.VELCHE(/1) 636 : N1EL = MELVA3.VELCHE(/2) 637 : N2PTEL = 0 638 : N2EL = 0 639 : SEGINI MELVA4 640 : DO 230 II = 1,N1PTEL 641 : DO 240 III = 1,N1EL 642 : MELVA4.VELCHE(II,III) = 4.D0*MELVA3.VELCHE(II,III) 643 : 240 CONTINUE 644 : 230 CONTINUE 645 : SEGDES MELVA3 646 : C 647 : NBP2=MELVA4.VELCHE(/1) 648 : NBP1=MELVA5.VELCHE(/1) 649 : NEL1=MELVA5.VELCHE(/2) 650 : NEL2=MELVA4.VELCHE(/2) 651 : N1PTEL=MAX(NBP1,NBP2) 652 : N1EL =MAX(NEL1,NEL2) 653 : N2PTEL=0 654 : N2EL =0 655 : SEGINI MELVA6 656 : DO 250 IGAU=1,N1PTEL 657 : IGMN1=MIN(IGAU,MELVA5.VELCHE(/1)) 658 : IGMN2=MIN(IGAU,MELVA4.VELCHE(/1)) 659 : DO 260 IB=1,N1EL 660 : IBMN1=MIN(IB ,MELVA5.VELCHE(/2)) 661 : IBMN2=MIN(IB ,MELVA4.VELCHE(/2)) 662 : MELVA6.VELCHE(IGAU,IB)=MELVA5.VELCHE(IGMN1,IBMN1)+ 663 : & MELVA4.VELCHE(IGMN2,IBMN2) 664 : 260 CONTINUE 665 : 250 CONTINUE 666 : SEGSUP MELVA4,MELVA5 667 : C 668 : N1PTEL = MELVA6.VELCHE(/1) 669 : N1EL = MELVA6.VELCHE(/2) 670 : N2PTEL = 0 671 : N2EL = 0 672 : IF (NOM4.EQ.NOMTT) THEN 673 : SEGINI MELVA2 674 : DO 270 II = 1,N1PTEL 675 : DO 280 III = 1,N1EL 676 : MELVA2.VELCHE(II,III)= 677 : & 1.D0/6.D0*MELVA6.VELCHE(II,III) 678 : 280 CONTINUE 679 : 270 CONTINUE 680 : SEGSUP MELVA6 681 : GOTO 290 682 : ENDIF 683 : IF (NOM5.EQ.NOMTT) THEN 684 : SEGINI MELVA3 685 : DO 300 II = 1,N1PTEL 686 : DO 310 III = 1,N1EL 687 : MELVA3.VELCHE(II,III)= 688 : & 1.D0/6.D0*MELVA6.VELCHE(II,III) 689 : 310 CONTINUE 690 : 300 CONTINUE 691 : SEGSUP MELVA6 692 : GOTO 290 693 : ENDIF 694 : ELSEIF (INO2.NE.0) THEN 695 : IF (NOM4.EQ.NOMTT) THEN 696 : MELVA2=MCHAM2.IELVAL(INO2) 697 : SEGACT MELVA2 698 : GOTO 290 699 : ENDIF 700 : IF ((IVAR.EQ.2).AND.(NOM5.EQ.NOMTT)) THEN 701 : MELVA3=MCHAM2.IELVAL(INO2) 702 : SEGACT MELVA3 703 : GOTO 290 704 : ENDIF 705 : ENDIF 706 : ELSE 707 : ITRO = 0 708 : DO 320 INO = 1,NCO1 709 : NOM2 = MCHAM2.NOMCHE(INO) 710 : IF (IVAR.EQ.1.AND.NOM4.EQ.NOM2) THEN 711 : MELVA2=MCHAM2.IELVAL(INO) 712 : SEGACT MELVA2 713 : GOTO 290 714 : ENDIF 715 : IF (IVAR.EQ.2) THEN 716 : IF (NOM4.EQ.NOM2) THEN 717 : MELVA2=MCHAM2.IELVAL(INO) 718 : SEGACT MELVA2 719 : ITRO = ITRO + 1 720 : ENDIF 721 : IF (NOM5.EQ.NOM2) THEN 722 : MELVA3=MCHAM2.IELVAL(INO) 723 : SEGACT MELVA3 724 : ITRO = ITRO + 1 725 : ENDIF 726 : IF (ITRO.EQ.2) GOTO 290 727 : ENDIF 728 : 320 CONTINUE 729 : ENDIF 730 : C 731 : SEGDES MCHEL2,MCHAM2,MNUAGE 731 : CALL ERREUR(665) 732 : GOTO 9910 733 : C 734 : 290 CONTINUE 735 : 736 : N1PTE1=MELVA2.VELCHE(/1) 737 : N1E1 =MELVA2.VELCHE(/2) 738 : IF (IVAR.EQ.2) THEN 739 : N1PTE2=MELVA3.VELCHE(/1) 740 : N1E2 =MELVA3.VELCHE(/2) 741 : ENDIF 742 : C On teste la taille du MCHAML_FLOTTANT 743 : IF (N1E1.NE.NEL0.AND.N1E1.NE.1.AND.NEL0.NE.1) THEN 744 : SEGDES MCHEL2,MCHAM2 745 : SEGDES MELVA2 746 : IF (IVAR.EQ.2) SEGDES MELVA3 747 : MOTERR(1:8)='VARINU ' 747 : CALL ERREUR(146) 748 : GOTO 9910 749 : ENDIF 750 : IF (IVAR.EQ.2.AND. 751 : & N1E2.NE.NEL0.AND.N1E2.NE.1.AND.NEL0.NE.1) THEN 752 : SEGDES MCHEL2,MCHAM2 753 : SEGDES MELVA2,MELVA3 754 : MOTERR(1:8)='VARINU ' 754 : CALL ERREUR(146) 755 : GOTO 9910 756 : ENDIF 757 : IF (N1PTE1.NE.1.AND.N1PTE1.NE.NBPGAU) THEN 758 : SEGDES MCHEL2,MCHAM2 759 : SEGDES MELVA2,MELVA3 760 : IF (IVAR.EQ.2) SEGDES MELVA3 761 : MOTERR(1:8)='VARINU ' 761 : CALL ERREUR(146) 762 : GOTO 9910 763 : ENDIF 764 : IF (IVAR.EQ.2.AND. 765 : & N1PTE2.NE.1.AND.N1PTE2.NE.NBPGAU) THEN 766 : SEGDES MCHEL2,MCHAM2 767 : SEGDES MELVA2,MELVA3 768 : MOTERR(1:8)='VARINU ' 768 : CALL ERREUR(146) 769 : GOTO 9910 770 : ENDIF 771 : C 772 : NUAVFL=NUAPOI(IA1) 773 : NUAVIN=NUAPOI(IBBON) 774 : SEGACT NUAVFL 775 : SEGACT NUAVIN 776 : NBC1=NUAFLO(/1) 777 : NBC2=NUAINT(/1) 778 : IF (IVAR.EQ.2) THEN 779 : NUAVF1=NUAPOI(IA2) 780 : SEGACT NUAVF1 781 : NBC3=NUAVF1.NUAFLO(/1) 782 : IF (NBC1.NE.NBC2.OR.NBC2.NE.NBC3) THEN 783 : SEGDES MCHEL2,MCHAM2 784 : SEGDES MELVA2,MELVA3,MNUAGE,NUAVFL,NUAVF1,NUAVIN 784 : CALL ERREUR(625) 785 : GOTO 9910 786 : ENDIF 787 : IF (NBC1.LE.1) THEN 788 : SEGDES MCHEL2,MCHAM2 789 : SEGDES MELVA2,MELVA3,MNUAGE,NUAVFL,NUAVF1,NUAVIN 790 : INTERR(1)=MNUAGE 791 : INTERR(2)=2 792 : INTERR(3)=2 792 : CALL ERREUR(628) 793 : GOTO 9910 794 : ENDIF 795 : ELSE 796 : IF (NBC1.NE.NBC2) THEN 797 : SEGDES MCHEL2,MCHAM2 798 : SEGDES MELVA2,MNUAGE,NUAVFL,NUAVIN 798 : CALL ERREUR(625) 799 : GOTO 9910 800 : ENDIF 801 : IF (NBC1.LE.1) THEN 802 : SEGDES MCHEL2,MCHAM2 803 : SEGDES MELVA2,MNUAGE,NUAVFL,NUAVIN 804 : INTERR(1)=MNUAGE 805 : INTERR(2)=2 806 : INTERR(3)=2 806 : CALL ERREUR(628) 807 : GOTO 9910 808 : ENDIF 809 : ENDIF 810 : C En cas de MCHAML de type caracteristiques on verifie 811 : C la coherence entre les modules d'young et la pente 812 : C des courbes de traction 813 : IF (IYOUN.NE.0.AND.NOMCHE(ICOMP).EQ.'TRAC ') THEN 813 : CALL VERINU(IPOI1,ISOUS,IYOUN,ICOMP) 814 : IF (IERR.NE.0) THEN 815 : SEGDES MCHEL2,MCHAM2 816 : SEGDES MELVA2,MNUAGE,NUAVFL,NUAVIN 817 : IF (IVAR.EQ.2) SEGDES MELVA3 818 : GOTO 9910 819 : ENDIF 820 : ENDIF 821 : C La valeur maxi. et mini. de l'objet flottant défini dans NUAGE 822 : IF (IVAR.EQ.1) THEN 823 : XMAX1=-1.D35 824 : XMIN1= 1.D35 825 : DO 330 IC=1,NBC1 826 : IF (NUAFLO(IC).GT.XMAX1) THEN 827 : XMAX1=NUAFLO(IC) 828 : IMAX1=IC 829 : ENDIF 830 : IF (NUAFLO(IC).LT.XMIN1) THEN 831 : XMIN1=NUAFLO(IC) 832 : IMIN1=IC 833 : ENDIF 834 : 330 CONTINUE 835 : ENDIF 836 : IF (IVAR.EQ.2) THEN 837 : XMAX1=-1.D35 838 : XMIN1= 1.D35 839 : XMAX3=-1.D35 840 : XMIN3= 1.D35 841 : DO 340 IC=1,NBC1 842 : IF (NUAFLO(IC).GT.XMAX1) XMAX1=NUAFLO(IC) 843 : IF (NUAFLO(IC).LT.XMIN1) XMIN1=NUAFLO(IC) 844 : IF (NUAVF1.NUAFLO(IC).GT.XMAX3) XMAX3=NUAVF1.NUAFLO(IC) 845 : IF (NUAVF1.NUAFLO(IC).LT.XMIN3) XMIN3=NUAVF1.NUAFLO(IC) 846 : 340 CONTINUE 847 : XZOB1 = 0.5D0*(XMIN1+XMAX1) 848 : XZOB3 = 0.5D0*(XMIN3+XMAX3) 849 : DO 350 IC=1,NBC1 850 : TEST1 = (NUAFLO(IC) - XMIN1) / XZOB1 851 : TEST3 = (NUAVF1.NUAFLO(IC) - XMIN3) / XZOB3 852 : IF (ABS(TEST1).LT.1.D-10.AND.ABS(TEST3).LT.1.D-10) 853 : & IMI1MI3=IC 854 : TEST1 = (NUAFLO(IC) - XMIN1) / XZOB1 855 : TEST3 = (NUAVF1.NUAFLO(IC) - XMAX3) / XZOB3 856 : IF (ABS(TEST1).LT.1.D-10.AND.ABS(TEST3).LT.1.D-10) 857 : & IMI1MA3=IC 858 : TEST1 = (NUAFLO(IC) - XMAX1) / XZOB1 859 : TEST3 = (NUAVF1.NUAFLO(IC) - XMIN3) / XZOB3 860 : IF (ABS(TEST1).LT.1.D-10.AND.ABS(TEST3).LT.1.D-10) 861 : & IMA1MI3=IC 862 : TEST1 = (NUAFLO(IC) - XMAX1) / XZOB1 863 : TEST3 = (NUAVF1.NUAFLO(IC) - XMAX3) / XZOB3 864 : IF (ABS(TEST1).LT.1.D-10.AND.ABS(TEST3).LT.1.D-10) 865 : & IMA1MA3=IC 866 : 350 CONTINUE 867 : C 868 : C Test : nuage sous forme GRILLE 869 : C 870 : NFLO = NBC1 871 : SEGINI IAMO2 872 : C 873 : NFLO = NBC1 874 : SEGINI IAMO2 875 : IFLO1 = 1 876 : IFLO2(IFLO1) = 1 877 : FLO1(IFLO1) = NUAFLO(1) 878 : FLO2(IFLO1,IFLO2(IFLO1)) = NUAVF1.NUAFLO(1) 879 : DO 360 IC1=2,NBC1 880 : DO 370 IFL1=1,IFLO1 881 : TEST1 = (NUAFLO(IC1) - FLO1(IFL1)) / XZOB1 882 : IF (ABS(TEST1).LT.1.D-10) GOTO 380 883 : 370 CONTINUE 884 : IFLO1 = IFLO1 + 1 885 : FLO1(IFLO1) = NUAFLO(IC1) 886 : IFLO2(IFLO1) = 1 887 : FLO2(IFLO1,IFLO2(IFLO1)) = NUAVF1.NUAFLO(IC1) 888 : GOTO 360 889 : 380 CONTINUE 890 : DO 390 IFL2=1,IFLO2(IFL1) 891 : TEST3 = 892 : & (NUAVF1.NUAFLO(IC1) - FLO2(IFL1,IFL2)) / XZOB3 893 : IF (ABS(TEST3).LT.1.D-10) THEN 894 : SEGDES MCHEL2,MCHAM2 895 : SEGDES MELVA2,MELVA3,MNUAGE 896 : SEGDES NUAVFL,NUAVF1,NUAVIN 897 : SEGSUP IAMO2 898 : INTERR(1)=MNUAGE 898 : CALL ERREUR(940) 899 : GOTO 9900 900 : ENDIF 901 : 390 CONTINUE 902 : IFLO2(IFL1) = IFLO2(IFL1) + 1 903 : FLO2(IFL1,IFLO2(IFL1)) = NUAVF1.NUAFLO(IC1) 904 : 360 CONTINUE 905 : C 906 : DO 400 IFL1=2,IFLO1 907 : IF (IFLO2(IFL1).NE.IFLO2(1)) THEN 908 : SEGDES MCHEL2,MCHAM2 909 : SEGDES MELVA2,MELVA3,MNUAGE 910 : SEGDES NUAVFL,NUAVF1,NUAVIN 911 : SEGSUP IAMO2 912 : INTERR(1)=MNUAGE 912 : CALL ERREUR(941) 913 : GOTO 9900 914 : ENDIF 915 : DO 410 IFL2=1,IFLO2(IFL1) 916 : DO 420 IFL=1,IFLO2(1) 917 : TEST3 = (FLO2(IFL1,IFL2) - FLO2(1,IFL)) / XZOB3 918 : IF (ABS(TEST3).LT.1.D-10) GOTO 410 919 : 420 CONTINUE 920 : SEGDES MCHEL2,MCHAM2 921 : SEGDES MELVA2,MELVA3,MNUAGE 922 : SEGDES NUAVFL,NUAVF1,NUAVIN 923 : SEGSUP IAMO2 924 : INTERR(1)=MNUAGE 924 : CALL ERREUR(941) 925 : GOTO 9900 926 : 410 CONTINUE 927 : 400 CONTINUE 928 : C 929 : SEGSUP IAMO2 930 : ENDIF 931 : C 932 : KFLOT = .TRUE. 933 : IF (.NOT.KREAL) THEN 934 : NOMID=IPNOMC 935 : SEGACT NOMID 936 : NOTYPE=MOTYPE 937 : SEGACT NOTYPE 938 : DO 430 IOBL=1,NBROBL 939 : IF (LESOBL(IOBL).EQ.NOMCO) THEN 940 : TYPV=TYPE(IOBL) 941 : IF (TYPV(1:6).NE.'REAL*8') KFLOT = .FALSE. 942 : GOTO 440 943 : ENDIF 944 : 430 CONTINUE 945 : DO 450 IFAC=1,NBRFAC 946 : IF (LESFAC(IFAC).EQ.NOMCO) THEN 947 : TYPV=TYPE(NBROBL+IFAC) 948 : IF (TYPV(1:6).NE.'REAL*8') KFLOT = .FALSE. 949 : GOTO 440 950 : ENDIF 951 : 450 CONTINUE 952 : 440 CONTINUE 953 : SEGDES NOMID 954 : SEGDES NOTYPE 955 : ENDIF 956 : C 957 : IF (IVAR.EQ.1) THEN 958 : C 959 : C Cas du nuage FLOTTANT-EVOLUTION 960 : C 961 : C La taille du nouvau MCHAML_EVOLUTION 962 : N1PTEL = 0 963 : N1EL = 0 964 : N2EL = N1E1 965 : IF (N1PTE1.EQ.1) THEN 966 : N2PTEL=1 967 : ELSE 968 : N2PTEL=NBPGAU 969 : ENDIF 970 : SEGINI MELVAL 971 : IELVAL(ICOMP)=MELVAL 972 : C 973 : DO 460 IEL=1,N2EL 974 : DO 470 IGAU=1,N2PTEL 975 : VA1=MELVA2.VELCHE(IGAU,IEL) 976 : C Si la valeur VA1 est tombée pile à un flottant défini dans 977 : C nuage, on prend la courbe correspondant au flottant. 978 : DO 480 IN=1,NBC1-1 979 : IF ((NUAFLO(IN+1)-NUAFLO(IN)).EQ.0.D0) THEN 980 : XZOB=0.5D0*(XMIN1+XMAX1) 981 : TEST1 = (VA1-NUAFLO(IN))/XZOB 982 : ELSE 983 : TEST1 = (VA1-NUAFLO(IN))/ 984 : & (NUAFLO(IN+1)-NUAFLO(IN)) 985 : ENDIF 986 : IF (ABS(TEST1).LT.1.D-10) THEN 987 : IEV3=NUAINT(IN) 988 : GOTO 490 989 : ENDIF 990 : 480 CONTINUE 991 : C Si la valeur VA1 est supérieure au flottant maxi., 992 : C on prend la courbe correspondant au flottant maxi.. 993 : IF (VA1.GE.NUAFLO(IMAX1)) THEN 994 : IEV3=NUAINT(IMAX1) 995 : C Si la valeur VA1 est inférieure au flottant mini., 996 : C on prend la courbe correspondant au flottant mini.. 997 : ELSEIF (VA1.LE.NUAFLO(IMIN1)) THEN 998 : IEV3=NUAINT(IMIN1) 999 : ELSE 1000 : VMAX1=-1.D35 1001 : VMIN1= 1.D35 1002 : DO 500 IC=1,NBC1 1003 : IF (VA1.GT.NUAFLO(IC).AND.NUAFLO(IC).GT.VMAX1) 1004 : & THEN 1005 : VMAX1=NUAFLO(IC) 1006 : IGA=IC 1007 : ENDIF 1008 : IF (VA1.LT.NUAFLO(IC).AND.NUAFLO(IC).LT.VMIN1) 1009 : & THEN 1010 : VMIN1=NUAFLO(IC) 1011 : IDR=IC 1012 : ENDIF 1013 : 500 CONTINUE 1014 : XX1=(NUAFLO(IDR)-VA1)/(NUAFLO(IDR)-NUAFLO(IGA)) 1015 : XX2=(VA1-NUAFLO(IGA))/(NUAFLO(IDR)-NUAFLO(IGA)) 1016 : IEV1=NUAINT(IGA) 1017 : IEV2=NUAINT(IDR) 1018 : IF (IEV1.EQ.IEV2) THEN 1019 : IEV3=IEV1 1020 : ELSE 1020 : CALL EVOLIN(IEV1,XX1,IEV2,XX2,IEV3) 1021 : IF (IEV3.EQ.0.OR.IERR.NE.0) THEN 1022 : SEGDES MCHEL2,MCHAM2 1023 : SEGDES MELVA2,MNUAGE,NUAVFL,NUAVIN 1024 : GOTO 9900 1025 : ENDIF 1026 : C En cas de MCHAML de type caracteristiques on modifie 1027 : C la courbe de traction issue de EVOLIN pour que la pente 1028 : C soit interpolée linéairement 1029 : IF (IYOUN.NE.0.AND.NOMCHE(ICOMP).EQ.'TRAC ') 1030 : & THEN 1030 : CALL MODICO(IPOI1,IEV3,ISOUS,ICOMP,IGA,IDR, 1031 : & IEV1,IEV2,VA1,1,IEV4) 1032 : IF (IEV4.EQ.0.OR.IERR.NE.0) THEN 1033 : SEGDES MCHEL2,MCHAM2 1034 : SEGDES MELVA2,MNUAGE,NUAVFL,NUAVIN 1035 : GOTO 9900 1036 : ENDIF 1037 : IEV3=IEV4 1038 : ENDIF 1039 : ENDIF 1040 : ENDIF 1041 : 490 CONTINUE 1042 : IELCHE(IGAU,IEL)=IEV3 1043 : 470 CONTINUE 1044 : 460 CONTINUE 1045 : C 1046 : SEGDES NUAVFL,NUAVIN 1047 : SEGDES MELVA1,MELVA2 1048 : C 1049 : IF (KFLOT) THEN 1050 : NCO1 = MCHAM2.IELVAL(/1) 1051 : IEVOL = IELCHE(1,1) 1052 : MEVOLL = IEVOL 1053 : SEGACT MEVOLL 1054 : KEVOLL = IEVOLL(1) 1055 : SEGACT KEVOLL 1056 : NOM4 = NOMEVX(1:8) 1057 : SEGDES KEVOLL 1058 : SEGDES MEVOLL 1059 : NCO1 = MCHAM2.IELVAL(/1) 1060 : DO 510 INO = 1,NCO1 1061 : NOM2 = MCHAM2.NOMCHE(INO) 1062 : IF (NOM2.EQ.NOM4) GO TO 520 1063 : 510 CONTINUE 1064 : KFLOT=.FALSE. 1065 : 520 CONTINUE 1066 : ENDIF 1067 : C 1068 : IF (KFLOT) THEN 1069 : TYPCHE(ICOMP)='REAL*8 ' 1070 : MELVA6=MELVAL 1071 : ICHAM2=MCHAM2 1071 : CALL VARIN2(ICHAM2,MELVA6,COQ,MELEME,SWORK,NOMCO,IMELE, 1072 : & MELGEO,MINTE,MINTE1,MELVAL,KERRE1) 1073 : SEGSUP MELVA6 1074 : ENDIF 1075 : C 1076 : IELVAL(ICOMP)=MELVAL 1077 : SEGDES MCHEL2 1078 : IF (.NOT. KFLOT) SEGDES MCHAM2,MELVAL 1079 : C 1080 : ENDIF 1081 : C 1082 : IF (IVAR.EQ.2) THEN 1083 : C 1084 : C Cas du nuage FLOTTANT-FLOTTANT-EVOLUTION 1085 : C 1086 : C La taille du nouvau MCHAML_EVOLUTION 1087 : N1PTEL = 0 1088 : N1EL = 0 1089 : N2EL = N1E1 1090 : IF (N1E1.EQ.1.AND.N1E2.EQ.1) THEN 1091 : N2EL=1 1092 : ELSE 1093 : N2EL=NEL0 1094 : ENDIF 1095 : IF (N1PTE1.EQ.1.AND.N1PTE2.EQ.1) THEN 1096 : N2PTEL=1 1097 : ELSE 1098 : N2PTEL=NBPGAU 1099 : ENDIF 1100 : SEGINI MELVAL 1101 : IELVAL(ICOMP)=MELVAL 1102 : C 1103 : DO 530 IEL=1,N2EL 1104 : DO 540 IGAU=1,N2PTEL 1105 : IEL1 = MIN(IEL,N1E1) 1106 : IGAU1 = MIN(IGAU,N1PTE1) 1107 : VA1=MELVA2.VELCHE(IGAU1,IEL1) 1108 : IEL2 = MIN(IEL,N1E2) 1109 : IGAU2 = MIN(IGAU,N1PTE2) 1110 : VA2=MELVA3.VELCHE(IGAU2,IEL2) 1111 : C Si les valeurs VA1 et VA2 sont tombées pile à un flottant défini dans 1112 : C nuage, on prend la courbe correspondant au flottant. 1113 : VMAX1=-1.D35 1114 : VMIN1=1.D35 1115 : VMAX2=-1.D35 1116 : VMIN2=1.D35 1117 : IDR1=0 1118 : IGA1=0 1119 : IDR2=0 1120 : IGA2=0 1121 : DO 550 IN=1,NBC1-1 1122 : IF ((NUAFLO(IN+1)-NUAFLO(IN)).EQ.0.D0) THEN 1123 : XZOB=0.5D0*(XMIN1+XMAX1) 1124 : TEST1 = (VA1-NUAFLO(IN))/XZOB 1125 : TMAX1 = (NUAFLO(IN)-NUAFLO(IMA1MA3))/XZOB 1126 : TMIN1 = (NUAFLO(IN)-NUAFLO(IMI1MI3))/XZOB 1127 : ELSE 1128 : TEST1 = (VA1-NUAFLO(IN))/ 1129 : & (NUAFLO(IN+1)-NUAFLO(IN)) 1130 : TMAX1 = (NUAFLO(IN)-NUAFLO(IMA1MA3))/ 1131 : & (NUAFLO(IN+1)-NUAFLO(IN)) 1132 : TMIN1 = (NUAFLO(IN)-NUAFLO(IMI1MI3))/ 1133 : & (NUAFLO(IN+1)-NUAFLO(IN)) 1134 : ENDIF 1135 : IF ((NUAVF1.NUAFLO(IN+1)-NUAVF1.NUAFLO(IN)).EQ.0.D0) 1136 : & THEN 1137 : XZOB=0.5D0*(XMIN3+XMAX3) 1138 : TEST2 = (VA2-NUAVF1.NUAFLO(IN))/XZOB 1139 : TMAX2 = 1140 : & (NUAVF1.NUAFLO(IN)-NUAVF1.NUAFLO(IMA1MA3))/XZOB 1141 : TMIN2 = 1142 : & (NUAVF1.NUAFLO(IN)-NUAVF1.NUAFLO(IMI1MI3))/XZOB 1143 : ELSE 1144 : TEST2 = (VA2-NUAVF1.NUAFLO(IN))/ 1145 : & (NUAVF1.NUAFLO(IN+1)-NUAVF1.NUAFLO(IN)) 1146 : TMAX2 = 1147 : & (NUAVF1.NUAFLO(IN)-NUAVF1.NUAFLO(IMA1MA3))/ 1148 : & (NUAVF1.NUAFLO(IN+1)-NUAVF1.NUAFLO(IN)) 1149 : TMIN2 = 1150 : & (NUAVF1.NUAFLO(IN)-NUAVF1.NUAFLO(IMI1MI3))/ 1151 : & (NUAVF1.NUAFLO(IN+1)-NUAVF1.NUAFLO(IN)) 1152 : ENDIF 1153 : IF 1154 : & (ABS(TEST1).LT.1.D-10.AND.ABS(TEST2).LT.1.D-10) 1155 : & THEN 1156 : IEV3=NUAINT(IN) 1157 : GOTO 560 1158 : ELSE 1159 : IF (ABS(TEST1).LT.1.D-10.OR. 1160 : & (VA1.GT.NUAFLO(IMA1MA3).AND. 1161 : & ABS(TMAX1).LT.1.D-10).OR. 1162 : & (VA1.LT.NUAFLO(IMI1MI3).AND. 1163 : & ABS(TMIN1).LT.1.D-10)) THEN 1164 : IF (IGA1.NE.-1) THEN 1165 : VMAX2=-1.D35 1166 : VMIN2=1.D35 1167 : ENDIF 1168 : IF (VA2.GT.NUAVF1.NUAFLO(IN).AND. 1169 : & NUAVF1.NUAFLO(IN).GE.VMAX2) THEN 1170 : VMAX2=NUAVF1.NUAFLO(IN) 1171 : IGA2=IN 1172 : IF (VA2.GT.NUAVF1.NUAFLO(IMA1MA3)) THEN 1173 : IDR2=IN 1174 : ENDIF 1175 : ENDIF 1176 : IF (VA2.LT.NUAVF1.NUAFLO(IN).AND. 1177 : & NUAVF1.NUAFLO(IN).LE.VMIN2) THEN 1178 : VMIN2=NUAVF1.NUAFLO(IN) 1179 : IDR2=IN 1180 : IF (VA2.LT.NUAVF1.NUAFLO(IMI1MI3)) THEN 1181 : IGA2=IN 1182 : ENDIF 1183 : ENDIF 1184 : IGA1=-1 1185 : IDR1=-1 1186 : GOTO 550 1187 : ELSE 1188 : IF (IGA1.EQ.-1)GOTO 550 1189 : IF (ABS(TEST2).LT.1.D-10.OR. 1190 : & (VA2.GT.NUAVF1.NUAFLO(IMA1MA3).AND. 1191 : & ABS(TMAX2).LT.1.D-10).OR. 1192 : & (VA2.LT.NUAVF1.NUAFLO(IMI1MI3).AND. 1193 : & ABS(TMIN2).LT.1.D-10)) THEN 1194 : IF (IGA2.NE.-1) THEN 1195 : VMAX1=-1.D35 1196 : VMIN1=1.D35 1197 : ENDIF 1198 : IF 1199 : & (VA1.GT.NUAFLO(IN).AND.NUAFLO(IN).GE.VMAX1) 1200 : & THEN 1201 : VMAX1=NUAFLO(IN) 1202 : IGA1=IN 1203 : IF (VA1.GT.NUAFLO(IMA1MA3)) THEN 1204 : IDR1=IN 1205 : ENDIF 1206 : ENDIF 1207 : IF 1208 : & (VA1.LT.NUAFLO(IN).AND.NUAFLO(IN).LE.VMIN1) 1209 : & THEN 1210 : VMIN1=NUAFLO(IN) 1211 : IDR1=IN 1212 : IF (VA1.LT.NUAFLO(IMI1MI3)) THEN 1213 : IGA1=IN 1214 : ENDIF 1215 : ENDIF 1216 : IGA2=-1 1217 : IDR2=-1 1218 : GOTO 550 1219 : ELSE 1220 : IF (IGA2.EQ.-1)GOTO 550 1221 : IF 1222 : & (VA1.GT.NUAFLO(IN).AND.NUAFLO(IN).GE.VMAX1) 1223 : & THEN 1224 : IF (VA2.GT.NUAVF1.NUAFLO(IN).AND. 1225 : & NUAVF1.NUAFLO(IN).GE.VMAX2) THEN 1226 : VMAX1=NUAFLO(IN) 1227 : VMAX2=NUAVF1.NUAFLO(IN) 1228 : IGA1=IN 1229 : ENDIF 1230 : IF (VA2.LT.NUAVF1.NUAFLO(IN).AND. 1231 : & NUAVF1.NUAFLO(IN).LE.VMIN2) THEN 1232 : VMAX1=NUAFLO(IN) 1233 : VMIN2=NUAVF1.NUAFLO(IN) 1234 : IGA2=IN 1235 : ENDIF 1236 : ENDIF 1237 : IF 1238 : & (VA1.LT.NUAFLO(IN).AND.NUAFLO(IN).LE.VMIN1) 1239 : & THEN 1240 : IF (VA2.LT.NUAVF1.NUAFLO(IN).AND. 1241 : & NUAVF1.NUAFLO(IN).LE.VMIN2) THEN 1242 : VMIN1=NUAFLO(IN) 1243 : VMIN2=NUAVF1.NUAFLO(IN) 1244 : IDR2=IN 1245 : ENDIF 1246 : IF (VA2.GT.NUAVF1.NUAFLO(IN).AND. 1247 : & NUAVF1.NUAFLO(IN).GE.VMAX2) THEN 1248 : VMIN1=NUAFLO(IN) 1249 : VMAX2=NUAVF1.NUAFLO(IN) 1250 : IDR1=IN 1251 : ENDIF 1252 : ENDIF 1253 : ENDIF 1254 : ENDIF 1255 : ENDIF 1256 : 550 CONTINUE 1257 : IF ((NUAFLO(NBC1)-NUAFLO(NBC1-1)).EQ.0.D0) THEN 1258 : XZOB=0.5D0*(XMIN1+XMAX1) 1259 : TEST1 = (VA1-NUAFLO(NBC1))/XZOB 1260 : TMAX1 = (NUAFLO(NBC1)-NUAFLO(IMA1MA3))/XZOB 1261 : TMIN1 = (NUAFLO(NBC1)-NUAFLO(IMI1MI3))/XZOB 1262 : ELSE 1263 : TEST1 = (VA1-NUAFLO(NBC1))/ 1264 : & (NUAFLO(NBC1)-NUAFLO(NBC1-1)) 1265 : TMAX1 = (NUAFLO(NBC1)-NUAFLO(IMA1MA3))/ 1266 : & (NUAFLO(NBC1)-NUAFLO(NBC1-1)) 1267 : TMIN1 = (NUAFLO(NBC1)-NUAFLO(IMI1MI3))/ 1268 : & (NUAFLO(NBC1)-NUAFLO(NBC1-1)) 1269 : ENDIF 1270 : IF 1271 : & ((NUAVF1.NUAFLO(NBC1)-NUAVF1.NUAFLO(NBC1-1)).EQ.0.D0) 1272 : & THEN 1273 : XZOB=0.5D0*(XMIN3+XMAX3) 1274 : TEST2 = (VA2-NUAVF1.NUAFLO(NBC1))/XZOB 1275 : TMAX2 = 1276 : & (NUAVF1.NUAFLO(NBC1)-NUAVF1.NUAFLO(IMA1MA3))/XZOB 1277 : TMIN2 = 1278 : & (NUAVF1.NUAFLO(NBC1)-NUAVF1.NUAFLO(IMI1MI3))/XZOB 1279 : ELSE 1280 : TEST2 = (VA2-NUAVF1.NUAFLO(NBC1))/ 1281 : & (NUAVF1.NUAFLO(NBC1)-NUAVF1.NUAFLO(NBC1-1)) 1282 : TMAX2 = 1283 : & (NUAVF1.NUAFLO(NBC1)-NUAVF1.NUAFLO(IMA1MA3))/ 1284 : & (NUAVF1.NUAFLO(NBC1)-NUAVF1.NUAFLO(NBC1-1)) 1285 : TMIN2 = 1286 : & (NUAVF1.NUAFLO(NBC1)-NUAVF1.NUAFLO(IMI1MI3))/ 1287 : & (NUAVF1.NUAFLO(NBC1)-NUAVF1.NUAFLO(NBC1-1)) 1288 : ENDIF 1289 : C 1290 : IF (ABS(TEST1).LT.1.D-10.AND.ABS(TEST2).LT.1.D-10) 1291 : & THEN 1292 : IEV3=NUAINT(NBC1) 1293 : GOTO 560 1294 : ELSE 1295 : IF (ABS(TEST1).LT.1.D-10.OR. 1296 : & (VA1.GT.NUAFLO(IMA1MA3).AND. 1297 : & ABS(TMAX1).LT.1.D-10).OR. 1298 : & (VA1.LT.NUAFLO(IMI1MI3).AND. 1299 : & ABS(TMIN1).LT.1.D-10)) THEN 1300 : IF (VA2.GT.NUAVF1.NUAFLO(NBC1).AND. 1301 : & NUAVF1.NUAFLO(NBC1).GE.VMAX2) THEN 1302 : VMAX2=NUAVF1.NUAFLO(NBC1) 1303 : IGA2=NBC1 1304 : IF (VA2.GT.NUAVF1.NUAFLO(IMA1MA3)) THEN 1305 : IDR2=NBC1 1306 : ENDIF 1307 : ENDIF 1308 : IF (VA2.LT.NUAVF1.NUAFLO(NBC1).AND. 1309 : & NUAVF1.NUAFLO(NBC1).LE.VMIN2) THEN 1310 : VMIN2=NUAVF1.NUAFLO(NBC1) 1311 : IDR2=NBC1 1312 : IF (VA2.LT.NUAVF1.NUAFLO(IMI1MI3)) THEN 1313 : IGA2=NBC1 1314 : ENDIF 1315 : ENDIF 1316 : IGA1=-1 1317 : IDR1=-1 1318 : GOTO 570 1319 : ELSE 1320 : IF (IGA1.EQ.-1)GOTO 570 1321 : IF (ABS(TEST2).LT.1.D-10.OR. 1322 : & (VA2.GT.NUAVF1.NUAFLO(IMA1MA3).AND. 1323 : & ABS(TMAX2).LT.1.D-10).OR. 1324 : & (VA2.LT.NUAVF1.NUAFLO(IMI1MI3).AND. 1325 : & ABS(TMIN2).LT.1.D-10)) THEN 1326 : IF 1327 : & (VA1.GT.NUAFLO(NBC1).AND.NUAFLO(NBC1).GE.VMAX1) 1328 : & THEN 1329 : VMAX1=NUAFLO(NBC1) 1330 : IGA1=NBC1 1331 : IF (VA1.GT.NUAFLO(IMA1MA3)) THEN 1332 : IDR1=NBC1 1333 : ENDIF 1334 : ENDIF 1335 : IF 1336 : & (VA1.LT.NUAFLO(NBC1).AND.NUAFLO(NBC1).LE.VMIN1) 1337 : & THEN 1338 : VMIN1=NUAFLO(NBC1) 1339 : IDR1=NBC1 1340 : IF (VA1.LT.NUAFLO(IMI1MI3)) THEN 1341 : IGA1=NBC1 1342 : ENDIF 1343 : ENDIF 1344 : IGA2=-1 1345 : IDR2=-1 1346 : GOTO 570 1347 : ELSE 1348 : IF (IGA1.EQ.-1.OR.IGA2.EQ.-1)GOTO 570 1349 : IF 1350 : & (VA1.GT.NUAFLO(NBC1).AND.NUAFLO(NBC1).GE.VMAX1) 1351 : & THEN 1352 : IF (VA2.GT.NUAVF1.NUAFLO(NBC1).AND. 1353 : & NUAVF1.NUAFLO(NBC1).GE.VMAX2) THEN 1354 : VMAX1=NUAFLO(NBC1) 1355 : VMAX2=NUAVF1.NUAFLO(NBC1) 1356 : IGA1=IN 1357 : ENDIF 1358 : IF (VA2.LT.NUAVF1.NUAFLO(NBC1).AND. 1359 : & NUAVF1.NUAFLO(NBC1).LE.VMIN2) THEN 1360 : VMAX1=NUAFLO(NBC1) 1361 : VMIN2=NUAVF1.NUAFLO(NBC1) 1362 : IGA2=IN 1363 : ENDIF 1364 : ENDIF 1365 : IF 1366 : & (VA1.LT.NUAFLO(NBC1).AND.NUAFLO(NBC1).LE.VMIN1) 1367 : & THEN 1368 : IF (VA2.LT.NUAVF1.NUAFLO(NBC1).AND. 1369 : & NUAVF1.NUAFLO(NBC1).LE.VMIN2) THEN 1370 : VMIN1=NUAFLO(NBC1) 1371 : VMIN2=NUAVF1.NUAFLO(NBC1) 1372 : IDR2=IN 1373 : ENDIF 1374 : IF (VA2.GT.NUAVF1.NUAFLO(NBC1).AND. 1375 : & NUAVF1.NUAFLO(NBC1).GE.VMAX2) THEN 1376 : VMIN1=NUAFLO(NBC1) 1377 : VMAX2=NUAVF1.NUAFLO(NBC1) 1378 : IDR1=IN 1379 : ENDIF 1380 : ENDIF 1381 : ENDIF 1382 : ENDIF 1383 : ENDIF 1384 : C Si les valeurs VA1 et VA2 sont supérieures au flottant maxi., 1385 : C on prend la courbe correspondant aux flottants maxi. 1386 : 570 CONTINUE 1387 : IF (VA1.GE.NUAFLO(IMA1MA3).AND. 1388 : & VA2.GE.NUAVF1.NUAFLO(IMA1MA3)) THEN 1389 : IEV3=NUAINT(IMA1MA3) 1390 : GOTO 560 1391 : ENDIF 1392 : IF (VA1.LE.NUAFLO(IMI1MI3).AND. 1393 : & VA2.LE.NUAVF1.NUAFLO(IMI1MI3)) THEN 1394 : IEV3=NUAINT(IMI1MI3) 1395 : GOTO 560 1396 : ENDIF 1397 : IF (VA1.LE.NUAFLO(IMI1MA3).AND. 1398 : & VA2.GE.NUAVF1.NUAFLO(IMI1MA3)) THEN 1399 : IEV3=NUAINT(IMI1MA3) 1400 : GOTO 560 1401 : ENDIF 1402 : IF (VA1.GE.NUAFLO(IMA1MI3).AND. 1403 : & VA2.LE.NUAVF1.NUAFLO(IMA1MI3)) THEN 1404 : IEV3=NUAINT(IMA1MI3) 1405 : GOTO 560 1406 : ENDIF 1407 : C Si seule la valeur VA1 est tombée pile à un flottant défini dans 1408 : C nuage ou est supérieure à la valeur maxi, on interpole sur VA2 1409 : IF (IGA1.EQ.-1) THEN 1410 : XX1=(NUAVF1.NUAFLO(IDR2)-VA2)/ 1411 : & (NUAVF1.NUAFLO(IDR2)-NUAVF1.NUAFLO(IGA2)) 1412 : XX2=(VA2-NUAVF1.NUAFLO(IGA2))/ 1413 : & (NUAVF1.NUAFLO(IDR2)-NUAVF1.NUAFLO(IGA2)) 1414 : IEV1=NUAINT(IGA2) 1415 : IEV2=NUAINT(IDR2) 1416 : IF (IEV1.EQ.IEV2) THEN 1417 : IEV3=IEV1 1418 : ELSE 1418 : CALL EVOLIN(IEV1,XX1,IEV2,XX2,IEV3) 1419 : IF (IEV3.EQ.0.OR.IERR.NE.0) THEN 1420 : SEGDES MCHEL2,MCHAM2 1421 : SEGDES MELVA2,MELVA3,MNUAGE,NUAVFL,NUAVF1 1422 : SEGDES NUAVIN 1423 : GOTO 9900 1424 : ENDIF 1425 : C En cas de MCHAML de type caracteristiques on modifie 1426 : C la courbe de traction issue de EVOLIN pour que la pente 1427 : C soit interpolée linéairement 1428 : IF (IYOUN.NE.0.AND.NOMCHE(ICOMP).EQ.'TRAC ') 1429 : & THEN 1429 : CALL MODICO(IPOI1,IEV3,ISOUS,ICOMP,IGA2,IDR2, 1430 : & IEV1,IEV2,VA2,2,IEV4) 1431 : IF (IEV4.EQ.0.OR.IERR.NE.0) THEN 1432 : SEGDES MCHEL2,MCHAM2 1433 : SEGDES MELVA2,MELVA3,MNUAGE,NUAVFL,NUAVF1 1434 : SEGDES NUAVIN 1435 : GOTO 9900 1436 : ENDIF 1437 : IEV3=IEV4 1438 : ENDIF 1439 : ENDIF 1440 : GOTO 560 1441 : ENDIF 1442 : C Si seule la valeur VA2 est tombée pile à un flottant défini dans 1443 : C nuage ou est supérieure à la valeur maxi, on interpole sur VA1 1444 : IF (IGA2.EQ.-1) THEN 1445 : XX1=(NUAFLO(IDR1)-VA1)/(NUAFLO(IDR1)-NUAFLO(IGA1)) 1446 : XX2=(VA1-NUAFLO(IGA1))/(NUAFLO(IDR1)-NUAFLO(IGA1)) 1447 : IEV1=NUAINT(IGA1) 1448 : IEV2=NUAINT(IDR1) 1449 : IF (IEV1.EQ.IEV2) THEN 1450 : IEV3=IEV1 1451 : ELSE 1451 : CALL EVOLIN(IEV1,XX1,IEV2,XX2,IEV3) 1452 : IF (IEV3.EQ.0.OR.IERR.NE.0) THEN 1453 : SEGDES MCHEL2,MCHAM2 1454 : SEGDES MELVA2,MELVA3,MNUAGE,NUAVFL,NUAVF1 1455 : SEGDES NUAVIN 1456 : GOTO 9900 1457 : ENDIF 1458 : C En cas de MCHAML de type caracteristiques on modifie 1459 : C la courbe de traction issue de EVOLIN pour que la pente 1460 : C soit interpolée linéairement 1461 : IF (IYOUN.NE.0.AND.NOMCHE(ICOMP).EQ.'TRAC ') 1462 : & THEN 1462 : CALL MODICO(IPOI1,IEV3,ISOUS,ICOMP,IGA1,IDR1, 1463 : & IEV1,IEV2,VA1,1,IEV4) 1464 : IF (IEV4.EQ.0.OR.IERR.NE.0) THEN 1465 : SEGDES MCHEL2,MCHAM2 1466 : SEGDES MELVA2,MELVA3,MNUAGE,NUAVFL,NUAVF1 1467 : SEGDES NUAVIN 1468 : GOTO 9900 1469 : ENDIF 1470 : IEV3=IEV4 1471 : ENDIF 1472 : ENDIF 1473 : GOTO 560 1474 : ENDIF 1475 : C Cas général : on interpole sur VA1 PUIS VA2 1476 : C -- > sur VA1 1477 : XX1=(NUAFLO(IDR1)-VA1)/(NUAFLO(IDR1)-NUAFLO(IGA1)) 1478 : XX2=(VA1-NUAFLO(IGA1))/(NUAFLO(IDR1)-NUAFLO(IGA1)) 1479 : IEV1=NUAINT(IGA1) 1480 : IEV2=NUAINT(IDR1) 1481 : IF (IEV1.EQ.IEV2) THEN 1482 : IEV3=IEV1 1483 : ELSE 1483 : CALL EVOLIN(IEV1,XX1,IEV2,XX2,IEV3) 1484 : IF (IEV3.EQ.0.OR.IERR.NE.0) THEN 1485 : SEGDES MCHEL2,MCHAM2 1486 : SEGDES MELVA2,MELVA3,MNUAGE,NUAVFL,NUAVF1 1487 : SEGDES NUAVIN 1488 : GOTO 9900 1489 : ENDIF 1490 : C En cas de MCHAML de type caracteristiques on modifie 1491 : C la courbe de traction issue de EVOLIN pour que la pente 1492 : C soit interpolée linéairement 1493 : IF (IYOUN.NE.0.AND.NOMCHE(ICOMP).EQ.'TRAC ') 1494 : & THEN 1494 : CALL MODICO(IPOI1,IEV3,ISOUS,ICOMP,IGA1,IDR1, 1495 : & IEV1,IEV2,VA1,1,IEV4) 1496 : IF (IEV4.EQ.0.OR.IERR.NE.0) THEN 1497 : SEGDES MCHEL2,MCHAM2 1498 : SEGDES MELVA2,MELVA3,MNUAGE,NUAVFL,NUAVF1 1499 : SEGDES NUAVIN 1500 : GOTO 9900 1501 : ENDIF 1502 : IEV3=IEV4 1503 : ENDIF 1504 : ENDIF 1505 : XX1=(NUAFLO(IDR2)-VA1)/(NUAFLO(IDR2)-NUAFLO(IGA2)) 1506 : XX2=(VA1-NUAFLO(IGA2))/(NUAFLO(IDR2)-NUAFLO(IGA2)) 1507 : IEV1=NUAINT(IGA2) 1508 : IEV2=NUAINT(IDR2) 1509 : IF (IEV1.EQ.IEV2) THEN 1510 : IEV4=IEV1 1511 : ELSE 1511 : CALL EVOLIN(IEV1,XX1,IEV2,XX2,IEV4) 1512 : IF (IEV4.EQ.0.OR.IERR.NE.0) THEN 1513 : SEGDES MCHEL2,MCHAM2 1514 : SEGDES MELVA2,MELVA3,MNUAGE,NUAVFL,NUAVF1 1515 : SEGDES NUAVIN 1516 : GOTO 9900 1517 : ENDIF 1518 : C En cas de MCHAML de type caracteristiques on modifie 1519 : C la courbe de traction issue de EVOLIN pour que la pente 1520 : C soit interpolée linéairement 1521 : IF (IYOUN.NE.0.AND.NOMCHE(ICOMP).EQ.'TRAC ') 1522 : & THEN 1522 : CALL MODICO(IPOI1,IEV4,ISOUS,ICOMP,IGA2,IDR2, 1523 : & IEV1,IEV2,VA1,1,IEV5) 1524 : IF (IEV5.EQ.0.OR.IERR.NE.0) THEN 1525 : SEGDES MCHEL2,MCHAM2 1526 : SEGDES MELVA2,MELVA3,MNUAGE,NUAVFL,NUAVF1 1527 : SEGDES NUAVIN 1528 : GOTO 9900 1529 : ENDIF 1530 : IEV4=IEV5 1531 : ENDIF 1532 : ENDIF 1533 : C 1534 : C -- > sur VA2 1535 : XX1=(NUAVF1.NUAFLO(IDR2)-VA2)/ 1536 : & (NUAVF1.NUAFLO(IDR2)-NUAVF1.NUAFLO(IDR1)) 1537 : XX2=(VA2-NUAVF1.NUAFLO(IDR1))/ 1538 : & (NUAVF1.NUAFLO(IDR2)-NUAVF1.NUAFLO(IDR1)) 1538 : CALL EVOLIN(IEV3,XX1,IEV4,XX2,IEV5) 1539 : IF (IEV5.EQ.0.OR.IERR.NE.0) THEN 1540 : SEGDES MCHEL2,MCHAM2 1541 : SEGDES MELVA2,MELVA3,MNUAGE,NUAVFL,NUAVF1 1542 : SEGDES NUAVIN 1543 : GOTO 9900 1544 : ENDIF 1545 : C En cas de MCHAML de type caracteristiques on modifie 1546 : C la courbe de traction issue de EVOLIN pour que la pente 1547 : C soit interpolée linéairement 1548 : IF (IYOUN.NE.0.AND.NOMCHE(ICOMP).EQ.'TRAC ') THEN 1548 : CALL MODICO(IPOI1,IEV5,ISOUS,ICOMP,IDR1,IDR2,IEV3, 1549 : & IEV4,VA2,2,IEV6) 1550 : IF (IEV6.EQ.0.OR.IERR.NE.0) THEN 1551 : SEGDES MCHEL2,MCHAM2 1552 : SEGDES MELVA2,MELVA3,MNUAGE,NUAVFL,NUAVF1 1553 : SEGDES NUAVIN 1554 : GOTO 9900 1555 : ENDIF 1556 : IEV5=IEV6 1557 : ENDIF 1558 : IEV3=IEV5 1559 : C 1560 : 560 CONTINUE 1561 : IELCHE(IGAU,IEL)=IEV3 1562 : 540 CONTINUE 1563 : 530 CONTINUE 1564 : C 1565 : SEGDES NUAVFL,NUAVIN 1566 : SEGDES MELVA1,MELVA2 1567 : C 1568 : IF (KFLOT) THEN 1569 : NCO1 = MCHAM2.IELVAL(/1) 1570 : IEVOL = IELCHE(1,1) 1571 : MEVOLL = IEVOL 1572 : SEGACT MEVOLL 1573 : KEVOLL = IEVOLL(1) 1574 : SEGACT KEVOLL 1575 : NOM4 = NOMEVX(1:8) 1576 : SEGDES KEVOLL 1577 : SEGDES MEVOLL 1578 : NCO1 = MCHAM2.IELVAL(/1) 1579 : DO 580 INO = 1,NCO1 1580 : NOM2 = MCHAM2.NOMCHE(INO) 1581 : IF (NOM2.EQ.NOM4) GO TO 590 1582 : 580 CONTINUE 1583 : KFLOT=.FALSE. 1584 : 590 CONTINUE 1585 : ENDIF 1586 : C 1587 : IF (KFLOT) THEN 1588 : TYPCHE(ICOMP)='REAL*8 ' 1589 : MELVA6=MELVAL 1590 : ICHAM2=MCHAM2 1590 : CALL VARIN2(ICHAM2,MELVA6,COQ,MELEME,SWORK,NOMCO,IMELE, 1591 : & MELGEO,MINTE,MINTE1,MELVAL,KERRE1) 1592 : SEGSUP MELVA6 1593 : ENDIF 1594 : C 1595 : IELVAL(ICOMP)=MELVAL 1596 : SEGDES MCHEL2 1597 : IF (.NOT. KFLOT) SEGDES MCHAM2,MELVAL 1598 : C 1599 : ENDIF 1600 : C 1601 : C--------------------------------------------------------- 1602 : C Composante de type LISTMOTS 1603 : C (evaluation externe) 1604 : C--------------------------------------------------------- 1605 : C 1606 : ELSE IF (CHA1(9:16).EQ.'LISTMOTS') THEN 1607 : *jk 1608 : if (FORMOD(1).EQ.'LIAISON') THEN 1609 : TYPCHE(ICOMP)=CHA1 1610 : N1PTEL=0 1611 : N1EL =0 1612 : N2PTEL=1 1613 : N2EL =1 1614 : SEGINI MELVAL 1615 : IELVAL(ICOMP)=MELVAL 1616 : IELCHE(N2PTEL,N2EL)=MELVA1.IELCHE(1,1) 1617 : SEGDES MELVAL,MELVA1 1618 : else 1619 : * 1620 : C 1621 : C Le LISTMOTS donne les parametres de la composante, en 1622 : C fonction desquels doit se faire l'evaluation externe. 1623 : C 1624 : C HYPOTHESE de CHAMP UNIFORME : la composante a les memes 1625 : C parametres en tout point d'integration de tout element 1626 : C de la sous-zone. 1627 : C Cette hypothese est necessaire car une composante ne peut 1628 : C etre associee qu'a une seule fonction externe. 1629 : C 1630 : N2PTE1=MELVA1.IELCHE(/1) 1631 : N2EL1=MELVA1.IELCHE(/2) 1632 : IF (N2PTE1.NE.1.AND.N2EL1.NE.1) THEN 1633 : MOTERR(1:8)=NOMCO 1633 : CALL ERREUR(953) 1634 : GOTO 9910 1635 : ENDIF 1636 : IVALIS(ICOMP) = 1 1637 : * 1638 : IF (JESIMU.EQ.0) THEN 1639 : C 1640 : C Acces au MCHAML des parametres sur la sous-zone 1641 : C 1642 : MCHEL2=IPOI3 1643 : SEGACT MCHEL2 1644 : IF (MCHEL2.ICHAML(/1).LT.NSOUS) THEN 1644 : CALL ERREUR(553) 1645 : SEGDES MCHEL2 1646 : GOTO 9910 1647 : ENDIF 1648 : 1649 : IF (IMAMOD.NE.MCHEL2.IMACHE(ISOUS).OR. 1650 : & CONMOD.NE.MCHEL2.CONCHE(ISOUS)) THEN 1651 : 1652 : do is = 1,mchel2.imache(/1) 1653 : if (imamod.eq.mchel2.imache(is).and. 1654 : & conmod.eq.mchel2.conche(is)) then 1655 : MCHAM2 = mchel2.ICHAML(is) 1656 : goto 449 1657 : endif 1658 : enddo 1659 : 1659 : CALL ERREUR(472) 1660 : SEGDES MCHEL2 1661 : GOTO 9910 1662 : ENDIF 1663 : MCHAM2=MCHEL2.ICHAML(ISOUS) 1664 : * 1665 : 449 CONTINUE 1666 : SEGACT,MCHAM2 1667 : 1668 : NCMP2=MCHAM2.NOMCHE(/2) 1669 : C 1670 : C Verification de la presence des parametres necessaires 1671 : C Verification que ces parametres sont du type REAL*8 1672 : C Releve des pointeurs vers les MELVAL correspondants 1673 : C Determination de la representation du champ de sortie 1674 : C 1675 : NOMCO4=NOMCO(1:4) 1676 : C 1677 : MLMOT1=MELVA1.IELCHE(1,1) 1678 : SEGACT,MLMOT1 1679 : NPARA=MLMOT1.MOTS(/2) 1680 : * 1681 : IF (MLMOT1.MOTS(1)(1:4).EQ.NOMSIM) THEN 1682 : JESIMU=1 1683 : NPARA=NPARA-1 1684 : ENDIF 1685 : * 1686 : SEGINI,WRKEXT 1687 : C 1688 : N1PTEL=1 1689 : N1EL=1 1690 : C 1691 : DO 600 IPARA=1,NPARA 1692 : C 1693 : JPARA=IPARA+JESIMU 1694 : ITROUV=0 1695 : DO 601 ICMP2=1,NCMP2 1696 : IF (MCHAM2.NOMCHE(ICMP2)(1:4).EQ. 1697 : & MLMOT1.MOTS(JPARA)(1:4)) THEN 1698 : ITROUV=1 1699 : GOTO 602 1700 : ENDIF 1701 : 601 CONTINUE 1702 : C 1703 : 1704 : IF (ITROUV.EQ.0) THEN 1705 : MOTERR(1:4)=MLMOT1.MOTS(JPARA)(1:4) 1706 : MOTERR(5:8)=NOMCO4 1706 : CALL ERREUR(954) 1707 : SEGSUP,WRKEXT 1708 : SEGDES,MLMOT1 1709 : SEGDES,MCHAM2 1710 : SEGDES,MCHEL2 1711 : GOTO 9910 1712 : ENDIF 1713 : C 1714 : 602 IF (MCHAM2.TYPCHE(ICMP2)(1:8).NE.'REAL*8 ') THEN 1715 : MOTERR(1:4)=MLMOT1.MOTS(JPARA)(1:4) 1716 : MOTERR(5:8)=NOMCO4 1716 : CALL ERREUR(955) 1717 : SEGSUP,WRKEXT 1718 : SEGDES,MLMOT1 1719 : SEGDES,MCHAM2 1720 : SEGDES,MCHEL2 1721 : GOTO 9910 1722 : ENDIF 1723 : C 1724 : NOMPAR(IPARA)=MLMOT1.MOTS(JPARA)(1:4) 1725 : IVAPAR(IPARA)=MCHAM2.IELVAL(ICMP2) 1726 : C 1727 : C N.B. Toutes les composantes du MCHAML de parametres 1728 : C s'appuient sur la meme famille de points de Gauss (cf. 1729 : C changement de support effectue en debut de traitement). 1730 : C Toutefois la representation peut etre differente d'un 1731 : C parametre a l'autre : uniforme, constante par element 1732 : C ou complete. La representation la plus fine sur tous 1733 : C les parametres impose celle de la variable de sortie. 1734 : C 1735 : MELVA2=IVAPAR(IPARA) 1736 : SEGACT,MELVA2 1737 : N1PTE2=MELVA2.VELCHE(/1) 1738 : N1EL2=MELVA2.VELCHE(/2) 1739 : IF (N1EL2.GT.1) THEN 1740 : IF (N1EL.EQ.1) THEN 1741 : N1EL=N1EL2 1742 : ELSE IF (N1EL2.NE.N1EL) THEN 1743 : MOTERR(1:8)='VARINU ' 1743 : CALL ERREUR(146) 1744 : SEGDES,MELVA2 1745 : SEGSUP,WRKEXT 1746 : SEGDES,MLMOT1 1747 : SEGDES,MCHAM2 1748 : SEGDES,MCHEL2 1749 : GOTO 9910 1750 : ENDIF 1751 : ENDIF 1752 : IF (N1PTE2.GT.1) THEN 1753 : IF (N1PTEL.EQ.1) THEN 1754 : N1PTEL=N1PTE2 1755 : ELSE IF (N1PTE2.NE.N1PTEL) THEN 1756 : MOTERR(1:8)='VARINU ' 1756 : CALL ERREUR(146) 1757 : SEGDES,MELVA2 1758 : SEGSUP,WRKEXT 1759 : SEGDES,MLMOT1 1760 : SEGDES,MCHAM2 1761 : SEGDES,MCHEL2 1762 : GOTO 9910 1763 : ENDIF 1764 : ENDIF 1765 : SEGDES,MELVA2 1766 : C 1767 : 600 CONTINUE 1768 : C 1769 : NPMAX = N1PTEL 1770 : NEMAX = N1EL 1771 : C 1772 : IF (JESIMU.EQ.0) THEN 1773 : 1774 : N1PAUX=N1PTEL 1775 : C 1776 : C Pour les COQ4, le nb de pts de GAUSS vaut 5, mais on 1777 : C ne prend que les 4 premiers (le 5eme sert uniquement 1778 : C au cisaillement) 1779 : IF (IMELE.EQ.49.AND.N1PAUX.EQ.5) N1PAUX=4 1780 : C 1781 : C Premier appel au module externe COMPUT pour verifications 1782 : C 1783 : IVERI=1 1784 : IERUT=0 1784 : CALL COMPUT(IVERI,NOMCO4,NOMPAR,VALPAR,NPARA, 1785 : & VALCMP,IERUT) 1786 : IF (IERUT.NE.0) THEN 1787 : INTERR(1)=IERUT 1787 : CALL ERREUR(957) 1788 : SEGSUP,WRKEXT 1789 : SEGDES,MLMOT1 1790 : SEGDES,MCHAM2 1791 : SEGDES,MCHEL2 1792 : GOTO 9910 1793 : ENDIF 1794 : 1795 : C 1796 : C Initialisation du MELVAL de sortie 1797 : C 1798 : TYPCHE(ICOMP)='REAL*8 ' 1799 : N2PTEL=0 1800 : N2EL=0 1801 : SEGINI MELVAL 1802 : IELVAL(ICOMP)=MELVAL 1803 : C 1804 : C Evaluation externe de la composante 1805 : C 1806 : IVERI=0 1807 : C 1808 : DO IPARA=1,NPARA 1809 : MELVA2=IVAPAR(IPARA) 1810 : SEGACT,MELVA2 1811 : ENDDO 1812 : C 1813 : DO 620 IEL=1,N1EL 1814 : DO 621 IGAU=1,N1PAUX 1815 : DO 622 IPARA=1,NPARA 1816 : MELVA2=IVAPAR(IPARA) 1817 : C** SEGACT,MELVA2 1818 : IBGAU=MIN(IGAU,MELVA2.VELCHE(/1)) 1819 : IELGA=MIN(IEL,MELVA2.VELCHE(/2)) 1820 : VALPAR(IPARA)=MELVA2.VELCHE(IBGAU,IELGA) 1821 : C** SEGDES,MELVA2 1822 : 622 CONTINUE 1823 : IERUT=0 1823 : CALL COMPUT(IVERI,NOMCO4,NOMPAR,VALPAR,NPARA, 1824 : & VELCHE(IGAU,IEL),IERUT) 1825 : IF (IERUT.NE.0) THEN 1826 : INTERR(1)=IERUT 1826 : CALL ERREUR(957) 1827 : DO IPARA=1,NPARA 1828 : MELVA2=IVAPAR(IPARA) 1829 : SEGDES,MELVA2 1830 : ENDDO 1831 : SEGSUP,WRKEXT 1832 : SEGDES,MLMOT1 1833 : SEGDES,MCHAM2 1834 : SEGDES,MCHEL2 1835 : GOTO 9900 1836 : ENDIF 1837 : 621 CONTINUE 1838 : 620 CONTINUE 1839 : C 1840 : DO IPARA=1,NPARA 1841 : MELVA2=IVAPAR(IPARA) 1842 : SEGDES,MELVA2 1843 : ENDDO 1844 : SEGSUP,WRKEXT 1845 : C 1846 : ENDIF 1847 : C 1848 : ENDIF 1849 : C 1850 : SEGDES,MELVAL 1851 : SEGDES,MLMOT1 1852 : SEGDES,MCHAM2 1853 : SEGDES,MCHEL2 1854 : SEGDES,MELVA1 1855 : * 1856 : endif 1857 : C 1858 : C--------------------------------------------------------- 1859 : C Composante de type TABLE 1860 : C (evaluation externe avec dlopen) 1861 : C--------------------------------------------------------- 1862 : C 1863 : ELSE IF (CHA1(9:16).EQ.'TABLE') THEN 1864 : *jk 1865 : if (FORMOD(1).EQ.'LIAISON') THEN 1866 : TYPCHE(ICOMP)=CHA1 1867 : N1PTEL=0 1868 : N1EL =0 1869 : N2PTEL=1 1870 : N2EL =1 1871 : SEGINI MELVAL 1872 : IELVAL(ICOMP)=MELVAL 1873 : IELCHE(N2PTEL,N2EL)=MELVA1.IELCHE(1,1) 1874 : SEGDES MELVAL,MELVA1 1875 : else 1876 : * 1877 : C 1878 : C 1879 : C La TABLE donne le nom de la loi et les parametres 1880 : C de la composante, en fonction desquels doit se faire 1881 : C l'evaluation externe. 1882 : C 1883 : N2PTE1=MELVA1.IELCHE(/1) 1884 : N2EL1=MELVA1.IELCHE(/2) 1885 : IF (N2PTE1.NE.1.AND.N2EL1.NE.1) THEN 1886 : MOTERR(1:8)=NOMCO 1886 : CALL ERREUR(953) 1887 : GOTO 9910 1888 : ENDIF 1889 : IVALIS(ICOMP) = 1 1890 : C 1891 : C Acces au MCHAML des parametres sur la sous-zone 1892 : C 1893 : MCHEL2=IPOI3 1894 : SEGACT MCHEL2 1895 : IF (MCHEL2.ICHAML(/1).LT.NSOUS) THEN 1895 : CALL ERREUR(553) 1896 : SEGDES MCHEL2 1897 : GOTO 9910 1898 : ENDIF 1899 : IF (IMAMOD.NE.MCHEL2.IMACHE(ISOUS).OR. 1900 : & CONMOD.NE.MCHEL2.CONCHE(ISOUS)) THEN 1901 : 1902 : do is = 1,mchel2.imache(/1) 1903 : if (imamod.eq.mchel2.imache(is).and. 1904 : & conmod.eq.mchel2.conche(is)) then 1905 : MCHAM2 = mchel2.ICHAML(is) 1906 : goto 649 1907 : endif 1908 : enddo 1909 : 1909 : CALL ERREUR(472) 1910 : SEGDES MCHEL2 1911 : GOTO 9910 1912 : ENDIF 1913 : MCHAM2=MCHEL2.ICHAML(ISOUS) 1914 : * 1915 : 649 CONTINUE 1916 : SEGACT,MCHAM2 1917 : NCMP2=MCHAM2.NOMCHE(/2) 1918 : C 1919 : C Verification de la presence des parametres necessaires 1920 : C Verification que ces parametres sont du type REAL*8 1921 : C Releve des pointeurs vers les MELVAL correspondants 1922 : C Determination de la representation du champ de sortie 1923 : C 1924 : NOMCO4=NOMCO(1:4) 1925 : 1926 : C Vérification de la table 1927 : MTAB1=MELVA1.IELCHE(1,1) 1928 : SEGACT,MTAB1 1929 : 1930 : C initialisation des indices 1931 : IVAR=0 1932 : IMOD=0 1933 : ILIB=0 1934 : IPRO=0 1935 : C Recherche sur les noms 1936 : if (NBESC.NE.0) SEGACT,IPILOC 1937 : 1938 : DO 630 IN=1,MTAB1.MLOTAB 1939 : IP=MTAB1.MTABII(IN) 1940 : IDEBCH=IPCHAR(IP) 1941 : IFINCH=IPCHAR(IP+1)-1 1942 : IF (ICHARA(IDEBCH:IFINCH).EQ.'VARIABLES') THEN 1943 : IVAR=IN 1944 : ELSE IF (ICHARA(IDEBCH:IFINCH).EQ.'MODELE') THEN 1945 : IMOD=IN 1946 : ELSE IF (ICHARA(IDEBCH:IFINCH).EQ.'LIBRAIRIE') THEN 1947 : ILIB=IN 1948 : ELSE IF (ICHARA(IDEBCH:IFINCH).EQ.'PROGRAMME') THEN 1949 : IPRO=IN 1950 : ENDIF 1951 : 630 CONTINUE 1952 : C pleiades IF (((IVAR.EQ.0).OR.(IMOD.EQ.0)).AND.(IPRO.EQ.0)) THEN 1953 : IF (IPRO.EQ.0) THEN 1954 : ITROUV=0 1955 : GOTO 631 1956 : ENDIF 1957 : 1958 : C Vérification des types 1959 : C Liste des variables 1960 : IF (MTAB1.MTABTV(IVAR).EQ.'LISTMOTS') THEN 1961 : MLMOT1=MTAB1.MTABIV(IVAR) 1962 : ELSE 1963 : ITROUV=0 1964 : GOTO 631 1965 : ENDIF 1966 : C Nom du modèle a trouver si on utilise la librairie 1967 : IF ((IMOD.NE.0).AND.(MTAB1.MTABTV(IMOD).EQ.'MOT')) THEN 1968 : IP=MTAB1.MTABIV(IMOD) 1969 : IDEBCH=IPCHAR(IP) 1970 : IFINCH=IPCHAR(IP+1)-1 1971 : MMOD=ICHARA(IDEBCH:IFINCH) 1972 : LM=IFINCH-IDEBCH+1 1973 : ITROU1 = 1 1974 : ELSE 1975 : CA ITROUV=0 1976 : ITROU1 = 0 1977 : C je commente ceci GOTO 631 1978 : ENDIF 1979 : 1980 : C Nom de la librairie 1981 : IF ((ILIB.NE.0).AND.(MTAB1.MTABTV(ILIB).EQ.'MOT')) THEN 1982 : IP=MTAB1.MTABIV(ILIB) 1983 : IDEBCH=IPCHAR(IP) 1984 : IFINCH=IPCHAR(IP+1)-1 1985 : MLIB=ICHARA(IDEBCH:IFINCH) 1986 : LL=IFINCH-IDEBCH+1 1987 : ELSE 1988 : LL=0 1989 : ENDIF 1990 : 1991 : C Nom du programme externe 1992 : IF ((IPRO.NE.0).AND.(MTAB1.MTABTV(IPRO).EQ.'MOT')) THEN 1993 : IP=MTAB1.MTABIV(IPRO) 1994 : IDEBCH=IPCHAR(IP) 1995 : IFINCH=IPCHAR(IP+1)-1 1996 : MPRO=ICHARA(IDEBCH:IFINCH) 1997 : LP=IFINCH-IDEBCH+1 1998 : ITROU2 = 1 1999 : lacomm = MPRO 2000 : ELSE 2001 : C Pour l instant, je fais une erreur si je n active 2002 : C pas de programme exterieur 2003 : LP=0 2004 : CA ITROUV=0 2005 : ITROU2 = 0 2006 : CA GOTO 631 2007 : ENDIF 2008 : 2009 : IF ((ITROU2.EQ.0).AND.(ITROU1.EQ.0)) THEN 2010 : ITROUV = 0 2011 : GOTO 631 2012 : ENDIF 2013 : C Si la table n'est pas correcte pour linstant je teste sur le programme externe uniquement 2014 : C Vérification de la table réussie 2015 : ITROUV=1 2016 : 631 CONTINUE 2017 : if (NBESC.NE.0) SEGDES,IPILOC 2018 : SEGDES,MTAB1 2019 : 2020 : C Erreur à la lecture de la table 2021 : IF (ITROUV.EQ.0) THEN 2022 : INTERR(1)=-3 2022 : CALL ERREUR(957) 2023 : SEGDES MCHEL2 2024 : SEGDES,MCHAM2 2025 : GOTO 9910 2026 : ENDIF 2027 : C Vérification de la liste de paramètres 2028 : SEGACT,MLMOT1 2029 : NPARA=MLMOT1.MOTS(/2) 2030 : SEGINI,WRKEXT 2031 : C 2032 : N1PTEL=1 2033 : N1EL=1 2034 : C 2035 : DO 650 IPARA=1,NPARA 2036 : C 2037 : JPARA=IPARA+JESIMU 2038 : ITROUV=0 2039 : DO 651 ICMP2=1,NCMP2 2040 : IF (MCHAM2.NOMCHE(ICMP2)(1:4).EQ. 2041 : & MLMOT1.MOTS(JPARA)(1:4)) THEN 2042 : ITROUV=1 2043 : GOTO 652 2044 : ENDIF 2045 : 651 CONTINUE 2046 : C 2047 : IF (ITROUV.EQ.0) THEN 2048 : MOTERR(1:4)=MLMOT1.MOTS(JPARA)(1:4) 2049 : MOTERR(5:8)=NOMCO4 2049 : CALL ERREUR(954) 2050 : SEGSUP,WRKEXT 2051 : SEGDES,MLMOT1 2052 : SEGDES,MCHAM2 2053 : SEGDES,MCHEL2 2054 : GOTO 9910 2055 : ENDIF 2056 : C 2057 : 652 IF (MCHAM2.TYPCHE(ICMP2)(1:8).NE.'REAL*8 ') THEN 2058 : MOTERR(1:4)=MLMOT1.MOTS(JPARA)(1:4) 2059 : MOTERR(5:8)=NOMCO4 2059 : CALL ERREUR(955) 2060 : SEGSUP,WRKEXT 2061 : SEGDES,MLMOT1 2062 : SEGDES,MCHAM2 2063 : SEGDES,MCHEL2 2064 : GOTO 9910 2065 : ENDIF 2066 : C 2067 : NOMPAR(IPARA)=MLMOT1.MOTS(JPARA)(1:4) 2068 : IVAPAR(IPARA)=MCHAM2.IELVAL(ICMP2) 2069 : C 2070 : C N.B. Toutes les composantes du MCHAML de parametres 2071 : C s'appuient sur la meme famille de points de Gauss (cf. 2072 : C changement de support effectue en debut de traitement). 2073 : C Toutefois la representation peut etre differente d'un 2074 : C parametre a l'autre : uniforme, constante par element 2075 : C ou complete. La representation la plus fine sur tous 2076 : C les parametres impose celle de la variable de sortie. 2077 : C 2078 : MELVA2=IVAPAR(IPARA) 2079 : SEGACT,MELVA2 2080 : N1PTE2=MELVA2.VELCHE(/1) 2081 : N1EL2=MELVA2.VELCHE(/2) 2082 : IF (N1EL2.GT.1) THEN 2083 : IF (N1EL.EQ.1) THEN 2084 : N1EL=N1EL2 2085 : ELSE IF (N1EL2.NE.N1EL) THEN 2086 : MOTERR(1:8)='VARINU ' 2086 : CALL ERREUR(146) 2087 : SEGDES,MELVA2 2088 : SEGSUP,WRKEXT 2089 : SEGDES,MLMOT1 2090 : SEGDES,MCHAM2 2091 : SEGDES,MCHEL2 2092 : GOTO 9910 2093 : ENDIF 2094 : ENDIF 2095 : IF (N1PTE2.GT.1) THEN 2096 : IF (N1PTEL.EQ.1) THEN 2097 : N1PTEL=N1PTE2 2098 : ELSE IF (N1PTE2.NE.N1PTEL) THEN 2099 : MOTERR(1:8)='VARINU ' 2099 : CALL ERREUR(146) 2100 : SEGDES,MELVA2 2101 : SEGSUP,WRKEXT 2102 : SEGDES,MLMOT1 2103 : SEGDES,MCHAM2 2104 : SEGDES,MCHEL2 2105 : GOTO 9910 2106 : ENDIF 2107 : ENDIF 2108 : SEGDES,MELVA2 2109 : C 2110 : 650 CONTINUE 2111 : C 2112 : NPMAX = N1PTEL 2113 : NEMAX = N1EL 2114 : C 2115 : N1PAUX=N1PTEL 2116 : C 2117 : C Pour les COQ4, le nb de pts de GAUSS vaut 5, mais on 2118 : C ne prend que les 4 premiers (le 5eme sert uniquement 2119 : C au cisaillement) 2120 : IF (IMELE.EQ.49.AND.N1PAUX.EQ.5) N1PAUX=4 2121 : C 2122 : C Ouverture de la loi et vérification du nombre de paramètres 2123 : C 2124 : C Initialisation du MELVAL de sortie 2125 : C 2126 : TYPCHE(ICOMP)='REAL*8 ' 2127 : N2PTEL=0 2128 : N2EL=0 2129 : SEGINI MELVAL 2130 : IELVAL(ICOMP)=MELVAL 2131 : C 2132 : DO IPARA=1,NPARA 2133 : MELVA2=IVAPAR(IPARA) 2134 : SEGACT,MELVA2 2135 : ENDDO 2136 : C 2137 : IF (ITROU2.EQ.1) THEN 2138 : C Appel par programme externe 2139 : ith=0 2139 : call ooonth(ith) 2140 : l=long(lacomm) 2141 : moterr=lacomm(1:l) 2141 : call lance(lacomm(1:l)//char(0),ith) 2142 : DO 1670 IPARA=1,NPARA 2143 : MELVA2=IVAPAR(IPARA) 2144 : I_CHAMP=1 2145 : C DO 2702 IEL=1,N1EL 2146 : C DO 2701 IGAU=1,N1PAUX 2147 : C IBGAU=MIN(IGAU,MELVA2.VELCHE(/1)) 2148 : C IELGA=MIN(IEL,MELVA2.VELCHE(/2)) 2149 : C PRINT*,'varinu ',MELVA2.VELCHE(IBGAU,IELGA) 2150 : C 2701 CONTINUE 2151 : C 2702 CONTINUE 2152 : 2152 : CALL becrdon(MELVA2.VELCHE,ith,IPARA, 2153 : &NPARA,I_CHAMP,N1EL,N1PAUX) 2154 : 1670 CONTINUE 2154 : call blires(VELCHE,iend,istat,ith) 2155 : * 2156 : ELSE IF (ITROU1.EQ.1) THEN 2157 : C appel par librairie 2157 : CA pleiades CALL NUMLOI(MMOD,LM,MLIB,LL,NOMCO4,NOMPAR,NPARA,LIB,NLOI) 2158 : IF (NLOI.EQ.0) THEN 2159 : INTERR(1)=-57 2159 : CALL ERREUR(957) 2160 : SEGSUP,WRKEXT 2161 : SEGDES,MLMOT1 2162 : SEGDES,MCHAM2 2163 : SEGDES,MCHEL2 2164 : GOTO 9910 2165 : ENDIF 2166 : 2167 : DO 670 IEL=1,N1EL 2168 : DO 671 IGAU=1,N1PAUX 2169 : DO 672 IPARA=1,NPARA 2170 : MELVA2=IVAPAR(IPARA) 2171 : C** SEGACT,MELVA2 2172 : IBGAU=MIN(IGAU,MELVA2.VELCHE(/1)) 2173 : IELGA=MIN(IEL,MELVA2.VELCHE(/2)) 2174 : VALPAR(IPARA)=MELVA2.VELCHE(IBGAU,IELGA) 2175 : C** SEGDES,MELVA2 2176 : 672 CONTINUE 2177 : IERUT=0 2177 : CA pleiades CALL LOIEXTERNE(VALPAR,VELCHE(IGAU,IEL),NLOI,IERUT) 2178 : IF (IERUT.NE.0) THEN 2179 : INTERR(1)=IERUT 2179 : CALL ERREUR(957) 2180 : DO IPARA=1,NPARA 2181 : MELVA2=IVAPAR(IPARA) 2182 : SEGDES,MELVA2 2183 : ENDDO 2184 : SEGSUP,WRKEXT 2185 : SEGDES,MLMOT1 2186 : SEGDES,MCHAM2 2187 : SEGDES,MCHEL2 2188 : GOTO 9900 2189 : ENDIF 2190 : 671 CONTINUE 2191 : 670 CONTINUE 2192 : 2192 : CA pleiades CALL DLCLOSE(LIB) 2193 : C Fin appel par librairie 2194 : ENDIF 2195 : C 2196 : DO IPARA=1,NPARA 2197 : MELVA2=IVAPAR(IPARA) 2198 : SEGDES,MELVA2 2199 : ENDDO 2200 : SEGSUP,WRKEXT 2201 : C 2202 : SEGDES,MELVAL 2203 : SEGDES,MLMOT1 2204 : SEGDES,MCHAM2 2205 : SEGDES,MCHEL2 2206 : SEGDES,MELVA1 2207 : * 2208 : endif 2209 : C 2210 : C--------------------------------------------------------- 2211 : C traitement des composante d'autres types 2212 : C que 'REAL*8' 'EVOLUTIO' ou 'NUAGE ' ou 'LISTMOTS' 2213 : C--------------------------------------------------------- 2214 : C 2215 : ELSE 2216 : C 2217 : TYPCHE(ICOMP)=CHA1 2218 : N1PTEL=0 2219 : N1EL =0 2220 : N2PTEL=1 2221 : N2EL =1 2222 : SEGINI MELVAL 2223 : IELVAL(ICOMP)=MELVAL 2224 : IELCHE(N2PTEL,N2EL)=MELVA1.IELCHE(1,1) 2225 : SEGDES MELVAL,MELVA1 2226 : C 2227 : ENDIF 2228 : C 2229 : 70 CONTINUE 2230 : * ajout d une composante pour IMPCOMPL 2231 : if (imatee.eq.34.and.iptamo.gt.0) then 2232 : N2 = N2 + 1 2233 : segadj mchaml 2234 : typche(N2) = 'REAL*8' 2235 : nomche(N2) = 'AMOR' 2236 : ielval(N2) = iptamo 2237 : endif 2238 : *''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 2239 : * FIN DE BOUCLE SUR LES COMPOSANTES 2240 : *''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 2241 : * 2242 : * cas simul 2243 : * 2244 : IF (JESIMU.EQ.1) THEN 2245 : * 2246 : * ON COMMENCE PAR ACTIVER TOUTES LES COMPOSANTES 2247 : * ET CREER LES MELVALS NON ENCORE CREES 2248 : * 2249 : DO 700 ICOMP=1,N2 2250 : IF (IVALIS(ICOMP).EQ.0) THEN 2251 : MELVAL=IELVAL(ICOMP) 2252 : SEGACT MELVAL 2253 : NPMAX = MAX(NPMAX,VELCHE(/1)) 2254 : NEMAX = MAX(NEMAX,VELCHE(/2)) 2255 : ENDIF 2256 : 700 CONTINUE 2257 : DO 701 ICOMP=1,N2 2258 : IF (IVALIS(ICOMP).EQ.1) THEN 2259 : TYPCHE(ICOMP)='REAL*8 ' 2260 : N1PTEL=NPMAX 2261 : N1EL=NEMAX 2262 : N2PTEL=0 2263 : N2EL=0 2264 : SEGINI MELVAL 2265 : IELVAL(ICOMP)=MELVAL 2266 : ENDIF 2267 : 701 CONTINUE 2268 : C 2269 : C Evaluation externe de la composante 2270 : C 2271 : DO IPARA=1,NPARA 2272 : MELVA2=IVAPAR(IPARA) 2273 : SEGACT,MELVA2 2274 : ENDDO 2275 : C* N'est-ce pas redondant avec boucles 700 et 701 car IVALIS=0 ou 1 ? 2276 : DO ICOMP=1,N2 2277 : MELVAL=IELVAL(ICOMP) 2278 : SEGACT,MELVAL*mod 2279 : ENDDO 2280 : C 2281 : DO 820 IEL=1,NEMAX 2282 : DO 821 IGAU=1,NPMAX 2283 : C 2284 : C Recuperation des parametres 2285 : C 2286 : DO 822 IPARA=1,NPARA 2287 : MELVA2=IVAPAR(IPARA) 2288 : C** SEGACT,MELVA2 2289 : N1PTE2=MELVA2.VELCHE(/1) 2290 : N1EL2=MELVA2.VELCHE(/2) 2291 : IF (N1PTE2.EQ.1) THEN 2292 : IF (N1EL2.EQ.1) THEN 2293 : VALPAR(IPARA)=MELVA2.VELCHE(1,1) 2294 : ELSE 2295 : VALPAR(IPARA)=MELVA2.VELCHE(1,IEL) 2296 : ENDIF 2297 : ELSE 2298 : VALPAR(IPARA)=MELVA2.VELCHE(IGAU,IEL) 2299 : ENDIF 2300 : C** SEGDES,MELVA2 2301 : 822 CONTINUE 2302 : * 2303 : * recuperation du tableau xval 2304 : * 2305 : DO 824 ICOMP=1,N2 2306 : MELVAL=IELVAL(ICOMP) 2307 : C** SEGACT,MELVAL 2308 : N1PTE1=VELCHE(/1) 2309 : N1EL1 =VELCHE(/2) 2310 : * 2311 : IF (N1PTE1.EQ.0.AND.N1EL1.EQ.0) THEN 2312 : XVAL(ICOMP)=0. 2313 : ELSE 2314 : IF (N1PTE1.EQ.1) THEN 2315 : IF (N1EL1.EQ.1) THEN 2316 : XVAL(ICOMP)=VELCHE(1,1) 2317 : ELSE 2318 : XVAL(ICOMP)=VELCHE(1,IEL) 2319 : ENDIF 2320 : ELSE 2321 : XVAL(ICOMP)=VELCHE(IGAU,IEL) 2322 : ENDIF 2323 : ENDIF 2324 : 824 CONTINUE 2325 : * 2326 : IERUT=0 2326 : CALL COMPUS(NOMVAL,XVAL,IVALIS,N2, 2327 : & NOMPAR,VALPAR,NPARA,CMNAME,IERUT) 2328 : IF (IERUT.NE.0) THEN 2329 : INTERR(1)=IERUT 2329 : CALL ERREUR(957) 2330 : DO IPARA=1,NPARA 2331 : MELVA2=IVAPAR(IPARA) 2332 : SEGDES,MELVA2 2333 : ENDDO 2334 : DO ICOMP=1,N2 2335 : MELVAL=IELVAL(ICOMP) 2336 : SEGDES,MELVAL 2337 : ENDDO 2338 : SEGSUP,WRKEXT 2339 : SEGDES,MLMOT1 2340 : SEGDES,MCHAM2 2341 : SEGDES,MCHEL2 2342 : GOTO 9900 2343 : ENDIF 2344 : * 2345 : * remplissage 2346 : * 2347 : DO 825 ICOMP=1,N2 2348 : IF (IVALIS(ICOMP).EQ.1) THEN 2349 : MELVAL=IELVAL(ICOMP) 2350 : VELCHE(IGAU,IEL) = XVAL(ICOMP) 2351 : ENDIF 2352 : 825 CONTINUE 2353 : * 2354 : 821 CONTINUE 2355 : 820 CONTINUE 2356 : * 2357 : * DESACTIVATIONS 2358 : * 2359 : DO IPARA=1,NPARA 2360 : MELVA2=IVAPAR(IPARA) 2361 : SEGDES,MELVA2 2362 : ENDDO 2363 : DO ICOMP=1,N2 2364 : MELVAL=IELVAL(ICOMP) 2365 : SEGDES,MELVAL 2366 : ENDDO 2367 : SEGSUP,WRKEXT 2368 : C 2369 : ENDIF 2370 : * 2371 : *''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 2372 : 2373 : SEGSUP SWORK 2374 : SEGSUP WRK53 2375 : SEGSUP WRKRES 2376 : IF (KNUAG) THEN 2377 : SEGSUP NOTYPE 2378 : NOMID=IPNOMC 2379 : if(lsupma)SEGSUP NOMID 2380 : ENDIF 2381 : IF (IAMOI.NE.0) SEGSUP IAMOI 2382 : SEGDES MCHAML,MCHAM1,IMODEL,MELEME 2383 : C 2384 : IF (MINTE.NE.0) SEGDES MINTE 2385 : IF (MINTE1.NE.0) SEGDES MINTE1 2386 : 2387 : 10 CONTINUE 2388 : C 2389 : C FIN de la boucle sur les sous-zones du MCHAML 2390 : C ----------------------------------------------- 2391 : * 2392 : * - STATIQUE - MODAL cree composantes facultatives 2393 : * 2394 : IF (dstati.and.iret.ne.0) THEN 2394 : call varin6(ipmodl,iret) 2395 : if (ierr.ne.0) return 2396 : ENDIF 2397 : 2398 : C Fin normale de VARINU 2399 : C ===================== 2400 : SEGDES MCHELM 2401 : SEGDES MCHEL1 2402 : SEGDES MMODEL 2403 : C** SEGDES MELEME 2404 : 2405 : RETURN 2406 : 2407 : C Erreur dans une sous zone / desactivation et retour 2408 : C =================================================== 2409 : 9900 CONTINUE 2410 : SEGSUP MELVAL 2411 : C 2412 : 9910 CONTINUE 2413 : SEGDES MELVA1 2414 : SEGSUP MCHAML 2415 : C 2416 : SEGDES MCHAM1 2417 : SEGDES MELEME 2418 : C 2419 : SEGSUP SWORK 2420 : SEGSUP WRK53 2421 : SEGSUP WRKRES 2422 : IF (IAMOI.NE.0) SEGSUP IAMOI 2423 : C 2424 : 9920 CONTINUE 2425 : 9930 CONTINUE 2426 : IRET=0 2427 : SEGDES IMODEL 2428 : SEGDES MMODEL 2429 : SEGDES MCHEL1 2430 : SEGSUP MCHELM 2431 : 2432 : RETURN 2433 : 2434 : END 2435 : 2436 :
© Cast3M 2003 - All rights reserved.
Disclaimer