1 : C MODELI SOURCE FANDEUR 14/01/22 21:15:10 7891 2 : C----------------------------------------------------------------------C 3 : C OPERATEUR MODELE C 4 : C C 5 : C Creation d'un objet MODELE C 6 : C C 7 : C Syntaxe : MOD1 = MODL GEO1 TYPE_CAL TYPE_MAT ( TYPE_ELE ) ; C 8 : C C 9 : C GEO1 MAILLAGE de base C 10 : C TYPE_CAL MOT(S) pour definir la FORMULATION C 11 : C TYPE_MAT MOT(S) pour definir le MATERIAU C 12 : C TYPE_ELE MOT(S) pour definir les ELEMENTS FINIS a utiliser C 13 : C MOD1 Resultat de type MODELE C 14 : C----------------------------------------------------------------------C 15 : C PPU : Modif pour les materiaux unidirectionels en plasticite 16 : 17 : SUBROUTINE MODELI 18 : 19 : IMPLICIT INTEGER(I-N) 20 : 21 : IMPLICIT REAL*8 (A-H,O-Z) 22 : -INC CCOPTIO 23 : -INC CCHAMP 24 : -INC SMELEME 25 : -INC SMMODEL 26 : POINTEUR IMODE3.IMODEL,IMODE4.IMODEL,IMODE5.IMODEL 27 : -INC SMTABLE 28 : -INC SMLMOTS 29 : -INC SMCOORD 30 : -INC CCGEOME 31 : 32 : POINTEUR NOMID1.NOMID 33 : SEGMENT ilmora 34 : integer LIMORA(100) 35 : endsegment 36 : SEGMENT LIMODE(0) 37 : SEGMENT PLICON 38 : integer mlicon(NLCON),tlicon(NLCON) 39 : ENDSEGMENT 40 : 41 : EXTERNAL LONG 42 : PARAMETER (NBFORM=15,NBCON=7,NBEXT=6,NBDIF=1) 43 : PARAMETER (N1MAX=300,N2MAX=200) 44 : 45 : DIMENSION LESMOD(N1MAX) 46 : CHARACTER*4 K4ILOI,deriv(1) 47 : CHARACTER*4 MOTEF(N2MAX),LESTEF(N2MAX),MOCON(NBCON),MOEXT(NBEXT), 48 : & MODIF(NBDIF) 49 : CHARACTER*8 TAPIND,TYPOBJ,CHARIN,CHARRE,CMATE,PHAM 50 : CHARACTER*8 PAR1,MDIINC,MDIDUA 51 : CHARACTER*(LCONMO) CONM 52 : CHARACTER*16 MOFORM(NBFORM),LESFOR(2),MOPROP(N1MAX),LESPRO(N1MAX) 53 : CHARACTER*16 mderiv(6),LMENOM,LDINOM,OPTEMP(3) 54 : CHARACTER*512 MOTEMP,LMELIB,LDILIB 55 : LOGICAL LOGRE,LOGIN,LMEEXT,LMENLX,LMEVIX,LOSTAT,LOMELA,LINOMID 56 : LOGICAL LDIEXT,LDISOR 57 : 58 : CHARACTER*4 MODEPL(11) 59 : CHARACTER*4 mgauss(4) 60 : DATA MODEPL / 'UX ','UY ','UZ ','UR ','UZ ','UT ', 61 : & 'P ','PI ','T ','TH ','VEL ' / 62 : DATA MGAUSS /'EPAI' , 'RIGI' , 'MASS' ,'CONT'/ 63 : DATA DERIV/'EPSI'/ 64 : DATA MDERIV/'LINEAIRE ','QUADRATIQUE ', 65 : $ 'TRUESDELL ','JAUMANN ', 66 : $ 'UTILISATEUR ','FEFP '/ 67 : DATA OPTEMP/'PHASE ','ADVECTION ', 68 : $ 'CONDUCTION '/ 69 : C----------------------------------------------------------------------C 70 : C DEFINITION DES NOMS DE FORMULATIONS C 71 : * formulation LIAISON : pour operateurs DYNE et COMP 72 : C----------------------------------------------------------------------C 73 : DATA MOFORM / 74 : & 'THERMIQUE ','MECANIQUE ','LIQUIDE ', 75 : & 'POREUX ','DARCY ','CONTACT ', 76 : & 'MAGNETODYNAMIQUE','NAVIER_STOKES ','MELANGE ', 77 : & 'EULER ','FISSURE ','LIAISON ', 78 : & 'THERMOHYDRIQUE ','ELECTROSTATIQUE ','DIFFUSION ' / 79 : 80 : DATA MOCON / 'CONS','INTE','DPGE','PHAS','STAT','LCOI','LCOS'/ 81 : DATA MOEXT / 'NUME','NOM_','PARA','C_MA','C_VA','LIB_' / 82 : DATA MODIF / 'INCO' / 83 : 84 : CONM=' ' 85 : PHAM=' ' 86 : MDIINC=' ' 87 : MDIDUA=' ' 88 : 89 : NPINT=0 90 : MN3=0 91 : MFR=0 92 : MFRTMP=0 93 : lucvar=0 94 : lucmat=0 95 : lucmaf=0 96 : luparx=0 97 : 98 : C Lecture d'un MAILLAGE ou d'une TABLE de sous-type DOMAINE ou 99 : C d'un MODELE (pour une formulation MELANGE) 100 : IPTABL = 0 101 : IPGEOM = 0 102 : IReMOD=0 102 : CALL LIRTAB('DOMAINE',IPTABL,0,IRET) 103 : IF (IERR.NE.0) RETURN 104 : IF (IRET.EQ.0) THEN 104 : CALL LIROBJ('MMODEL',IPMODE,0,IReMOD) 105 : IF (IERR.NE.0) RETURN 106 : IF (IReMOD.GT.0) THEN 107 : MMODEL=IPMODE 108 : SEGACT,MMODEL 109 : GOTO 674 110 : ELSE 110 : CALL LIROBJ('MAILLAGE',IPGEOM,1,IRET) 111 : ipgeoini=ipgeom 112 : IF (IERR.NE.0) RETURN 113 : ENDIF 114 : ELSE 115 : IVALIN=0 116 : XVALIN=0.D0 117 : LOGIN=.TRUE. 118 : IOBIN=0 119 : TAPIND='MOT ' 120 : CHARIN='MAILLAGE' 121 : TYPOBJ='MAILLAGE' 121 : CALL ACCTAB(IPTABL,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN, 122 : . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE) 123 : IF (IERR.NE.0) RETURN 124 : IPGEOM=IOBRE 125 : ENDIF 126 : 127 : C Lecture d'une FORMULATION 128 : ICOND=1 129 : NFOR=0 130 : NMAT=0 130 : CALL MESLIR(-182) 130 : 51 IF (NFOR.NE.0) CALL MESLIR(-181) 130 : CALL LIRMOT(MOFORM,NBFORM,IPFORM,ICOND) 131 : IF (IERR.NE.0) RETURN 132 : IF (IPFORM.EQ.0) GOTO 52 133 : NFOR=NFOR+1 134 : IF (NFOR.GT.2) THEN 134 : CALL ERREUR(251) 135 : RETURN 136 : ENDIF 137 : ICOND=0 138 : LESFOR(NFOR)=MOFORM(IPFORM) 139 : GOTO 51 140 : C Cas d'une FORMULATION simple (NFOR=1) 141 : 52 IF (NFOR.EQ.1) THEN 142 : jderiv=mepsil 143 : IF (LESFOR(1).EQ.'THERMIQUE') THEN 143 : CALL MODEL1(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) 144 : ELSE IF(LESFOR(1).EQ.'MECANIQUE') THEN 144 : CALL MODEL2(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) 145 : ELSE IF(LESFOR(1).EQ.'LIQUIDE') THEN 145 : CALL MODEL3(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) 146 : * ELSE IF(LESFOR(1).EQ.'CONVECTION') THEN 146 : * CALL MODEL4(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) 147 : ELSE IF(LESFOR(1).EQ.'POREUX') THEN 147 : CALL MODEL6(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) 148 : ELSE IF(LESFOR(1).EQ.'DARCY') THEN 148 : CALL MODEL7(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) 149 : ELSE IF(LESFOR(1).EQ.'CONTACT') THEN 149 : CALL MODEL8(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) 150 : * ELSE IF(LESFOR(1).EQ.'RAYONNEMENT') THEN 150 : * CALL MODEL9(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) 151 : ELSE IF(LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN 151 : CALL MODE10(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) 152 : ELSE IF(LESFOR(1).EQ.'NAVIER_STOKES') THEN 152 : CALL MODE11(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) 153 : ELSE IF (LESFOR(1).EQ.'MELANGE') THEN 153 : CALL MODE12(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) 154 : DO i=1,N1MAX 155 : LESMOD(i)=0 156 : ENDDO 157 : ELSE IF(LESFOR(1).EQ.'EULER') THEN 157 : CALL MODE13(MOPROP,NPROP,NBTEF,N1MAX) 158 : ELSE IF(LESFOR(1).EQ.'FISSURE') THEN 158 : CALL MODE14(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) 159 : ELSE IF(LESFOR(1).EQ.'LIAISON') THEN 159 : CALL MODE15(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) 160 : ELSE IF(LESFOR(1).EQ.'THERMOHYDRIQUE') THEN 160 : CALL MODE16(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) 161 : ELSE IF(LESFOR(1).EQ.'ELECTROSTATIQUE ') THEN 161 : CALL MODE17(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) 162 : ELSE IF(LESFOR(1).EQ.'DIFFUSION ') THEN 162 : CALL MODE18(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) 163 : ELSE 163 : CALL ERREUR (251) 164 : ENDIF 165 : IF(IERR.NE.0) RETURN 166 : ELSE 167 : C Cas d'une FORMULATION couplee (NFOR=2) 168 : IF ((LESFOR(1).EQ.'LIQUIDE'.AND.LESFOR(2).EQ.'MECANIQUE').OR. 169 : . (LESFOR(2).EQ.'LIQUIDE'.AND.LESFOR(1).EQ.'MECANIQUE')) THEN 169 : CALL MODEL5(NPROP,MOTEF,NBTEF,N2MAX) 170 : IF(IERR.NE.0) RETURN 171 : ELSE 171 : CALL ERREUR(251) 172 : RETURN 173 : ENDIF 174 : ENDIF 175 : C Lecture eventuelle des proprietes du MODELE de MATERIAU 175 : CALL MESLIR(-180) 176 : ifrtt=0 177 : icabfr=0 178 : IFROCA=0 179 : ifacaf=0 180 : isyme=0 181 : nbga=10 182 : nbdang=3 183 : icavit=0 184 : kjh=0 185 : iraye=0 186 : iconv=0 187 : NMAT=0 188 : IF (NPROP.EQ.0) GOTO 43 188 : 41 IF (NMAT.NE.0) CALL MESLIR(-179) 188 : CALL LIRMOT(MOPROP,NPROP,LAPROP,0) 189 : c* if( laprop.ne.0) write(6,*) ' lecture de ', moprop(laprop) 190 : IF (IERR.NE.0) RETURN 191 : * --- si frottement frocable il faut lire un modele et un maillage 192 : IF(LESFOR(1).EQ.'CONTACT') then 193 : if(laprop.eq.3) then 193 : call ecrobj('MAILLAGE',IPGEOM) 193 : call impf 193 : call lirobj('MAILLAGE',ipgeo2,1,iretou) 194 : if(ierr.ne.0) return 195 : endif 196 : if(laprop.eq.5) then 197 : ifrtt=0 198 : ifroca=1 198 : * call lirobj('MMODEL',IFROCA,1,iOK) 199 : * IF(ierr.NE.0) return 199 : Call lirobj('MAILLAGE',IBETON,1,IOK) 200 : IF(ierr.NE.0) return 201 : endif 202 : if(laprop.eq.4) then 203 : ifrtt=1 204 : endif 205 : ENDIF 206 : * ---------- pour rayonnement 207 : IF (iraye.eq.1) then 208 : if(laprop.eq.1) icavit=1 209 : if(laprop.eq.9) then 209 : call lirent( nbdang,1,iretou) 210 : if(ierr.ne.0) return 211 : endif 212 : if(laprop.eq.8) then 212 : call lirent( nbga,1,iretou) 213 : if(ierr.ne.0) return 214 : endif 215 : if(laprop.eq.7)then 216 : isyme=1 216 : call lirobj('POINT',ipp1,1,iretou) 216 : call lirobj('POINT',ipp2,1,iretou) 216 : if(idim.eq.3)call lirobj('POINT',ipp3,1,iretou) 217 : if(ierr.ne.0) return 218 : endif 219 : if(laprop.eq.2) then 220 : ifacaf=1 220 : call lirobj('MAILLAGE',ipfac1,1,iretou) 220 : call lirobj('MAILLAGE',ipfac2,1,iretou) 220 : call lirobj('MAILLAGE',ipfac3,1,iretou) 220 : call lirobj('MMODEL',imoco,1,iretou) 221 : if(ierr.ne.0) return 222 : endif 223 : ENDIF 224 : * ---------- pour les melanges on cherche a lire un modele ------- 225 : IF (LESFOR(1).EQ.'MELANGE') THEN 225 : CALL LIROBJ('MMODEL',IPMOD,0,iOK) 226 : IF (IERR.NE.0) RETURN 227 : * ----- le melange par defaut est 'PARALLELE' 228 : IF (iOK.NE.0) THEN 229 : IF (LAPROP.EQ.0) LAPROP=3 230 : LESMOD(NMAT+1)=IPMOD 231 : ENDIF 232 : ENDIF 233 : * ---------- changement de moprop si convection ou rayonnement ------- 234 : IF (lesfor(1).eq.'THERMIQUE' .AND. kjh.eq.0) then 235 : IF (moprop(laprop).eq.'CONVECTION') then 236 : iconv=1 237 : nmat=nmat+1 238 : kjh=1 239 : lespro(nmat)=moprop(laprop) 239 : call model4(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) 240 : go to 41 241 : ELSE IF (moprop(laprop).eq.'RAYONNEMENT') then 242 : iraye=1 243 : kjh=1 244 : nmat=nmat+1 245 : lespro(nmat)=moprop(laprop) 246 : segini ilmora 246 : call model9(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) 247 : go to 41 248 : ENDIF 249 : ENDIF 250 : IF (LAPROP.EQ.0) GOTO 42 251 : NMAT=NMAT+1 252 : LESPRO(NMAT)=MOPROP(LAPROP) 253 : GOTO 41 254 : C Option par defaut suivant la formulation 255 : 42 CONTINUE 256 : IF (NMAT.NE.0) THEN 257 : C on teste tout de suite l'existence de la donnee de la derivee 258 : C il ne faut pas de modele de materiau commencant par deri 259 : nmit=nmat 260 : do i=1,nmit 261 : if( lespro(i)(1:4).eq.'EPSI') then 261 : call erreur(19) 262 : return 263 : endif 264 : enddo 265 : * on cherche le mot deri 265 : CALL LIRMOT(deriv,1,itrou,0) 266 : IF(itrou.ne.0) then 266 : call lirmot(mderiv,5,iret,1) 267 : if(ierr.ne.0) return 268 : Jderiv=iret 269 : ENDIF 270 : C THERMIQUE : 'ISOTROPE' 271 : IF (LESFOR(1).EQ.'THERMIQUE' ) THEN 272 : IPROP = 3 273 : IF (IDIM.EQ.1) IPROP = 1 273 : CALL PLACE(MOPROP,IPROP,IPLAC,LESPRO(1)) 274 : IF (IPLAC.EQ.0) THEN 275 : DO i=NMAT,1,-1 276 : LESPRO(i+1)=LESPRO(i) 277 : ENDDO 278 : LESPRO(1)='ISOTROPE' 279 : NMAT=NMAT+1 280 : ELSEif(NMAT.EQ.1)THEN 281 : NMAT=NMAT+1 282 : LESPRO(2)='CONDUCTION' 283 : ENDIF 284 : * on ajoute le mot conduction si besoin avec phase et advection 285 : idoico=0 286 : idejco=0 287 : DO i=1,nmat 287 : CALL PLACE (OPTEMP,3,iplac,LESPRO(i)) 288 : if(iplac.eq.1.or.iplac.eq.2) idoico=1 289 : if(iplac.eq.3) idejco=1 290 : enddo 291 : if( idoico.ne.0.and.idejco.eq.0) then 292 : nmat=nmat+1 293 : lespro(nmat)='CONDUCTION' 294 : endif 295 : C MECANIQUE / POREUX : 'ELASTIQUE' 'ISOTROPE' 296 : ELSE IF (LESFOR(1).EQ.'MECANIQUE'.OR. 297 : & LESFOR(1).EQ.'POREUX') THEN 298 : IF (NMAT.GE.2)THEN 298 : CALL MODELA(MOPROP,NMOD) 298 : CALL PLACE(MOPROP,NMOD,IPLAC,LESPRO(2)) 299 : IF (IPLAC.EQ.0) THEN 300 : DO i=NMAT,2,-1 301 : LESPRO(i+1)=LESPRO(i) 302 : ENDDO 303 : LESPRO(2)='ISOTROPE' 304 : NMAT=NMAT+1 305 : ENDIF 306 : ELSE IF (NMAT.EQ.1) THEN 307 : LESPRO(2)='ISOTROPE' 308 : NMAT=2 309 : ENDIF 310 : C MECANIQUE / POREUX : modele par defaut en comportement non lineaire 310 : CALL MODNLI(MOPROP,NMOD) 310 : CALL PLACE(MOPROP,NMOD,IPLAC,LESPRO(NMAT)) 311 : C Par defaut : PLASTIQUE ISOTROPE 312 : IF (IPLAC.EQ.1) THEN 313 : NMAT=NMAT+1 314 : LESPRO(NMAT)='ISOTROPE' 315 : C Par defaut : FLUAGE NORTON 316 : ELSE IF (IPLAC.EQ.2) THEN 317 : NMAT=NMAT+1 318 : LESPRO(NMAT)='NORTON' 319 : C Par defaut : VISCOPLASTIQUE CHABOCHE 320 : ELSE IF (IPLAC.EQ.3) THEN 321 : NMAT=NMAT+1 322 : LESPRO(NMAT)='CHABOCHE' 323 : C Par defaut : ENDOMMAGEMENT MAZARS 324 : ELSE IF (IPLAC.EQ.4) THEN 325 : NMAT=NMAT+1 326 : LESPRO(NMAT)='MAZARS' 327 : C Par defaut : ENDOMMAGEMENT PLASTIQUE P/Y 328 : ELSE IF (IPLAC.EQ.5) THEN 329 : NMAT=NMAT+1 330 : LESPRO(NMAT)='PSURY' 331 : ELSE IF (IPLAC.EQ.6) THEN 332 : C Si 'MECANIQUE' OU 'POREUX' : pas de comportement par defaut 333 : C pour 'NON_LINEAIRE' 334 : C*? IF (LESFOR(1).EQ.'MECANIQUE'.OR. 335 : C*? . LESFOR(1).EQ.'POREUX') THEN 335 : CALL ERREUR(945) 336 : RETURN 337 : C*? ENDIF 338 : ELSE IF (IPLAC.EQ.7) THEN 339 : C Si 'MECANIQUE' : pas de comportement par defaut pour 'VISCO_EXTERNE' 340 : IF (LESFOR(1).EQ.'MECANIQUE') THEN 340 : CALL ERREUR(946) 341 : C Si 'POREUX' : option non implementee 342 : ELSE IF (LESFOR(1).EQ.'POREUX') THEN 342 : CALL ERREUR(251) 343 : ENDIF 344 : RETURN 345 : ENDIF 346 : C MAGNETODYNAMIQUE : 'POTENTIEL_VECTEUR' 'ISOTROPE' 347 : ELSE IF(LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN 348 : IF (NMAT.EQ.1) THEN 349 : IF (LESPRO(1).NE.'POTENTIEL_VECTEU') THEN 350 : LESPRO(2)=LESPRO(1) 351 : LESPRO(1)='POTENTIEL_VECTEU' 352 : ELSE 353 : LESPRO(2)='ISOTROPE' 354 : ENDIF 355 : NMAT=2 356 : ENDIF 357 : C MELANGE : 'CEREM' 358 : ELSE IF (LESFOR(1).EQ.'MELANGE') THEN 359 : NMAT1=NMAT 360 : IF (NMAT.EQ.0) THEN 361 : LESPRO(1)='CEREM' 362 : NMAT=1 363 : ENDIF 364 : C LIAISON : pas d option par defaut 365 : ELSE IF (LESFOR(1).EQ.'LIAISON') THEN 366 : C ELECTROSTATIQUE : 'ISOTROPE' 367 : ELSE IF (LESFOR(1).EQ.'ELECTROSTATIQUE' ) THEN 368 : IPROP = 3 369 : IF (IDIM.EQ.1) IPROP = 1 369 : CALL PLACE(MOPROP(1),IPROP,IPLAC,LESPRO(1)) 370 : IF (IPLAC.EQ.0) THEN 371 : DO i=NMAT,1,-1 372 : LESPRO(i+1)=LESPRO(i) 373 : ENDDO 374 : LESPRO(1)='ISOTROPE' 375 : NMAT=NMAT+1 376 : ENDIF 377 : C DIFFUSION : 'ISOTROPE' 'FICK' 378 : ELSE IF (LESFOR(1).EQ.'DIFFUSION' ) THEN 379 : IPROP = 3 380 : IF (IDIM.EQ.1) IPROP = 1 380 : CALL PLACE(MOPROP(1),IPROP,IPLAC,LESPRO(1)) 381 : IF (IPLAC.EQ.0) THEN 382 : DO i=NMAT,1,-1 383 : LESPRO(i+1)=LESPRO(i) 384 : ENDDO 385 : LESPRO(1)='ISOTROPE' 386 : NMAT=NMAT+1 387 : ENDIF 387 : CALL MODDIF(MOPROP,NMOD) 387 : CALL PLACE(MOPROP,NMOD,IPLAC,LESPRO(NMAT)) 388 : IF (IPLAC.EQ.0) THEN 389 : NMAT=NMAT+1 390 : LESPRO(NMAT)='FICK' 391 : ENDIF 392 : ELSEIF(LESFOR(1).EQ.'CONTACT' ) THEN 392 : call place ( moprop,2,iplac,lespro(1)) 393 : if( iplac.eq.0) then 394 : do iur=1,nmat 395 : lespro(nmat+2-iur)=lespro (nmat +1-iur) 396 : enddo 397 : lespro(1)='UNILATERAL' 398 : nmat=nmat+1 399 : endif 400 : ENDIF 401 : ELSE 402 : * si nmat=0 on met le premier mot autorisé 403 : NMAT=1 404 : LESPRO(1)=MOPROP(1) 405 : IF(LESFOR(1).EQ.'THERMIQUE') THEN 406 : LESPRO(2)='CONDUCTION' 407 : NMAT=NMAT+1 408 : ELSE IF (LESFOR(1).EQ.'MECANIQUE'.OR.LESFOR(1).EQ.'POREUX'.OR. 409 : & LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN 410 : C Option par defaut : MECANIQUE / POREUX ELASTIQUE ISOTROPE 411 : C ou MAGNETODYNAMIQUE POTENTIEL_VECTEUR ISOTROPE 412 : NMAT=NMAT+1 413 : LESPRO(NMAT)='ISOTROPE' 414 : C Par defaut : DIFFUSION ISOTROPE FICK 415 : ELSE IF (LESFOR(1).EQ.'DIFFUSION') THEN 416 : NMAT=NMAT+1 417 : IPROP = 4 418 : IF (IDIM.EQ.1) IPROP = 2 419 : LESPRO(NMAT)=MOPROP(IPROP) 420 : C Par defaut : NEWTONIEN 421 : ELSE IF (LESFOR(1).EQ.'NAVIER_STOKES'.OR. 422 : & LESFOR(1).EQ.'EULER') THEN 423 : NMAT = 1 424 : LESPRO(NMAT)='NEWTONIEN' 425 : C Par defaut pour la formulation FISSURE 426 : ELSE IF (LESFOR(1).EQ.'FISSURE') THEN 427 : NMAT = 3 428 : LESPRO(1)='MASS' 429 : LESPRO(2)='PARF' 430 : LESPRO(3)='POISEU_BLASIUS' 431 : ELSE IF(LESFOR(1).EQ.'CONTACT') THEN 432 : NMAT=1 433 : LESPRO(1)='UNILATERAL' 434 : ENDIF 435 : ENDIF 436 : 437 : C Lecture eventuelle des types d'ELEMENTS FINIS a utiliser 438 : 43 ITEF=0 439 : IF (NBTEF.EQ.0) GOTO 2 439 : CALL MESLIR(-178) 439 : 1 IF (ITEF.NE.0) CALL MESLIR(-177) 439 : CALL LIRMOT(MOTEF,NBTEF,LETEF,0) 440 : IF (IERR.NE.0) RETURN 441 : IF (LETEF.EQ.0) GOTO 2 442 : ITEF=ITEF+1 443 : LESTEF(ITEF)=MOTEF(LETEF) 444 : GOTO 1 445 : 446 : c Lecture eventuelle de listmots 447 : 2 continue 447 : call lirobj('LISTMOTS',jlmot1,0,irmot1) 447 : if (irmot1.eq.1) call lirobj('LISTMOTS',jlmot2,1,irmot2) 448 : 449 : * lecture pour mecanique aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa 450 : C En formulations 'MECANIQUE' et 'POREUX' : detection d'une loi non 451 : C lineaire externe, le cas echeant saisie de donnees complementaires. 452 : C Caracterisation : loi non lineaire externe si 453 : C - famille 'VISCO_EXTERNE' ou 454 : C - famille 'NON_LINEAIRE', materiau 'UTILISATEUR'. 455 : C si pas loi externe lecture eventuelle des parametres externes 456 : LMEEXT=.FALSE. 457 : LMEVIX=.FALSE. 458 : LMENLX=.FALSE. 459 : LMENUM = 0 460 : LMENOM = ' ' 461 : LMELIB = ' ' 462 : LMELGB = 0 463 : LMEPTR = 0 464 : LMEIVI = 0 465 : 466 : IF ( (NFOR.EQ.1).AND. 467 : . (LESFOR(1).EQ.'MECANIQUE'.OR.LESFOR(1).EQ.'POREUX') ) THEN 468 : DO i=1,NMAT 469 : IF (LESPRO(i).EQ.'VISCO_EXTERNE') THEN 470 : LMEVIX=.TRUE. 471 : C* GOTO 201 472 : GOTO 203 473 : ENDIF 474 : ENDDO 475 : 201 IF (.NOT.LMEVIX) THEN 476 : DO i=1,NMAT 477 : IF (LESPRO(i).EQ.'UTILISATEUR') THEN 478 : LMENLX = .TRUE. 479 : GOTO 203 480 : ENDIF 481 : ENDDO 482 : ENDIF 483 : C........N.B. LMEEXT exprime la condition (NFOR.EQ.1) ET 484 : C (LESFOR(1).EQ.'MECANIQUE') ET (loi non lineaire externe) 485 : 203 LMEEXT = LMEVIX.OR.LMENLX 486 : IF ( LMEEXT ) THEN 487 : * lecture et verif des noms des materiaux, des 488 : * noms des variables internes, des noms des parametre externe pour 489 : *loi externes 489 : 210 CALL LIRMOT(MOEXT,NBEXT,LEXT,0) 490 : C Si on ne trouve plus l'un des mots cles attendus, on sort 491 : IF (LEXT.EQ.0) GOTO 211 492 : C Lecture d'un entier sous 'NUME_LOI' 493 : IF (LEXT.EQ.1) THEN 493 : CALL LIRENT(LMENUM,1,IRET) 494 : IF (IERR.NE.0) RETURN 495 : C Valeur illicite du numero de la loi (superieur ou egal a 1) 496 : IF (LMENUM.LT.1 .OR. LMENUM.GE.1000000) THEN 497 : INTERR(1) = LMENUM 497 : CALL ERREUR(36) 497 : CALL ERREUR(947) 498 : RETURN 499 : ENDIF 500 : C Lecture du nom de la loi sous 'NOM_LOI' 501 : ELSE IF (LEXT.EQ.2) THEN 502 : MOTEMP = ' ' 502 : CALL LIRCHA(MOTEMP,1,IRET) 503 : IF (IERR.NE.0) RETURN 504 : IF (IRET.GT.16) THEN 505 : INTERR(1) = IRET 506 : MOTERR = MOTEMP 506 : CALL ERREUR(-2) 506 : CALL ERREUR(36) 507 : RETURN 508 : ENDIF 509 : LMENOM(1:IRET) = MOTEMP(1:IRET) 510 : C Lecture d'un objet LISTMOTS sous 'PARA_LOI' 511 : ELSE IF (LEXT.EQ.3) THEN 511 : CALL LIROBJ('LISTMOTS',LUPARX,1,IRET) 512 : IF (IERR.NE.0) RETURN 513 : C Lecture d'un objet LISTMOTS sous 'C_MATERIAU' 514 : ELSE IF (LEXT.EQ.4) THEN 514 : CALL LIROBJ('LISTMOTS',LUCMAT,1,IRET) 515 : IF (IERR.NE.0) RETURN 516 : C Lecture d'un objet LISTMOTS sous 'C_VARINTER' 517 : ELSE IF (LEXT.EQ.5) THEN 517 : CALL LIROBJ('LISTMOTS',LUCVAR,1,IRET) 518 : IF (IERR.NE.0) RETURN 519 : C Lecture du chemin de la bibliotheque de la loi 520 : ELSE IF (LEXT.EQ.6) THEN 521 : MOTEMP = ' ' 521 : CALL LIRCHA(MOTEMP,1,IRET) 522 : IF (IERR.NE.0) RETURN 523 : IF (IRET.GT.500) THEN 524 : INTERR(1) = IRET 525 : MOTERR = MOTEMP 525 : CALL ERREUR(-2) 525 : CALL ERREUR(36) 526 : RETURN 527 : ENDIF 528 : C*TMP Option non disponible pour l'instant 529 : C*TMP -> en attente specification plus precise et portable (?) 530 : write(ioimp,*) 'Option LIB_LOI' 530 : CALL ERREUR(251) 531 : RETURN 532 : LMELIB(1:IRET) = MOTEMP(1:IRET) 533 : LMELGB = IRET 534 : LMEPTR = IRET 535 : ENDIF 536 : C On repete jusqu'a ce qu'on ne trouve plus aucun des 537 : C mots cles attendus, regle de surcharge le cas echeant 538 : GOTO 210 539 : 211 CONTINUE 540 : C...........Verifications sur les donnees 541 : C Il manque 'NUME_LOI' ou 'NOM_LOI' (toujours obligatoire) 542 : IF (LMENUM.EQ.0 .AND. LMENOM.EQ.' ') THEN 542 : CALL ERREUR(641) 543 : RETURN 544 : ENDIF 545 : IF (LMENUM.NE.0 .AND. LMENOM.NE.' ') THEN 546 : MOTERR(1:16) = 'NUME_LOINOM_LOI ' 546 : CALL ERREUR(135) 547 : RETURN 548 : ENDIF 549 : C Dans le cas d'un modele NON_LINEAIRE UTILISATEUR, on rajoute en fin de 550 : C liste des proprietes du modele, le numero ou le nom de la loi attribue 551 : C par l'utilisateur. 552 : NMAT = NMAT + 1 553 : LESPRO(NMAT) = ' ' 554 : IF (LMENUM.EQ.0) THEN 555 : LESPRO(NMAT) = LMENOM 556 : ELSE 557 : WRITE(LESPRO(NMAT)(1:16),'(I16)') LMENUM 558 : ENDIF 559 : C Verifications pour une loi 'NON_LINEAIRE' 'UTILISATEUR' 560 : IF ( LMENLX ) THEN 561 : C Il manque les composantes materielles sous 'C_MATERIAU' 562 : IF (LUCMAT.EQ.0) THEN 562 : CALL ERREUR(641) 563 : RETURN 564 : ENDIF 565 : C La liste des composantes materielles saisie sous 566 : C 'C_MATERIAU' ne doit pas etre vide 567 : MLMOTS=LUCMAT 568 : SEGACT,MLMOTS 569 : NBCOMP = MOTS(/2) 570 : SEGDES,MLMOTS 571 : IF (NBCOMP.EQ.0) THEN 571 : CALL ERREUR(964) 572 : RETURN 573 : ENDIF 574 : ENDIF 575 : C Dans le cas d'une libraire externe, quelques verifications puis 576 : C recherche du pointeur de la fonction externe 577 : IF (LMEPTR.GT.0) THEN 578 : IF (LMENUM.EQ.0) THEN 579 : i_z = INDEX(LMENOM,' ') 580 : IF (i_z.EQ.0) i_z = 16 581 : IRET = LONG(LMENOM) 582 : IF (i_z.NE.IRET) THEN 583 : write(ioimp,*) 'PAS D ESPACE dans NOM_LOI en cas de LIB_LOI' 583 : CALL ERREUR(21) 584 : RETURN 585 : ENDIF 586 : ELSE 587 : IRET = 0 588 : DO i = 1, 16 589 : IRET = IRET + 1 590 : IF (LESPRO(NMAT)(i:i).NE.' ') GOTO 220 591 : ENDDO 592 : 220 LMENOM = 'umat_'//LESPRO(NMAT)(IRET:16) 593 : IRET = 22-IRET 594 : ENDIF 595 : C** LMELIB = LMELIB(1:LMELGB)//CHAR(0) 596 : C** MOTEMP = LMENOM(1:IRET)//CHAR(0) 596 : C** CALL PTRLOI(LMELIB,LMELGB,MOTEMP,IRET,LMEPTR) 597 : IF (LMEPTR.LE.0) THEN 597 : CALL ERREUR(21) 598 : RETURN 599 : ENDIF 600 : ENDIF 601 : ELSE 602 : * si pas lois externes lecture des noms des parametres externes 602 : CALL LIRMOT(MOEXT(2),1,LEXT,0) 603 : If(lext.ne.0) then 603 : CALL LIROBJ('LISTMOTS',luparx,1,iret) 604 : IF(IERR.NE.0) return 605 : endif 606 : ENDIF 607 : C Verifications sur les parametres, si declares 608 : IF (luparx.GT.0) THEN 609 : C Si la temperature 'T ' fait partie des parametres de 610 : C la loi, elle doit etre declaree en tete 611 : mlmots=luparx 612 : SEGACT,MLMOTS 613 : NBPARA=MOTS(/2) 614 : IF (NBPARA.GT.0) THEN 615 : DO IP = 1, NBPARA 616 : IF (MOTS(IP).EQ.'T ') THEN 617 : IF (IP.GT.1) THEN 618 : SEGDES,MLMOTS 618 : CALL ERREUR(948) 619 : RETURN 620 : ENDIF 621 : GOTO 221 622 : ENDIF 623 : ENDDO 624 : 221 CONTINUE 625 : ENDIF 626 : C Pas de parametres redondants 627 : IF (NBPARA.GT.1) THEN 628 : DO 230 IP1 = 1, NBPARA-1 629 : PAR1 = MOTS(IP1) 630 : DO 231 IP2 = IP1+1, NBPARA 631 : IF (MOTS(IP2).EQ.PAR1) THEN 632 : SEGDES,MLMOTS 632 : CALL ERREUR(949) 633 : RETURN 634 : ENDIF 635 : 231 CONTINUE 636 : 230 CONTINUE 637 : ENDIF 638 : SEGDES,MLMOTS 639 : ENDIF 640 : ENDIF 641 : * fin lecture mecanique aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa 642 : 643 : C Formulation 'DIFFUSION' : oooooooooooooooooooooooooooooooooooooooooooo 644 : C - Detection d'une loi non lineaire externe (mot-cle 'UTILISATEUR') 645 : C - Detection de la quantite de l'effet Soret (mot-cle 'SORET') 646 : C - Lecture de l'inconnue "diffusant" (mot-cle 'INCO') 647 : 3 CONTINUE 648 : LDIEXT = .FALSE. 649 : LDISOR = .FALSE. 650 : LDINUM = 0 651 : LDINOM = ' ' 652 : LDILIB = ' ' 653 : LDILGB = 0 654 : LDIPTR = 0 655 : IF (NFOR.EQ.1 .AND. LESFOR(1).EQ.'DIFFUSION') THEN 656 : * -- Recherche des informations sur la presence d'une loi externe -- 657 : DO i=1,NMAT 658 : LDIEXT = LESPRO(i).EQ.'UTILISATEUR' 659 : LDISOR = LESPRO(i).EQ.'SORET' 660 : ENDDO 661 : *- Lecture des informations pour la loi externe 662 : IF (LDIEXT) THEN 663 : 310 CONTINUE 663 : CALL LIRMOT(MOEXT,NBEXT,LEXT,0) 664 : IF (LEXT.EQ.0) GOTO 311 665 : C Lecture d'un entier sous 'NUME_LOI' 666 : IF (LEXT.EQ.1) THEN 666 : CALL LIRENT(LDINUM,1,IRET) 667 : IF (IERR.NE.0) RETURN 668 : IF (LDINUM.LT.1 .OR. LDINUM.GE.1000000) THEN 669 : INTERR(1) = LDINUM 669 : CALL ERREUR(36) 669 : CALL ERREUR(947) 670 : RETURN 671 : ENDIF 672 : C Lecture du nom de la loi sous 'NOM_LOI' 673 : ELSE IF (LEXT.EQ.2) THEN 674 : MOTEMP = ' ' 674 : CALL LIRCHA(MOTEMP,1,IRET) 675 : IF (IERR.NE.0) RETURN 676 : IF (IRET.GT.16) THEN 677 : INTERR(1) = IRET 678 : MOTERR = MOTEMP 678 : CALL ERREUR(-2) 678 : CALL ERREUR(36) 679 : RETURN 680 : ENDIF 681 : LDINOM(1:IRET) = MOTEMP(1:IRET) 682 : C Lecture d'un objet LISTMOTS sous 'PARA_LOI' 683 : ELSE IF (LEXT.EQ.3) THEN 683 : CALL LIROBJ('LISTMOTS',luparx,1,IRET) 684 : IF (IERR.NE.0) RETURN 685 : C Lecture d'un objet LISTMOTS sous 'C_MATERIAU' 686 : ELSE IF (LEXT.EQ.4) THEN 686 : CALL LIROBJ('LISTMOTS',lucmat,1,IRET) 687 : IF (IERR.NE.0) RETURN 688 : C Lecture d'un objet LISTMOTS sous 'C_VARINTER' 689 : ELSE IF (LEXT.EQ.5) THEN 689 : CALL LIROBJ('LISTMOTS',lucvar,1,IRET) 690 : IF (IERR.NE.0) RETURN 691 : C Lecture du chemin de la bibliotheque de la loi 692 : ELSE IF (LEXT.EQ.6) THEN 693 : MOTEMP = ' ' 693 : CALL LIRCHA(MOTEMP,1,IRET) 694 : IF (IERR.NE.0) RETURN 695 : IF (IRET.GT.500) THEN 696 : INTERR(1) = IRET 697 : MOTERR = MOTEMP 697 : CALL ERREUR(-2) 697 : CALL ERREUR(36) 698 : RETURN 699 : ENDIF 700 : C*TMP Option non disponible pour l'instant 701 : C*TMP -> en attente specification plus precise et portable (?) 702 : write(ioimp,*) 'Option LIB_LOI' 702 : CALL ERREUR(251) 703 : RETURN 704 : LDILIB(1:IRET) = MOTEMP(1:IRET) 705 : LDILGB = IRET 706 : LDIPTR = IRET 707 : ENDIF 708 : GOTO 310 709 : 311 CONTINUE 710 : C Verifications des informations obligatoires de la loi externe 711 : C Il manque 'NUME_LOI' ou 'NOM_LOI' (toujours obligatoire) 712 : IF (LDINUM.EQ.0 .AND. LDINOM.EQ.' ') THEN 712 : CALL ERREUR(641) 713 : RETURN 714 : ENDIF 715 : IF (LDINUM.NE.0 .AND. LDINOM.NE.' ') THEN 716 : MOTERR(1:16) = 'NUME_LOINOM_LOI ' 716 : CALL ERREUR(135) 717 : RETURN 718 : ENDIF 719 : C Il manque la liste 'C_MATERIAU' 720 : IF (lucmat.EQ.0) THEN 720 : CALL ERREUR(641) 721 : RETURN 722 : ENDIF 723 : C Les liste des composantes ne doivent pas etre vides. 724 : DO i = 1, 3 725 : IF (i.EQ.1) MLMOTS = luparx 726 : IF (i.EQ.2) MLMOTS = lucmat 727 : IF (i.EQ.3) MLMOTS = lucvar 728 : IF (MLMOTS.NE.0) THEN 729 : SEGACT,MLMOTS 730 : NBCOMP = MOTS(/2) 731 : SEGDES,MLMOTS 732 : IF (NBCOMP.EQ.0) THEN 732 : CALL ERREUR(964) 733 : RETURN 734 : ENDIF 735 : ENDIF 736 : ENDDO 737 : C Dans le cas d'un modele UTILISATEUR, on rajoute en fin de 738 : C liste des proprietes du modele, le numero attribue par l'utilisateur. 739 : NMAT = NMAT + 1 740 : LESPRO(NMAT) = ' ' 741 : IF (LDINUM.EQ.0) THEN 742 : LESPRO(NMAT) = LDINOM 743 : ELSE 744 : WRITE(LESPRO(NMAT)(1:16),'(I16)') LDINUM 745 : ENDIF 746 : C Dans le cas d'une libraire externe, quelques verifications puis 747 : C recherche du pointeur de la fonction externe 748 : IF (LDIPTR.GT.0) THEN 749 : IF (LDINUM.EQ.0) THEN 750 : i_z = INDEX(LDINOM,' ') 751 : IF (i_z.EQ.0) i_z = 16 752 : IRET = LONG(LDINOM) 753 : IF (i_z.NE.IRET) THEN 754 : write(ioimp,*) 'PAS D ESPACE dans NOM_LOI en cas de LIB_LOI' 754 : CALL ERREUR(21) 755 : RETURN 756 : ENDIF 757 : ELSE 758 : IRET = 0 759 : DO i = 1, 16 760 : IRET = IRET + 1 761 : IF (LESPRO(NMAT)(i:i).NE.' ') GOTO 320 762 : ENDDO 763 : 320 LDINOM = 'umat_'//LESPRO(NMAT)(IRET:16) 764 : IRET = 22-IRET 765 : ENDIF 766 : C** LDILIB = LDILIB(1:LDILGB)//CHAR(0) 767 : C** MOTEMP = LDINOM(1:IRET)//CHAR(0) 767 : C** CALL PTRLOI(LDILIB,LDILGB,MOTEMP,IRET,LDIPTR) 768 : IF (LDIPTR.LT.0) THEN 768 : CALL ERREUR(21) 769 : RETURN 770 : ENDIF 771 : ENDIF 772 : ENDIF 773 : *- Lecture des informations pour la loi Soret : 774 : *- quantite dont le gradient est l'origine de l'effet ('T' par defaut) 775 : IF (LDISOR) THEN 776 : mlmots = 0 777 : CHARIN = 'T ' 778 : C Lecture du mot-cle 'PARA_LOI' et donnees associees 778 : CALL LIRMOT(MOEXT(2),1,LEXT,0) 779 : IF (IERR.NE.0) RETURN 780 : IF (LEXT.EQ.1) THEN 780 : CALL LIROBJ('LISTMOTS',mlmots,0,IRET) 781 : IF (IERR.NE.0) RETURN 782 : IF (IRET.EQ.0) THEN 782 : CALL LIRCHA(CHARIN,1,IRETI) 783 : ELSE 784 : SEGACT,mlmots 785 : NBCOMP = mots(/2) 786 : IF (NBCOMP.EQ.0) THEN 786 : CALL ERREUR(964) 787 : ELSE 788 : CHARIN = MOTS(1) 789 : IRETI = LONG(CHARIN) 789 : IF (IRETI.EQ.0) CALL ERREUR(643) 790 : ENDIF 791 : SEGDES,mlmots 792 : ENDIF 793 : IF (IERR.NE.0) RETURN 794 : IF (IRETI.GT.2) WRITE(IOIMP,30) CHARIN(1:IRETI),2 795 : IRETI = MIN(IRETI,2) 796 : CHARIN(IRETI+1:8) = ' ' 797 : ENDIF 798 : JGM = 1 799 : JGN = 8 800 : SEGINI,mlmots 801 : mots(1) = CHARIN 802 : luparx = mlmots 803 : ENDIF 804 : * -- Pour la formulation DIFFUSION : lecture quantite (ddl) diffusant -- 805 : * -- On cherche a lire le mot 'INCO' suivi du nom de l'INCOnnue donne -- 806 : * -- soit par un LISTMOTS, soit par un MOT puis eventuellement du nom -- 807 : * -- de la grandeur DUALe donne par un objet de meme type que pour le -- 808 : * -- nom de l'inconnue. -- 808 : CALL LIRMOT(MODIF,NBDIF,LEXT,0) 809 : IF (LEXT.EQ.0) THEN 810 : C*8 MDIINC='CONC ' 811 : C*8 MDIDUA='QCONC ' 812 : MDIINC='CO ' 813 : MDIDUA='QCO ' 814 : ELSE 815 : MDIINC=' ' 816 : MDIDUA='Q ' 817 : CHARIN=' ' 818 : CHARRE=' ' 818 : CALL LIROBJ('LISTMOTS',mlmots,0,IRET) 819 : IF (IERR.NE.0) RETURN 820 : IF (mlmots.NE.0) THEN 821 : SEGACT,mlmots 822 : NBCOMP = MOTS(/2) 823 : IF (NBCOMP.EQ.0) THEN 823 : CALL ERREUR(643) 824 : ELSE 825 : CHARIN=MOTS(1) 826 : IRETI=LONG(CHARIN) 827 : ENDIF 828 : SEGDES,mlmots 829 : IF (IERR.NE.0) RETURN 829 : CALL LIROBJ('LISTMOTS',mlmots,0,IRETE) 830 : IF (IERR.NE.0) RETURN 831 : IF (mlmots.NE.0) THEN 832 : SEGACT,mlmots 833 : NBCOMP = MOTS(/2) 834 : IF (NBCOMP.EQ.0) THEN 834 : CALL ERREUR(643) 835 : ELSE 836 : CHARRE=MOTS(1) 837 : IRETE=LONG(CHARRE) 837 : IF (IRETE.EQ.0) CALL ERREUR(643) 838 : ENDIF 839 : SEGDES,mlmots 840 : IF (IERR.NE.0) RETURN 841 : ENDIF 842 : ELSE 842 : CALL LIRCHA(CHARIN,1,IRETI) 843 : IF (IERR.NE.0) RETURN 843 : CALL LIRCHA(CHARRE,0,IRETE) 844 : IF (IERR.NE.0) RETURN 845 : ENDIF 846 : IF (IRETI.EQ.0) THEN 846 : CALL ERREUR(643) 847 : RETURN 848 : ENDIF 848 : *OF A mettre en message : CALL ERREUR(-xx) 849 : C*8 IF (IRETI.GT.6) WRITE(IOIMP,30) CHARIN(1:IRETI),6 850 : C*8 IRETI=MIN(IRETI,6) 851 : IF (IRETI.GT.2) WRITE(IOIMP,30) CHARIN(1:IRETI),2 852 : IRETI=MIN(IRETI,2) 853 : MDIINC(1:IRETI)=CHARIN(1:IRETI) 854 : IF (IRETE.EQ.0) THEN 855 : MDIDUA(2:1+IRETI)=MDIINC(1:IRETI) 856 : ELSE 857 : C*8 IF (IRETE.GT.8) WRITE(IOIMP,30) CHARRE(1:IRETE),8 858 : C*8 IRETE=MIN(IRETE,8) 859 : IF (IRETE.GT.4) WRITE(IOIMP,30) CHARRE(1:IRETE),4 860 : IRETE=MIN(IRETE,4) 861 : MDIDUA(1:IRETE)=CHARRE(1:IRETE) 862 : ENDIF 863 : ENDIF 864 : 30 FORMAT('MODELI : Composante ',A,' tronquee a ',I1,' caracteres') 865 : c* Verification des noms de primale et duale lues 865 : CALL VERMDI(MDIINC,MDIDUA) 866 : IF (IERR.NE.0) RETURN 867 : c* 868 : ENDIF 869 : C Fin Formulation 'DIFFUSION' oooooooooooooooooooooooooooooooooooooooooo 870 : 871 : C Lecture eventuelle du NOM de CONSTITUANT, du nombre de POINTs 872 : C d'INTEGRATION, du point support pour les modes en DEFOrmations 873 : C PLANEs GENEralisees, du nom de la phase. fin des lecture en 22 874 : 674 IPTGEN=0 875 : IPMOD1=0 876 : ngrig=0 877 : ngmas=0 878 : ngcon=0 879 : npint=0 880 : klcon= 0 881 : kcons=0 881 : 675 CALL LIRMOT(MOCON,NBCON,LECON,0) 882 : IF (LECON.EQ.0) GOTO 22 883 : IF (LECON.EQ.1) THEN 883 : CALL LIRCHA(CONM,1,kcons) 884 : IF (IERR.NE.0) RETURN 885 : ELSE IF (LECON.EQ.2) THEN 886 : 677 continue 887 : legaus=0 887 : CALL LIRMOT(MGAUSS,4,legaus,0) 888 : if( legaus.eq.0.and.npint.eq.0) then 889 : legaus=1 890 : else 891 : go to 675 892 : endif 892 : CALL LIRENT(NPINTT,1,IRET) 893 : IF (IERR.NE.0) RETURN 894 : if(legaus.eq.1) npint=npintt 895 : if(legaus.eq.2) ngrig=npintt 896 : if(legaus.eq.3) ngmas=npintt 897 : if(legaus.eq.4) ngcon=npintt 898 : MN3=1 899 : IF (NPINT.ne.0.and.MOD(NPINT,2).EQ.0) THEN 899 : CALL ERREUR(607) 900 : ENDIF 901 : go to 677 902 : ELSE IF (LECON.EQ.3) THEN 902 : CALL LIROBJ('POINT',IPTGEN,1,IRET) 903 : IF (IERR.NE.0) RETURN 904 : ELSE IF (LECON.EQ.4) THEN 904 : CALL LIRCHA(PHAM,1,IRET) 905 : IF(IERR.NE.0) RETURN 906 : ELSE IF (LECON.EQ.5) THEN 906 : CALL LIROBJ('MMODEL',IPMOD1,0,IRET) 907 : IF (IERR.NE.0) RETURN 908 : ELSE IF (LECON.EQ.6.OR.LECON.EQ.7) THEN 908 : CALL LIROBJ('MMODEL',IPMOD2,0,IRET) 909 : IF (IERR.NE.0) RETURN 910 : if (ipmod2.gt.0) then 911 : if (klcon.eq.0) then 912 : nlcon = 10 913 : segini plicon 914 : endif 915 : klcon = klcon + 1 916 : if (klcon.gt.nlcon) then 917 : nlcon = nlcon + 10 918 : segadj plicon 919 : endif 920 : mlicon(klcon) = ipmod2 921 : tlicon(klcon) = lecon 922 : endif 923 : ENDIF 924 : GOTO 675 925 : 22 CONTINUE 926 : 927 : C Erreur si aucun point n'est fourni avec le mot-cle GENE pour les modes 928 : C de calcul 'MECANIQUE'/'POREUX' ou ce point est indispensable. 929 : IF (IPTGEN.EQ.0) THEN 930 : IF ( (NFOR.EQ.1) .AND. 931 : & (LESFOR(1).EQ.'MECANIQUE'.OR.LESFOR(1).EQ.'POREUX') ) THEN 932 : IF (IFOUR.EQ.-3 .OR. (IFOUR.GE.7.AND.IFOUR.LE.11) .OR. 933 : & IFOUR.EQ.14) THEN 934 : SEGSUP,MMODEL 934 : CALL ERREUR(925) 935 : RETURN 936 : ENDIF 937 : ENDIF 938 : ENDIF 939 : C Recuperation des caracteristiques du MAILLAGE dans MELEME 940 : * on se pose le pb du maillage non conforme itypel=48 qui contine les relations 941 : MELEME=IPGEOM 942 : SEGACT,MELEME 943 : NSOU =MELEME.LISOUS(/1) 944 : NSOU1=MAX(1,NSOU) 945 : ICONFO=0 946 : DO 38 INB=1,NSOU1 947 : IF (NSOU.EQ.0) THEN 948 : IPT2=MELEME 949 : ELSE 950 : IPT2=MELEME.LISOUS(INB) 951 : SEGACT,IPT2 952 : ENDIF 953 : IF (IPT2.ITYPEL.EQ.48) ICONFO=ICONFO+1 954 : 38 CONTINUE 955 : * 956 : C Initialisation du segment MMODEL 957 : * 958 : N1=NSOU1 959 : SEGINI,MMODEL 960 : IPMODE=MMODEL 961 : C* Nom du constituant par defaut si non donne en entree 962 : IF (kcons.EQ.0) WRITE(CONM,FMT='(I16)') IPMODE 963 : *** IF (kcons.EQ.0) CONM='MODELI' 964 : 965 : IF (IReMOD.NE.0) GOTO 70 966 : C Remplissage du segment MMODEL 967 : IF (LESFOR(1).EQ.'NAVIER_STOKES') MN3=2 968 : IF (LESFOR(1).EQ.'EULER') MN3=2 969 : IF (LESFOR(1).EQ.'DARCY') MN3=2 970 : IF (LESFOR(1).EQ.'THERMOHYDRIQUE' ) mn3=2 971 : IF(LESFOR(1).EQ.'MECANIQUE'.OR.lesfor(1).eq.'POREUX'.or.nfor.eq.2) 972 : $ mn3=12 973 : IF (LESFOR(1).EQ.'LIQUIDE' ) mn3=12 974 : IF (LESFOR(1).EQ.'LIAISON') mn3=12 975 : IF (LESFOR(1).EQ.'ELECTROSTATIQUE') mn3=12 976 : IF (LESFOR(1).EQ.'DIFFUSION') mn3=12 977 : C*********************************************************************** 978 : C Boucle sur les maillages elementaires de MELEME 979 : C*********************************************************************** 980 : DO 10 IM=1,NSOU1 981 : NOBMOD=0 982 : IF (LESFOR(1).EQ.'CONTACT') THEN 983 : IF (IFROCA.NE.0) NOBMOD=2 984 : IF (ifrtt.ne.0) nobmod=1 985 : ELSE IF (LESFOR(1).EQ.'DIFFUSION') THEN 986 : NOBDIF = NOBMOD 987 : NOBMOD = NOBMOD + 3 988 : IF (LDIPTR.GT.0) NOBMOD = NOBMOD + 1 989 : C* ELSE IF ( (NFOR.EQ.1) .AND. 990 : C* & ( LESFOR(1).EQ.'MECANIQUE' .OR. 991 : C* & LESFOR(1).EQ.'POREUX' ) ) THEN 992 : C* Modeles utilisateur en MECANIQUE : 993 : ELSE IF (LMEEXT) THEN 994 : NOBMEC = NOBMOD 995 : IF (LMEPTR.GT.0) NOBMOD = NOBMOD + 2 996 : IF (LMEVIX) NOBMOD = NOBMOD + 1 997 : ENDIF 998 : if(iraye.eq.1) nobmod=2*icavit+isyme*idim+ifacaf*4 999 : SEGINI,IMODEL 1000 : if(iraye.ne.0) limora(im)= nobmod+1-n1 1001 : IF (LESFOR(1).EQ.'CONTACT'.AND.IFROCA.EQ.1)THEN 1002 : imamod=ipgeo2 1003 : ipt1=ipgeo2 1004 : segact ipt1 1005 : ityp1=ipt1.itypel 1006 : segdes ipt1 1007 : TYMODE(1)='MAILLAGE' 1008 : IVAMOD(1)=IPGEOM 1009 : TYMODE(2)='MAILLAGE' 1010 : IVAMOD(2)=IBETON 1011 : ipgeom=ipgeo2 1012 : ENDIF 1013 : IF (LESFOR(1).EQ.'CONTACT'.AND.ifrtt.eq.1) then 1014 : ivamod(1)=ipgeo2 1015 : tymode(1)='MAILLAGE' 1016 : ENDIF 1017 : if(iraye.ne.0) then 1018 : if(icavit.ne.0) then 1019 : tymode(1)='ENTIER' 1020 : ivamod(1)=nbga 1021 : tymode(2)='ENTIER' 1022 : ivamod(2)=nbdang 1023 : if(isyme.eq.1) then 1024 : tymode(3 )='POINT' 1025 : tymode(4)='POINT' 1026 : if(idim.eq.3)tymode(5)='POINT' 1027 : ivamod(3 )=ipp1 1028 : ivamod(4)=ipp2 1029 : if(idim.eq.3)ivamod(5)=ipp3 1030 : endif 1031 : endif 1032 : if(ifacaf.ne.0) then 1033 : tymode(1)='MAILLAGE' 1034 : tymode(2)='MAILLAGE' 1035 : tymode(3)='MAILLAGE' 1036 : tymode(4)='MMODEL' 1037 : ivamod(1)=ipfac1 1038 : ivamod(2)=ipfac2 1039 : ivamod(3)=ipfac3 1040 : ivamod(4)=imoco 1041 : endif 1042 : endif 1043 : IF (LESFOR(1).EQ.'DIFFUSION') THEN 1044 : TYMODE(NOBDIF+1)=MDIINC 1045 : IVAMOD(NOBDIF+1)=LDINUM 1046 : TYMODE(NOBDIF+2)=MDIDUA 1047 : IVAMOD(NOBDIF+2)=LDINUM 1048 : IF (LDIPTR.GT.0) THEN 1049 : C*TMP Option non disponible pour l'instant 1050 : C*TMP -> en attente specification plus precise et portable (?) 1050 : CALL POSCHA(LDILIB(1:LDILGB)//'='//LDINOM,i_z) 1051 : TYMODE(NOBDIF+3)='LDIEXT ' 1052 : IVAMOD(NOBDIF+3)=LDIPTR 1053 : TYMODE(NOBDIF+4)='MOT ' 1054 : IVAMOD(NOBDIF+4)=i_z 1055 : ENDIF 1056 : ENDIF 1057 : IF (LMEEXT) THEN 1058 : IF (LMEPTR.GT.0) THEN 1058 : CALL POSCHA(LMELIB(1:LMELGB)//'='//LMENOM(1:16),i_z) 1059 : TYMODE(NOBMEC+1)='LMEEXT ' 1060 : IVAMOD(NOBMEC+1)=LMEPTR 1061 : TYMODE(NOBMEC+2)='MOT ' 1062 : IVAMOD(NOBMEC+2)=i_z 1063 : NOBMEC = NOBMEC + 2 1064 : ENDIF 1065 : IF (LMEVIX) THEN 1066 : LMEIVI = NOBMEC + 1 1067 : TYMODE(LMEIVI)='IVIEX ' 1068 : IVAMOD(LMEIVI)=0 1069 : ENDIF 1070 : ENDIF 1071 : 1072 : CONMOD=CONM 1073 : conmod(17:24)=PHAM 1074 : KMODEL(IM)=IMODEL 1075 : * kich liaison conditionelle 1076 : IF(LESFOR(1).EQ.'LIAISON'.AND.klcon.gt.0) THEN 1077 : do ilc = 1,klcon 1078 : mmode2 = mlicon(ilc) 1079 : segact mmode2 1080 : if (mmode2.kmodel(/1).gt.1) then 1081 : * liaison conditionnelle mal specifiee 1081 : call erreur(5) 1082 : segdes mmode2 1083 : return 1084 : endif 1085 : imode2 = mmode2.kmodel(1) 1086 : segact imode2 1087 : if (imode2.formod(1).ne.'LIAISON') THEN 1087 : call erreur(5) 1088 : segdes imode2,mmode2 1089 : return 1090 : endif 1091 : if (tlicon(ilc).eq.6) TYMODE(ilc)='CONDINFE' 1092 : if (tlicon(ilc).eq.7) TYMODE(ilc)='CONDSUPE' 1093 : IVAMOD(ilc)=IMODE2 1094 : segdes imode2,mmode2 1095 : enddo 1096 : segsup plicon 1097 : ENDIF 1098 : * fin liaison conditionnelle 1099 : IF (NSOU.EQ.0) THEN 1100 : ITYP1=ITYPEL 1101 : IMAMOD=IPGEOM 1102 : NBNN=NUM(/1) 1103 : ELSE 1104 : IPT1=LISOUS(IM) 1105 : SEGACT,IPT1 1106 : ITYP1=IPT1.ITYPEL 1107 : IMAMOD=IPT1 1108 : NBNN=IPT1.NUM(/1) 1109 : SEGDES,IPT1 1110 : ENDIF 1111 : if(ityp1.eq.48) then 1112 : NEFMOD=22 1113 : go to 11 1114 : endif 1115 : C Determination de la valeur de NEFMOD pour IMODEL zzzzzzzzzzzzzzzzzzz 1116 : C -------------------------------------------------- 1117 : C Affectation du type d'ELEMENTS FINIS si donnes par utilisateur 1118 : 1119 : IF (ITEF.NE.0) THEN 1120 : C Cas de la FORMULATION 'NAVIER_STOKES' 1121 : IF (LESFOR(1).EQ.'NAVIER_STOKES') THEN 1122 : IF (LESTEF(1).EQ.'LINE')THEN 1123 : NEFMOD=0 1124 : IF (ITYP1.EQ. 3) NEFMOD=129 1125 : IF (ITYP1.EQ. 7) NEFMOD=130 1126 : IF (ITYP1.EQ.11) NEFMOD=131 1127 : IF (ITYP1.EQ.33) NEFMOD=132 1128 : IF (ITYP1.EQ.34) NEFMOD=133 1129 : IF (ITYP1.EQ.35) NEFMOD=134 1130 : IF (ITYP1.EQ.36) NEFMOD=135 1131 : IF (NEFMOD.EQ.0) GOTO 99 1132 : ELSE IF(LESTEF(1).EQ.'MACR')THEN 1133 : NEFMOD=0 1134 : IF (ITYP1.EQ. 3) NEFMOD=136 1135 : IF (ITYP1.EQ. 7) NEFMOD=137 1136 : IF (ITYP1.EQ.11) NEFMOD=138 1137 : IF (ITYP1.EQ.33) NEFMOD=139 1138 : IF (ITYP1.EQ.34) NEFMOD=140 1139 : C IF (ITYP1.EQ.35) NEFMOD=141 1140 : C Il nous manque la pyramide 1141 : IF (NEFMOD.EQ.0) GOTO 99 1142 : ELSE IF (LESTEF(1).EQ.'QUAF') THEN 1143 : NEFMOD=0 1144 : IF (ITYP1.EQ. 3) NEFMOD=143 1145 : IF (ITYP1.EQ. 7) NEFMOD=144 1146 : IF (ITYP1.EQ.11) NEFMOD=145 1147 : IF (ITYP1.EQ.33) NEFMOD=146 1148 : IF (ITYP1.EQ.34) NEFMOD=147 1149 : IF (ITYP1.EQ.35) NEFMOD=148 1150 : IF (ITYP1.EQ.36) NEFMOD=149 1151 : C Il nous manque la pyramide 1152 : IF (NEFMOD.EQ.0) GO TO 99 1153 : ELSE IF (LESTEF(1).EQ.'LINB') THEN 1154 : NEFMOD=0 1155 : IF (ITYP1.EQ. 3) NEFMOD=158 1156 : IF (ITYP1.EQ. 7) NEFMOD=159 1157 : IF (ITYP1.EQ.11) NEFMOD=160 1158 : IF (ITYP1.EQ.33) NEFMOD=161 1159 : IF (ITYP1.EQ.34) NEFMOD=162 1160 : C IF (ITYP1.EQ.35) NEFMOD=163 1161 : C IF (ITYP1.EQ.36) NEFMOD=164 1162 : C Il nous manque la pyramide et le tetrahedre 1163 : IF (NEFMOD.EQ.0) GOTO 99 1164 : ELSE 1165 : DO i=1,ITEF 1165 : CALL PLACE(NOMTP,LNOMTP,MELE,LESTEF(i)) 1166 : IF (MELE.EQ.0) GOTO 99 1167 : MEGE=NUMGEO(MELE) 1168 : IF (MEGE.EQ.0) GOTO 99 1169 : IF (MEGE.EQ.ITYP1) GOTO 610 1170 : ENDDO 1171 : GO TO 99 1172 : 610 NEFMOD=MELE 1173 : ENDIF 1174 : C Cas de la FORMULATION 'EULER' 1175 : ELSE IF (LESFOR(1).EQ.'EULER') THEN 1176 : NEFMOD=0 1177 : IF (ITYP1.EQ. 2) NEFMOD=ITYP1 1178 : IF (ITYP1.EQ. 4) NEFMOD=ITYP1 1179 : IF (ITYP1.EQ. 8) NEFMOD=ITYP1 1180 : IF (ITYP1.EQ.14) NEFMOD=ITYP1 1181 : IF (ITYP1.EQ.16) NEFMOD=ITYP1 1182 : IF (ITYP1.EQ.23) NEFMOD=ITYP1 1183 : IF (ITYP1.EQ.25) NEFMOD=ITYP1 1184 : IF (NEFMOD.EQ.0) GOTO 99 1185 : C Cas des autres FORMULATIONs 1186 : ELSE 1187 : DO i=1,ITEF 1187 : CALL PLACE(NOMTP,LNOMTP,MELE,LESTEF(i)) 1188 : IF (MELE.EQ.0) GOTO 99 1189 : MEGE=NUMGEO(MELE) 1190 : IF (MEGE.EQ.0) GOTO 99 1191 : IF (MEGE.EQ.ITYP1) GOTO 6 1192 : do jma = 1, nmat 1193 : if (lespro(jma).eq.'IMPEDANCE') goto 6 1194 : enddo 1195 : ENDDO 1196 : GOTO 99 1197 : C Cas particulier pour les elements polygonaux 1198 : 6 IF (ITYP1.EQ.32) THEN 1199 : MELE=MELE+NBNN-3 1200 : IF (NBNN.GT.14) GOTO 99 1201 : ENDIF 1202 : NEFMOD=MELE 1203 : ENDIF 1204 : C Affectation des elements finis de maniere automatique 1205 : ELSE 1206 : C Cas des milieux POREUX 1207 : IF (LESFOR(1).EQ.'POREUX') THEN 1208 : NEFMOD=0 1209 : IF (ITYP1.EQ. 6) NEFMOD=79 1210 : IF (ITYP1.EQ.10) NEFMOD=80 1211 : IF (ITYP1.EQ.15) NEFMOD=81 1212 : IF (ITYP1.EQ.24) NEFMOD=82 1213 : IF (ITYP1.EQ.17) NEFMOD=83 1214 : IF (ITYP1.EQ.29) NEFMOD=108 1215 : IF (ITYP1.EQ.30) NEFMOD=109 1216 : IF (ITYP1.EQ.31) NEFMOD=110 1217 : IF (NEFMOD.EQ.0) GOTO 99 1218 : C Cas des elements de frottement (formulation FROTTEMENT) 1219 : ELSE IF (LESFOR(1).EQ.'CONTACT') THEN 1220 : ** NEFMOD=22 pv est passe par la 1221 : NEFMOD=0 1222 : if(ifrtt.eq.1) then 1223 : IF (ITYP1.EQ.22.AND.IDIM.EQ.2) NEFMOD=107 1224 : IF (ITYP1.EQ.22.AND.IDIM.EQ.3) NEFMOD=165 1225 : elseif(ifroca.ne.0) then 1226 : IF (ITYP1.EQ.22.AND.IDIM.EQ.2) NEFMOD=261 1227 : IF (ITYP1.EQ.22.AND.IDIM.EQ.3) NEFMOD=262 1228 : endif 1229 : * IF (NEFMOD.EQ.0) GOTO 99 1230 : C Cas des elements hybrides (imposes en DARCY) 1231 : ELSE IF (LESFOR(1).EQ.'DARCY') THEN 1232 : NEFMOD=0 1233 : IF (ITYP1.EQ. 3) NEFMOD=143 1234 : C IF (ITYP1.EQ. 4) NEFMOD=99 1235 : C IF (ITYP1.EQ. 8) NEFMOD=100 1236 : C IF (ITYP1.EQ.23) NEFMOD=101 1237 : C IF (ITYP1.EQ.16) NEFMOD=102 1238 : C IF (ITYP1.EQ.14) NEFMOD=103 1239 : IF (ITYP1.EQ. 7) NEFMOD=99 1240 : IF (ITYP1.EQ.11) NEFMOD=100 1241 : IF (ITYP1.EQ.35) NEFMOD=101 1242 : IF (ITYP1.EQ.34) NEFMOD=102 1243 : IF (ITYP1.EQ.33) NEFMOD=103 1244 : IF (NEFMOD.EQ.0) GOTO 99 1245 : C Cas de la formulation MAGNETODYNAMIQUE 1246 : ELSE IF (LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN 1247 : NEFMOD=0 1248 : IF (ITYP1.EQ. 4) NEFMOD=128 1249 : IF (NEFMOD.EQ.0) GOTO 99 1250 : C Cas de la formulation 'NAVIER_STOKES' 1251 : ELSE IF (LESFOR(1).EQ.'NAVIER_STOKES') THEN 1252 : IF (ILNAVI.EQ.0) THEN 1252 : CALL MESLIR(-341) 1253 : SEGSUP MMODEL 1254 : RETURN 1255 : ELSEIF (ILNAVI.EQ.1) THEN 1256 : C LICE 1257 : NEFMOD=0 1258 : IF (ITYP1.EQ. 3) NEFMOD=195 1259 : IF (ITYP1.EQ. 7) NEFMOD=196 1260 : IF (ITYP1.EQ.11) NEFMOD=197 1261 : IF (ITYP1.EQ.33) NEFMOD=198 1262 : IF (ITYP1.EQ.34) NEFMOD=199 1263 : IF (ITYP1.EQ.35) NEFMOD=200 1264 : IF (ITYP1.EQ.36) NEFMOD=201 1265 : IF (NEFMOD.EQ.0) GOTO 99 1266 : ELSEIF (ILNAVI.EQ.2) THEN 1267 : C LIMS 1268 : NEFMOD=0 1269 : IF (ITYP1.EQ. 3) NEFMOD=202 1270 : IF (ITYP1.EQ. 7) NEFMOD=203 1271 : IF (ITYP1.EQ.11) NEFMOD=204 1272 : IF (ITYP1.EQ.33) NEFMOD=205 1273 : IF (ITYP1.EQ.34) NEFMOD=206 1274 : IF (ITYP1.EQ.35) NEFMOD=207 1275 : IF (ITYP1.EQ.36) NEFMOD=208 1276 : IF (NEFMOD.EQ.0) GOTO 99 1277 : ELSEIF (ILNAVI.EQ.3) THEN 1278 : C LBMS 1279 : NEFMOD=0 1280 : IF (ITYP1.EQ. 3) NEFMOD=209 1281 : IF (ITYP1.EQ. 7) NEFMOD=210 1282 : IF (ITYP1.EQ.11) NEFMOD=211 1283 : IF (ITYP1.EQ.33) NEFMOD=212 1284 : IF (ITYP1.EQ.34) NEFMOD=213 1285 : IF (ITYP1.EQ.35) NEFMOD=214 1286 : IF (ITYP1.EQ.36) NEFMOD=215 1287 : IF (NEFMOD.EQ.0) GOTO 99 1288 : ELSEIF (ILNAVI.EQ.4) THEN 1289 : C MCCE 1290 : NEFMOD=0 1291 : IF (ITYP1.EQ. 3) NEFMOD=216 1292 : IF (ITYP1.EQ. 7) NEFMOD=217 1293 : IF (ITYP1.EQ.11) NEFMOD=218 1294 : IF (ITYP1.EQ.33) NEFMOD=219 1295 : IF (ITYP1.EQ.34) NEFMOD=220 1296 : IF (ITYP1.EQ.35) NEFMOD=221 1297 : IF (ITYP1.EQ.36) NEFMOD=222 1298 : IF (NEFMOD.EQ.0) GOTO 99 1299 : ELSEIF (ILNAVI.EQ.5) THEN 1300 : C MCP1 1301 : NEFMOD=0 1302 : IF (ITYP1.EQ. 3) NEFMOD=223 1303 : IF (ITYP1.EQ. 7) NEFMOD=224 1304 : IF (ITYP1.EQ.11) NEFMOD=225 1305 : IF (ITYP1.EQ.33) NEFMOD=226 1306 : IF (ITYP1.EQ.34) NEFMOD=227 1307 : IF (ITYP1.EQ.35) NEFMOD=228 1308 : IF (ITYP1.EQ.36) NEFMOD=229 1309 : IF (NEFMOD.EQ.0) GOTO 99 1310 : ELSEIF (ILNAVI.EQ.6) THEN 1311 : C MCMS 1312 : NEFMOD=0 1313 : IF (ITYP1.EQ. 3) NEFMOD=230 1314 : IF (ITYP1.EQ. 7) NEFMOD=231 1315 : IF (ITYP1.EQ.11) NEFMOD=232 1316 : IF (ITYP1.EQ.33) NEFMOD=233 1317 : IF (ITYP1.EQ.34) NEFMOD=234 1318 : IF (ITYP1.EQ.35) NEFMOD=235 1319 : IF (ITYP1.EQ.36) NEFMOD=236 1320 : IF (NEFMOD.EQ.0) GOTO 99 1321 : ELSEIF (ILNAVI.EQ.7) THEN 1322 : C QFCE 1323 : NEFMOD=0 1324 : IF (ITYP1.EQ. 3) NEFMOD=237 1325 : IF (ITYP1.EQ. 7) NEFMOD=238 1326 : IF (ITYP1.EQ.11) NEFMOD=239 1327 : IF (ITYP1.EQ.33) NEFMOD=240 1328 : IF (ITYP1.EQ.34) NEFMOD=241 1329 : IF (ITYP1.EQ.35) NEFMOD=242 1330 : IF (ITYP1.EQ.36) NEFMOD=243 1331 : IF (NEFMOD.EQ.0) GOTO 99 1332 : ELSEIF (ILNAVI.EQ.8) THEN 1333 : C QFP1 1334 : NEFMOD=0 1335 : IF (ITYP1.EQ. 3) NEFMOD=244 1336 : IF (ITYP1.EQ. 7) NEFMOD=245 1337 : IF (ITYP1.EQ.11) NEFMOD=246 1338 : IF (ITYP1.EQ.33) NEFMOD=247 1339 : IF (ITYP1.EQ.34) NEFMOD=248 1340 : IF (ITYP1.EQ.35) NEFMOD=249 1341 : IF (ITYP1.EQ.36) NEFMOD=250 1342 : IF (NEFMOD.EQ.0) GOTO 99 1343 : ELSEIF (ILNAVI.EQ.9) THEN 1344 : C QFMS 1345 : NEFMOD=0 1346 : IF (ITYP1.EQ. 3) NEFMOD=251 1347 : IF (ITYP1.EQ. 7) NEFMOD=252 1348 : IF (ITYP1.EQ.11) NEFMOD=253 1349 : IF (ITYP1.EQ.33) NEFMOD=254 1350 : IF (ITYP1.EQ.34) NEFMOD=255 1351 : IF (ITYP1.EQ.35) NEFMOD=256 1352 : IF (ITYP1.EQ.36) NEFMOD=257 1353 : IF (NEFMOD.EQ.0) GOTO 99 1354 : ENDIF 1355 : C Cas de la formulation 'EULER' 1356 : ELSE IF (LESFOR(1).EQ.'EULER') THEN 1357 : NEFMOD=0 1358 : IF (ITYP1.EQ. 2) NEFMOD=ITYP1 1359 : IF (ITYP1.EQ. 4) NEFMOD=ITYP1 1360 : IF (ITYP1.EQ. 8) NEFMOD=ITYP1 1361 : IF (ITYP1.EQ.14) NEFMOD=ITYP1 1362 : IF (ITYP1.EQ.16) NEFMOD=ITYP1 1363 : IF (ITYP1.EQ.23) NEFMOD=ITYP1 1364 : IF (ITYP1.EQ.25) NEFMOD=ITYP1 1365 : IF (NEFMOD.EQ.0) GOTO 99 1366 : C Cas des autres formulations 1367 : ELSE 1368 : NEFMOD=ITYP1 1369 : c kich cas du POI1 1370 : if (ityp1.eq.1) nefmod = 45 1371 : C Cas particuliers des elements polygonaux 1372 : IF (NEFMOD.EQ.32) NEFMOD=111+NBNN -3 1373 : C Cas particuliers des elements finis pour IDIM=1 1374 : IF (IDIM.EQ.1) THEN 1375 : NEFMOD=0 1376 : IF (LESFOR(1).EQ.'THERMIQUE') THEN 1377 : IF (iconv.NE.0 .OR. iraye.NE.0) THEN 1378 : IF (ITYP1.EQ.1) NEFMOD=45 1379 : IF (ITYP1.EQ.2) NEFMOD=ITYP1 1380 : ELSE 1381 : IF (ITYP1.EQ.2) NEFMOD=191 1382 : IF (ITYP1.EQ.3) NEFMOD=192 1383 : ENDIF 1384 : ELSE IF (LESFOR(1).EQ.'MECANIQUE') THEN 1385 : IF (ITYP1.EQ.2) NEFMOD=193 1386 : IF (ITYP1.EQ.3) NEFMOD=194 1387 : ELSE IF (LESFOR(1).EQ.'FISSURE') THEN 1388 : IF (ITYP1.EQ.2) NEFMOD=ITYP1 1389 : ELSE IF (LESFOR(1).EQ.'ELECTROSTATIQUE') THEN 1390 : IF (ITYP1.EQ.2) NEFMOD=193 1391 : IF (ITYP1.EQ.3) NEFMOD=194 1392 : ELSE IF (LESFOR(1).EQ.'DIFFUSION') THEN 1393 : IF (ITYP1.EQ.2) NEFMOD=193 1394 : IF (ITYP1.EQ.3) NEFMOD=194 1395 : ENDIF 1396 : ENDIF 1397 : IF (NEFMOD.EQ.0) GOTO 99 1398 : MELE=NEFMOD 1399 : ENDIF 1400 : ENDIF 1401 : * fin de le determination de NEFMOD zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz 1402 : C Poursuite du remplissage du IM-eme modele elementaire IMODEL 1403 : IF (NMAT.NE.0) THEN 1404 : IF (LESFOR(1).EQ.'MELANGE') THEN 1405 : MATMOD(1)=LESPRO(1) 1406 : ELSE 1407 : DO i=1,NMAT 1408 : MATMOD(i)=LESPRO(i) 1409 : ENDDO 1410 : ENDIF 1411 : ENDIF 1412 : DO i=1,NFOR 1413 : FORMOD(i)=LESFOR(i) 1414 : ENDDO 1415 : IF (MN3.NE.0) INFMOD(1)=NPINT 1416 : IF (NPINT.NE.0.AND.NEFMOD.NE.28) THEN 1417 : SEGSUP,IMODEL 1418 : SEGSUP,MMODEL 1418 : CALL ERREUR(608) 1419 : RETURN 1420 : ENDIF 1421 : C Point support pour les modes en defo. GENE (IFOUR=-3, 7 a 11, 14) 1422 : IPDPGE=IPTGEN 1423 : IF (NSDPGE.LT.IPDPGE) NSDPGE=IPDPGE 1424 : C Verification de l'existence du MMODEL 1424 : CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,IMATE,INATU) 1425 : IF (CMATE.EQ.' ') THEN 1426 : write(ioimp,*) ' petit probleme apres nomate' 1427 : SEGSUP,IMODEL 1428 : SEGSUP,MMODEL 1428 : CALL ERREUR(251) 1429 : RETURN 1430 : ENDIF 1431 : C* Petit cas particulier en cas de modele VISCO_EXTERNE : 1432 : C* On recupere IVIEX stocke dans INATU (cf. NOMATE) 1433 : IF (INATU.LE.-2) THEN 1434 : IVIEX = -2 - INATU 1435 : INATU = -2 1436 : C* TYMODE(LMEIVI)='IVIEX ' 1437 : IVAMOD(LMEIVI)= IVIEX 1438 : ENDIF 1439 : * 1440 : ideriv=jderiv 1441 : CMATEE=CMATE 1442 : IMATEE=IMATE 1443 : INATUU=INATU 1444 : * initialisation des nomid 1445 : IF (FORMOD(1).NE.'NAVIER_STOKES'.AND.FORMOD(1).NE.'EULER' 1446 : &.AND.formod(1).ne.'MELANGE') THEN 1447 : if (formod(1).EQ.'LIAISON') then 1448 : linomid=.false. 1449 : else 1450 : linomid=.true. 1451 : do jn = 1,matmod(/2) 1452 : if (matmod(jn).eq.'MODAL'.or.matmod(jn).eq.'STATIQUE' 1453 : & .or.matmod(jn).eq.'IMPEDANCE') 1454 : & linomid =.false. 1455 : enddo 1456 : endif 1457 : if (linomid) then 1457 : call inomid(imodel,' ',iret,lucvar,lucmat,lucmaf,luparx) 1458 : endif 1459 : ELSE 1460 : linomid=.true. 1461 : ENDIF 1462 : C Quelques tests supplementaires en attendant mieux 1463 : IF(LESFOR(1).EQ.'THERMIQUE') THEN 1464 : IF(MATMOD(/2).GE.2)THEN 1464 : call place(MATMOD,MATMOD(/2),IPLAZ,'PHASE') 1465 : IF(iplaz.ne.0 ) THEN 1466 : c test que les elements sont lineaires 1467 : ipt4=imamod 1468 : segact ipt4 1469 : itt=ipt4.itypel 1470 : if(kdegre(itt) .gt. 2) then 1470 : call erreur(982) 1471 : return 1472 : endif 1473 : endif 1474 : endif 1475 : endif 1476 : IF (LESFOR(1).EQ.'MECANIQUE') THEN 1477 : C Cas du materiau unidirectionnel 1478 : IF (IMATE.EQ.4) THEN 1479 : MFR=NUMMFR(NEFMOD) 1480 : C Cas des cerces : sans interet ! 1481 : IF (MFR.EQ.27) THEN 1482 : SEGSUP,IMODEL 1483 : SEGSUP,MMODEL 1483 : CALL ERREUR(251) 1484 : RETURN 1485 : ENDIF 1486 : C Cas de la plasticite 1487 : IF (INATU.NE.0) THEN 1488 : C OK si massif bidim ou si coque tridim dans le cas acier_uni 1489 : IF (INATU.EQ.40)THEN 1490 : IF ((MFR.NE.1.OR.IFOUR.GT.0).AND. 1491 : . ((MFR.NE.3.AND.MFR.NE.9).OR.IFOUR.NE.2)) THEN 1492 : SEGSUP IMODEL 1493 : SEGSUP MMODEL 1493 : CALL ERREUR(251) 1494 : RETURN 1495 : ENDIF 1496 : C Dans les autres cas, on n'autorise pour le moment que COQ2 et massif 1497 : ELSE IF (MELE.NE.44.AND.MFR.NE.1) THEN 1498 : SEGSUP IMODEL 1499 : SEGSUP MMODEL 1499 : CALL ERREUR(251) 1500 : RETURN 1501 : ENDIF 1502 : ENDIF 1503 : ENDIF 1504 : * 1505 : * Cas du materiau 'ZONE_COHESIVE' 1506 : IF (IMATE.EQ.12) THEN 1507 : MFR=NUMMFR(NEFMOD) 1508 : IF (MFR.NE.77) THEN 1509 : SEGSUP,IMODEL 1510 : SEGSUP,MMODEL 1510 : CALL ERREUR(251) 1511 : RETURN 1512 : ENDIF 1513 : ENDIF 1514 : 1515 : C Cas du modele section : on n'autorise pour le moment que TIMO 1516 : IF (CMATE.EQ.'SECTION'.AND.MELE.NE.84) THEN 1517 : SEGSUP,IMODEL 1518 : SEGSUP,MMODEL 1518 : CALL ERREUR(251) 1519 : RETURN 1520 : ENDIF 1521 : ENDIF 1522 : C Le modele de GURSON n'est possible qu'en 3D, axisymetrique ou 1523 : C deformations planes 1524 : IF (INATU.EQ.38) THEN 1525 : IF ( (IFOUR.NE.0).AND.(IFOUR.NE.2).AND.(IFOUR.NE.-1) ) THEN 1526 : SEGSUP,IMODEL 1527 : SEGSUP,MMODEL 1528 : MOTERR(1:8)='GURSON' 1529 : MOTERR(9:16)='MECANIQU' 1530 : INTERR(1) = IFOUR 1530 : CALL ERREUR (81) 1531 : RETURN 1532 : ENDIF 1533 : ENDIF 1534 : 1535 : C Le modele ISS_GRANGE n'est utilisable qu'en 3D 1536 : IF ((INATU.EQ.151).AND.(IFOUR.NE.2)) THEN 1537 : SEGSUP,IMODEL 1538 : SEGSUP,MMODEL 1539 : INTERR(1) = IFOUR 1539 : CALL ERREUR (709) 1540 : RETURN 1541 : ENDIF 1542 : C Le modele RUP_THER n'est utilisable qu'en 3D 1543 : IF ((INATU.EQ.152).AND.(IFOUR.NE.2)) THEN 1544 : SEGSUP,IMODEL 1545 : SEGSUP,MMODEL 1546 : INTERR(1) = IFOUR 1546 : CALL ERREUR (709) 1547 : RETURN 1548 : ENDIF 1549 : C Le modele COULOMB n'est utilisable qu'en 3D avec les éléments JOI1 1550 : IF ((INATU.EQ.34).AND.(IFOUR.NE.2) 1551 : . .AND.(NUMMFR(NEFMOD).EQ.75)) THEN 1552 : SEGSUP,IMODEL 1553 : SEGSUP,MMODEL 1554 : INTERR(1) = IFOUR 1554 : CALL ERREUR (709) 1555 : RETURN 1556 : ENDIF 1557 : C.. Restrictions en formulation 'MECANIQUE' avec une loi de 1558 : C comportement non lineaire externe 1559 : C Rappel : LMEEXT exprime la condition (NFOR.EQ.1) ET 1560 : C (LESFOR(1).EQ.'MECANIQUE') ET (loi non lineaire externe) 1561 : IF ( LMEEXT ) THEN 1562 : C En formulation 'MECANIQUE', les lois non lineaires externes 1563 : C n'autorisent qu'une seule composante de temperature 1564 : C => incompatibilite avec des modeles de coques n'ayant pas 1565 : C de points d'integration dans l'epaisseur (trois composantes 1566 : C dans ce cas, 'TINF', 'T ' et 'TSUP') 1567 : C Le test ci-dessous est coherent avec celui de IDTEMP. 1568 : MFR = NUMMFR(NEFMOD) 1569 : IF ( (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9).AND. 1570 : . (NPINT.EQ.0) ) THEN 1571 : SEGSUP IMODEL 1572 : SEGSUP MMODEL 1572 : CALL ERREUR(951) 1573 : RETURN 1574 : ENDIF 1575 : C Les lois de la famille 'VISCO_EXTERNE' ne s'appliquent pour 1576 : C l'instant qu'aux elements massifs, avec option de calcul 3D 1577 : C Et restriction pour l'instant a 'VISCO_EXTERNE' 'GENERAL' 1578 : IF ( LMEVIX ) THEN 1579 : IF ((MFR.NE.1.AND.MFR.NE.31) .OR. IFOUR.NE.2) THEN 1580 : KERRE = 950 1581 : ELSE IF ( IVIEX.NE.1 ) THEN 1582 : KERRE = 958 1583 : ELSE 1584 : KERRE = 0 1585 : ENDIF 1586 : IF (KERRE.NE.0) THEN 1587 : SEGSUP IMODEL 1588 : SEGSUP MMODEL 1588 : CALL ERREUR(KERRE) 1589 : RETURN 1590 : ENDIF 1591 : ENDIF 1592 : ENDIF 1593 : C Formulation 'CONVECTION' 1594 : C Adequation EF de type COQue et mot 'INFERIEURE' / 'SUPERIEURE' 1595 : IF (LESFOR(1).EQ.'CONVECTION') THEN 1596 : IF (NMAT.NE.0.AND.NEFMOD.NE.27.AND.NEFMOD.NE.41.AND. 1597 : . NEFMOD.NE.44.AND.NEFMOD.NE.49.AND.NEFMOD.NE.56) THEN 1598 : SEGSUP,IMODEL 1599 : SEGSUP,MMODEL 1599 : CALL ERREUR(16) 1600 : RETURN 1601 : ENDIF 1602 : IF (NMAT.EQ.0.AND.(NEFMOD.EQ.27.OR.NEFMOD.EQ.41.OR. 1603 : . NEFMOD.EQ.44.OR.NEFMOD.EQ.49.OR.NEFMOD.EQ.56)) THEN 1604 : SEGSUP,IMODEL 1605 : SEGSUP,MMODEL 1605 : CALL ERREUR(513) 1606 : RETURN 1607 : ENDIF 1608 : ENDIF 1609 : C Formulation 'DIFFUSION' - Modele UTILISATEUR : 1610 : C Verification que les composantes "lineaires" sont declarees 1611 : IF (LESFOR(1) .EQ. 'DIFFUSION' .AND. LDIEXT) THEN 1611 : CALL IDDILI(IMATE,0, MOCOMP,NBROBL,NBRFAC) 1612 : MLMOTS = MOCOMP 1613 : MLMOT1 = lucmat 1614 : SEGACT,MLMOT1 1615 : NBCOMP = MLMOT1.MOTS(/2) 1616 : ICOMP = 0 1617 : DO i = 1, NBROBL 1617 : CALL PLACE(MLMOT1.MOTS,NBCOMP,IPLAC,MOTS(i)) 1618 : IF (IPLAC.EQ.0) THEN 1619 : WRITE(IOIMP,80) MOTS(i) 1620 : 80 FORMAT('La composante obligatoire ',A8,' est absente') 1621 : ELSE 1622 : ICOMP = ICOMP+1 1623 : ENDIF 1624 : ENDDO 1625 : SEGDES,MLMOT1 1626 : SEGSUP,MLMOTS 1627 : IF (ICOMP.NE.NBROBL) THEN 1627 : CALL ERREUR(21) 1628 : RETURN 1629 : ENDIF 1630 : ENDIF 1631 : C Petite verification (a priori sans probleme) 1632 : IF (LESFOR(1) .EQ. 'DIFFUSION' .OR. 1633 : & LESFOR(1) .EQ. 'ELECTROSTATIQUE') THEN 1634 : MFR1 = NUMMFR(nefmod) 1635 : IF (MFR1.NE.1) THEN 1635 : CALL ERREUR(21) 1636 : RETURN 1637 : ENDIF 1638 : ENDIF 1639 : *kich 1640 : 11 CONTINUE 1641 : * initialisation du infele et des segment d'integration 1642 : IF (LESFOR(1).EQ.'MECANIQUE' .OR. LESFOR(1).EQ.'POREUX'.OR. 1643 : $ LESFOR(1).EQ.'LIQUIDE' .OR. LESFOR(1).EQ.'DIFFUSION' .OR. 1644 : $ LESFOR(1).EQ.'ELECTROSTATIQUE' .OR. 1645 : $ NFOR.EQ.2 ) THEN 1646 : infele(2)=npint 1647 : infele(3)=ngmas 1648 : infele(4)=ngcon 1649 : infele(6)=ngrig 1649 : call prquoi (imodel) 1650 : endif 1651 : * initialisation des nomid (cas particuliers) 1652 : if (.not.linomid) then 1653 : if (irmot1.eq.1) then 1654 : mlmot5 = jlmot1 1655 : mlmot6 = jlmot2 1656 : segact mlmot5,mlmot6 1656 : if (mlmot5.mots(/2).ne.mlmot6.mots(/2)) call erreur(26) 1657 : lucvar = jlmot1 1658 : lucmat = jlmot2 1659 : nobmod = 2 1660 : segadj imodel 1661 : ivamod(1) = jlmot1 1662 : ivamod(2) = jlmot2 1663 : tymode(1) = 'LISTMOTS' 1664 : tymode(2) = 'LISTMOTS' 1665 : endif 1665 : call prquoi (imodel) 1665 : call inomid(imodel,' ',iret,lucvar,lucmat,lucmaf,luparx) 1666 : endif 1667 : *kich 1668 : C Verification de non redondance des nom des composantes 1669 : C sauf pour les formulations Navier_Stokes et Euler 1670 : IF (FORMOD(1).NE.'NAVIER_STOKES'.AND.FORMOD(1).NE.'EULER') THEN 1671 : ipmo=imodel 1672 : mfr1=NUMMFR(nefmod) 1673 : mfr2 = infele(13) 1673 : CALL cotemo(ipmo,mfr2) 1674 : IF (IERR.NE.0) RETURN 1675 : ENDIF 1676 : IF (IM.EQ.1) MFRTMP=mfr1 1677 : 1678 : SEGDES,IMODEL 1679 : 10 CONTINUE 1680 : ***************************************************** 1681 : * fin de boucle sur les sous-parties du maillages 1682 : ************************************************** 1683 : C maillage non conforme bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb 1684 : C ** On cree les multiplicateurs de Lagrange 1685 : IF (MELEME.LISOUS(/1).EQ.0) GOTO 66 1686 : IF (ICONFO.EQ.0) GOTO 66 1687 : NBLIS=MELEME.LISOUS(/1) 1688 : LDEPL=0 1689 : IADEPL=0 1690 : IF (NFOR.EQ.1) THEN 1691 : IF (LESFOR(1).EQ.'MECANIQUE') THEN 1692 : IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-3) THEN 1693 : LDEPL=2 1694 : IADEPL=0 1695 : ELSE IF (IFOUR.EQ.0) THEN 1696 : LDEPL=2 1697 : IADEPL=3 1698 : ELSE IF (IFOUR.EQ.1) THEN 1699 : LDEPL=3 1700 : IADEPL=3 1701 : ELSE IF (IFOUR.EQ.2) THEN 1702 : LDEPL=3 1703 : IADEPL=0 1704 : ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN 1705 : IF (IFOUR.LE.6) THEN 1706 : LDEPL=1 1707 : IADEPL=0 1708 : ELSE IF (IFOUR.GE.7.AND.IFOUR.LE.10) THEN 1709 : LDEPL=2 1710 : IADEPL=0 1711 : IF (IFOUR.EQ.9.OR.IFOUR.EQ.10) ISPE1D=1 1712 : ELSE IF (IFOUR.EQ.11) THEN 1713 : LDEPL=3 1714 : IADEPL=0 1715 : ELSE IF (IFOUR.EQ.15) THEN 1716 : LDEPL=2 1717 : IADEPL=3 1718 : ELSE 1719 : LDEPL=1 1720 : IADEPL=3 1721 : ENDIF 1722 : ENDIF 1723 : ELSE IF(LESFOR(1).EQ.'LIQUIDE') THEN 1724 : LDEPL=2 1725 : IADEPL=6 1726 : ELSE IF(LESFOR(1).EQ.'THERMIQUE') THEN 1727 : LDEPL= 1 1728 : IADEPL=8 1729 : ELSE IF(LESFOR(1).EQ.'DARCY') THEN 1730 : LDEPL= 1 1731 : IADEPL=9 1732 : ELSE IF (LESFOR(1).EQ.'ELECTROSTATIQUE') THEN 1733 : LDEPL= 1 1734 : IADEPL= 10 1735 : ELSE IF (LESFOR(1).EQ.'DIFFUSION') THEN 1736 : LDEPL= 1 1737 : IADEPL=-1 1738 : ELSE 1739 : LDEPL=0 1740 : IADEPL=0 1741 : ENDIF 1742 : ENDIF 1743 : 1744 : NBMULT=LDEPL 1745 : N1=MAX(1,MELEME.LISOUS(/1))+ICONFO*(NBMULT-1) 1746 : MMODEL=IPMODE 1747 : SEGADJ MMODEL 1748 : INDIC=MMODEL.KMODEL(/1) 1749 : KNBPT=0 1750 : DO 13 INB=1,MELEME.LISOUS(/1) 1751 : IPT2=MELEME.LISOUS(INB) 1752 : SEGACT IPT2 1753 : IF (IPT2.ITYPEL.NE.48) GOTO 13 1754 : KNBPT=KNBPT+IPT2.NUM(/2) 1755 : DO 15 K=1,NBMULT 1756 : NBNN=IPT2.NUM(/1)+1 1757 : NBELEM=IPT2.NUM(/2) 1758 : NBSOUS=0 1759 : NBREF=0 1760 : SEGINI IPT3 1761 : IPT3.ITYPEL=22 1762 : DO 14 J=1,IPT2.NUM(/2) 1763 : ipt3.icolor(j)=ipt2.icolor(j) 1764 : DO 14 I=1,IPT2.NUM(/1) 1765 : IPT3.NUM(I+1,J)=IPT2.NUM(I,J) 1766 : 14 CONTINUE 1767 : MN3=1 1768 : NFOR=1 1769 : NMAT=0 1770 : NOBMOD=0 1771 : Nbrobl=1 1772 : NBRFAC=0 1773 : SEGINI NOMID 1774 : IF (IADEPL.GE.0) THEN 1775 : LESOBL(1)=MODEPL(IADEPL+K) 1776 : ELSE 1777 : LESOBL(1)=MDIINC 1778 : ENDIF 1779 : SEGDES NOMID 1780 : SEGINI IMODE5 1781 : SEGACT MMODEL*MOD 1782 : IMODE5.CONMOD=CONM 1783 : IMODE5.IMAMOD=IPT3 1784 : IMODE5.NEFMOD=22 1785 : IMODE5.INFMOD=MFRTMP 1786 : IMODE5.conmod(17:24)=' ' 1787 : IMODE5.LNOMID(1)=NOMID 1788 : IMODE5.FORMOD(1)=LESFOR(1) 1789 : IF (K.NE.1) THEN 1790 : MMODEL.KMODEL(INDIC)=IMODE5 1791 : INDIC=INDIC-1 1792 : ELSE 1793 : MMODEL.KMODEL(INB)=IMODE5 1794 : ENDIF 1795 : SEGDES IMODE5 1796 : 15 CONTINUE 1797 : 13 CONTINUE 1798 : C ** 1799 : NBPT1=XCOOR(/1)/(IDIM+1) 1800 : NBPTS=NBPT1+KNBPT*NBMULT 1801 : SEGADJ MCOORD 1802 : DO 65 K=1,MMODEL.KMODEL(/1) 1803 : IMODE5=MMODEL.KMODEL(K) 1804 : SEGACT IMODE5*MOD,MMODEL*MOD 1805 : IF (IMODE5.NEFMOD.NE.22 ) GOTO 65 1806 : IPT3=IMODE5.IMAMOD 1807 : NBLI=IPT3.NUM(/1) 1808 : SEGACT IPT3*MOD 1809 : DO 67 I=1,IPT3.NUM(/2) 1810 : NGLOB=(NBPT1+I-1)*(IDIM+1) 1811 : XCOOR(NGLOB+1)=XCOOR((IPT3.NUM(NBLI,I)-1)*(IDIM+1)+1) 1812 : XCOOR(NGLOB+2)=XCOOR((IPT3.NUM(NBLI,I)-1)*(IDIM+1)+2) 1813 : IPT3.NUM(1,I)=NBPT1+I 1814 : 67 CONTINUE 1815 : IMODE5.IMAMOD=IPT3 1816 : MMODEL.KMODEL(K)=IMODE5 1817 : NBPT1=NBPT1+IPT3.NUM(/2) 1818 : C SEGDES IMODE5,IPT3 1819 : 65 CONTINUE 1820 : C SEGDES MMODEL 1821 : *** fin maillage non conformes bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb 1822 : 66 CONTINUE 1823 : DO 68 K=1,MMODEL.KMODEL(/1) 1824 : IMODE5=MMODEL.KMODEL(K) 1825 : SEGACT IMODE5 1826 : IF (IMODE5.NEFMOD.NE.22 ) GOTO 68 1827 : IPT3=IMODE5.IMAMOD 1828 : SEGACT IPT3 1829 : 68 CONTINUE 1830 : IPMODE=MMODEL 1831 : C construction modeles elementaires pour MELANGE cccccccccccccc 1832 : C une loi de melange pointe sur des modeles 1833 : C elementaires de meme support 1834 : lomela = .true. 1835 : IF (LESFOR(1).eq.'MELANGE') THEN 1836 : segini limode 1837 : do 500 ilm = 1,NMAT1 1838 : IF (LESMOD(ilm).GT.0) THEN 1839 : n1 = nsou1 1840 : segini mmode2 1841 : WRITE(CONM,FMT='(I16)') mmode2 1842 : segsup mmode2 1843 : do 511 im = 1,nsou1 1844 : imodel = kmodel(im) 1845 : IF (ilm.eq.1) THEN 1846 : segact imodel*mod 1847 : nmat = 1 1848 : mn3 = infmod(/1) 1849 : nfor = 1 1850 : nobmod = ivamod(/1) 1851 : segadj imodel 1852 : ELSE 1853 : segact imodel 1854 : MN3 = infmod(/1) 1855 : NFOR = 1 1856 : NMAT = 1 1857 : NOBMOD = 0 1858 : segini imode2 1859 : imode2.imamod = imamod 1860 : imode2.nefmod = nefmod 1861 : if (mn3.gt.0) then 1862 : do imm = 1,mn3 1863 : imode2.infmod(imm) = infmod(imm) 1864 : enddo 1865 : endif 1866 : imode2.formod(1) = 'MELANGE' 1867 : imode2.IPDPGE = IPDPGE 1868 : imode2.conmod = conm 1869 : imode2.conmod(17:24) = pham 1870 : imodel = imode2 1871 : limode(**) = imodel 1872 : matmod(1) = lespro(ilm) 1873 : ENDIF 1874 : c lmomat = 0 1875 : c lmovar = 0 1876 : MMODE1 = LESMOD(ilm) 1877 : SEGACT MMODE1 1878 : kbmod = ivamod(/1) 1879 : nobmod = kbmod + MMODE1.KMODEL(/1) 1880 : segadj imodel 1881 : DO 515 im1 = 1,MMODE1.KMODEL(/1) 1882 : imode1 = mmode1.kmodel(im1) 1883 : segact imode1 1884 : mfo1 = imode1.formod(/2) 1885 : mma1 = imode1.matmod(/2) 1886 : if (imode1.conmod(17:24).eq.' ') then 1887 : write(ioimp,*) 'pas de nom de phase pour MELANGE ' 1888 : lomela = .false. 1889 : endif 1890 : IF (imodel.imamod.eq.imode1.imamod) THEN 1891 : * quelques verifs 1892 : if (matmod(1).eq.'SERIE'.and.im1.gt.1) then 1893 : do im2 = 1,MMODE1.KMODEL(/1) 1894 : imode2 = mmode1.kmodel(im2) 1895 : segact imode2 1896 : mfo2 = imode2.formod(/2) 1897 : mma2 = imode2.matmod(/2) 1898 : if (mfo1.eq.mfo2.and.imode1.formod(mfo1).eq.imode2.formod(mfo2)) 1899 : & then 1900 : ** pas de phase identique dans la meme fomulation 1901 : ** if (imode1.conmod(17:24).eq.imode2.conmod(17:24)) lomela =.false. 1902 : if (mma1.ne.mma2.OR. 1903 : & imode1.matmod(mma1).ne.imode2.matmod(mma2)) lomela = .false. 1904 : 1905 : endif 1906 : enddo 1907 : endif 1908 : IF (.NOT.lomela) THEN 1909 : **** detruire 1910 : 509 do imu = 1,kmodel(/1) 1911 : imodel = kmodel(imu) 1912 : segsup imodel 1913 : enddo 1914 : segsup mmodel 1915 : do imu1 = 1,MMODE1.KMODEL(/1) 1916 : IMODE1 = MMODE1.KMODEL(imu1) 1917 : segdes imode1 1918 : enddo 1919 : segdes mmode1 1919 : call erreur(251) 1920 : return 1921 : ENDIF 1922 : **** 1923 : kbmod = kbmod + 1 1924 : tymode(kbmod) = 'IMODEL' 1925 : ivamod(kbmod) = imode1 1926 : ENDIF 1927 : 515 CONTINUE 1928 : 1929 : nobmod = kbmod 1930 : segadj imodel 1931 : MFR = NUMMFR(NEFMOD) 1931 : CALL IDMATR(MFR,IMODEL,IPNOMC,NOBL,NFAC) 1932 : segdes imodel 1933 : 511 continue 1934 : do 503 im1 = 1,MMODE1.KMODEL(/1) 1935 : IMODE1 = MMODE1.KMODEL(im1) 1936 : segdes imode1 1937 : 503 continue 1938 : segdes mmode1 1939 : ELSE 1940 : do im = 1,nsou1 1941 : imodel = kmodel(im) 1942 : segact imodel*mod 1943 : nmat = 1 1944 : segadj imodel 1945 : enddo 1946 : ENDIF 1947 : 500 continue 1948 : n1i = kmodel(/1) 1949 : N1 = kmodel(/1) + limode(/1) 1950 : segadj mmodel 1951 : do 502 is = 1,limode(/1) 1952 : kmodel(n1i + is) = limode(is) 1953 : 502 continue 1954 : segsup limode 1955 : ENDIF 1956 : C fin des lois melanges ccccccccccccccccccccccccccccccccccccccccccccc 1957 : * 1958 : * traitement si en entree des modèles 1959 : 70 CONTINUE 1960 : IF (iremod.gt.0) THEN 1961 : do im = 1,kmodel(/1) 1962 : imodel = kmodel(im) 1963 : segact imodel*mod 1964 : if (CONM.NE.' ') conmod = CONM 1965 : if (PHAM.NE.' ') conmod(17:24) = PHAM 1966 : if (IPTGEN.GT.0) IPDPGE=IPTGEN 1967 : if (NPINT.GT.0) write(ioimp,*) 'ne change pas le nb pts inte' 1968 : segdes imodel 1969 : enddo 1970 : ENDIF 1971 : C en cas de modele STAT ddddddddddddddddddddddddddddddddddddddddddd 1972 : C cas du mot cle STAT : pointer le modele elementaire approprie 1973 : 1974 : IF (ipmod1.gt.0) THEN 1975 : MMODE1 = ipmod1 1976 : SEGACT MMODE1 1977 : DO im1 = 1,MMODE1.KMODEL(/1) 1978 : IMODE1 = MMODE1.KMODEL(im1) 1979 : segact imode1 1980 : ENDDO 1981 : DO im = 1,kmodel(/1) 1982 : imodel = kmodel(im) 1983 : segact imodel*mod 1984 : nobmod = ivamod(/1) 1985 : nobmod = nobmod + 1 1986 : nfor = formod(/2) 1987 : nmat = matmod(/2) 1988 : mn3 = infmod(/1) 1989 : segadj imodel 1990 : kbmod = 0 1991 : do im1 = 1,MMODE1.KMODEL(/1) 1992 : imode1 = mmode1.kmodel(im1) 1993 : imomo = imode1 1994 : lostat = .true. 1995 : * criteres de verif assez faibles ... 1996 : if (imode1.nefmod.eq.nefmod.and. 1997 : & imode1.imamod.ne.imamod.and. 1998 : & imode1.matmod(/2).eq.matmod(/2).and. 1999 : & imode1.formod(/2).eq.formod(/2)) then 2000 : do lmo = 1,formod(/2) 2001 : if (formod(lmo).ne.imode1.formod(lmo)) lostat = .false. 2002 : enddo 2003 : do lmo = 1,matmod(/2) 2004 : if (matmod(lmo).ne.imode1.matmod(lmo)) lostat = .false. 2005 : enddo 2006 : else 2007 : lostat = .false. 2008 : endif 2009 : if (lostat.and.formod(1).eq.'MELANGE') then 2010 : * verifs supplementaires : les modeles de ivamod sont ils bien construi 2011 : lomela = .true. 2012 : if ((nobmod - imode1.ivamod(/1)).gt.1) lomela = .false. 2013 : if (imode1.ivamod(/1).gt.0) then 2014 : do ivm3 = 1,imode1.ivamod(/1) 2015 : IF(imode1.tymode(ivm3).eq.'IMODEL') THEN 2016 : imode3 = imode1.ivamod(ivm3) 2017 : segact imode3 2018 : ENDIF 2019 : enddo 2020 : endif 2021 : IF (nobmod.gt.1) THEN 2022 : do ivm1 = 1,(nobmod-1) 2023 : imode2 = ivamod(ivm1) 2024 : segact imode2 2025 : cc 2026 : if (imode2.ivamod(/1).ge.1) then 2027 : do ivm2 = 1,imode2.ivamod(/1) 2028 : if (imode2.tymode(ivm2).eq.'STATIO') then 2029 : imode4 = imode2.ivamod(ivm2) 2030 : segact imode4 2031 : if (imode1.ivamod(/1).ge.1) then 2032 : do ivm3 = 1,imode1.ivamod(/1) 2033 : IF(imode1.tymode(ivm3).eq.'IMODEL') THEN 2034 : imode3 = imode1.ivamod(ivm3) 2035 : cc 2036 : lostat = .true. 2037 : * criteres de verif assez faibles ... 2038 : if (imode3.nefmod.eq.imode4.nefmod.and. 2039 : & imode3.imamod.eq.imode4.imamod.and. 2040 : & imode3.matmod(/2).eq.imode4.matmod(/2).and. 2041 : & imode3.conmod(17:24).eq.imode4.conmod(17:24).and. 2042 : & imode3.formod(/2).eq.imode4.formod(/2)) then 2043 : do lmo = 1,imode4.formod(/2) 2044 : if (imode4.formod(lmo).ne.imode3.formod(lmo)) lostat = .false. 2045 : enddo 2046 : do lmo = 1,imode4.matmod(/2) 2047 : if (imode4.matmod(lmo).ne.imode3.matmod(lmo)) lostat = .false. 2048 : enddo 2049 : else 2050 : lostat = .false. 2051 : endif 2052 : if (lostat) then 2053 : segdes imode4 2054 : goto 75 2055 : endif 2056 : cc 2057 : ENDIF 2058 : enddo 2059 : else 2060 : lostat = .false. 2061 : endif 2062 : endif 2063 : segdes imode4 2064 : enddo 2065 : * 2066 : else 2067 : lomela = .false. 2068 : endif 2069 : 75 lomela = lomela.and.lostat 2070 : segdes imode2 2071 : enddo 2072 : ENDIF 2073 : lostat = lomela 2074 : do ivm3 = 1,imode1.ivamod(/1) 2075 : c imode1 = imomo 2076 : IF(imode1.tymode(ivm3).eq.'IMODEL') THEN 2077 : imode3 = imode1.ivamod(ivm3) 2078 : segdes imode3 2079 : ENDIF 2080 : enddo 2081 : endif 2082 : if (lostat) then 2083 : kbmod = kbmod + 1 2084 : tymode(nobmod) = 'STATIO' 2085 : ivamod(nobmod) = imomo 2086 : goto 79 2087 : endif 2088 : enddo 2089 : **** ca se passe mal 2090 : if (kbmod.ne.1) then 2091 : do imu = 1,kmodel(/1) 2092 : imodel = kmodel(imu) 2093 : segsup imodel 2094 : enddo 2095 : segsup mmodel 2096 : do im1 = 1,MMODE1.KMODEL(/1) 2097 : IMODE1 = MMODE1.KMODEL(im1) 2098 : segdes imode1 2099 : enddo 2100 : segdes mmode1 2101 : write(ioimp,*) ' STATIO EN DEFAUT voir notice ' 2101 : call erreur(251) 2102 : return 2103 : endif 2104 : **** 2105 : 79 segdes imodel 2106 : ENDDO 2107 : DO im1 = 1,MMODE1.KMODEL(/1) 2108 : IMODE1 = MMODE1.KMODEL(im1) 2109 : segdes imode1 2110 : ENDDO 2111 : SEGDES MMODE1 2112 : ENDIF 2113 : * fin du modele STAT ddddddddddddddddddddddddddddddddddddddddddddddd 2114 : 2115 : IF (IPGEOM.NE.0) SEGDES,MELEME 2116 : C Ecriture de l'objet MODELE cree 2117 : SEGDES,MMODEL 2117 : CALL ECROBJ('MMODEL',IPMODE) 2118 : RETURN 2119 : 2120 : C Traitement des ERREURS 2120 : 99 CALL ERREUR(21) 2121 : IF (IPGEOM.NE.0) SEGDES,MELEME 2122 : SEGSUP,MMODEL 2123 : RETURN 2124 : END 2125 : 2126 :
© Cast3M 2003 - All rights reserved.
Disclaimer