C MODELI SOURCE FANDEUR 14/01/22 21:15:10 7891 C----------------------------------------------------------------------C C OPERATEUR MODELE C C C C Creation d'un objet MODELE C C C C Syntaxe : MOD1 = MODL GEO1 TYPE_CAL TYPE_MAT ( TYPE_ELE ) ; C C C C GEO1 MAILLAGE de base C C TYPE_CAL MOT(S) pour definir la FORMULATION C C TYPE_MAT MOT(S) pour definir le MATERIAU C C TYPE_ELE MOT(S) pour definir les ELEMENTS FINIS a utiliser C C MOD1 Resultat de type MODELE C C----------------------------------------------------------------------C C PPU : Modif pour les materiaux unidirectionels en plasticite SUBROUTINE MODELI IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC CCOPTIO -INC CCHAMP -INC SMELEME -INC SMMODEL POINTEUR IMODE3.IMODEL,IMODE4.IMODEL,IMODE5.IMODEL -INC SMTABLE -INC SMLMOTS -INC SMCOORD -INC CCGEOME POINTEUR NOMID1.NOMID SEGMENT ilmora integer LIMORA(100) endsegment SEGMENT LIMODE(0) SEGMENT PLICON integer mlicon(NLCON),tlicon(NLCON) ENDSEGMENT EXTERNAL LONG PARAMETER (NBFORM=15,NBCON=7,NBEXT=6,NBDIF=1) PARAMETER (N1MAX=300,N2MAX=200) DIMENSION LESMOD(N1MAX) CHARACTER*4 K4ILOI,deriv(1) CHARACTER*4 MOTEF(N2MAX),LESTEF(N2MAX),MOCON(NBCON),MOEXT(NBEXT), & MODIF(NBDIF) CHARACTER*8 TAPIND,TYPOBJ,CHARIN,CHARRE,CMATE,PHAM CHARACTER*8 PAR1,MDIINC,MDIDUA CHARACTER*(LCONMO) CONM CHARACTER*16 MOFORM(NBFORM),LESFOR(2),MOPROP(N1MAX),LESPRO(N1MAX) CHARACTER*16 mderiv(6),LMENOM,LDINOM,OPTEMP(3) CHARACTER*512 MOTEMP,LMELIB,LDILIB LOGICAL LOGRE,LOGIN,LMEEXT,LMENLX,LMEVIX,LOSTAT,LOMELA,LINOMID LOGICAL LDIEXT,LDISOR CHARACTER*4 MODEPL(11) CHARACTER*4 mgauss(4) DATA MODEPL / 'UX ','UY ','UZ ','UR ','UZ ','UT ', & 'P ','PI ','T ','TH ','VEL ' / DATA MGAUSS /'EPAI' , 'RIGI' , 'MASS' ,'CONT'/ DATA DERIV/'EPSI'/ DATA MDERIV/'LINEAIRE ','QUADRATIQUE ', $ 'TRUESDELL ','JAUMANN ', $ 'UTILISATEUR ','FEFP '/ DATA OPTEMP/'PHASE ','ADVECTION ', $ 'CONDUCTION '/ C----------------------------------------------------------------------C C DEFINITION DES NOMS DE FORMULATIONS C * formulation LIAISON : pour operateurs DYNE et COMP C----------------------------------------------------------------------C DATA MOFORM / & 'THERMIQUE ','MECANIQUE ','LIQUIDE ', & 'POREUX ','DARCY ','CONTACT ', & 'MAGNETODYNAMIQUE','NAVIER_STOKES ','MELANGE ', & 'EULER ','FISSURE ','LIAISON ', & 'THERMOHYDRIQUE ','ELECTROSTATIQUE ','DIFFUSION ' / DATA MOCON / 'CONS','INTE','DPGE','PHAS','STAT','LCOI','LCOS'/ DATA MOEXT / 'NUME','NOM_','PARA','C_MA','C_VA','LIB_' / DATA MODIF / 'INCO' / CONM=' ' PHAM=' ' MDIINC=' ' MDIDUA=' ' NPINT=0 MN3=0 MFR=0 MFRTMP=0 lucvar=0 lucmat=0 lucmaf=0 luparx=0 C Lecture d'un MAILLAGE ou d'une TABLE de sous-type DOMAINE ou C d'un MODELE (pour une formulation MELANGE) IPTABL = 0 IPGEOM = 0 IReMOD=0 CALL LIRTAB('DOMAINE',IPTABL,0,IRET) IF (IERR.NE.0) RETURN IF (IRET.EQ.0) THEN CALL LIROBJ('MMODEL',IPMODE,0,IReMOD) IF (IERR.NE.0) RETURN IF (IReMOD.GT.0) THEN MMODEL=IPMODE SEGACT,MMODEL GOTO 674 ELSE CALL LIROBJ('MAILLAGE',IPGEOM,1,IRET) ipgeoini=ipgeom IF (IERR.NE.0) RETURN ENDIF ELSE IVALIN=0 XVALIN=0.D0 LOGIN=.TRUE. IOBIN=0 TAPIND='MOT ' CHARIN='MAILLAGE' TYPOBJ='MAILLAGE' CALL ACCTAB(IPTABL,TAPIND,IVALIN,XVALIN,CHARIN,LOGIN,IOBIN, . TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE) IF (IERR.NE.0) RETURN IPGEOM=IOBRE ENDIF C Lecture d'une FORMULATION ICOND=1 NFOR=0 NMAT=0 CALL MESLIR(-182) 51 IF (NFOR.NE.0) CALL MESLIR(-181) CALL LIRMOT(MOFORM,NBFORM,IPFORM,ICOND) IF (IERR.NE.0) RETURN IF (IPFORM.EQ.0) GOTO 52 NFOR=NFOR+1 IF (NFOR.GT.2) THEN CALL ERREUR(251) RETURN ENDIF ICOND=0 LESFOR(NFOR)=MOFORM(IPFORM) GOTO 51 C Cas d'une FORMULATION simple (NFOR=1) 52 IF (NFOR.EQ.1) THEN jderiv=mepsil IF (LESFOR(1).EQ.'THERMIQUE') THEN CALL MODEL1(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) ELSE IF(LESFOR(1).EQ.'MECANIQUE') THEN CALL MODEL2(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) ELSE IF(LESFOR(1).EQ.'LIQUIDE') THEN CALL MODEL3(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) * ELSE IF(LESFOR(1).EQ.'CONVECTION') THEN * CALL MODEL4(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) ELSE IF(LESFOR(1).EQ.'POREUX') THEN CALL MODEL6(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) ELSE IF(LESFOR(1).EQ.'DARCY') THEN CALL MODEL7(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) ELSE IF(LESFOR(1).EQ.'CONTACT') THEN CALL MODEL8(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) * ELSE IF(LESFOR(1).EQ.'RAYONNEMENT') THEN * CALL MODEL9(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) ELSE IF(LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN CALL MODE10(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) ELSE IF(LESFOR(1).EQ.'NAVIER_STOKES') THEN CALL MODE11(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) ELSE IF (LESFOR(1).EQ.'MELANGE') THEN CALL MODE12(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) DO i=1,N1MAX LESMOD(i)=0 ENDDO ELSE IF(LESFOR(1).EQ.'EULER') THEN CALL MODE13(MOPROP,NPROP,NBTEF,N1MAX) ELSE IF(LESFOR(1).EQ.'FISSURE') THEN CALL MODE14(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) ELSE IF(LESFOR(1).EQ.'LIAISON') THEN CALL MODE15(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) ELSE IF(LESFOR(1).EQ.'THERMOHYDRIQUE') THEN CALL MODE16(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) ELSE IF(LESFOR(1).EQ.'ELECTROSTATIQUE ') THEN CALL MODE17(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) ELSE IF(LESFOR(1).EQ.'DIFFUSION ') THEN CALL MODE18(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) ELSE CALL ERREUR (251) ENDIF IF(IERR.NE.0) RETURN ELSE C Cas d'une FORMULATION couplee (NFOR=2) IF ((LESFOR(1).EQ.'LIQUIDE'.AND.LESFOR(2).EQ.'MECANIQUE').OR. . (LESFOR(2).EQ.'LIQUIDE'.AND.LESFOR(1).EQ.'MECANIQUE')) THEN CALL MODEL5(NPROP,MOTEF,NBTEF,N2MAX) IF(IERR.NE.0) RETURN ELSE CALL ERREUR(251) RETURN ENDIF ENDIF C Lecture eventuelle des proprietes du MODELE de MATERIAU CALL MESLIR(-180) ifrtt=0 icabfr=0 IFROCA=0 ifacaf=0 isyme=0 nbga=10 nbdang=3 icavit=0 kjh=0 iraye=0 iconv=0 NMAT=0 IF (NPROP.EQ.0) GOTO 43 41 IF (NMAT.NE.0) CALL MESLIR(-179) CALL LIRMOT(MOPROP,NPROP,LAPROP,0) c* if( laprop.ne.0) write(6,*) ' lecture de ', moprop(laprop) IF (IERR.NE.0) RETURN * --- si frottement frocable il faut lire un modele et un maillage IF(LESFOR(1).EQ.'CONTACT') then if(laprop.eq.3) then call ecrobj('MAILLAGE',IPGEOM) call impf call lirobj('MAILLAGE',ipgeo2,1,iretou) if(ierr.ne.0) return endif if(laprop.eq.5) then ifrtt=0 ifroca=1 * call lirobj('MMODEL',IFROCA,1,iOK) * IF(ierr.NE.0) return Call lirobj('MAILLAGE',IBETON,1,IOK) IF(ierr.NE.0) return endif if(laprop.eq.4) then ifrtt=1 endif ENDIF * ---------- pour rayonnement IF (iraye.eq.1) then if(laprop.eq.1) icavit=1 if(laprop.eq.9) then call lirent( nbdang,1,iretou) if(ierr.ne.0) return endif if(laprop.eq.8) then call lirent( nbga,1,iretou) if(ierr.ne.0) return endif if(laprop.eq.7)then isyme=1 call lirobj('POINT',ipp1,1,iretou) call lirobj('POINT',ipp2,1,iretou) if(idim.eq.3)call lirobj('POINT',ipp3,1,iretou) if(ierr.ne.0) return endif if(laprop.eq.2) then ifacaf=1 call lirobj('MAILLAGE',ipfac1,1,iretou) call lirobj('MAILLAGE',ipfac2,1,iretou) call lirobj('MAILLAGE',ipfac3,1,iretou) call lirobj('MMODEL',imoco,1,iretou) if(ierr.ne.0) return endif ENDIF * ---------- pour les melanges on cherche a lire un modele ------- IF (LESFOR(1).EQ.'MELANGE') THEN CALL LIROBJ('MMODEL',IPMOD,0,iOK) IF (IERR.NE.0) RETURN * ----- le melange par defaut est 'PARALLELE' IF (iOK.NE.0) THEN IF (LAPROP.EQ.0) LAPROP=3 LESMOD(NMAT+1)=IPMOD ENDIF ENDIF * ---------- changement de moprop si convection ou rayonnement ------- IF (lesfor(1).eq.'THERMIQUE' .AND. kjh.eq.0) then IF (moprop(laprop).eq.'CONVECTION') then iconv=1 nmat=nmat+1 kjh=1 lespro(nmat)=moprop(laprop) call model4(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) go to 41 ELSE IF (moprop(laprop).eq.'RAYONNEMENT') then iraye=1 kjh=1 nmat=nmat+1 lespro(nmat)=moprop(laprop) segini ilmora call model9(MOPROP,NPROP,MOTEF,NBTEF,N1MAX,N2MAX) go to 41 ENDIF ENDIF IF (LAPROP.EQ.0) GOTO 42 NMAT=NMAT+1 LESPRO(NMAT)=MOPROP(LAPROP) GOTO 41 C Option par defaut suivant la formulation 42 CONTINUE IF (NMAT.NE.0) THEN C on teste tout de suite l'existence de la donnee de la derivee C il ne faut pas de modele de materiau commencant par deri nmit=nmat do i=1,nmit if( lespro(i)(1:4).eq.'EPSI') then call erreur(19) return endif enddo * on cherche le mot deri CALL LIRMOT(deriv,1,itrou,0) IF(itrou.ne.0) then call lirmot(mderiv,5,iret,1) if(ierr.ne.0) return Jderiv=iret ENDIF C THERMIQUE : 'ISOTROPE' IF (LESFOR(1).EQ.'THERMIQUE' ) THEN IPROP = 3 IF (IDIM.EQ.1) IPROP = 1 CALL PLACE(MOPROP,IPROP,IPLAC,LESPRO(1)) IF (IPLAC.EQ.0) THEN DO i=NMAT,1,-1 LESPRO(i+1)=LESPRO(i) ENDDO LESPRO(1)='ISOTROPE' NMAT=NMAT+1 ELSEif(NMAT.EQ.1)THEN NMAT=NMAT+1 LESPRO(2)='CONDUCTION' ENDIF * on ajoute le mot conduction si besoin avec phase et advection idoico=0 idejco=0 DO i=1,nmat CALL PLACE (OPTEMP,3,iplac,LESPRO(i)) if(iplac.eq.1.or.iplac.eq.2) idoico=1 if(iplac.eq.3) idejco=1 enddo if( idoico.ne.0.and.idejco.eq.0) then nmat=nmat+1 lespro(nmat)='CONDUCTION' endif C MECANIQUE / POREUX : 'ELASTIQUE' 'ISOTROPE' ELSE IF (LESFOR(1).EQ.'MECANIQUE'.OR. & LESFOR(1).EQ.'POREUX') THEN IF (NMAT.GE.2)THEN CALL MODELA(MOPROP,NMOD) CALL PLACE(MOPROP,NMOD,IPLAC,LESPRO(2)) IF (IPLAC.EQ.0) THEN DO i=NMAT,2,-1 LESPRO(i+1)=LESPRO(i) ENDDO LESPRO(2)='ISOTROPE' NMAT=NMAT+1 ENDIF ELSE IF (NMAT.EQ.1) THEN LESPRO(2)='ISOTROPE' NMAT=2 ENDIF C MECANIQUE / POREUX : modele par defaut en comportement non lineaire CALL MODNLI(MOPROP,NMOD) CALL PLACE(MOPROP,NMOD,IPLAC,LESPRO(NMAT)) C Par defaut : PLASTIQUE ISOTROPE IF (IPLAC.EQ.1) THEN NMAT=NMAT+1 LESPRO(NMAT)='ISOTROPE' C Par defaut : FLUAGE NORTON ELSE IF (IPLAC.EQ.2) THEN NMAT=NMAT+1 LESPRO(NMAT)='NORTON' C Par defaut : VISCOPLASTIQUE CHABOCHE ELSE IF (IPLAC.EQ.3) THEN NMAT=NMAT+1 LESPRO(NMAT)='CHABOCHE' C Par defaut : ENDOMMAGEMENT MAZARS ELSE IF (IPLAC.EQ.4) THEN NMAT=NMAT+1 LESPRO(NMAT)='MAZARS' C Par defaut : ENDOMMAGEMENT PLASTIQUE P/Y ELSE IF (IPLAC.EQ.5) THEN NMAT=NMAT+1 LESPRO(NMAT)='PSURY' ELSE IF (IPLAC.EQ.6) THEN C Si 'MECANIQUE' OU 'POREUX' : pas de comportement par defaut C pour 'NON_LINEAIRE' C*? IF (LESFOR(1).EQ.'MECANIQUE'.OR. C*? . LESFOR(1).EQ.'POREUX') THEN CALL ERREUR(945) RETURN C*? ENDIF ELSE IF (IPLAC.EQ.7) THEN C Si 'MECANIQUE' : pas de comportement par defaut pour 'VISCO_EXTERNE' IF (LESFOR(1).EQ.'MECANIQUE') THEN CALL ERREUR(946) C Si 'POREUX' : option non implementee ELSE IF (LESFOR(1).EQ.'POREUX') THEN CALL ERREUR(251) ENDIF RETURN ENDIF C MAGNETODYNAMIQUE : 'POTENTIEL_VECTEUR' 'ISOTROPE' ELSE IF(LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN IF (NMAT.EQ.1) THEN IF (LESPRO(1).NE.'POTENTIEL_VECTEU') THEN LESPRO(2)=LESPRO(1) LESPRO(1)='POTENTIEL_VECTEU' ELSE LESPRO(2)='ISOTROPE' ENDIF NMAT=2 ENDIF C MELANGE : 'CEREM' ELSE IF (LESFOR(1).EQ.'MELANGE') THEN NMAT1=NMAT IF (NMAT.EQ.0) THEN LESPRO(1)='CEREM' NMAT=1 ENDIF C LIAISON : pas d option par defaut ELSE IF (LESFOR(1).EQ.'LIAISON') THEN C ELECTROSTATIQUE : 'ISOTROPE' ELSE IF (LESFOR(1).EQ.'ELECTROSTATIQUE' ) THEN IPROP = 3 IF (IDIM.EQ.1) IPROP = 1 CALL PLACE(MOPROP(1),IPROP,IPLAC,LESPRO(1)) IF (IPLAC.EQ.0) THEN DO i=NMAT,1,-1 LESPRO(i+1)=LESPRO(i) ENDDO LESPRO(1)='ISOTROPE' NMAT=NMAT+1 ENDIF C DIFFUSION : 'ISOTROPE' 'FICK' ELSE IF (LESFOR(1).EQ.'DIFFUSION' ) THEN IPROP = 3 IF (IDIM.EQ.1) IPROP = 1 CALL PLACE(MOPROP(1),IPROP,IPLAC,LESPRO(1)) IF (IPLAC.EQ.0) THEN DO i=NMAT,1,-1 LESPRO(i+1)=LESPRO(i) ENDDO LESPRO(1)='ISOTROPE' NMAT=NMAT+1 ENDIF CALL MODDIF(MOPROP,NMOD) CALL PLACE(MOPROP,NMOD,IPLAC,LESPRO(NMAT)) IF (IPLAC.EQ.0) THEN NMAT=NMAT+1 LESPRO(NMAT)='FICK' ENDIF ELSEIF(LESFOR(1).EQ.'CONTACT' ) THEN call place ( moprop,2,iplac,lespro(1)) if( iplac.eq.0) then do iur=1,nmat lespro(nmat+2-iur)=lespro (nmat +1-iur) enddo lespro(1)='UNILATERAL' nmat=nmat+1 endif ENDIF ELSE * si nmat=0 on met le premier mot autorisé NMAT=1 LESPRO(1)=MOPROP(1) IF(LESFOR(1).EQ.'THERMIQUE') THEN LESPRO(2)='CONDUCTION' NMAT=NMAT+1 ELSE IF (LESFOR(1).EQ.'MECANIQUE'.OR.LESFOR(1).EQ.'POREUX'.OR. & LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN C Option par defaut : MECANIQUE / POREUX ELASTIQUE ISOTROPE C ou MAGNETODYNAMIQUE POTENTIEL_VECTEUR ISOTROPE NMAT=NMAT+1 LESPRO(NMAT)='ISOTROPE' C Par defaut : DIFFUSION ISOTROPE FICK ELSE IF (LESFOR(1).EQ.'DIFFUSION') THEN NMAT=NMAT+1 IPROP = 4 IF (IDIM.EQ.1) IPROP = 2 LESPRO(NMAT)=MOPROP(IPROP) C Par defaut : NEWTONIEN ELSE IF (LESFOR(1).EQ.'NAVIER_STOKES'.OR. & LESFOR(1).EQ.'EULER') THEN NMAT = 1 LESPRO(NMAT)='NEWTONIEN' C Par defaut pour la formulation FISSURE ELSE IF (LESFOR(1).EQ.'FISSURE') THEN NMAT = 3 LESPRO(1)='MASS' LESPRO(2)='PARF' LESPRO(3)='POISEU_BLASIUS' ELSE IF(LESFOR(1).EQ.'CONTACT') THEN NMAT=1 LESPRO(1)='UNILATERAL' ENDIF ENDIF C Lecture eventuelle des types d'ELEMENTS FINIS a utiliser 43 ITEF=0 IF (NBTEF.EQ.0) GOTO 2 CALL MESLIR(-178) 1 IF (ITEF.NE.0) CALL MESLIR(-177) CALL LIRMOT(MOTEF,NBTEF,LETEF,0) IF (IERR.NE.0) RETURN IF (LETEF.EQ.0) GOTO 2 ITEF=ITEF+1 LESTEF(ITEF)=MOTEF(LETEF) GOTO 1 c Lecture eventuelle de listmots 2 continue call lirobj('LISTMOTS',jlmot1,0,irmot1) if (irmot1.eq.1) call lirobj('LISTMOTS',jlmot2,1,irmot2) * lecture pour mecanique aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa C En formulations 'MECANIQUE' et 'POREUX' : detection d'une loi non C lineaire externe, le cas echeant saisie de donnees complementaires. C Caracterisation : loi non lineaire externe si C - famille 'VISCO_EXTERNE' ou C - famille 'NON_LINEAIRE', materiau 'UTILISATEUR'. C si pas loi externe lecture eventuelle des parametres externes LMEEXT=.FALSE. LMEVIX=.FALSE. LMENLX=.FALSE. LMENUM = 0 LMENOM = ' ' LMELIB = ' ' LMELGB = 0 LMEPTR = 0 LMEIVI = 0 IF ( (NFOR.EQ.1).AND. . (LESFOR(1).EQ.'MECANIQUE'.OR.LESFOR(1).EQ.'POREUX') ) THEN DO i=1,NMAT IF (LESPRO(i).EQ.'VISCO_EXTERNE') THEN LMEVIX=.TRUE. C* GOTO 201 GOTO 203 ENDIF ENDDO 201 IF (.NOT.LMEVIX) THEN DO i=1,NMAT IF (LESPRO(i).EQ.'UTILISATEUR') THEN LMENLX = .TRUE. GOTO 203 ENDIF ENDDO ENDIF C........N.B. LMEEXT exprime la condition (NFOR.EQ.1) ET C (LESFOR(1).EQ.'MECANIQUE') ET (loi non lineaire externe) 203 LMEEXT = LMEVIX.OR.LMENLX IF ( LMEEXT ) THEN * lecture et verif des noms des materiaux, des * noms des variables internes, des noms des parametre externe pour *loi externes 210 CALL LIRMOT(MOEXT,NBEXT,LEXT,0) C Si on ne trouve plus l'un des mots cles attendus, on sort IF (LEXT.EQ.0) GOTO 211 C Lecture d'un entier sous 'NUME_LOI' IF (LEXT.EQ.1) THEN CALL LIRENT(LMENUM,1,IRET) IF (IERR.NE.0) RETURN C Valeur illicite du numero de la loi (superieur ou egal a 1) IF (LMENUM.LT.1 .OR. LMENUM.GE.1000000) THEN INTERR(1) = LMENUM CALL ERREUR(36) CALL ERREUR(947) RETURN ENDIF C Lecture du nom de la loi sous 'NOM_LOI' ELSE IF (LEXT.EQ.2) THEN MOTEMP = ' ' CALL LIRCHA(MOTEMP,1,IRET) IF (IERR.NE.0) RETURN IF (IRET.GT.16) THEN INTERR(1) = IRET MOTERR = MOTEMP CALL ERREUR(-2) CALL ERREUR(36) RETURN ENDIF LMENOM(1:IRET) = MOTEMP(1:IRET) C Lecture d'un objet LISTMOTS sous 'PARA_LOI' ELSE IF (LEXT.EQ.3) THEN CALL LIROBJ('LISTMOTS',LUPARX,1,IRET) IF (IERR.NE.0) RETURN C Lecture d'un objet LISTMOTS sous 'C_MATERIAU' ELSE IF (LEXT.EQ.4) THEN CALL LIROBJ('LISTMOTS',LUCMAT,1,IRET) IF (IERR.NE.0) RETURN C Lecture d'un objet LISTMOTS sous 'C_VARINTER' ELSE IF (LEXT.EQ.5) THEN CALL LIROBJ('LISTMOTS',LUCVAR,1,IRET) IF (IERR.NE.0) RETURN C Lecture du chemin de la bibliotheque de la loi ELSE IF (LEXT.EQ.6) THEN MOTEMP = ' ' CALL LIRCHA(MOTEMP,1,IRET) IF (IERR.NE.0) RETURN IF (IRET.GT.500) THEN INTERR(1) = IRET MOTERR = MOTEMP CALL ERREUR(-2) CALL ERREUR(36) RETURN ENDIF C*TMP Option non disponible pour l'instant C*TMP -> en attente specification plus precise et portable (?) write(ioimp,*) 'Option LIB_LOI' CALL ERREUR(251) RETURN LMELIB(1:IRET) = MOTEMP(1:IRET) LMELGB = IRET LMEPTR = IRET ENDIF C On repete jusqu'a ce qu'on ne trouve plus aucun des C mots cles attendus, regle de surcharge le cas echeant GOTO 210 211 CONTINUE C...........Verifications sur les donnees C Il manque 'NUME_LOI' ou 'NOM_LOI' (toujours obligatoire) IF (LMENUM.EQ.0 .AND. LMENOM.EQ.' ') THEN CALL ERREUR(641) RETURN ENDIF IF (LMENUM.NE.0 .AND. LMENOM.NE.' ') THEN MOTERR(1:16) = 'NUME_LOINOM_LOI ' CALL ERREUR(135) RETURN ENDIF C Dans le cas d'un modele NON_LINEAIRE UTILISATEUR, on rajoute en fin de C liste des proprietes du modele, le numero ou le nom de la loi attribue C par l'utilisateur. NMAT = NMAT + 1 LESPRO(NMAT) = ' ' IF (LMENUM.EQ.0) THEN LESPRO(NMAT) = LMENOM ELSE WRITE(LESPRO(NMAT)(1:16),'(I16)') LMENUM ENDIF C Verifications pour une loi 'NON_LINEAIRE' 'UTILISATEUR' IF ( LMENLX ) THEN C Il manque les composantes materielles sous 'C_MATERIAU' IF (LUCMAT.EQ.0) THEN CALL ERREUR(641) RETURN ENDIF C La liste des composantes materielles saisie sous C 'C_MATERIAU' ne doit pas etre vide MLMOTS=LUCMAT SEGACT,MLMOTS NBCOMP = MOTS(/2) SEGDES,MLMOTS IF (NBCOMP.EQ.0) THEN CALL ERREUR(964) RETURN ENDIF ENDIF C Dans le cas d'une libraire externe, quelques verifications puis C recherche du pointeur de la fonction externe IF (LMEPTR.GT.0) THEN IF (LMENUM.EQ.0) THEN i_z = INDEX(LMENOM,' ') IF (i_z.EQ.0) i_z = 16 IRET = LONG(LMENOM) IF (i_z.NE.IRET) THEN write(ioimp,*) 'PAS D ESPACE dans NOM_LOI en cas de LIB_LOI' CALL ERREUR(21) RETURN ENDIF ELSE IRET = 0 DO i = 1, 16 IRET = IRET + 1 IF (LESPRO(NMAT)(i:i).NE.' ') GOTO 220 ENDDO 220 LMENOM = 'umat_'//LESPRO(NMAT)(IRET:16) IRET = 22-IRET ENDIF C** LMELIB = LMELIB(1:LMELGB)//CHAR(0) C** MOTEMP = LMENOM(1:IRET)//CHAR(0) C** CALL PTRLOI(LMELIB,LMELGB,MOTEMP,IRET,LMEPTR) IF (LMEPTR.LE.0) THEN CALL ERREUR(21) RETURN ENDIF ENDIF ELSE * si pas lois externes lecture des noms des parametres externes CALL LIRMOT(MOEXT(2),1,LEXT,0) If(lext.ne.0) then CALL LIROBJ('LISTMOTS',luparx,1,iret) IF(IERR.NE.0) return endif ENDIF C Verifications sur les parametres, si declares IF (luparx.GT.0) THEN C Si la temperature 'T ' fait partie des parametres de C la loi, elle doit etre declaree en tete mlmots=luparx SEGACT,MLMOTS NBPARA=MOTS(/2) IF (NBPARA.GT.0) THEN DO IP = 1, NBPARA IF (MOTS(IP).EQ.'T ') THEN IF (IP.GT.1) THEN SEGDES,MLMOTS CALL ERREUR(948) RETURN ENDIF GOTO 221 ENDIF ENDDO 221 CONTINUE ENDIF C Pas de parametres redondants IF (NBPARA.GT.1) THEN DO 230 IP1 = 1, NBPARA-1 PAR1 = MOTS(IP1) DO 231 IP2 = IP1+1, NBPARA IF (MOTS(IP2).EQ.PAR1) THEN SEGDES,MLMOTS CALL ERREUR(949) RETURN ENDIF 231 CONTINUE 230 CONTINUE ENDIF SEGDES,MLMOTS ENDIF ENDIF * fin lecture mecanique aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa C Formulation 'DIFFUSION' : oooooooooooooooooooooooooooooooooooooooooooo C - Detection d'une loi non lineaire externe (mot-cle 'UTILISATEUR') C - Detection de la quantite de l'effet Soret (mot-cle 'SORET') C - Lecture de l'inconnue "diffusant" (mot-cle 'INCO') 3 CONTINUE LDIEXT = .FALSE. LDISOR = .FALSE. LDINUM = 0 LDINOM = ' ' LDILIB = ' ' LDILGB = 0 LDIPTR = 0 IF (NFOR.EQ.1 .AND. LESFOR(1).EQ.'DIFFUSION') THEN * -- Recherche des informations sur la presence d'une loi externe -- DO i=1,NMAT LDIEXT = LESPRO(i).EQ.'UTILISATEUR' LDISOR = LESPRO(i).EQ.'SORET' ENDDO *- Lecture des informations pour la loi externe IF (LDIEXT) THEN 310 CONTINUE CALL LIRMOT(MOEXT,NBEXT,LEXT,0) IF (LEXT.EQ.0) GOTO 311 C Lecture d'un entier sous 'NUME_LOI' IF (LEXT.EQ.1) THEN CALL LIRENT(LDINUM,1,IRET) IF (IERR.NE.0) RETURN IF (LDINUM.LT.1 .OR. LDINUM.GE.1000000) THEN INTERR(1) = LDINUM CALL ERREUR(36) CALL ERREUR(947) RETURN ENDIF C Lecture du nom de la loi sous 'NOM_LOI' ELSE IF (LEXT.EQ.2) THEN MOTEMP = ' ' CALL LIRCHA(MOTEMP,1,IRET) IF (IERR.NE.0) RETURN IF (IRET.GT.16) THEN INTERR(1) = IRET MOTERR = MOTEMP CALL ERREUR(-2) CALL ERREUR(36) RETURN ENDIF LDINOM(1:IRET) = MOTEMP(1:IRET) C Lecture d'un objet LISTMOTS sous 'PARA_LOI' ELSE IF (LEXT.EQ.3) THEN CALL LIROBJ('LISTMOTS',luparx,1,IRET) IF (IERR.NE.0) RETURN C Lecture d'un objet LISTMOTS sous 'C_MATERIAU' ELSE IF (LEXT.EQ.4) THEN CALL LIROBJ('LISTMOTS',lucmat,1,IRET) IF (IERR.NE.0) RETURN C Lecture d'un objet LISTMOTS sous 'C_VARINTER' ELSE IF (LEXT.EQ.5) THEN CALL LIROBJ('LISTMOTS',lucvar,1,IRET) IF (IERR.NE.0) RETURN C Lecture du chemin de la bibliotheque de la loi ELSE IF (LEXT.EQ.6) THEN MOTEMP = ' ' CALL LIRCHA(MOTEMP,1,IRET) IF (IERR.NE.0) RETURN IF (IRET.GT.500) THEN INTERR(1) = IRET MOTERR = MOTEMP CALL ERREUR(-2) CALL ERREUR(36) RETURN ENDIF C*TMP Option non disponible pour l'instant C*TMP -> en attente specification plus precise et portable (?) write(ioimp,*) 'Option LIB_LOI' CALL ERREUR(251) RETURN LDILIB(1:IRET) = MOTEMP(1:IRET) LDILGB = IRET LDIPTR = IRET ENDIF GOTO 310 311 CONTINUE C Verifications des informations obligatoires de la loi externe C Il manque 'NUME_LOI' ou 'NOM_LOI' (toujours obligatoire) IF (LDINUM.EQ.0 .AND. LDINOM.EQ.' ') THEN CALL ERREUR(641) RETURN ENDIF IF (LDINUM.NE.0 .AND. LDINOM.NE.' ') THEN MOTERR(1:16) = 'NUME_LOINOM_LOI ' CALL ERREUR(135) RETURN ENDIF C Il manque la liste 'C_MATERIAU' IF (lucmat.EQ.0) THEN CALL ERREUR(641) RETURN ENDIF C Les liste des composantes ne doivent pas etre vides. DO i = 1, 3 IF (i.EQ.1) MLMOTS = luparx IF (i.EQ.2) MLMOTS = lucmat IF (i.EQ.3) MLMOTS = lucvar IF (MLMOTS.NE.0) THEN SEGACT,MLMOTS NBCOMP = MOTS(/2) SEGDES,MLMOTS IF (NBCOMP.EQ.0) THEN CALL ERREUR(964) RETURN ENDIF ENDIF ENDDO C Dans le cas d'un modele UTILISATEUR, on rajoute en fin de C liste des proprietes du modele, le numero attribue par l'utilisateur. NMAT = NMAT + 1 LESPRO(NMAT) = ' ' IF (LDINUM.EQ.0) THEN LESPRO(NMAT) = LDINOM ELSE WRITE(LESPRO(NMAT)(1:16),'(I16)') LDINUM ENDIF C Dans le cas d'une libraire externe, quelques verifications puis C recherche du pointeur de la fonction externe IF (LDIPTR.GT.0) THEN IF (LDINUM.EQ.0) THEN i_z = INDEX(LDINOM,' ') IF (i_z.EQ.0) i_z = 16 IRET = LONG(LDINOM) IF (i_z.NE.IRET) THEN write(ioimp,*) 'PAS D ESPACE dans NOM_LOI en cas de LIB_LOI' CALL ERREUR(21) RETURN ENDIF ELSE IRET = 0 DO i = 1, 16 IRET = IRET + 1 IF (LESPRO(NMAT)(i:i).NE.' ') GOTO 320 ENDDO 320 LDINOM = 'umat_'//LESPRO(NMAT)(IRET:16) IRET = 22-IRET ENDIF C** LDILIB = LDILIB(1:LDILGB)//CHAR(0) C** MOTEMP = LDINOM(1:IRET)//CHAR(0) C** CALL PTRLOI(LDILIB,LDILGB,MOTEMP,IRET,LDIPTR) IF (LDIPTR.LT.0) THEN CALL ERREUR(21) RETURN ENDIF ENDIF ENDIF *- Lecture des informations pour la loi Soret : *- quantite dont le gradient est l'origine de l'effet ('T' par defaut) IF (LDISOR) THEN mlmots = 0 CHARIN = 'T ' C Lecture du mot-cle 'PARA_LOI' et donnees associees CALL LIRMOT(MOEXT(2),1,LEXT,0) IF (IERR.NE.0) RETURN IF (LEXT.EQ.1) THEN CALL LIROBJ('LISTMOTS',mlmots,0,IRET) IF (IERR.NE.0) RETURN IF (IRET.EQ.0) THEN CALL LIRCHA(CHARIN,1,IRETI) ELSE SEGACT,mlmots NBCOMP = mots(/2) IF (NBCOMP.EQ.0) THEN CALL ERREUR(964) ELSE CHARIN = MOTS(1) IRETI = LONG(CHARIN) IF (IRETI.EQ.0) CALL ERREUR(643) ENDIF SEGDES,mlmots ENDIF IF (IERR.NE.0) RETURN IF (IRETI.GT.2) WRITE(IOIMP,30) CHARIN(1:IRETI),2 IRETI = MIN(IRETI,2) CHARIN(IRETI+1:8) = ' ' ENDIF JGM = 1 JGN = 8 SEGINI,mlmots mots(1) = CHARIN luparx = mlmots ENDIF * -- Pour la formulation DIFFUSION : lecture quantite (ddl) diffusant -- * -- On cherche a lire le mot 'INCO' suivi du nom de l'INCOnnue donne -- * -- soit par un LISTMOTS, soit par un MOT puis eventuellement du nom -- * -- de la grandeur DUALe donne par un objet de meme type que pour le -- * -- nom de l'inconnue. -- CALL LIRMOT(MODIF,NBDIF,LEXT,0) IF (LEXT.EQ.0) THEN C*8 MDIINC='CONC ' C*8 MDIDUA='QCONC ' MDIINC='CO ' MDIDUA='QCO ' ELSE MDIINC=' ' MDIDUA='Q ' CHARIN=' ' CHARRE=' ' CALL LIROBJ('LISTMOTS',mlmots,0,IRET) IF (IERR.NE.0) RETURN IF (mlmots.NE.0) THEN SEGACT,mlmots NBCOMP = MOTS(/2) IF (NBCOMP.EQ.0) THEN CALL ERREUR(643) ELSE CHARIN=MOTS(1) IRETI=LONG(CHARIN) ENDIF SEGDES,mlmots IF (IERR.NE.0) RETURN CALL LIROBJ('LISTMOTS',mlmots,0,IRETE) IF (IERR.NE.0) RETURN IF (mlmots.NE.0) THEN SEGACT,mlmots NBCOMP = MOTS(/2) IF (NBCOMP.EQ.0) THEN CALL ERREUR(643) ELSE CHARRE=MOTS(1) IRETE=LONG(CHARRE) IF (IRETE.EQ.0) CALL ERREUR(643) ENDIF SEGDES,mlmots IF (IERR.NE.0) RETURN ENDIF ELSE CALL LIRCHA(CHARIN,1,IRETI) IF (IERR.NE.0) RETURN CALL LIRCHA(CHARRE,0,IRETE) IF (IERR.NE.0) RETURN ENDIF IF (IRETI.EQ.0) THEN CALL ERREUR(643) RETURN ENDIF *OF A mettre en message : CALL ERREUR(-xx) C*8 IF (IRETI.GT.6) WRITE(IOIMP,30) CHARIN(1:IRETI),6 C*8 IRETI=MIN(IRETI,6) IF (IRETI.GT.2) WRITE(IOIMP,30) CHARIN(1:IRETI),2 IRETI=MIN(IRETI,2) MDIINC(1:IRETI)=CHARIN(1:IRETI) IF (IRETE.EQ.0) THEN MDIDUA(2:1+IRETI)=MDIINC(1:IRETI) ELSE C*8 IF (IRETE.GT.8) WRITE(IOIMP,30) CHARRE(1:IRETE),8 C*8 IRETE=MIN(IRETE,8) IF (IRETE.GT.4) WRITE(IOIMP,30) CHARRE(1:IRETE),4 IRETE=MIN(IRETE,4) MDIDUA(1:IRETE)=CHARRE(1:IRETE) ENDIF ENDIF 30 FORMAT('MODELI : Composante ',A,' tronquee a ',I1,' caracteres') c* Verification des noms de primale et duale lues CALL VERMDI(MDIINC,MDIDUA) IF (IERR.NE.0) RETURN c* ENDIF C Fin Formulation 'DIFFUSION' oooooooooooooooooooooooooooooooooooooooooo C Lecture eventuelle du NOM de CONSTITUANT, du nombre de POINTs C d'INTEGRATION, du point support pour les modes en DEFOrmations C PLANEs GENEralisees, du nom de la phase. fin des lecture en 22 674 IPTGEN=0 IPMOD1=0 ngrig=0 ngmas=0 ngcon=0 npint=0 klcon= 0 kcons=0 675 CALL LIRMOT(MOCON,NBCON,LECON,0) IF (LECON.EQ.0) GOTO 22 IF (LECON.EQ.1) THEN CALL LIRCHA(CONM,1,kcons) IF (IERR.NE.0) RETURN ELSE IF (LECON.EQ.2) THEN 677 continue legaus=0 CALL LIRMOT(MGAUSS,4,legaus,0) if( legaus.eq.0.and.npint.eq.0) then legaus=1 else go to 675 endif CALL LIRENT(NPINTT,1,IRET) IF (IERR.NE.0) RETURN if(legaus.eq.1) npint=npintt if(legaus.eq.2) ngrig=npintt if(legaus.eq.3) ngmas=npintt if(legaus.eq.4) ngcon=npintt MN3=1 IF (NPINT.ne.0.and.MOD(NPINT,2).EQ.0) THEN CALL ERREUR(607) ENDIF go to 677 ELSE IF (LECON.EQ.3) THEN CALL LIROBJ('POINT',IPTGEN,1,IRET) IF (IERR.NE.0) RETURN ELSE IF (LECON.EQ.4) THEN CALL LIRCHA(PHAM,1,IRET) IF(IERR.NE.0) RETURN ELSE IF (LECON.EQ.5) THEN CALL LIROBJ('MMODEL',IPMOD1,0,IRET) IF (IERR.NE.0) RETURN ELSE IF (LECON.EQ.6.OR.LECON.EQ.7) THEN CALL LIROBJ('MMODEL',IPMOD2,0,IRET) IF (IERR.NE.0) RETURN if (ipmod2.gt.0) then if (klcon.eq.0) then nlcon = 10 segini plicon endif klcon = klcon + 1 if (klcon.gt.nlcon) then nlcon = nlcon + 10 segadj plicon endif mlicon(klcon) = ipmod2 tlicon(klcon) = lecon endif ENDIF GOTO 675 22 CONTINUE C Erreur si aucun point n'est fourni avec le mot-cle GENE pour les modes C de calcul 'MECANIQUE'/'POREUX' ou ce point est indispensable. IF (IPTGEN.EQ.0) THEN IF ( (NFOR.EQ.1) .AND. & (LESFOR(1).EQ.'MECANIQUE'.OR.LESFOR(1).EQ.'POREUX') ) THEN IF (IFOUR.EQ.-3 .OR. (IFOUR.GE.7.AND.IFOUR.LE.11) .OR. & IFOUR.EQ.14) THEN SEGSUP,MMODEL CALL ERREUR(925) RETURN ENDIF ENDIF ENDIF C Recuperation des caracteristiques du MAILLAGE dans MELEME * on se pose le pb du maillage non conforme itypel=48 qui contine les relations MELEME=IPGEOM SEGACT,MELEME NSOU =MELEME.LISOUS(/1) NSOU1=MAX(1,NSOU) ICONFO=0 DO 38 INB=1,NSOU1 IF (NSOU.EQ.0) THEN IPT2=MELEME ELSE IPT2=MELEME.LISOUS(INB) SEGACT,IPT2 ENDIF IF (IPT2.ITYPEL.EQ.48) ICONFO=ICONFO+1 38 CONTINUE * C Initialisation du segment MMODEL * N1=NSOU1 SEGINI,MMODEL IPMODE=MMODEL C* Nom du constituant par defaut si non donne en entree IF (kcons.EQ.0) WRITE(CONM,FMT='(I16)') IPMODE *** IF (kcons.EQ.0) CONM='MODELI' IF (IReMOD.NE.0) GOTO 70 C Remplissage du segment MMODEL IF (LESFOR(1).EQ.'NAVIER_STOKES') MN3=2 IF (LESFOR(1).EQ.'EULER') MN3=2 IF (LESFOR(1).EQ.'DARCY') MN3=2 IF (LESFOR(1).EQ.'THERMOHYDRIQUE' ) mn3=2 IF(LESFOR(1).EQ.'MECANIQUE'.OR.lesfor(1).eq.'POREUX'.or.nfor.eq.2) $ mn3=12 IF (LESFOR(1).EQ.'LIQUIDE' ) mn3=12 IF (LESFOR(1).EQ.'LIAISON') mn3=12 IF (LESFOR(1).EQ.'ELECTROSTATIQUE') mn3=12 IF (LESFOR(1).EQ.'DIFFUSION') mn3=12 C*********************************************************************** C Boucle sur les maillages elementaires de MELEME C*********************************************************************** DO 10 IM=1,NSOU1 NOBMOD=0 IF (LESFOR(1).EQ.'CONTACT') THEN IF (IFROCA.NE.0) NOBMOD=2 IF (ifrtt.ne.0) nobmod=1 ELSE IF (LESFOR(1).EQ.'DIFFUSION') THEN NOBDIF = NOBMOD NOBMOD = NOBMOD + 3 IF (LDIPTR.GT.0) NOBMOD = NOBMOD + 1 C* ELSE IF ( (NFOR.EQ.1) .AND. C* & ( LESFOR(1).EQ.'MECANIQUE' .OR. C* & LESFOR(1).EQ.'POREUX' ) ) THEN C* Modeles utilisateur en MECANIQUE : ELSE IF (LMEEXT) THEN NOBMEC = NOBMOD IF (LMEPTR.GT.0) NOBMOD = NOBMOD + 2 IF (LMEVIX) NOBMOD = NOBMOD + 1 ENDIF if(iraye.eq.1) nobmod=2*icavit+isyme*idim+ifacaf*4 SEGINI,IMODEL if(iraye.ne.0) limora(im)= nobmod+1-n1 IF (LESFOR(1).EQ.'CONTACT'.AND.IFROCA.EQ.1)THEN imamod=ipgeo2 ipt1=ipgeo2 segact ipt1 ityp1=ipt1.itypel segdes ipt1 TYMODE(1)='MAILLAGE' IVAMOD(1)=IPGEOM TYMODE(2)='MAILLAGE' IVAMOD(2)=IBETON ipgeom=ipgeo2 ENDIF IF (LESFOR(1).EQ.'CONTACT'.AND.ifrtt.eq.1) then ivamod(1)=ipgeo2 tymode(1)='MAILLAGE' ENDIF if(iraye.ne.0) then if(icavit.ne.0) then tymode(1)='ENTIER' ivamod(1)=nbga tymode(2)='ENTIER' ivamod(2)=nbdang if(isyme.eq.1) then tymode(3 )='POINT' tymode(4)='POINT' if(idim.eq.3)tymode(5)='POINT' ivamod(3 )=ipp1 ivamod(4)=ipp2 if(idim.eq.3)ivamod(5)=ipp3 endif endif if(ifacaf.ne.0) then tymode(1)='MAILLAGE' tymode(2)='MAILLAGE' tymode(3)='MAILLAGE' tymode(4)='MMODEL' ivamod(1)=ipfac1 ivamod(2)=ipfac2 ivamod(3)=ipfac3 ivamod(4)=imoco endif endif IF (LESFOR(1).EQ.'DIFFUSION') THEN TYMODE(NOBDIF+1)=MDIINC IVAMOD(NOBDIF+1)=LDINUM TYMODE(NOBDIF+2)=MDIDUA IVAMOD(NOBDIF+2)=LDINUM IF (LDIPTR.GT.0) THEN C*TMP Option non disponible pour l'instant C*TMP -> en attente specification plus precise et portable (?) CALL POSCHA(LDILIB(1:LDILGB)//'='//LDINOM,i_z) TYMODE(NOBDIF+3)='LDIEXT ' IVAMOD(NOBDIF+3)=LDIPTR TYMODE(NOBDIF+4)='MOT ' IVAMOD(NOBDIF+4)=i_z ENDIF ENDIF IF (LMEEXT) THEN IF (LMEPTR.GT.0) THEN CALL POSCHA(LMELIB(1:LMELGB)//'='//LMENOM(1:16),i_z) TYMODE(NOBMEC+1)='LMEEXT ' IVAMOD(NOBMEC+1)=LMEPTR TYMODE(NOBMEC+2)='MOT ' IVAMOD(NOBMEC+2)=i_z NOBMEC = NOBMEC + 2 ENDIF IF (LMEVIX) THEN LMEIVI = NOBMEC + 1 TYMODE(LMEIVI)='IVIEX ' IVAMOD(LMEIVI)=0 ENDIF ENDIF CONMOD=CONM conmod(17:24)=PHAM KMODEL(IM)=IMODEL * kich liaison conditionelle IF(LESFOR(1).EQ.'LIAISON'.AND.klcon.gt.0) THEN do ilc = 1,klcon mmode2 = mlicon(ilc) segact mmode2 if (mmode2.kmodel(/1).gt.1) then * liaison conditionnelle mal specifiee call erreur(5) segdes mmode2 return endif imode2 = mmode2.kmodel(1) segact imode2 if (imode2.formod(1).ne.'LIAISON') THEN call erreur(5) segdes imode2,mmode2 return endif if (tlicon(ilc).eq.6) TYMODE(ilc)='CONDINFE' if (tlicon(ilc).eq.7) TYMODE(ilc)='CONDSUPE' IVAMOD(ilc)=IMODE2 segdes imode2,mmode2 enddo segsup plicon ENDIF * fin liaison conditionnelle IF (NSOU.EQ.0) THEN ITYP1=ITYPEL IMAMOD=IPGEOM NBNN=NUM(/1) ELSE IPT1=LISOUS(IM) SEGACT,IPT1 ITYP1=IPT1.ITYPEL IMAMOD=IPT1 NBNN=IPT1.NUM(/1) SEGDES,IPT1 ENDIF if(ityp1.eq.48) then NEFMOD=22 go to 11 endif C Determination de la valeur de NEFMOD pour IMODEL zzzzzzzzzzzzzzzzzzz C -------------------------------------------------- C Affectation du type d'ELEMENTS FINIS si donnes par utilisateur IF (ITEF.NE.0) THEN C Cas de la FORMULATION 'NAVIER_STOKES' IF (LESFOR(1).EQ.'NAVIER_STOKES') THEN IF (LESTEF(1).EQ.'LINE')THEN NEFMOD=0 IF (ITYP1.EQ. 3) NEFMOD=129 IF (ITYP1.EQ. 7) NEFMOD=130 IF (ITYP1.EQ.11) NEFMOD=131 IF (ITYP1.EQ.33) NEFMOD=132 IF (ITYP1.EQ.34) NEFMOD=133 IF (ITYP1.EQ.35) NEFMOD=134 IF (ITYP1.EQ.36) NEFMOD=135 IF (NEFMOD.EQ.0) GOTO 99 ELSE IF(LESTEF(1).EQ.'MACR')THEN NEFMOD=0 IF (ITYP1.EQ. 3) NEFMOD=136 IF (ITYP1.EQ. 7) NEFMOD=137 IF (ITYP1.EQ.11) NEFMOD=138 IF (ITYP1.EQ.33) NEFMOD=139 IF (ITYP1.EQ.34) NEFMOD=140 C IF (ITYP1.EQ.35) NEFMOD=141 C Il nous manque la pyramide IF (NEFMOD.EQ.0) GOTO 99 ELSE IF (LESTEF(1).EQ.'QUAF') THEN NEFMOD=0 IF (ITYP1.EQ. 3) NEFMOD=143 IF (ITYP1.EQ. 7) NEFMOD=144 IF (ITYP1.EQ.11) NEFMOD=145 IF (ITYP1.EQ.33) NEFMOD=146 IF (ITYP1.EQ.34) NEFMOD=147 IF (ITYP1.EQ.35) NEFMOD=148 IF (ITYP1.EQ.36) NEFMOD=149 C Il nous manque la pyramide IF (NEFMOD.EQ.0) GO TO 99 ELSE IF (LESTEF(1).EQ.'LINB') THEN NEFMOD=0 IF (ITYP1.EQ. 3) NEFMOD=158 IF (ITYP1.EQ. 7) NEFMOD=159 IF (ITYP1.EQ.11) NEFMOD=160 IF (ITYP1.EQ.33) NEFMOD=161 IF (ITYP1.EQ.34) NEFMOD=162 C IF (ITYP1.EQ.35) NEFMOD=163 C IF (ITYP1.EQ.36) NEFMOD=164 C Il nous manque la pyramide et le tetrahedre IF (NEFMOD.EQ.0) GOTO 99 ELSE DO i=1,ITEF CALL PLACE(NOMTP,LNOMTP,MELE,LESTEF(i)) IF (MELE.EQ.0) GOTO 99 MEGE=NUMGEO(MELE) IF (MEGE.EQ.0) GOTO 99 IF (MEGE.EQ.ITYP1) GOTO 610 ENDDO GO TO 99 610 NEFMOD=MELE ENDIF C Cas de la FORMULATION 'EULER' ELSE IF (LESFOR(1).EQ.'EULER') THEN NEFMOD=0 IF (ITYP1.EQ. 2) NEFMOD=ITYP1 IF (ITYP1.EQ. 4) NEFMOD=ITYP1 IF (ITYP1.EQ. 8) NEFMOD=ITYP1 IF (ITYP1.EQ.14) NEFMOD=ITYP1 IF (ITYP1.EQ.16) NEFMOD=ITYP1 IF (ITYP1.EQ.23) NEFMOD=ITYP1 IF (ITYP1.EQ.25) NEFMOD=ITYP1 IF (NEFMOD.EQ.0) GOTO 99 C Cas des autres FORMULATIONs ELSE DO i=1,ITEF CALL PLACE(NOMTP,LNOMTP,MELE,LESTEF(i)) IF (MELE.EQ.0) GOTO 99 MEGE=NUMGEO(MELE) IF (MEGE.EQ.0) GOTO 99 IF (MEGE.EQ.ITYP1) GOTO 6 do jma = 1, nmat if (lespro(jma).eq.'IMPEDANCE') goto 6 enddo ENDDO GOTO 99 C Cas particulier pour les elements polygonaux 6 IF (ITYP1.EQ.32) THEN MELE=MELE+NBNN-3 IF (NBNN.GT.14) GOTO 99 ENDIF NEFMOD=MELE ENDIF C Affectation des elements finis de maniere automatique ELSE C Cas des milieux POREUX IF (LESFOR(1).EQ.'POREUX') THEN NEFMOD=0 IF (ITYP1.EQ. 6) NEFMOD=79 IF (ITYP1.EQ.10) NEFMOD=80 IF (ITYP1.EQ.15) NEFMOD=81 IF (ITYP1.EQ.24) NEFMOD=82 IF (ITYP1.EQ.17) NEFMOD=83 IF (ITYP1.EQ.29) NEFMOD=108 IF (ITYP1.EQ.30) NEFMOD=109 IF (ITYP1.EQ.31) NEFMOD=110 IF (NEFMOD.EQ.0) GOTO 99 C Cas des elements de frottement (formulation FROTTEMENT) ELSE IF (LESFOR(1).EQ.'CONTACT') THEN ** NEFMOD=22 pv est passe par la NEFMOD=0 if(ifrtt.eq.1) then IF (ITYP1.EQ.22.AND.IDIM.EQ.2) NEFMOD=107 IF (ITYP1.EQ.22.AND.IDIM.EQ.3) NEFMOD=165 elseif(ifroca.ne.0) then IF (ITYP1.EQ.22.AND.IDIM.EQ.2) NEFMOD=261 IF (ITYP1.EQ.22.AND.IDIM.EQ.3) NEFMOD=262 endif * IF (NEFMOD.EQ.0) GOTO 99 C Cas des elements hybrides (imposes en DARCY) ELSE IF (LESFOR(1).EQ.'DARCY') THEN NEFMOD=0 IF (ITYP1.EQ. 3) NEFMOD=143 C IF (ITYP1.EQ. 4) NEFMOD=99 C IF (ITYP1.EQ. 8) NEFMOD=100 C IF (ITYP1.EQ.23) NEFMOD=101 C IF (ITYP1.EQ.16) NEFMOD=102 C IF (ITYP1.EQ.14) NEFMOD=103 IF (ITYP1.EQ. 7) NEFMOD=99 IF (ITYP1.EQ.11) NEFMOD=100 IF (ITYP1.EQ.35) NEFMOD=101 IF (ITYP1.EQ.34) NEFMOD=102 IF (ITYP1.EQ.33) NEFMOD=103 IF (NEFMOD.EQ.0) GOTO 99 C Cas de la formulation MAGNETODYNAMIQUE ELSE IF (LESFOR(1).EQ.'MAGNETODYNAMIQUE') THEN NEFMOD=0 IF (ITYP1.EQ. 4) NEFMOD=128 IF (NEFMOD.EQ.0) GOTO 99 C Cas de la formulation 'NAVIER_STOKES' ELSE IF (LESFOR(1).EQ.'NAVIER_STOKES') THEN IF (ILNAVI.EQ.0) THEN CALL MESLIR(-341) SEGSUP MMODEL RETURN ELSEIF (ILNAVI.EQ.1) THEN C LICE NEFMOD=0 IF (ITYP1.EQ. 3) NEFMOD=195 IF (ITYP1.EQ. 7) NEFMOD=196 IF (ITYP1.EQ.11) NEFMOD=197 IF (ITYP1.EQ.33) NEFMOD=198 IF (ITYP1.EQ.34) NEFMOD=199 IF (ITYP1.EQ.35) NEFMOD=200 IF (ITYP1.EQ.36) NEFMOD=201 IF (NEFMOD.EQ.0) GOTO 99 ELSEIF (ILNAVI.EQ.2) THEN C LIMS NEFMOD=0 IF (ITYP1.EQ. 3) NEFMOD=202 IF (ITYP1.EQ. 7) NEFMOD=203 IF (ITYP1.EQ.11) NEFMOD=204 IF (ITYP1.EQ.33) NEFMOD=205 IF (ITYP1.EQ.34) NEFMOD=206 IF (ITYP1.EQ.35) NEFMOD=207 IF (ITYP1.EQ.36) NEFMOD=208 IF (NEFMOD.EQ.0) GOTO 99 ELSEIF (ILNAVI.EQ.3) THEN C LBMS NEFMOD=0 IF (ITYP1.EQ. 3) NEFMOD=209 IF (ITYP1.EQ. 7) NEFMOD=210 IF (ITYP1.EQ.11) NEFMOD=211 IF (ITYP1.EQ.33) NEFMOD=212 IF (ITYP1.EQ.34) NEFMOD=213 IF (ITYP1.EQ.35) NEFMOD=214 IF (ITYP1.EQ.36) NEFMOD=215 IF (NEFMOD.EQ.0) GOTO 99 ELSEIF (ILNAVI.EQ.4) THEN C MCCE NEFMOD=0 IF (ITYP1.EQ. 3) NEFMOD=216 IF (ITYP1.EQ. 7) NEFMOD=217 IF (ITYP1.EQ.11) NEFMOD=218 IF (ITYP1.EQ.33) NEFMOD=219 IF (ITYP1.EQ.34) NEFMOD=220 IF (ITYP1.EQ.35) NEFMOD=221 IF (ITYP1.EQ.36) NEFMOD=222 IF (NEFMOD.EQ.0) GOTO 99 ELSEIF (ILNAVI.EQ.5) THEN C MCP1 NEFMOD=0 IF (ITYP1.EQ. 3) NEFMOD=223 IF (ITYP1.EQ. 7) NEFMOD=224 IF (ITYP1.EQ.11) NEFMOD=225 IF (ITYP1.EQ.33) NEFMOD=226 IF (ITYP1.EQ.34) NEFMOD=227 IF (ITYP1.EQ.35) NEFMOD=228 IF (ITYP1.EQ.36) NEFMOD=229 IF (NEFMOD.EQ.0) GOTO 99 ELSEIF (ILNAVI.EQ.6) THEN C MCMS NEFMOD=0 IF (ITYP1.EQ. 3) NEFMOD=230 IF (ITYP1.EQ. 7) NEFMOD=231 IF (ITYP1.EQ.11) NEFMOD=232 IF (ITYP1.EQ.33) NEFMOD=233 IF (ITYP1.EQ.34) NEFMOD=234 IF (ITYP1.EQ.35) NEFMOD=235 IF (ITYP1.EQ.36) NEFMOD=236 IF (NEFMOD.EQ.0) GOTO 99 ELSEIF (ILNAVI.EQ.7) THEN C QFCE NEFMOD=0 IF (ITYP1.EQ. 3) NEFMOD=237 IF (ITYP1.EQ. 7) NEFMOD=238 IF (ITYP1.EQ.11) NEFMOD=239 IF (ITYP1.EQ.33) NEFMOD=240 IF (ITYP1.EQ.34) NEFMOD=241 IF (ITYP1.EQ.35) NEFMOD=242 IF (ITYP1.EQ.36) NEFMOD=243 IF (NEFMOD.EQ.0) GOTO 99 ELSEIF (ILNAVI.EQ.8) THEN C QFP1 NEFMOD=0 IF (ITYP1.EQ. 3) NEFMOD=244 IF (ITYP1.EQ. 7) NEFMOD=245 IF (ITYP1.EQ.11) NEFMOD=246 IF (ITYP1.EQ.33) NEFMOD=247 IF (ITYP1.EQ.34) NEFMOD=248 IF (ITYP1.EQ.35) NEFMOD=249 IF (ITYP1.EQ.36) NEFMOD=250 IF (NEFMOD.EQ.0) GOTO 99 ELSEIF (ILNAVI.EQ.9) THEN C QFMS NEFMOD=0 IF (ITYP1.EQ. 3) NEFMOD=251 IF (ITYP1.EQ. 7) NEFMOD=252 IF (ITYP1.EQ.11) NEFMOD=253 IF (ITYP1.EQ.33) NEFMOD=254 IF (ITYP1.EQ.34) NEFMOD=255 IF (ITYP1.EQ.35) NEFMOD=256 IF (ITYP1.EQ.36) NEFMOD=257 IF (NEFMOD.EQ.0) GOTO 99 ENDIF C Cas de la formulation 'EULER' ELSE IF (LESFOR(1).EQ.'EULER') THEN NEFMOD=0 IF (ITYP1.EQ. 2) NEFMOD=ITYP1 IF (ITYP1.EQ. 4) NEFMOD=ITYP1 IF (ITYP1.EQ. 8) NEFMOD=ITYP1 IF (ITYP1.EQ.14) NEFMOD=ITYP1 IF (ITYP1.EQ.16) NEFMOD=ITYP1 IF (ITYP1.EQ.23) NEFMOD=ITYP1 IF (ITYP1.EQ.25) NEFMOD=ITYP1 IF (NEFMOD.EQ.0) GOTO 99 C Cas des autres formulations ELSE NEFMOD=ITYP1 c kich cas du POI1 if (ityp1.eq.1) nefmod = 45 C Cas particuliers des elements polygonaux IF (NEFMOD.EQ.32) NEFMOD=111+NBNN -3 C Cas particuliers des elements finis pour IDIM=1 IF (IDIM.EQ.1) THEN NEFMOD=0 IF (LESFOR(1).EQ.'THERMIQUE') THEN IF (iconv.NE.0 .OR. iraye.NE.0) THEN IF (ITYP1.EQ.1) NEFMOD=45 IF (ITYP1.EQ.2) NEFMOD=ITYP1 ELSE IF (ITYP1.EQ.2) NEFMOD=191 IF (ITYP1.EQ.3) NEFMOD=192 ENDIF ELSE IF (LESFOR(1).EQ.'MECANIQUE') THEN IF (ITYP1.EQ.2) NEFMOD=193 IF (ITYP1.EQ.3) NEFMOD=194 ELSE IF (LESFOR(1).EQ.'FISSURE') THEN IF (ITYP1.EQ.2) NEFMOD=ITYP1 ELSE IF (LESFOR(1).EQ.'ELECTROSTATIQUE') THEN IF (ITYP1.EQ.2) NEFMOD=193 IF (ITYP1.EQ.3) NEFMOD=194 ELSE IF (LESFOR(1).EQ.'DIFFUSION') THEN IF (ITYP1.EQ.2) NEFMOD=193 IF (ITYP1.EQ.3) NEFMOD=194 ENDIF ENDIF IF (NEFMOD.EQ.0) GOTO 99 MELE=NEFMOD ENDIF ENDIF * fin de le determination de NEFMOD zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz C Poursuite du remplissage du IM-eme modele elementaire IMODEL IF (NMAT.NE.0) THEN IF (LESFOR(1).EQ.'MELANGE') THEN MATMOD(1)=LESPRO(1) ELSE DO i=1,NMAT MATMOD(i)=LESPRO(i) ENDDO ENDIF ENDIF DO i=1,NFOR FORMOD(i)=LESFOR(i) ENDDO IF (MN3.NE.0) INFMOD(1)=NPINT IF (NPINT.NE.0.AND.NEFMOD.NE.28) THEN SEGSUP,IMODEL SEGSUP,MMODEL CALL ERREUR(608) RETURN ENDIF C Point support pour les modes en defo. GENE (IFOUR=-3, 7 a 11, 14) IPDPGE=IPTGEN IF (NSDPGE.LT.IPDPGE) NSDPGE=IPDPGE C Verification de l'existence du MMODEL CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,IMATE,INATU) IF (CMATE.EQ.' ') THEN write(ioimp,*) ' petit probleme apres nomate' SEGSUP,IMODEL SEGSUP,MMODEL CALL ERREUR(251) RETURN ENDIF C* Petit cas particulier en cas de modele VISCO_EXTERNE : C* On recupere IVIEX stocke dans INATU (cf. NOMATE) IF (INATU.LE.-2) THEN IVIEX = -2 - INATU INATU = -2 C* TYMODE(LMEIVI)='IVIEX ' IVAMOD(LMEIVI)= IVIEX ENDIF * ideriv=jderiv CMATEE=CMATE IMATEE=IMATE INATUU=INATU * initialisation des nomid IF (FORMOD(1).NE.'NAVIER_STOKES'.AND.FORMOD(1).NE.'EULER' &.AND.formod(1).ne.'MELANGE') THEN if (formod(1).EQ.'LIAISON') then linomid=.false. else linomid=.true. do jn = 1,matmod(/2) if (matmod(jn).eq.'MODAL'.or.matmod(jn).eq.'STATIQUE' & .or.matmod(jn).eq.'IMPEDANCE') & linomid =.false. enddo endif if (linomid) then call inomid(imodel,' ',iret,lucvar,lucmat,lucmaf,luparx) endif ELSE linomid=.true. ENDIF C Quelques tests supplementaires en attendant mieux IF(LESFOR(1).EQ.'THERMIQUE') THEN IF(MATMOD(/2).GE.2)THEN call place(MATMOD,MATMOD(/2),IPLAZ,'PHASE') IF(iplaz.ne.0 ) THEN c test que les elements sont lineaires ipt4=imamod segact ipt4 itt=ipt4.itypel if(kdegre(itt) .gt. 2) then call erreur(982) return endif endif endif endif IF (LESFOR(1).EQ.'MECANIQUE') THEN C Cas du materiau unidirectionnel IF (IMATE.EQ.4) THEN MFR=NUMMFR(NEFMOD) C Cas des cerces : sans interet ! IF (MFR.EQ.27) THEN SEGSUP,IMODEL SEGSUP,MMODEL CALL ERREUR(251) RETURN ENDIF C Cas de la plasticite IF (INATU.NE.0) THEN C OK si massif bidim ou si coque tridim dans le cas acier_uni IF (INATU.EQ.40)THEN IF ((MFR.NE.1.OR.IFOUR.GT.0).AND. . ((MFR.NE.3.AND.MFR.NE.9).OR.IFOUR.NE.2)) THEN SEGSUP IMODEL SEGSUP MMODEL CALL ERREUR(251) RETURN ENDIF C Dans les autres cas, on n'autorise pour le moment que COQ2 et massif ELSE IF (MELE.NE.44.AND.MFR.NE.1) THEN SEGSUP IMODEL SEGSUP MMODEL CALL ERREUR(251) RETURN ENDIF ENDIF ENDIF * * Cas du materiau 'ZONE_COHESIVE' IF (IMATE.EQ.12) THEN MFR=NUMMFR(NEFMOD) IF (MFR.NE.77) THEN SEGSUP,IMODEL SEGSUP,MMODEL CALL ERREUR(251) RETURN ENDIF ENDIF C Cas du modele section : on n'autorise pour le moment que TIMO IF (CMATE.EQ.'SECTION'.AND.MELE.NE.84) THEN SEGSUP,IMODEL SEGSUP,MMODEL CALL ERREUR(251) RETURN ENDIF ENDIF C Le modele de GURSON n'est possible qu'en 3D, axisymetrique ou C deformations planes IF (INATU.EQ.38) THEN IF ( (IFOUR.NE.0).AND.(IFOUR.NE.2).AND.(IFOUR.NE.-1) ) THEN SEGSUP,IMODEL SEGSUP,MMODEL MOTERR(1:8)='GURSON' MOTERR(9:16)='MECANIQU' INTERR(1) = IFOUR CALL ERREUR (81) RETURN ENDIF ENDIF C Le modele ISS_GRANGE n'est utilisable qu'en 3D IF ((INATU.EQ.151).AND.(IFOUR.NE.2)) THEN SEGSUP,IMODEL SEGSUP,MMODEL INTERR(1) = IFOUR CALL ERREUR (709) RETURN ENDIF C Le modele RUP_THER n'est utilisable qu'en 3D IF ((INATU.EQ.152).AND.(IFOUR.NE.2)) THEN SEGSUP,IMODEL SEGSUP,MMODEL INTERR(1) = IFOUR CALL ERREUR (709) RETURN ENDIF C Le modele COULOMB n'est utilisable qu'en 3D avec les éléments JOI1 IF ((INATU.EQ.34).AND.(IFOUR.NE.2) . .AND.(NUMMFR(NEFMOD).EQ.75)) THEN SEGSUP,IMODEL SEGSUP,MMODEL INTERR(1) = IFOUR CALL ERREUR (709) RETURN ENDIF C.. Restrictions en formulation 'MECANIQUE' avec une loi de C comportement non lineaire externe C Rappel : LMEEXT exprime la condition (NFOR.EQ.1) ET C (LESFOR(1).EQ.'MECANIQUE') ET (loi non lineaire externe) IF ( LMEEXT ) THEN C En formulation 'MECANIQUE', les lois non lineaires externes C n'autorisent qu'une seule composante de temperature C => incompatibilite avec des modeles de coques n'ayant pas C de points d'integration dans l'epaisseur (trois composantes C dans ce cas, 'TINF', 'T ' et 'TSUP') C Le test ci-dessous est coherent avec celui de IDTEMP. MFR = NUMMFR(NEFMOD) IF ( (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9).AND. . (NPINT.EQ.0) ) THEN SEGSUP IMODEL SEGSUP MMODEL CALL ERREUR(951) RETURN ENDIF C Les lois de la famille 'VISCO_EXTERNE' ne s'appliquent pour C l'instant qu'aux elements massifs, avec option de calcul 3D C Et restriction pour l'instant a 'VISCO_EXTERNE' 'GENERAL' IF ( LMEVIX ) THEN IF ((MFR.NE.1.AND.MFR.NE.31) .OR. IFOUR.NE.2) THEN KERRE = 950 ELSE IF ( IVIEX.NE.1 ) THEN KERRE = 958 ELSE KERRE = 0 ENDIF IF (KERRE.NE.0) THEN SEGSUP IMODEL SEGSUP MMODEL CALL ERREUR(KERRE) RETURN ENDIF ENDIF ENDIF C Formulation 'CONVECTION' C Adequation EF de type COQue et mot 'INFERIEURE' / 'SUPERIEURE' IF (LESFOR(1).EQ.'CONVECTION') THEN IF (NMAT.NE.0.AND.NEFMOD.NE.27.AND.NEFMOD.NE.41.AND. . NEFMOD.NE.44.AND.NEFMOD.NE.49.AND.NEFMOD.NE.56) THEN SEGSUP,IMODEL SEGSUP,MMODEL CALL ERREUR(16) RETURN ENDIF IF (NMAT.EQ.0.AND.(NEFMOD.EQ.27.OR.NEFMOD.EQ.41.OR. . NEFMOD.EQ.44.OR.NEFMOD.EQ.49.OR.NEFMOD.EQ.56)) THEN SEGSUP,IMODEL SEGSUP,MMODEL CALL ERREUR(513) RETURN ENDIF ENDIF C Formulation 'DIFFUSION' - Modele UTILISATEUR : C Verification que les composantes "lineaires" sont declarees IF (LESFOR(1) .EQ. 'DIFFUSION' .AND. LDIEXT) THEN CALL IDDILI(IMATE,0, MOCOMP,NBROBL,NBRFAC) MLMOTS = MOCOMP MLMOT1 = lucmat SEGACT,MLMOT1 NBCOMP = MLMOT1.MOTS(/2) ICOMP = 0 DO i = 1, NBROBL CALL PLACE(MLMOT1.MOTS,NBCOMP,IPLAC,MOTS(i)) IF (IPLAC.EQ.0) THEN WRITE(IOIMP,80) MOTS(i) 80 FORMAT('La composante obligatoire ',A8,' est absente') ELSE ICOMP = ICOMP+1 ENDIF ENDDO SEGDES,MLMOT1 SEGSUP,MLMOTS IF (ICOMP.NE.NBROBL) THEN CALL ERREUR(21) RETURN ENDIF ENDIF C Petite verification (a priori sans probleme) IF (LESFOR(1) .EQ. 'DIFFUSION' .OR. & LESFOR(1) .EQ. 'ELECTROSTATIQUE') THEN MFR1 = NUMMFR(nefmod) IF (MFR1.NE.1) THEN CALL ERREUR(21) RETURN ENDIF ENDIF *kich 11 CONTINUE * initialisation du infele et des segment d'integration IF (LESFOR(1).EQ.'MECANIQUE' .OR. LESFOR(1).EQ.'POREUX'.OR. $ LESFOR(1).EQ.'LIQUIDE' .OR. LESFOR(1).EQ.'DIFFUSION' .OR. $ LESFOR(1).EQ.'ELECTROSTATIQUE' .OR. $ NFOR.EQ.2 ) THEN infele(2)=npint infele(3)=ngmas infele(4)=ngcon infele(6)=ngrig call prquoi (imodel) endif * initialisation des nomid (cas particuliers) if (.not.linomid) then if (irmot1.eq.1) then mlmot5 = jlmot1 mlmot6 = jlmot2 segact mlmot5,mlmot6 if (mlmot5.mots(/2).ne.mlmot6.mots(/2)) call erreur(26) lucvar = jlmot1 lucmat = jlmot2 nobmod = 2 segadj imodel ivamod(1) = jlmot1 ivamod(2) = jlmot2 tymode(1) = 'LISTMOTS' tymode(2) = 'LISTMOTS' endif call prquoi (imodel) call inomid(imodel,' ',iret,lucvar,lucmat,lucmaf,luparx) endif *kich C Verification de non redondance des nom des composantes C sauf pour les formulations Navier_Stokes et Euler IF (FORMOD(1).NE.'NAVIER_STOKES'.AND.FORMOD(1).NE.'EULER') THEN ipmo=imodel mfr1=NUMMFR(nefmod) mfr2 = infele(13) CALL cotemo(ipmo,mfr2) IF (IERR.NE.0) RETURN ENDIF IF (IM.EQ.1) MFRTMP=mfr1 SEGDES,IMODEL 10 CONTINUE ***************************************************** * fin de boucle sur les sous-parties du maillages ************************************************** C maillage non conforme bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb C ** On cree les multiplicateurs de Lagrange IF (MELEME.LISOUS(/1).EQ.0) GOTO 66 IF (ICONFO.EQ.0) GOTO 66 NBLIS=MELEME.LISOUS(/1) LDEPL=0 IADEPL=0 IF (NFOR.EQ.1) THEN IF (LESFOR(1).EQ.'MECANIQUE') THEN IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-3) THEN LDEPL=2 IADEPL=0 ELSE IF (IFOUR.EQ.0) THEN LDEPL=2 IADEPL=3 ELSE IF (IFOUR.EQ.1) THEN LDEPL=3 IADEPL=3 ELSE IF (IFOUR.EQ.2) THEN LDEPL=3 IADEPL=0 ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN IF (IFOUR.LE.6) THEN LDEPL=1 IADEPL=0 ELSE IF (IFOUR.GE.7.AND.IFOUR.LE.10) THEN LDEPL=2 IADEPL=0 IF (IFOUR.EQ.9.OR.IFOUR.EQ.10) ISPE1D=1 ELSE IF (IFOUR.EQ.11) THEN LDEPL=3 IADEPL=0 ELSE IF (IFOUR.EQ.15) THEN LDEPL=2 IADEPL=3 ELSE LDEPL=1 IADEPL=3 ENDIF ENDIF ELSE IF(LESFOR(1).EQ.'LIQUIDE') THEN LDEPL=2 IADEPL=6 ELSE IF(LESFOR(1).EQ.'THERMIQUE') THEN LDEPL= 1 IADEPL=8 ELSE IF(LESFOR(1).EQ.'DARCY') THEN LDEPL= 1 IADEPL=9 ELSE IF (LESFOR(1).EQ.'ELECTROSTATIQUE') THEN LDEPL= 1 IADEPL= 10 ELSE IF (LESFOR(1).EQ.'DIFFUSION') THEN LDEPL= 1 IADEPL=-1 ELSE LDEPL=0 IADEPL=0 ENDIF ENDIF NBMULT=LDEPL N1=MAX(1,MELEME.LISOUS(/1))+ICONFO*(NBMULT-1) MMODEL=IPMODE SEGADJ MMODEL INDIC=MMODEL.KMODEL(/1) KNBPT=0 DO 13 INB=1,MELEME.LISOUS(/1) IPT2=MELEME.LISOUS(INB) SEGACT IPT2 IF (IPT2.ITYPEL.NE.48) GOTO 13 KNBPT=KNBPT+IPT2.NUM(/2) DO 15 K=1,NBMULT NBNN=IPT2.NUM(/1)+1 NBELEM=IPT2.NUM(/2) NBSOUS=0 NBREF=0 SEGINI IPT3 IPT3.ITYPEL=22 DO 14 J=1,IPT2.NUM(/2) ipt3.icolor(j)=ipt2.icolor(j) DO 14 I=1,IPT2.NUM(/1) IPT3.NUM(I+1,J)=IPT2.NUM(I,J) 14 CONTINUE MN3=1 NFOR=1 NMAT=0 NOBMOD=0 Nbrobl=1 NBRFAC=0 SEGINI NOMID IF (IADEPL.GE.0) THEN LESOBL(1)=MODEPL(IADEPL+K) ELSE LESOBL(1)=MDIINC ENDIF SEGDES NOMID SEGINI IMODE5 SEGACT MMODEL*MOD IMODE5.CONMOD=CONM IMODE5.IMAMOD=IPT3 IMODE5.NEFMOD=22 IMODE5.INFMOD=MFRTMP IMODE5.conmod(17:24)=' ' IMODE5.LNOMID(1)=NOMID IMODE5.FORMOD(1)=LESFOR(1) IF (K.NE.1) THEN MMODEL.KMODEL(INDIC)=IMODE5 INDIC=INDIC-1 ELSE MMODEL.KMODEL(INB)=IMODE5 ENDIF SEGDES IMODE5 15 CONTINUE 13 CONTINUE C ** NBPT1=XCOOR(/1)/(IDIM+1) NBPTS=NBPT1+KNBPT*NBMULT SEGADJ MCOORD DO 65 K=1,MMODEL.KMODEL(/1) IMODE5=MMODEL.KMODEL(K) SEGACT IMODE5*MOD,MMODEL*MOD IF (IMODE5.NEFMOD.NE.22 ) GOTO 65 IPT3=IMODE5.IMAMOD NBLI=IPT3.NUM(/1) SEGACT IPT3*MOD DO 67 I=1,IPT3.NUM(/2) NGLOB=(NBPT1+I-1)*(IDIM+1) XCOOR(NGLOB+1)=XCOOR((IPT3.NUM(NBLI,I)-1)*(IDIM+1)+1) XCOOR(NGLOB+2)=XCOOR((IPT3.NUM(NBLI,I)-1)*(IDIM+1)+2) IPT3.NUM(1,I)=NBPT1+I 67 CONTINUE IMODE5.IMAMOD=IPT3 MMODEL.KMODEL(K)=IMODE5 NBPT1=NBPT1+IPT3.NUM(/2) C SEGDES IMODE5,IPT3 65 CONTINUE C SEGDES MMODEL *** fin maillage non conformes bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb 66 CONTINUE DO 68 K=1,MMODEL.KMODEL(/1) IMODE5=MMODEL.KMODEL(K) SEGACT IMODE5 IF (IMODE5.NEFMOD.NE.22 ) GOTO 68 IPT3=IMODE5.IMAMOD SEGACT IPT3 68 CONTINUE IPMODE=MMODEL C construction modeles elementaires pour MELANGE cccccccccccccc C une loi de melange pointe sur des modeles C elementaires de meme support lomela = .true. IF (LESFOR(1).eq.'MELANGE') THEN segini limode do 500 ilm = 1,NMAT1 IF (LESMOD(ilm).GT.0) THEN n1 = nsou1 segini mmode2 WRITE(CONM,FMT='(I16)') mmode2 segsup mmode2 do 511 im = 1,nsou1 imodel = kmodel(im) IF (ilm.eq.1) THEN segact imodel*mod nmat = 1 mn3 = infmod(/1) nfor = 1 nobmod = ivamod(/1) segadj imodel ELSE segact imodel MN3 = infmod(/1) NFOR = 1 NMAT = 1 NOBMOD = 0 segini imode2 imode2.imamod = imamod imode2.nefmod = nefmod if (mn3.gt.0) then do imm = 1,mn3 imode2.infmod(imm) = infmod(imm) enddo endif imode2.formod(1) = 'MELANGE' imode2.IPDPGE = IPDPGE imode2.conmod = conm imode2.conmod(17:24) = pham imodel = imode2 limode(**) = imodel matmod(1) = lespro(ilm) ENDIF c lmomat = 0 c lmovar = 0 MMODE1 = LESMOD(ilm) SEGACT MMODE1 kbmod = ivamod(/1) nobmod = kbmod + MMODE1.KMODEL(/1) segadj imodel DO 515 im1 = 1,MMODE1.KMODEL(/1) imode1 = mmode1.kmodel(im1) segact imode1 mfo1 = imode1.formod(/2) mma1 = imode1.matmod(/2) if (imode1.conmod(17:24).eq.' ') then write(ioimp,*) 'pas de nom de phase pour MELANGE ' lomela = .false. endif IF (imodel.imamod.eq.imode1.imamod) THEN * quelques verifs if (matmod(1).eq.'SERIE'.and.im1.gt.1) then do im2 = 1,MMODE1.KMODEL(/1) imode2 = mmode1.kmodel(im2) segact imode2 mfo2 = imode2.formod(/2) mma2 = imode2.matmod(/2) if (mfo1.eq.mfo2.and.imode1.formod(mfo1).eq.imode2.formod(mfo2)) & then ** pas de phase identique dans la meme fomulation ** if (imode1.conmod(17:24).eq.imode2.conmod(17:24)) lomela =.false. if (mma1.ne.mma2.OR. & imode1.matmod(mma1).ne.imode2.matmod(mma2)) lomela = .false. endif enddo endif IF (.NOT.lomela) THEN **** detruire 509 do imu = 1,kmodel(/1) imodel = kmodel(imu) segsup imodel enddo segsup mmodel do imu1 = 1,MMODE1.KMODEL(/1) IMODE1 = MMODE1.KMODEL(imu1) segdes imode1 enddo segdes mmode1 call erreur(251) return ENDIF **** kbmod = kbmod + 1 tymode(kbmod) = 'IMODEL' ivamod(kbmod) = imode1 ENDIF 515 CONTINUE nobmod = kbmod segadj imodel MFR = NUMMFR(NEFMOD) CALL IDMATR(MFR,IMODEL,IPNOMC,NOBL,NFAC) segdes imodel 511 continue do 503 im1 = 1,MMODE1.KMODEL(/1) IMODE1 = MMODE1.KMODEL(im1) segdes imode1 503 continue segdes mmode1 ELSE do im = 1,nsou1 imodel = kmodel(im) segact imodel*mod nmat = 1 segadj imodel enddo ENDIF 500 continue n1i = kmodel(/1) N1 = kmodel(/1) + limode(/1) segadj mmodel do 502 is = 1,limode(/1) kmodel(n1i + is) = limode(is) 502 continue segsup limode ENDIF C fin des lois melanges ccccccccccccccccccccccccccccccccccccccccccccc * * traitement si en entree des modèles 70 CONTINUE IF (iremod.gt.0) THEN do im = 1,kmodel(/1) imodel = kmodel(im) segact imodel*mod if (CONM.NE.' ') conmod = CONM if (PHAM.NE.' ') conmod(17:24) = PHAM if (IPTGEN.GT.0) IPDPGE=IPTGEN if (NPINT.GT.0) write(ioimp,*) 'ne change pas le nb pts inte' segdes imodel enddo ENDIF C en cas de modele STAT ddddddddddddddddddddddddddddddddddddddddddd C cas du mot cle STAT : pointer le modele elementaire approprie IF (ipmod1.gt.0) THEN MMODE1 = ipmod1 SEGACT MMODE1 DO im1 = 1,MMODE1.KMODEL(/1) IMODE1 = MMODE1.KMODEL(im1) segact imode1 ENDDO DO im = 1,kmodel(/1) imodel = kmodel(im) segact imodel*mod nobmod = ivamod(/1) nobmod = nobmod + 1 nfor = formod(/2) nmat = matmod(/2) mn3 = infmod(/1) segadj imodel kbmod = 0 do im1 = 1,MMODE1.KMODEL(/1) imode1 = mmode1.kmodel(im1) imomo = imode1 lostat = .true. * criteres de verif assez faibles ... if (imode1.nefmod.eq.nefmod.and. & imode1.imamod.ne.imamod.and. & imode1.matmod(/2).eq.matmod(/2).and. & imode1.formod(/2).eq.formod(/2)) then do lmo = 1,formod(/2) if (formod(lmo).ne.imode1.formod(lmo)) lostat = .false. enddo do lmo = 1,matmod(/2) if (matmod(lmo).ne.imode1.matmod(lmo)) lostat = .false. enddo else lostat = .false. endif if (lostat.and.formod(1).eq.'MELANGE') then * verifs supplementaires : les modeles de ivamod sont ils bien construi lomela = .true. if ((nobmod - imode1.ivamod(/1)).gt.1) lomela = .false. if (imode1.ivamod(/1).gt.0) then do ivm3 = 1,imode1.ivamod(/1) IF(imode1.tymode(ivm3).eq.'IMODEL') THEN imode3 = imode1.ivamod(ivm3) segact imode3 ENDIF enddo endif IF (nobmod.gt.1) THEN do ivm1 = 1,(nobmod-1) imode2 = ivamod(ivm1) segact imode2 cc if (imode2.ivamod(/1).ge.1) then do ivm2 = 1,imode2.ivamod(/1) if (imode2.tymode(ivm2).eq.'STATIO') then imode4 = imode2.ivamod(ivm2) segact imode4 if (imode1.ivamod(/1).ge.1) then do ivm3 = 1,imode1.ivamod(/1) IF(imode1.tymode(ivm3).eq.'IMODEL') THEN imode3 = imode1.ivamod(ivm3) cc lostat = .true. * criteres de verif assez faibles ... if (imode3.nefmod.eq.imode4.nefmod.and. & imode3.imamod.eq.imode4.imamod.and. & imode3.matmod(/2).eq.imode4.matmod(/2).and. & imode3.conmod(17:24).eq.imode4.conmod(17:24).and. & imode3.formod(/2).eq.imode4.formod(/2)) then do lmo = 1,imode4.formod(/2) if (imode4.formod(lmo).ne.imode3.formod(lmo)) lostat = .false. enddo do lmo = 1,imode4.matmod(/2) if (imode4.matmod(lmo).ne.imode3.matmod(lmo)) lostat = .false. enddo else lostat = .false. endif if (lostat) then segdes imode4 goto 75 endif cc ENDIF enddo else lostat = .false. endif endif segdes imode4 enddo * else lomela = .false. endif 75 lomela = lomela.and.lostat segdes imode2 enddo ENDIF lostat = lomela do ivm3 = 1,imode1.ivamod(/1) c imode1 = imomo IF(imode1.tymode(ivm3).eq.'IMODEL') THEN imode3 = imode1.ivamod(ivm3) segdes imode3 ENDIF enddo endif if (lostat) then kbmod = kbmod + 1 tymode(nobmod) = 'STATIO' ivamod(nobmod) = imomo goto 79 endif enddo **** ca se passe mal if (kbmod.ne.1) then do imu = 1,kmodel(/1) imodel = kmodel(imu) segsup imodel enddo segsup mmodel do im1 = 1,MMODE1.KMODEL(/1) IMODE1 = MMODE1.KMODEL(im1) segdes imode1 enddo segdes mmode1 write(ioimp,*) ' STATIO EN DEFAUT voir notice ' call erreur(251) return endif **** 79 segdes imodel ENDDO DO im1 = 1,MMODE1.KMODEL(/1) IMODE1 = MMODE1.KMODEL(im1) segdes imode1 ENDDO SEGDES MMODE1 ENDIF * fin du modele STAT ddddddddddddddddddddddddddddddddddddddddddddddd IF (IPGEOM.NE.0) SEGDES,MELEME C Ecriture de l'objet MODELE cree SEGDES,MMODEL CALL ECROBJ('MMODEL',IPMODE) RETURN C Traitement des ERREURS 99 CALL ERREUR(21) IF (IPGEOM.NE.0) SEGDES,MELEME SEGSUP,MMODEL RETURN END