C IDMATR SOURCE JK148537 23/10/23 21:15:04 11769 SUBROUTINE IDMATR(MFR,IPMODL,IPNOMC,NBROBL,NBRFAC) *--------------------------------------------------------------------* * Noms de composantes de materiaux * *--------------------------------------------------------------------* * * * ENTREES: * * MFR Numero de formulation * * IPMODL objet modele elementaire ( segment actif ) * * * * SORTIES: * * IPNOMC pointeur sur les listes de noms de composantes * * obligatoires et facultatives * * NBROBL nombre de composantes obligatoires * * NBRFAC nombre de composantes facultatives * * * *--------------------------------------------------------------------* * IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMLMOTS -INC SMMODEL POINTEUR NOMID1.NOMID * ******Modif SELLIER **************************************************** * augmentation nombre de caracteristiques * PARAMETER (ITA=100) * CHARACTER*16 MOMODL(100) PARAMETER (ITA=500) CHARACTER*16 MOMODL(500) integer I,J,K,L c nombre de variables et de parametres par variables c include './nombre_helmholtz.h' -INC HNBRHEL CHARACTER*1 motnl1,motnlv1,motnld1,motnla1 CHARACTER*2 motnl2 CHARACTER*3 motnl3 CHARACTER*4 motnl4 ******fin modif SELLIER ************************************************ CHARACTER*(LOCOMP) TABOBL(ITA),TABFAC(ITA) * IMODEL=IPMODL * Le segment existe-t-il deja? IF (lnomid(6).NE.0) THEN nomid = lnomid(6) SEGACT,nomid nbrobl = lesobl(/2) nbrfac = lesfac(/2) IF (nbrobl+nbrfac.EQ.0) GOTO 765 SEGINI,nomid1=nomid ipnomc=nomid1 RETURN ENDIF 765 CONTINUE JGOBL=0 JGFAC=0 ipnomc=0 IRET = 1 * NMAT=MATMOD(/2) NFOR=FORMOD(/2) MELE=NEFMOD *-------------------------------------------------------------------- * CAS DE LA FORMULATION THERMOHYDRIQUE *-------------------------------------------------------------------- CALL PLACE(FORMOD,NFOR,ithehy,'THERMOHYDRIQUE') IF (ithehy.ne.0) then if ( matmod(1).eq.'SCHREFLER') then JGOBL = 20 TABOBL(1)='KGG' TABOBL(2)='KGC' TABOBL(3)='KGT' TABOBL(4)='KCG' TABOBL(5)='KCC' TABOBL(6)='KCT' TABOBL(7)='KTG' TABOBL(8)='KTC' TABOBL(9)='KTT' TABOBL(10)='CGG' TABOBL(11)='CGC' TABOBL(12)='CGT' TABOBL(13)='CCG' TABOBL(14)='CCC' TABOBL(15)='CCT' TABOBL(16)='CTG' TABOBL(17)='CTC' TABOBL(18)='CTT' TABOBL(19)='KTGG' TABOBL(20)='KTCG' else IRET = 0 call erreur(5) endif GO TO 9999 ENDIF *-------------------------------------------------------------------- * CAS DE LA FORMULATION LIQUIDE ET ELEMENT DE RACCORD LITU *-------------------------------------------------------------------- CALL PLACE(FORMOD,NFOR,ILIQU,'LIQUIDE') IF (ILIQU.NE.0) THEN IF (MFR.NE.41.AND.MFR.NE.43) THEN JGOBL = 6 TABOBL(1)='RHO ' TABOBL(2)='CSON' TABOBL(3)='RORF' TABOBL(4)='CREF' TABOBL(5)='LCAR' TABOBL(6)='G ' ELSEIF (MFR.EQ.41) THEN JGOBL = 5 TABOBL(1)='RHO ' TABOBL(2)='CSON' TABOBL(3)='RORF' TABOBL(4)='CREF' TABOBL(5)='LCAR' c* ELSEIF (MFR.EQ.43) THEN ELSE JGOBL = 3 TABOBL(1)='RHO ' TABOBL(2)='LCAR' TABOBL(3)='RORF' ENDIF GOTO 9999 ENDIF *-------------------------------------------------------------------- * CAS DE LA FORMULATION THERMIQUE * CAS DE LA FORMULATION DARCY *-------------------------------------------------------------------- CALL PLACE(FORMOD,NFOR,ITHER ,'THERMIQUE') CALL PLACE(FORMOD,NFOR,IDARCY,'DARCY' ) IF (ITHER.NE.0 .OR. IDARCY.NE.0) THEN IF (ITHER.NE.0) THEN C Cas particuliers de THERMIQUE CONVECTION : CALL PLACE(MATMOD,NMAT,ICONV,'CONVECTION') IF (ICONV.NE.0) THEN C IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN CC Coques thermiques C JGOBL =2 C TABOBL(1)='HINF' C TABOBL(2)='HSUP' C JGFAC =2 C TABFAC(1)='TCINF' C TABFAC(2)='TCSUP' C else C Elements massifs JGOBL = 1 TABOBL(1)='H' JGFAC=1 TABFAC(1)='TC' C endif GOTO 9999 ENDIF C Cas particuliers de THERMIQUE RAYONNEMENT : CALL PLACE(MATMOD,NMAT,IRAYE,'RAYONNEMENT') IF (IRAYE.NE.0) THEN C Cas particuliers de THERMIQUE RAYONNEMENT : CALL PLACE(MATMOD,NMAT,ICAVE,'CAVITE') CALL PLACE(MATMOD,NMAT,IFACA,'FAC_A_FAC') CALL PLACE(MATMOD,NMAT,IINFI,'INFINI') IF (ICAVE.NE.0) THEN C RAYONNEMENT en CAVITE : IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN JGOBL=2 TABOBL(1)='EINF' TABOBL(2)='ESUP' else JGOBL=1 TABOBL(1)='EMIS' endif JGFAC=3 TABFAC(1)='CABS' TABFAC(2)='TABS' TABFAC(3)='H' ELSEIF (IFACA.NE.0) THEN C RAYONNEMENT FACE_A_FACE : JGOBL=1 TABOBL(1)='EMIS' JGFAC = 1 TABFAC(1)='H' ELSEIF (IINFI.NE.0) THEN C RAYONNEMENT a l'INFINI : IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN JGOBL=3 TABOBL(1)='EINF' TABOBL(2)='ESUP' TABOBL(3)='T_IN' ELSE JGOBL=2 TABOBL(1)='EMIS' TABOBL(2)='T_IN' ENDIF JGFAC = 2 TABFAC(1)='E_IN' TABFAC(2)='H' ELSE IRET = 0 CALL ERREUR(5) ENDIF GOTO 9999 ENDIF C Cas particuliers de THERMIQUE SOURCE : ISRCE = 0 CALL PLACE(MATMOD,NMAT,ISRCE,'SOURCE') IF (ISRCE.NE.0) THEN IF (INATUU.EQ.1.AND.IMATEE.EQ.1) THEN JGOBL = 1 TABOBL(1)='QVOL' JGFAC = 2 TABFAC(1)='QINF' TABFAC(2)='QSUP' GOTO 9999 ELSEIF (INATUU.EQ.2.AND.IMATEE.EQ.1) THEN JGOBL = 3 TABOBL(1)='QTOT' TABOBL(2)='ORIG' TABOBL(3)='RGAU' GOTO 9999 ELSEIF (INATUU.EQ.2.AND.IMATEE.EQ.2) THEN JGOBL = 5 TABOBL(1)='QTOT' TABOBL(2)='ORIG' TABOBL(3)='RGAU' TABOBL(4)='DIRE' TABOBL(5)='ZGAU' GOTO 9999 ELSE c write(6,*) 'INATUU, IMATEE =',INATUU, IMATEE WRITE(6,*) ' Dans IDMATR : numero IMATEE non prevu' CALL ERREUR(21) RETURN ENDIF ENDIF ENDIF C* Cas THERMIQUE et DARCY CALL PLACE(MATMOD,NMAT,IORTH,'ORTHOTROPE') CALL PLACE(MATMOD,NMAT,IANIS,'ANISOTROPE') IF (IORTH.EQ.0.AND.IANIS.EQ.0)THEN JGOBL = 1 IF(MFR .EQ. 75)THEN C Cas des JOI1 (MFR=75) ==> Ressorts THERMIQUES C ==================== TABOBL(1)='KT' ELSE TABOBL(1)='K ' ENDIF ELSEIF (IORTH.NE.0) THEN * ELEMENTS COQUES IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN JGOBL=5 TABOBL(1)='K1 ' TABOBL(2)='K2 ' TABOBL(3)='K3 ' TABOBL(4)='V1X ' TABOBL(5)='V1Y ' ELSEIF (MFR.EQ.1.OR.MFR.EQ.45) THEN * ELEMENTS MASSIFS et HYBRIDES IF (IDIM.EQ.2) THEN IF (IFOMOD.EQ.1) THEN * ELEMENT MASSIF DE FOURIER JGOBL=5 TABOBL(1)='K1 ' TABOBL(2)='K2 ' TABOBL(3)='V1X ' TABOBL(4)='V1Y ' TABOBL(5)='K3 ' ELSE JGOBL=4 TABOBL(1)='K1 ' TABOBL(2)='K2 ' TABOBL(3)='V1X ' TABOBL(4)='V1Y ' ENDIF ELSEIF (IDIM.EQ.3) THEN JGOBL=9 TABOBL(1)='K1 ' TABOBL(2)='K2 ' TABOBL(3)='K3 ' TABOBL(4)='V1X ' TABOBL(5)='V1Y ' TABOBL(6)='V1Z ' TABOBL(7)='V2X ' TABOBL(8)='V2Y ' TABOBL(9)='V2Z ' ENDIF ENDIF ELSEIF (IANIS.NE.0) THEN * ELEMENTS MASSIFS IF (MFR.EQ.1.OR.MFR.EQ.45) THEN IF (IDIM.EQ.2) THEN IF (IFOMOD.EQ.1) THEN * ELEMENT MASSIF DE FOURIER JGOBL=6 TABOBL(1)='K11 ' TABOBL(2)='K22 ' TABOBL(3)='K21 ' TABOBL(4)='V1X ' TABOBL(5)='V1Y ' TABOBL(6)='K33 ' ELSE JGOBL=5 TABOBL(1)='K11 ' TABOBL(2)='K22 ' TABOBL(3)='K21 ' TABOBL(4)='V1X ' TABOBL(5)='V1Y ' ENDIF ELSEIF (IDIM.EQ.3) THEN JGOBL=12 TABOBL(1)='K11 ' TABOBL(2)='K22 ' TABOBL(3)='K33 ' TABOBL(4)='K21 ' TABOBL(5)='K31 ' TABOBL(6)='K32 ' TABOBL(7)='V1X ' TABOBL(8)='V1Y ' TABOBL(9)='V1Z ' TABOBL(10)='V2X ' TABOBL(11)='V2Y ' TABOBL(12)='V2Z ' ENDIF ENDIF ENDIF C* C* Cas THERMIQUE CONDUCTION, THERMIQUE PHASE ou THERMIQUE ADVECTION : IF (ITHER.NE.0) THEN CALL PLACE(MATMOD,NMAT,IPHA,'PHASE') IF (IPHA.NE.0) THEN JGOBL0 = JGOBL JGOBL= JGOBL0+4 TABOBL(JGOBL0+1)='RHO ' TABOBL(JGOBL0+2)='C ' TABOBL(JGOBL0+3)='QLAT' TABOBL(JGOBL0+4)='TPHA' JGFAC=1 TABFAC(1)='H ' GOTO 9999 ENDIF CALL PLACE(MATMOD,NMAT,IADVE,'ADVECTION') if (iadve .ne. 0) then C Cas des Tuyaux 1D (MFR=79) C =========================== IF (MFR .EQ. 79) THEN JGFAC = 3 TABFAC(1)='RHO ' TABFAC(2)='C ' TABFAC(3)='VITE' C Cas Massif (MFR=1) C =========================== ELSEIF (MFR .EQ. 1) THEN C Bidimensionnel PLAN DPGE C =========================== IF (IFOUR.EQ.-3) THEN JGFAC = 5 TABFAC(1)='RHO ' TABFAC(2)='C ' TABFAC(3)='VITX' TABFAC(4)='VITY' TABFAC(5)='VITZ' C Bidimensionnel PLAN (CP/DP) C =========================== ELSEIF (IFOUR.EQ.-2 .OR. IFOUR.EQ.-1) THEN JGFAC = 4 TABFAC(1)='RHO ' TABFAC(2)='C ' TABFAC(3)='VITX' TABFAC(4)='VITY' C Axisymetrie C =========================== ELSEIF (IFOUR .EQ. 0) THEN JGFAC = 4 TABFAC(1)='RHO ' TABFAC(2)='C ' TABFAC(3)='VITR' TABFAC(4)='VITZ' C Fourier C =========================== ELSEIF (IFOUR .EQ. 1) THEN CALL ERREUR(21) RETURN C JGFAC = 5C C TABFAC(1)='RHO ' C TABFAC(2)='C ' C TABFAC(3)='VITR' C TABFAC(4)='VITZ' C TABFAC(5)='VITT' C Tridimensionnel C =========================== ELSEIF (IFOUR .EQ. 2) THEN JGFAC = 5 TABFAC(1)='RHO ' TABFAC(2)='C ' TABFAC(3)='VITX' TABFAC(4)='VITY' TABFAC(5)='VITZ' C Unidimensionnel (1D) C =========================== ELSEIF (IFOUR.GE.3 .AND. IFOUR.LE.15) THEN IF (IFOUR.LE.6) THEN JGFAC = 3 TABFAC(1)='RHO ' TABFAC(2)='C ' TABFAC(3)='VITX' ELSEIF (IFOUR.EQ.7 .OR. IFOUR.EQ.8) THEN JGFAC = 4 C Verifier l'utilite des composantes au dela de 4 TABFAC(1)='RHO ' TABFAC(2)='C ' TABFAC(3)='VITX' TABFAC(4)='VITY' ELSEIF (IFOUR.EQ.9 .OR. IFOUR.EQ.10) THEN JGFAC = 4 C Verifier l'utilite des composantes au dela de 4 TABFAC(1)='RHO ' TABFAC(2)='C ' TABFAC(3)='VITX' TABFAC(4)='VITZ' ELSEIF (IFOUR.EQ.11) THEN JGFAC = 5 C Verifier l'utilite des composantes au dela de 4 TABFAC(1)='RHO ' TABFAC(2)='C ' TABFAC(3)='VITX' TABFAC(4)='VITY' TABFAC(5)='VITZ' ELSEIF (IFOUR.EQ.12.OR.IFOUR.EQ.13.OR.IFOUR.EQ.15) THEN JGFAC = 3 TABFAC(1)='RHO ' TABFAC(2)='C ' TABFAC(3)='VITR' ELSEIF (IFOUR.EQ.14) THEN JGFAC = 4 C Verifier l'utilite des composantes au dela de 4 TABFAC(1)='RHO ' TABFAC(2)='C ' TABFAC(3)='VITR' TABFAC(4)='VITZ' ENDIF ENDIF ENDIF GOTO 9999 endif C composantes facultatives THERMIQUE CONDUCTION seule IF(MFR .EQ. 75)THEN C Cas des JOI1 (MFR=75) ==> Ressorts THERMIQUES C ==================== JGFAC = 4 TABFAC(1)='M' TABFAC(2)='C' TABFAC(3)='TINI' ELSE JGFAC = 4 TABFAC(1)='RHO ' TABFAC(2)='C ' TABFAC(3)='H ' TABFAC(4)='TINI' ENDIF ENDIF GOTO 9999 ENDIF *-------------------------------------------------------------------- * CAS DE LA FORMULATION MECANIQUE *-------------------------------------------------------------------- CALL PLACE(FORMOD,NFOR,IMECA,'MECANIQUE') IF (IMECA.NE.0) THEN * CALL MODLIN(MOMODL,NMOD) CALL PLACE(MOMODL,NMOD,IRET,MATMOD(1)) IF (IRET.EQ.0) GOTO 9999 IF (NMAT.GE.2) THEN CALL MODELA(MOMODL,NMOD) CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(2)) if ((IPLAC.EQ.9.OR.IPLAC.EQ.10).AND.NMAT.GT.2) then INMAT = 3 goto 19 endif IF (IPLAC.NE.0) THEN INMAT=3 IF (IPLAC.EQ.1) THEN INMAT=3 GOTO 10 ENDIF IF (IPLAC.EQ.2) THEN * * MATERIAU ELASTIQUE ORTHOTROPE * IF (MFR.EQ.75) THEN * JOINT UNIDIMENSIONNEL JOI1 * IF(IFOUR.EQ.2)THEN JGOBL=12 TABOBL(1)='V1X ' TABOBL(2)='V1Y ' TABOBL(3)='V1Z ' TABOBL(4)='V2X ' TABOBL(5)='V2Y ' TABOBL(6)='V2Z ' TABOBL(7)='KN ' TABOBL(8)='KS1 ' TABOBL(9)='KS2 ' TABOBL(10)='QN ' TABOBL(11)='QS1 ' TABOBL(12)='QS2 ' * JGFAC=10 TABFAC(1)='MASS' TABFAC(2)='JX ' TABFAC(3)='JY ' TABFAC(4)='JZ ' TABFAC(5)='ALPN' TABFAC(6)='ALP1' TABFAC(7)='ALP2' TABFAC(8)='ALQN' TABFAC(9)='ALQ1' TABFAC(10)='ALQ2' * ELSEIF(IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN JGOBL=5 TABOBL(1)='V1X ' TABOBL(2)='V1Y ' TABOBL(3)='KN ' TABOBL(4)='KS ' TABOBL(5)='QS ' * JGFAC=6 TABFAC(1)='MASS' TABFAC(2)='JZ' TABFAC(4)='ALPN' TABFAC(5)='ALPS' TABFAC(6)='ALQS' ENDIF * ELSEIF (MFR.EQ.3) THEN * COQUES MINCES * JGOBL=6 TABOBL(1)='YG1 ' TABOBL(2)='YG2 ' TABOBL(3)='NU12' TABOBL(4)='G12 ' TABOBL(5)='V1X ' TABOBL(6)='V1Y ' * IF(IFOUR.EQ.-2) THEN JGFAC=4 ELSE JGFAC=3 ENDIF TABFAC(1)='ALP1' TABFAC(2)='ALP2' TABFAC(3)='RHO ' IF(IFOUR.EQ.-2) TABFAC(4)='DIM3' ELSEIF (MFR.EQ.9.OR.MFR.EQ.5) THEN * COQUES AVEC CISAILLEMENT TRANSVERSE * JGOBL=8 TABOBL(1)='YG1 ' TABOBL(2)='YG2 ' TABOBL(3)='NU12' TABOBL(4)='G12 ' TABOBL(5)='G23 ' TABOBL(6)='G13 ' TABOBL(7)='V1X ' TABOBL(8)='V1Y ' * JGFAC=3 TABFAC(1)='RHO ' TABFAC(2)='ALP1' TABFAC(3)='ALP2' ELSEIF (MFR.EQ.1.OR.MFR.EQ.31) THEN * ELEMENTS MASSIFS * IF(IDIM.EQ.3)THEN * ELEMENTS 3D JGOBL=15 TABOBL(1)='YG1 ' TABOBL(2)='YG2 ' TABOBL(3)='YG3 ' TABOBL(4)='NU12' TABOBL(5)='NU23' TABOBL(6)='NU13' TABOBL(7)='G12 ' TABOBL(8)='G23 ' TABOBL(9)='G13 ' TABOBL(10)='V1X ' TABOBL(11)='V1Y ' TABOBL(12)='V1Z ' TABOBL(13)='V2X ' TABOBL(14)='V2Y ' TABOBL(15)='V2Z ' * JGFAC=4 TABFAC(1)='RHO ' TABFAC(2)='ALP1' TABFAC(3)='ALP2' TABFAC(4)='ALP3' ELSEIF (IDIM.EQ.2) THEN IF(IFOUR.EQ.-2)THEN * CONTRAINTE PLANE JGOBL=9 TABOBL(1)='YG1 ' TABOBL(2)='YG2 ' TABOBL(3)='NU12' TABOBL(4)='G12 ' TABOBL(5)='V1X ' TABOBL(6)='V1Y ' TABOBL(7)='YG3 ' TABOBL(8)='NU23' TABOBL(9)='NU13' * JGFAC=4 TABFAC(1)='RHO ' TABFAC(2)='ALP1' TABFAC(3)='ALP2' TABFAC(4)='DIM3' ELSEIF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN * DEFORMATION PLANE ,AXISYMETRIE JGOBL=9 TABOBL(1)='YG1 ' TABOBL(2)='YG2 ' TABOBL(3)='YG3 ' TABOBL(4)='NU12' TABOBL(5)='NU23' TABOBL(6)='NU13' TABOBL(7)='G12 ' TABOBL(8)='V1X ' TABOBL(9)='V1Y ' * JGFAC=4 TABFAC(1)='RHO ' TABFAC(2)='ALP1' TABFAC(3)='ALP2' TABFAC(4)='ALP3' ELSEIF (IFOUR.EQ.1) THEN * AXISYMETRIE DE FOURIER JGOBL=15 TABOBL(1)='YG1 ' TABOBL(2)='YG2 ' TABOBL(3)='YG3 ' TABOBL(4)='NU12' TABOBL(5)='NU23' TABOBL(6)='NU13' TABOBL(7)='G12 ' TABOBL(8)='G23 ' TABOBL(9)='G13 ' TABOBL(10)='V1X ' TABOBL(11)='V1Y ' TABOBL(12)='V1Z ' TABOBL(13)='V2X ' TABOBL(14)='V2Y ' TABOBL(15)='V2Z ' * JGFAC=4 TABFAC(1)='RHO ' TABFAC(2)='ALP1' TABFAC(3)='ALP2' TABFAC(4)='ALP3' ENDIF ELSEIF (IDIM.EQ.1) THEN C= Dans le cas UNID SPHErique, on doit avoir YG2=YG3 et NU12=NU13 C= et dans le cas thermomecanique ALP2=ALP3. JGOBL=6 TABOBL(1)='YG1 ' TABOBL(2)='YG2 ' TABOBL(3)='YG3 ' TABOBL(4)='NU12' TABOBL(5)='NU23' TABOBL(6)='NU13' IF (IFOUR.EQ.6) THEN JGFAC=2 ELSEIF (IFOUR.EQ.5 .OR. IFOUR.EQ.10) THEN JGFAC=3 TABFAC(3)='ALP3' ELSEIF (IFOUR.EQ.4.OR.IFOUR.EQ.8.OR. . IFOUR.EQ.13) THEN JGFAC=3 TABFAC(3)='ALP2' ELSE JGFAC=4 TABFAC(3)='ALP2' TABFAC(4)='ALP3' ENDIF TABFAC(1)='RHO ' TABFAC(2)='ALP1' ENDIF ELSEIF (MFR.EQ.35) THEN * ELEMENTS JOINTS IF (IFOUR.EQ.2) THEN JGOBL=5 TABOBL(1)='KS1 ' TABOBL(2)='KS2 ' TABOBL(3)='KN ' TABOBL(4)='V1X ' TABOBL(5)='V1Y ' * JGFAC=2 TABFAC(1)='RHO ' TABFAC(2)='ALPN' ENDIF ENDIF ELSEIF (IPLAC.EQ.3)THEN * MATERIAU ANISOTROPE ELASTIQUE * IF(MFR.EQ.75)THEN * JOINT UNIDIMESIONNEL JOI1 * IF (IFOUR.EQ.2) THEN JGOBL=27 TABOBL(1)='V1X ' TABOBL(2)='V1Y ' TABOBL(3)='V1Z ' TABOBL(4)='V2X ' TABOBL(5)='V2Y ' TABOBL(6)='V2Z ' TABOBL(7)='D11 ' TABOBL(8)='D22 ' TABOBL(9)='D33 ' TABOBL(10)='D44 ' TABOBL(11)='D55 ' TABOBL(12)='D66 ' TABOBL(13)='D21 ' TABOBL(14)='D31 ' TABOBL(15)='D32 ' TABOBL(16)='D41 ' TABOBL(17)='D42 ' TABOBL(18)='D43 ' TABOBL(19)='D51 ' TABOBL(20)='D52 ' TABOBL(21)='D53 ' TABOBL(22)='D54 ' TABOBL(23)='D61 ' TABOBL(24)='D62 ' TABOBL(25)='D63 ' TABOBL(26)='D64 ' TABOBL(27)='D65 ' * JGFAC=10 * MASS: masse totale de l'élément joint TABFAC(1)='MASS' TABFAC(2)='JX ' TABFAC(3)='JY ' TABFAC(4)='JZ ' TABFAC(5)='ALP1' TABFAC(6)='ALP2' TABFAC(7)='ALP3' TABFAC(8)='ALQ1' TABFAC(9)='ALQ2' TABFAC(10)='ALQ3' * ELSEIF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN JGOBL=8 TABOBL(1)='V1X ' TABOBL(2)='V1Y ' TABOBL(3)='D11 ' TABOBL(4)='D22 ' TABOBL(5)='D33 ' TABOBL(6)='D21 ' TABOBL(7)='D31 ' TABOBL(8)='D32 ' * JGFAC=5 * MASS: masse totale de l'élément joint TABFAC(1)='MASS' TABFAC(2)='JZ ' TABFAC(3)='ALP1' TABFAC(4)='ALP2' TABFAC(5)='ALQ3' ENDIF ENDIF * * ELEMENTS MASSIFS * IF(MFR.EQ.1.OR.MFR.EQ.31)THEN IF(IDIM.EQ.3)THEN * ELEMENTS 3D JGOBL=27 TABOBL(1)='D11 ' TABOBL(2)='D21 ' TABOBL(3)='D22 ' TABOBL(4)='D31 ' TABOBL(5)='D32 ' TABOBL(6)='D33 ' TABOBL(7)='D41 ' TABOBL(8)='D42 ' TABOBL(9)='D43 ' TABOBL(10)='D44 ' TABOBL(11)='D51 ' TABOBL(12)='D52 ' TABOBL(13)='D53 ' TABOBL(14)='D54 ' TABOBL(15)='D55 ' TABOBL(16)='D61 ' TABOBL(17)='D62 ' TABOBL(18)='D63 ' TABOBL(19)='D64 ' TABOBL(20)='D65 ' TABOBL(21)='D66 ' TABOBL(22)='V1X ' TABOBL(23)='V1Y ' TABOBL(24)='V1Z ' TABOBL(25)='V2X ' TABOBL(26)='V2Y ' TABOBL(27)='V2Z ' * JGFAC=7 TABFAC(1)='RHO ' TABFAC(2)='ALP1' TABFAC(3)='ALP2' TABFAC(4)='ALP3' TABFAC(5)='AL12' TABFAC(6)='AL13' TABFAC(7)='AL23' ELSEIF (IDIM.EQ.2) THEN IF (IFOUR.EQ.-2) THEN * CONTRAINTE PLANE JGOBL=12 TABOBL(1)='D11 ' TABOBL(2)='D21 ' TABOBL(3)='D22 ' TABOBL(4)='D41 ' TABOBL(5)='D42 ' TABOBL(6)='D44 ' TABOBL(7)='V1X ' TABOBL(8)='V1Y ' TABOBL(9)='D31 ' TABOBL(10)='D32 ' TABOBL(11)='D33 ' TABOBL(12)='D43 ' * JGFAC=5 TABFAC(1)='RHO ' TABFAC(2)='ALP1' TABFAC(3)='ALP2' TABFAC(4)='AL12' TABFAC(5)='DIM3' ELSEIF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN * DEFORMATION PLANE ,AXISYMETRIE JGOBL=12 TABOBL(1)='D11 ' TABOBL(2)='D21 ' TABOBL(3)='D22 ' TABOBL(4)='D31 ' TABOBL(5)='D32 ' TABOBL(6)='D33 ' TABOBL(7)='D41 ' TABOBL(8)='D42 ' TABOBL(9)='D43 ' TABOBL(10)='D44 ' TABOBL(11)='V1X ' TABOBL(12)='V1Y ' * JGFAC=5 TABFAC(1)='RHO ' TABFAC(2)='ALP1' TABFAC(3)='ALP2' TABFAC(4)='AL12' TABFAC(5)='ALP3' ELSEIF (IFOUR.EQ.1) THEN * AXISYMETRIE DE FOURIER JGOBL=15 TABOBL(1)='D11 ' TABOBL(2)='D21 ' TABOBL(3)='D22 ' TABOBL(4)='D31 ' TABOBL(5)='D32 ' TABOBL(6)='D33 ' TABOBL(7)='D41 ' TABOBL(8)='D42 ' TABOBL(9)='D43 ' TABOBL(10)='D44 ' TABOBL(11)='D55 ' TABOBL(12)='D65 ' TABOBL(13)='D66 ' TABOBL(14)='V1X ' TABOBL(15)='V1Y ' * JGFAC=5 TABFAC(1)='RHO ' TABFAC(2)='ALP1' TABFAC(3)='ALP2' TABFAC(4)='AL12' TABFAC(5)='ALP3' ENDIF ENDIF ENDIF ELSEIF (IPLAC.EQ.4) THEN IF (MFR.EQ.33) THEN * MILIEU POREUX ISOTROPE * JGOBL=12 TABOBL(1) ='YOUN' TABOBL(2) ='NU ' TABOBL(3) ='RHO ' TABOBL(4) ='ALPH' TABOBL(5) ='COB ' TABOBL(6) ='MOB ' TABOBL(7) ='ALPM' TABOBL(8) ='PERM' TABOBL(9) ='VISC' TABOBL(10)='KF ' TABOBL(11)='RHOF' TABOBL(12)='ALPF' * IF (IFOUR.EQ.-2) THEN JGFAC=1 TABFAC(1)='DIM3' ENDIF ENDIF ELSEIF (IPLAC.EQ.5) THEN IF (MFR.EQ.37) THEN * MILIEU HOMOGENEISE * JGOBL=16 TABOBL( 1)='B11 ' TABOBL( 2)='B22 ' TABOBL( 3)='B12 ' TABOBL( 4)='ROF ' TABOBL( 5)='ROS ' TABOBL( 6)='YOUN' TABOBL( 7)='CSON' TABOBL( 8)='RORF' TABOBL( 9)='CREF' TABOBL(10)='LCAR' TABOBL(11)='E111' TABOBL(12)='E112' TABOBL(13)='E121' TABOBL(14)='E122' TABOBL(15)='E221' TABOBL(16)='E222' ENDIF ELSEIF (IPLAC.EQ.6) THEN C C MATERIAU ELASTIQUE UNIDIRECTIONNEL C IF ((MFR.EQ.1.OR.MFR.EQ.31).AND.IDIM.EQ.3) THEN JGOBL=7 TABOBL(1)='YOUN' TABOBL(2)='V1X ' TABOBL(3)='V1Y ' TABOBL(4)='V1Z ' TABOBL(5)='V2X ' TABOBL(6)='V2Y ' TABOBL(7)='V2Z ' ELSE JGOBL=3 TABOBL(1)='YOUN' TABOBL(2)='V1X ' TABOBL(3)='V1Y ' ENDIF IF((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31).AND. . IFOUR.EQ.-2) THEN JGFAC=3 TABFAC(3)='DIM3' ELSE JGFAC=2 ENDIF TABFAC(1)='RHO ' TABFAC(2)='ALPH' ELSEIF (IPLAC.EQ.7) THEN C MODELE ET MATERIAU DE LA SECTION DU MODELE A FIBRE C JGOBL=2 TABOBL(1)='MODS' TABOBL(2)='MATS' JGFAC=1 TABFAC(1)='MANO' C ---- IPLAC 8: Ajoute par Jiang, 22/08/1995 et fleuret 28/05/96 ELSEIF (IPLAC.EQ.8) THEN C MODELE ET MATERIAU POUR LE CABLE PRECONTRAINT C JGOBL=1 TABOBL(1)='YOUN' JGFAC=8 TABFAC(1)='FF' TABFAC(2)='PHIF' TABFAC(3)='GANC' TABFAC(4)='RMU0' TABFAC(5)='FPRG' TABFAC(6)='RH10' TABFAC(7)='ALPH' TABFAC(8)='RHO ' ELSEIF (IPLAC.EQ.9) THEN C MODAL C JGOBL=3 TABOBL(1)='FREQ' TABOBL(2)='MASS' TABOBL(3)='DEFO' JGFAC = 9 TABFAC(1) = 'AMOR' TABFAC(2) = 'CGRA' TABFAC(3) = 'MADE' TABFAC(4) = 'RICR' TABFAC(5) = 'MAIB' TABFAC(6) = 'MACR' TABFAC(7) = 'AMCR' TABFAC(8) = 'ALP0' TABFAC(9) = 'ECRO' ELSEIF (IPLAC.EQ.10) THEN C STATIQUE C JGOBL=3 TABOBL(1)='DEFO' TABOBL(2)='RIDE' TABOBL(3)='MADE' JGFAC = 8 TABFAC(1) = 'AMOR' TABFAC(2) = 'RICR' TABFAC(3) = 'MAIA' TABFAC(4) = 'MAIB' TABFAC(5) = 'MACR' TABFAC(6) = 'AMCR' TABFAC(7) = 'BET0' TABFAC(8) = 'ECRO' ELSEIF (IPLAC.EQ.11) THEN C ZONE_COHESIVE C JGOBL=2 TABOBL(1)='KS' TABOBL(2)='KN' ENDIF INMAT=3 GOTO 20 ELSE INMAT=2 GOTO 10 ENDIF ENDIF INMAT=0 10 CONTINUE * * MATERIAU ELASTIQUE ISOTROPE * IF (MFR.EQ.35) THEN * VALABLE EN 2D COMME EN 3D JGOBL=2 TABOBL(1)='KS ' TABOBL(2)='KN ' JGFAC=2 TABFAC(1)='RHO ' TABFAC(2)='ALPN' * ELSEIF (MFR.EQ.78) THEN * VALABLE EN 2D COMME EN 3D JGOBL=2 TABOBL(1)='KS ' TABOBL(2)='KN ' * * JOINT CISAILLEMENT (2D) * ELSEIF (MFR.EQ.53) THEN * VALABLE EN 2D "COMME EN 3D" JGOBL=1 TABOBL(1)='KS ' * JGFAC=2 TABFAC(1)='RHO ' TABFAC(2)='ALPN' * * TOUS LES AUTRES CAS * ELSE JGOBL=2 TABOBL(1)='YOUN' TABOBL(2)='NU ' * IF((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.63).AND. . IFOUR.EQ.-2) THEN JGFAC=4 TABFAC(3)='DIM3' TABFAC(4)='VISQ' ELSE JGFAC=3 TABFAC(3)='VISQ' ENDIF TABFAC(1)='RHO ' TABFAC(2)='ALPH' * AM CAS FORMULATION NON-LOCALE INLOC = 0 MN3 = INFMOD(/1) IF (MN3.GE.13) INLOC=-1*INFMOD(13) IF (INLOC.GT.0) THEN JGOBL0 = JGFAC * moyenne IF(INLOC.EQ.1) THEN JGFAC=JGOBL0+1 TABFAC(JGOBL0+1)='LCAR' * stress-based ELSEIF(INLOC.EQ.2) THEN JGFAC=JGOBL0+2 TABFAC(JGOBL0+1)='LCAR' TABFAC(JGOBL0+2)='SBFT' * helmholtz ELSE IF(INLOC.EQ.3) THEN * sellier 03/07/20 * JGFAC=JGOBL0+6 * TABFAC(JGOBL0+1)='LCAR' * TABFAC(JGOBL0+2)='LCF1' * TABFAC(JGOBL0+3)='LCF2' * TABFAC(JGOBL0+4)='LCF3' * TABFAC(JGOBL0+5)='LCF4' * TABFAC(JGOBL0+6)='LCF5' JGFAC=JGOBL0+NB_PARA_HELM c variables de Helmholtz a diffusions ORThotropes c modif liste para heilmholtz sellier 10//11/22 c print*,'Dans IDMATR ', NB_HELM, 'formulationss Helmholtz' do I=1,NB_HELM c numero de la variable de Helmholtz write (motnl1,'(I1)') I c Capacité (infinie si BH=1) motnl3='CAP' motnl4=motnl3//motnl1 TABFAC(JGOBL0+NB_PARA_PAR_HELM*(I-1)+1)=motnl4 c print*,motnl4 c Blocage de Dirichlet si 1 sinon 0 motnl3='BLO' motnl4=motnl3//motnl1 TABFAC(JGOBL0+NB_PARA_PAR_HELM*(I-1)+2)=motnl4 c print*,motnl4 c Valeur imposee a la zone de blocage de Dirichlet motnl3='DEP' motnl4=motnl3//motnl1 TABFAC(JGOBL0+NB_PARA_PAR_HELM*(I-1)+3)=motnl4 c print*,motnl4 c Valeur initiale de la variable de Helmholtz motnl3='INI' motnl4=motnl3//motnl1 TABFAC(JGOBL0+NB_PARA_PAR_HELM*(I-1)+4)=motnl4 c print*,motnl4 c indicateur logique de lineratite pour ne pas passer par istep=3 si 1 motnl3='LIN' motnl4=motnl3//motnl1 TABFAC(JGOBL0+NB_PARA_PAR_HELM*(I-1)+5)=motnl4 c print*,motnl4 do J=1,3 c coefficients de diffusion write (motnld1,'(I1)') J c diffusion motnl2='DH' c 1er indice: numero de la variable d helmholtz motnl3=motnl2//motnl1 c 2eme indice : direction motnl4=motnl3//motnld1 TABFAC(JGOBL0+(I-1)*NB_PARA_PAR_HELM+ # 5+(J-1)*4+1)=motnl4 c print*,motnl4 do K=1,3 write (motnla1,'(I1)') K c direction principales de diffusion motnlv1='V' c indice numero de la variable motnl2=motnlv1//motnl1 c indice direction principale motnl3=motnl2//motnld1 c projection sur axe indice de base fixe motnl4=motnl3//motnla1 TABFAC(JGOBL0+(I-1)*NB_PARA_PAR_HELM+ # 5+(J-1)*4+1+K)=motnl4 c print*,motnl4 end do end do end do Cc on rajoute 2 inutiles pour compenser un decalage constatte dans castem20 C TABFAC(JGOBL0+NB_PARA_HELM+1)='FAC1' C TABFAC(JGOBL0+NB_PARA_HELM+2)='FAC2' * fin modif sellier * cas non prevu ELSE IRET = 0 CALL ERREUR(5) ENDIF ENDIF * ENDIF * IF (INMAT.EQ.0) GOTO 9999 * 19 CONTINUE 20 CONTINUE DO jm = 1,matmod(/2) IF (matmod(jm).eq.'IMPEDANCE') THEN imate = imatee INMAT = INMAT + 1 JGOBL = 0 JGFAC = 0 IF(CMATEE.EQ.'IMPELAST') THEN *IMPE_ELAS JGOBL0 = JGOBL JGOBL= JGOBL0+1 TABOBL(JGOBL0 + 1) ='RAID' JGOBL0 = JGFAC JGFAC = JGOBL0+4 TABFAC(JGOBL0+1) = 'AMOR' TABFAC(JGOBL0+2) = 'ZNU' TABFAC(JGOBL0+3) = 'MASS' TABFAC(JGOBL0+4) = 'ALPH' GOTO 22 ELSEIF (CMATEE.EQ.'IMPVOIGT'.or.CMATEE.EQ.'IMPREUSS') THEN *IMPE_VOIGT ou IMPE_REUSS JGOBL0 = JGOBL JGOBL= JGOBL0+2 TABOBL(JGOBL0 + 1) ='RAID' TABOBL(JGOBL0 + 2) ='VISC' JGOBL0 = JGFAC JGFAC = JGOBL0+2 TABFAC(JGOBL0+1) = 'MASS' TABFAC(JGOBL0+2) = 'AMOR' GOTO 22 ELSEIF (CMATEE.EQ.'IMPCOMPL') then *IMPE_COMPLEXE JGOBL0 = JGOBL JGOBL= JGOBL0+1 TABOBL(JGOBL0 + 1) ='RAID' JGOBL0 = JGFAC JGFAC = JGFAC+4 TABFAC(JGOBL0+1) = 'MOCO' TABFAC(JGOBL0+2) = 'VISC' TABFAC(JGOBL0+3) = 'MASS' TABFAC(JGOBL0+4) = 'AMOR' GOTO 22 ELSE ENDIF 22 CONTINUE * if (mele.eq.45) then JGOBL0 = JGFAC JGFAC = JGOBL0+3 IF(CMATEE.EQ.'IMPELAST') THEN TABFAC(JGOBL0+1) = TABFAC(JGOBL0-2) TABFAC(JGOBL0+2) = TABFAC(JGOBL0-1) TABFAC(JGOBL0+3) = TABFAC(JGOBL0) TABFAC(JGOBL0-2) = 'CPLE' TABFAC(JGOBL0-1) = 'INER' TABFAC(JGOBL0) = 'AROT' ELSE TABFAC(JGOBL0+1) = 'CPLE' TABFAC(JGOBL0+2) = 'INER' TABFAC(JGOBL0+3) = 'AROT' ENDIF * endif IF (NMAT.GE.INMAT) inmat = inmat+1 * GOTO 9999 ENDIF ENDDO * IF (NMAT.GE.INMAT) THEN CALL MODNLI(MOMODL,NMOD) CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT)) IF (IPLAC.EQ.1) THEN INMAT=INMAT+1 CALL MODPLA(MOMODL,NMOD) CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT)) IF (IPLAC.EQ.0) THEN * ISOTROPE IPLAC=1 * ELSE * INMAT=INMAT+1 ENDIF CALL IDPLAS(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET) ELSEIF (IPLAC.EQ.2) THEN INMAT=INMAT+1 CALL MODFLU(MOMODL,NMOD) CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT)) IF (IPLAC.EQ.0) THEN * NORTON IPLAC=1 * ELSE * INMAT=INMAT+1 ENDIF CALL IDFLUA(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET) ELSEIF (IPLAC.EQ.3) THEN INMAT=INMAT+1 CALL MODVIS(MOMODL,NMOD) CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT)) IF (IPLAC.EQ.0) THEN * ONERA IPLAC=2 * ELSE * INMAT=INMAT+1 ENDIF C C Cas particulier des modeles GATT_MONERIE et UO2 C 'RHO ' et 'ALPH' sont obligatoires IF (IPLAC.EQ.18.OR.IPLAC.EQ.19) THEN JGOBL0 = JGOBL JGOBL=JGOBL0+2 TABOBL(JGOBL0+1)='RHO ' TABOBL(JGOBL0+2)='ALPH' JGOBL0=JGFAC JGFAC=JGOBL0-2 IF (JGFAC.GT.0) THEN DO 200 I=1,JGFAC TABFAC(I)=TABFAC(I+2) 200 CONTINUE ENDIF C === C Modeles SYMONDS & COWPER SYCO1 et SYCO2 C === ELSEIF (IPLAC.EQ.28) THEN JGOBL0=JGOBL JGOBL=JGOBL0+1 TABOBL(JGOBL0+1)='ECRO' ELSEIF (IPLAC.EQ.29) THEN JGOBL0=JGOBL JGOBL=JGOBL0+1 TABOBL(JGOBL0+1)='ECRO' ENDIF CALL IDVISC(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET) C ELSEIF (IPLAC.EQ.4) THEN INMAT=INMAT+1 CALL MODEND(MOMODL,NMOD) CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT)) IF (IPLAC.EQ.0) THEN * MAZARS IPLAC=1 * ELSE * INMAT=INMAT+1 ENDIF CALL IDENDO(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET) ELSEIF (IPLAC.EQ.5) THEN INMAT=INMAT+1 CALL MODPLE(MOMODL,NMOD) CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT)) IF (IPLAC.EQ.0) THEN * TRIAXIAL P/Y IPLAC=1 * ELSE * INMAT=INMAT+1 ENDIF CALL IDPLEN(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET) ELSEIF (IPLAC.EQ.6) THEN INMAT=INMAT+1 CALL MODENL(MOMODL,NMOD) CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT)) IF (IPLAC.EQ.0) THEN * ISOTROPE IPLAC=1 * ELSE * INMAT=INMAT+1 ENDIF CALL IDELNL(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET) ELSEIF (IPLAC.EQ.7) THEN C Pas de composantes supplementaires pour une loi 'VISCO_EXTERNE' IRET = 1 ELSEIF(IPLAC.EQ.0.AND.IMATEE.EQ.31) THEN GOTO 9999 ELSE GOTO 9999 ENDIF C IRET code retour de IDPLAS,IDFLUA,IDVISC,IDENDO,IDPLEN,IDELNL IF (IRET.EQ.0) GOTO 9999 ENDIF * Parametres CRIP et FUSION : do jma=1,matmod(/2) if(matmod(jma).eq.'CRIP') then JGOBL = JGOBL + 1 TABOBL(JGOBL) = 'LIMP' elseif(matmod(jma).eq.'FUSION') then JGOBL = JGOBL + 1 TABOBL(JGOBL) = 'TFUS' endif enddo * GOTO 9999 ENDIF *-------------------------------------------------------------------- * CAS DE LA FORMULATION POREUX *-------------------------------------------------------------------- CALL PLACE(FORMOD,NFOR,IPORE,'POREUX') IF (IPORE.NE.0) THEN * CALL MODLIN(MOMODL,NMOD) CALL PLACE(MOMODL,NMOD,IRET,MATMOD(1)) IF (IRET.EQ.0) GOTO 9999 * * D'ABORD : CAS NON ISOTROPE * IF (NMAT.GE.2) THEN CALL MODELA(MOMODL,NMOD) CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(2)) IF (IPLAC.NE.0) THEN INMAT=3 IF (IPLAC.EQ.1) THEN INMAT=3 GOTO 30 ENDIF IF (IPLAC.EQ.2) THEN * * MATERIAU ELASTIQUE ORTHOTROPE * IF (MFR.EQ.33) THEN * * ELEMENTS MASSIFS * IF(IDIM.EQ.3)THEN * ELEMENTS 3D JGOBL=19 TABOBL(1)='YG1 ' TABOBL(2)='YG2 ' TABOBL(3)='YG3 ' TABOBL(4)='NU12' TABOBL(5)='NU23' TABOBL(6)='NU13' TABOBL(7)='G12 ' TABOBL(8)='G23 ' TABOBL(9)='G13 ' TABOBL(10)='V1X ' TABOBL(11)='V1Y ' TABOBL(12)='V1Z ' TABOBL(13)='V2X ' TABOBL(14)='V2Y ' TABOBL(15)='V2Z ' TABOBL(16)='COB1' TABOBL(17)='COB2' TABOBL(18)='COB3' TABOBL(19)='MOB ' * JGFAC=12 TABFAC(1)='RHO ' TABFAC(2)='ALP1' TABFAC(3)='ALP2' TABFAC(4)='ALP3' TABFAC(5)='ALPM' TABFAC(6)='PER1' TABFAC(7)='PER2' TABFAC(8)='PER3' TABFAC(9)='VISC' TABFAC(10)='KF ' TABFAC(11)='RHOF' TABFAC(12)='ALPF' ELSEIF (IDIM.EQ.2) THEN IF(IFOUR.EQ.-2)THEN * CONTRAINTE PLANE JGOBL=12 TABOBL(1)='YG1 ' TABOBL(2)='YG2 ' TABOBL(3)='NU12' TABOBL(4)='G12 ' TABOBL(5)='V1X ' TABOBL(6)='V1Y ' TABOBL(7)='COB1' TABOBL(8)='COB2' TABOBL(9)='MOB ' TABOBL(10)='YG3 ' TABOBL(11)='NU23' TABOBL(12)='NU13' * JGFAC=11 TABFAC(1)='RHO ' TABFAC(2)='ALP1' TABFAC(3)='ALP2' TABFAC(4)='ALPM' TABFAC(5)='PER1' TABFAC(6)='PER2' TABFAC(7)='VISC' TABFAC(8)='KF ' TABFAC(9)='RHOF' TABFAC(10)='ALPF' TABFAC(11)='DIM3' ELSEIF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN * DEFORMATION PLANE ,AXISYMETRIE JGOBL=13 TABOBL(1)='YG1 ' TABOBL(2)='YG2 ' TABOBL(3)='YG3 ' TABOBL(4)='NU12' TABOBL(5)='NU23' TABOBL(6)='NU13' TABOBL(7)='G12 ' TABOBL(8)='V1X ' TABOBL(9)='V1Y ' TABOBL(10)='COB1' TABOBL(11)='COB2' TABOBL(12)='COB3' TABOBL(13)='MOB ' * JGFAC=11 TABFAC(1)='RHO ' TABFAC(2)='ALP1' TABFAC(3)='ALP2' TABFAC(4)='ALP3' TABFAC(5)='ALPM' TABFAC(6)='PER1' TABFAC(7)='PER2' TABFAC(8)='VISC' TABFAC(9)='KF ' TABFAC(10)='RHOF' TABFAC(11)='ALPF' * ELSEIF (IFOUR.EQ.1) THEN * AXISYMETRIE DE FOURIER JGOBL=15 TABOBL(1)='YG1 ' TABOBL(2)='YG2 ' TABOBL(3)='YG3 ' TABOBL(4)='NU12' TABOBL(5)='NU23' TABOBL(6)='NU13' TABOBL(7)='G12 ' TABOBL(8)='G23 ' TABOBL(9)='G13 ' TABOBL(10)='V1X ' TABOBL(11)='V1Y ' TABOBL(12)='COB1' TABOBL(13)='COB2' TABOBL(14)='COB3' TABOBL(15)='MOB ' * JGFAC=12 TABFAC(1)='RHO ' TABFAC(2)='ALP1' TABFAC(3)='ALP2' TABFAC(4)='ALP3' TABFAC(5)='ALPM' TABFAC(6)='PER1' TABFAC(7)='PER2' TABFAC(8)='PER3' TABFAC(9)='VISC' TABFAC(10)='KF ' TABFAC(11)='RHOF' TABFAC(12)='ALPF' ENDIF ENDIF ELSE * * CAS NON PREVU * IRET = 0 GOTO 9999 ENDIF ELSEIF (IPLAC.EQ.3)THEN * * MATERIAU ANISOTROPE ELASTIQUE * IF(MFR.EQ.33)THEN * * ELEMENTS MASSIFS * IF(IDIM.EQ.3)THEN * ELEMENTS 3D JGOBL=34 TABOBL(1)='D11 ' TABOBL(2)='D21 ' TABOBL(3)='D22 ' TABOBL(4)='D31 ' TABOBL(5)='D32 ' TABOBL(6)='D33 ' TABOBL(7)='D41 ' TABOBL(8)='D42 ' TABOBL(9)='D43 ' TABOBL(10)='D44 ' TABOBL(11)='D51 ' TABOBL(12)='D52 ' TABOBL(13)='D53 ' TABOBL(14)='D54 ' TABOBL(15)='D55 ' TABOBL(16)='D61 ' TABOBL(17)='D62 ' TABOBL(18)='D63 ' TABOBL(19)='D64 ' TABOBL(20)='D65 ' TABOBL(21)='D66 ' TABOBL(22)='V1X ' TABOBL(23)='V1Y ' TABOBL(24)='V1Z ' TABOBL(25)='V2X ' TABOBL(26)='V2Y ' TABOBL(27)='V2Z ' TABOBL(28)='COB1' TABOBL(29)='COB2' TABOBL(30)='COB3' TABOBL(31)='CO12' TABOBL(32)='CO13' TABOBL(33)='CO23' TABOBL(34)='MOB ' * JGFAC=18 TABFAC(1)='RHO ' TABFAC(2)='ALP1' TABFAC(3)='ALP2' TABFAC(4)='ALP3' TABFAC(5)='AL12' TABFAC(6)='AL13' TABFAC(7)='AL23' TABFAC(8)='ALPM' TABFAC(9 )='PER1' TABFAC(10)='PER2' TABFAC(11)='PER3' TABFAC(12)='PE12' TABFAC(13)='PE13' TABFAC(14)='PE23' TABFAC(15)='VISC' TABFAC(16)='KF ' TABFAC(17)='RHOF' TABFAC(18)='ALPF' ELSEIF (IDIM.EQ.2) THEN IF (IFOUR.EQ.-2) THEN * CONTRAINTE PLANE JGOBL=16 TABOBL(1)='D11 ' TABOBL(2)='D21 ' TABOBL(3)='D22 ' TABOBL(4)='D41 ' TABOBL(5)='D42 ' TABOBL(6)='D44 ' TABOBL(7)='V1X ' TABOBL(8)='V1Y ' TABOBL(9 )='COB1' TABOBL(10)='COB2' TABOBL(11)='CO12' TABOBL(12)='MOB ' TABOBL(13)='D31 ' TABOBL(14)='D32 ' TABOBL(15)='D33 ' TABOBL(16)='D43 ' * JGFAC=13 TABFAC(1)='RHO ' TABFAC(2)='ALP1' TABFAC(3)='ALP2' TABFAC(4)='AL12' TABFAC(5)='ALPM' TABFAC(6)='PER1' TABFAC(7)='PER2' TABFAC(8)='PE12' TABFAC(9)='VISC' TABFAC(10)='KF ' TABFAC(11)='RHOF' TABFAC(12)='ALPF' TABFAC(13)='DIM3' * ELSEIF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN * DEFORMATION PLANE ,AXISYMETRIE JGOBL=17 TABOBL(1)='D11 ' TABOBL(2)='D21 ' TABOBL(3)='D22 ' TABOBL(4)='D31 ' TABOBL(5)='D32 ' TABOBL(6)='D33 ' TABOBL(7)='D41 ' TABOBL(8)='D42 ' TABOBL(9)='D43 ' TABOBL(10)='D44 ' TABOBL(11)='V1X ' TABOBL(12)='V1Y ' TABOBL(13)='COB1' TABOBL(14)='COB2' TABOBL(15)='CO12' TABOBL(16)='COB3' TABOBL(17)='MOB ' * JGFAC=13 TABFAC(1)='RHO ' TABFAC(2)='ALP1' TABFAC(3)='ALP2' TABFAC(4)='AL12' TABFAC(5)='ALP3' TABFAC(6)='ALPM' TABFAC(7)='PER1' TABFAC(8)='PER2' TABFAC(9)='PE12' TABFAC(10)='VISC' TABFAC(11)='KF ' TABFAC(12)='RHOF' TABFAC(13)='ALPF' * ELSEIF (IFOUR.EQ.1) THEN * AXISYMETRIE DE FOURIER JGOBL=20 TABOBL(1)='D11 ' TABOBL(2)='D21 ' TABOBL(3)='D22 ' TABOBL(4)='D31 ' TABOBL(5)='D32 ' TABOBL(6)='D33 ' TABOBL(7)='D41 ' TABOBL(8)='D42 ' TABOBL(9)='D43 ' TABOBL(10)='D44 ' TABOBL(11)='D55 ' TABOBL(12)='D65 ' TABOBL(13)='D66 ' TABOBL(14)='V1X ' TABOBL(15)='V1Y ' TABOBL(16)='COB1' TABOBL(17)='COB2' TABOBL(18)='CO12' TABOBL(19)='COB3' TABOBL(20)='MOB ' * JGFAC=14 TABFAC(1)='RHO ' TABFAC(2)='ALP1' TABFAC(3)='ALP2' TABFAC(4)='AL12' TABFAC(5)='ALP3' TABFAC(6)='ALPM' TABFAC(7)='PER1' TABFAC(8)='PER2' TABFAC(9)='PE12' TABFAC(10)='PER3' TABFAC(11)='VISC' TABFAC(12)='KF ' TABFAC(13)='RHOF' TABFAC(14)='ALPF' ENDIF ENDIF ELSE * * CAS NON PREVU * IRET = 0 GOTO 9999 ENDIF ELSEIF (IPLAC.EQ.6) THEN C C MATERIAU ELASTIQUE UNIDIRECTIONNEL C IF(MFR.EQ.33)THEN IF (IDIM.EQ.3) THEN JGOBL=9 TABOBL(1)='YOUN' TABOBL(2)='V1X ' TABOBL(3)='V1Y ' TABOBL(4)='V1Z ' TABOBL(5)='V2X ' TABOBL(6)='V2Y ' TABOBL(7)='V2Z ' TABOBL(8)='COB ' TABOBL(9)='MOB ' ELSE JGOBL=5 TABOBL(1)='YOUN' TABOBL(2)='V1X ' TABOBL(3)='V1Y ' TABOBL(4)='COB ' TABOBL(5)='MOB ' ENDIF * IF(IFOUR.EQ.-2) THEN JGFAC=9 TABFAC(9)='DIM3' ELSE JGFAC=8 ENDIF TABFAC(1)='RHO ' TABFAC(2)='ALPH' TABFAC(3)='ALPM' TABFAC(4)='PERM' TABFAC(5)='VISC' TABFAC(6)='KF ' TABFAC(7)='RHOF' TABFAC(8)='ALPF' ELSE * * CAS NON PREVU * IRET = 0 GO TO 9999 ENDIF * ENDIF INMAT=3 GOTO 40 ELSE INMAT=2 GOTO 30 ENDIF ENDIF INMAT=0 30 CONTINUE * * CAS MATERIAU POREUX ELASTIQUE ISOTROPE * IF(MELE.GE.79.AND.MELE.LE.83)THEN * JGOBL=4 TABOBL(1) ='YOUN' TABOBL(2) ='NU ' TABOBL(3) ='COB ' TABOBL(4) ='MOB ' * IF(IFOUR.EQ.-2) THEN JGFAC=9 TABFAC(9)='DIM3' ELSE JGFAC=8 ENDIF TABFAC(1)='RHOF' TABFAC(2)='ALPF' TABFAC(3)='ALPM' TABFAC(4)='PERM' TABFAC(5)='VISC' TABFAC(6)='KF ' TABFAC(7)='RHO ' TABFAC(8)='ALPH' * ELSEIF(MELE.GE.108.AND.MELE.LE.110)THEN * * CAS DES JOINTS POREUX ISOTROPES (VALABLE EN 2D COMME EN 3D) * JGOBL=4 TABOBL(1)='KS ' TABOBL(2)='KN ' TABOBL(3)='COB ' TABOBL(4)='MOB ' * JGFAC=4 TABFAC(1)='PERT' TABFAC(2)='PERH' TABFAC(3)='PERB' TABFAC(4)='VISC' * ELSEIF(MELE.GE.173.AND.MELE.LE.177)THEN * JGOBL=10 TABOBL(1) ='YOUN' TABOBL(2) ='NU ' TABOBL(3) ='COP1' TABOBL(4) ='COP2' TABOBL(5) ='CPP1' TABOBL(6) ='CPP2' TABOBL(7) ='KK11' TABOBL(8) ='KK12' TABOBL(9) ='KK21' TABOBL(10)='KK22' * IF(IFOUR.EQ.-2) THEN JGFAC=9 TABFAC(9)='DIM3' ELSE JGFAC=8 ENDIF TABFAC(1)='RHOF' TABFAC(2)='ALPF' TABFAC(3)='ALPM' TABFAC(4)='PK11' TABFAC(5)='PK12' TABFAC(6)='PK21' TABFAC(7)='PK22' TABFAC(8)='ALPH' * ELSEIF(MELE.GE.185.AND.MELE.LE.187)THEN * * CAS DES JOINTS POREUX ISOTROPES (VALABLE EN 2D COMME EN 3D) * JGOBL=10 TABOBL(1)='KS ' TABOBL(2)='KN ' TABOBL(3)='COP1' TABOBL(4)='COP2' TABOBL(5)='CPP1' TABOBL(6)='CPP2' TABOBL(7)='KK11' TABOBL(8)='KK12' TABOBL(9)='KK21' TABOBL(10)='KK22' * IF(IFOUR.EQ.-2) THEN JGFAC=18 TABFAC(18)='DIM3' ELSE JGFAC=17 ENDIF TABFAC(1)='RHOF' TABFAC(2)='ALPF' TABFAC(3)='ALPM' TABFAC(4)='PT11' TABFAC(5)='PH11' TABFAC(6)='PB11' TABFAC(7)='PT12' TABFAC(8)='PH12' TABFAC(9)='PB12' TABFAC(10)='PT21' TABFAC(11)='PH21' TABFAC(12)='PB21' TABFAC(13)='PT22' TABFAC(14)='PH22' TABFAC(15)='PB22' TABFAC(16)='RHO ' TABFAC(17)='ALPH' ELSEIF(MELE.GE.178.AND.MELE.LE.182)THEN * JGOBL=17 TABOBL(1)='YOUN' TABOBL(2)='NU ' TABOBL(3)='COP1' TABOBL(4)='COP2' TABOBL(5)='COP3' TABOBL(6)='CPP1' TABOBL(7)='CPP2' TABOBL(8)='CPP3' TABOBL(9)='KK11' TABOBL(10)='KK12' TABOBL(11)='KK13' TABOBL(12)='KK21' TABOBL(13)='KK22' TABOBL(14)='KK23' TABOBL(15)='KK31' TABOBL(16)='KK32' TABOBL(17)='KK33' * IF(IFOUR.EQ.-2) THEN JGFAC=15 TABFAC(15)='DIM3' ELSE JGFAC=14 ENDIF TABFAC(1)='RHOF' TABFAC(2)='ALPF' TABFAC(3)='ALPM' TABFAC(4)='PK11' TABFAC(5)='PK12' TABFAC(6)='PK13' TABFAC(7)='PK21' TABFAC(8)='PK22' TABFAC(9)='PK23' TABFAC(10)='PK31' TABFAC(11)='PK32' TABFAC(12)='PK33' TABFAC(13)='RHO ' TABFAC(14)='ALPH' ELSEIF(MELE.GE.188.AND.MELE.LE.190)THEN * * CAS DES JOINTS POREUX ISOTROPES (VALABLE EN 2D COMME EN 3D) * JGOBL=17 TABOBL(1)='KS ' TABOBL(2)='KN ' TABOBL(3)='COP1' TABOBL(4)='COP2' TABOBL(5)='COP3' TABOBL(6)='CPP1' TABOBL(7)='CPP2' TABOBL(8)='CPP3' TABOBL(9)='KK11' TABOBL(10)='KK12' TABOBL(11)='KK13' TABOBL(12)='KK21' TABOBL(13)='KK22' TABOBL(14)='KK23' TABOBL(15)='KK31' TABOBL(16)='KK32' TABOBL(17)='KK33' * IF(IFOUR.EQ.-2) THEN JGFAC=33 TABFAC(33)='DIM3' ELSE JGFAC=32 ENDIF TABFAC(1)='RHOF' TABFAC(2)='ALPF' TABFAC(3)='ALPM' TABFAC(4)='PT11' TABFAC(5)='PH11' TABFAC(6)='PB11' TABFAC(7)='PT12' TABFAC(8)='PH12' TABFAC(9)='PB12' TABFAC(10)='PT13' TABFAC(11)='PH13' TABFAC(12)='PB13' TABFAC(13)='PT21' TABFAC(14)='PH21' TABFAC(15)='PB21' TABFAC(16)='PT22' TABFAC(17)='PH22' TABFAC(18)='PB22' TABFAC(19)='PT23' TABFAC(20)='PH23' TABFAC(21)='PB23' TABFAC(22)='PT31' TABFAC(23)='PH31' TABFAC(24)='PB31' TABFAC(25)='PT32' TABFAC(26)='PH32' TABFAC(27)='PB32' TABFAC(28)='PT33' TABFAC(29)='PH33' TABFAC(30)='PB33' TABFAC(31)='RHO ' TABFAC(32)='ALPH' ENDIF * IF (INMAT.EQ.0) THEN ** IRET = 0 GOTO 9999 ENDIF * 40 CONTINUE IF (NMAT.GE.INMAT) THEN CALL MODNLI(MOMODL,NMOD) CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT)) IF (IPLAC.EQ.1) THEN INMAT=INMAT+1 CALL MODPLA(MOMODL,NMOD) CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT)) IF (IPLAC.EQ.0) THEN * ISOTROPE IPLAC=1 * ELSE * INMAT=INMAT+1 ENDIF CALL IDPLAS(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET) IF (IRET.EQ.0) GOTO 9999 ELSEIF (IPLAC.EQ.2) THEN INMAT=INMAT+1 CALL MODFLU(MOMODL,NMOD) CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT)) IF (IPLAC.EQ.0) THEN * NORTON IPLAC=1 * ELSE * INMAT=INMAT+1 ENDIF CALL IDFLUA(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET) IF (IRET.EQ.0) GOTO 9999 ELSEIF (IPLAC.EQ.3) THEN INMAT=INMAT+1 CALL MODVIS(MOMODL,NMOD) CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT)) IF (IPLAC.EQ.0) THEN * ONERA IPLAC=2 * ELSE * INMAT=INMAT+1 ENDIF CALL IDVISC(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET) IF (IRET.EQ.0) GOTO 9999 ELSEIF (IPLAC.EQ.4) THEN INMAT=INMAT+1 CALL MODEND(MOMODL,NMOD) CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(INMAT)) IF (IPLAC.EQ.0) THEN * MAZARS IPLAC=1 * ELSE * INMAT=INMAT+1 ENDIF CALL IDENDO(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET) IF (IRET.EQ.0) GOTO 9999 ELSE * GOTO 9999 ENDIF * * En cas de creation de materiaux combinant plusieurs materiaux * deja existant Ex ELASTIQUE ISOTROPE PLASTIQUE PARFAIT FLUAGE N * GOTO 40 * * GOTO 9999 ENDIF GOTO 9999 ENDIF *-------------------------------------------------------------------- * CAS DE LA FORMULATION CONTACT *-------------------------------------------------------------------- CALL PLACE(FORMOD,NFOR,ICONT,'CONTACT') IF (ICONT.NE.0) THEN CALL MODFRO(MOMODL,NMOD) iplla =0 do iou = 1,NMAT CALL PLACE(MOMODL(1),5,IPLAC,MATMOD(iou)) iplla = max(iplac,iplla) enddo IF (iplla.EQ.0) THEN IRET = 0 GOTO 9999 ENDIF IF ((IPLLA.EQ.1) .OR. (IPLLA.EQ.2) .OR. (IPLLA.EQ.3)) THEN * CONTACT SIMPLE * -------------- INMAT=1 JGOBL=0 JGFAC=2 TABFAC(1)='JEU' TABFAC(2)='ADHE' ELSEIF (IPLLA .EQ. 4) THEN * FROTTEMENT DE COULOMB * --------------------- INMAT=1 JGOBL=1 TABOBL(1)='MU ' JGFAC=3 TABFAC(1)='COHE' TABFAC(2)='ADHE' TABFAC(3)='JEU' ELSEIF (IPLLA .EQ. 5) THEN * FROTTEMENTS DE CABLES * --------------------- INMAT=1 JGOBL=2 TABOBL(1)='FF ' TABOBL(2)='PHIF' JGFAC=0 ELSE IRET=0 CALL ERREUR (261) RETURN ENDIF GOTO 9999 ENDIF *-------------------------------------------------------------------- * CAS DE LA FORMULATION CONTRAINTE *-------------------------------------------------------------------- CALL PLACE(FORMOD,NFOR,ICNTR,'CONTRAINTE') IF (ICNTR.NE.0) THEN CALL MODCLI(MOMODL,NMOD) iplla =0 do iou = 1,NMAT CALL PLACE(MOMODL(1),NMOD,IPLAC,MATMOD(iou)) iplla = max(iplac,iplla) enddo IF (iplla.EQ.0) THEN IRET = 0 GOTO 9999 ENDIF IF (IPLLA .EQ. 1) THEN * ROTATION * --------------------- INMAT=1 JGOBL=1 TABOBL(1)='ANGL' ELSEIF (IPLLA .EQ. 2) THEN * DEPLACEMENT * --------------------- INMAT=1 JGOBL=1 TABOBL(1)='AMPL' ENDIF ENDIF *-------------------------------------------------------------------- * CAS DE LA FORMULATION MAGNETODYNAMIQUE *-------------------------------------------------------------------- CALL PLACE(FORMOD,NFOR,ICONV,'MAGNETODYNAMIQUE') IF (ICONV.NE.0) THEN * * FORMULATION EN COQUES IF(MFR.EQ.3) THEN CALL PLACE(MATMOD,NMAT,ISOT,'ISOTROPE') IF(ISOT.NE.0) THEN JGOBL=3 TABOBL(1)='ETA' TABOBL(2)='PERM' TABOBL(3)='EPAI' ELSE CALL PLACE(MATMOD,NMAT,IORTH,'ORTHOTROPE') IF(IORTH.NE.0) THEN JGOBL=4 TABOBL(1)='ETA1' TABOBL(2)='ETA2' TABOBL(3)='PERM' TABOBL(4)='EPAI' ENDIF ENDIF ENDIF * GOTO 9999 ENDIF *-------------------------------------------------------------------- * CAS DE LA FORMULATION FISSURE *-------------------------------------------------------------------- CALL PLACE(FORMOD,NFOR,ICONV,'FISSURE') IF (ICONV.NE.0) THEN * * si POISEU_BLASIUS ou POISEU_COLEBROOK ou par defaut JGOBL=1 TABOBL(1)='RUGO' * si FROTTEMENT1 ou FROTTEMENT2 CALL PLACE(MATMOD,NMAT,IFT1,'FROTTEMENT1') CALL PLACE(MATMOD,NMAT,IFT2,'FROTTEMENT2') IF(IFT1.NE.0.OR.IFT2.NE.0) THEN JGOBL=7 TABOBL(2)='REC' TABOBL(3)='FK' TABOBL(4)='FA' TABOBL(5)='FB' TABOBL(6)='FC' TABOBL(7)='FD' ELSE * si FROTTEMENT3 ou FROTTEMENT4 CALL PLACE(MATMOD,NMAT,IFT1,'FROTTEMENT3') CALL PLACE(MATMOD,NMAT,IFT2,'FROTTEMENT4') IF(IFT1.NE.0.OR.IFT2.NE.0) THEN JGOBL=2 TABOBL(2)='FK' ENDIF ENDIF GOTO 9999 ENDIF *-------------------------------------------------------------------- * CAS DE LA FORMULATION NAVIER_STOKES *-------------------------------------------------------------------- CALL PLACE(FORMOD,NFOR,INAST,'NAVIER_STOKES') IF (INAST.GT.0) THEN iplac = imatee if (iplac.eq.0) then iret = 0 goto 9999 endif * JGOBL = 0 JGFAC = 0 if (iplac.eq.4) then *NLIN JGOBL0 = JGOBL JGOBL = JGOBL0+1 TABOBL(JGOBL0 + 1) ='REYN' JGOBL0 = JGFAC JGFAC = JGOBL0+1 TABFAC(JGOBL0 + 1) ='FREQ' endif GOTO 9999 ENDIF *-------------------------------------------------------------------- * CAS DE LA FORMULATION MELANGE *-------------------------------------------------------------------- CALL PLACE(FORMOD,NFOR,ICONV,'MELANGE') IF (ICONV.NE.0) THEN CALL MODMEL(MOMODL,NMOD) CALL PLACE(MOMODL,NMOD,IPLAC,MATMOD(1)) if (iplac.eq.0) then goto 9999 endif INMAT=1 * * a priori elements massifs ou coques : pas de verif * IF (IPLAC.NE.3.AND.IPLAC.NE.4) THEN JGOBL = 0 JGFAC = 0 CALL IDMETA(MFR,TABOBL,TABFAC,JGOBL,JGFAC,ITA,IPLAC,IRET) IF (IRET.EQ.0) GOTO 9999 ELSE ENDIF GOTO 9999 ENDIF *-------------------------------------------------------------------- * CAS DE LA FORMULATION LIAISON *-------------------------------------------------------------------- CALL PLACE(FORMOD,NFOR,ICONV,'LIAISON') IF (ICONV.NE.0) THEN iplac = imatee if (iplac.eq.0) then iret = 0 goto 9999 endif * JGOBL = 0 JGFAC = 0 * 'SORT' facultatif dans tous les cas IF (iplac.EQ.1) THEN *PO_PL_FL JGOBL0 = JGOBL JGOBL = JGOBL0+7 TABOBL(JGOBL0 + 1) ='NORM' TABOBL(JGOBL0 + 2) ='INER' TABOBL(JGOBL0 + 3) ='CONV' TABOBL(JGOBL0 + 4) ='VISC' TABOBL(JGOBL0 + 5) ='PELO' TABOBL(JGOBL0 + 6) ='PRAP' TABOBL(JGOBL0 + 7) ='JFLU' ELSEIF (iplac.eq.2) then *PO_PL_FR JGOBL0 = JGOBL JGOBL = JGOBL0+7 TABOBL(JGOBL0 + 1) ='NORM' TABOBL(JGOBL0 + 2) ='RAID' TABOBL(JGOBL0 + 3) ='JEU' TABOBL(JGOBL0 + 4) ='GLIS' TABOBL(JGOBL0 + 5) ='ADHE' TABOBL(JGOBL0 + 6) ='RTAN' TABOBL(JGOBL0 + 7) ='ATAN' JGOBL0 = JGFAC JGFAC = JGOBL0 +2 TABFAC(JGOBL0+1) = 'AMOR' TABFAC(JGOBL0+2) = 'LOIC' ELSEIF (iplac.eq.3) then *PO_PL JGOBL0 = JGOBL JGOBL= JGOBL0+3 TABOBL(JGOBL0 + 1) ='NORM' TABOBL(JGOBL0 + 2) ='RAID' TABOBL(JGOBL0 + 3) ='JEU' JGOBL0 = JGFAC JGFAC = JGOBL0+4 TABFAC(JGOBL0+1) = 'LOIC' TABFAC(JGOBL0+2) = 'PERM' TABFAC(JGOBL0 + 3) ='SPLA' TABFAC(JGOBL0 + 4) ='AMOR' ELSEIF (iplac.eq.4) then *PO_PO_FR JGOBL0 = JGOBL JGOBL= JGOBL0 + 8 TABOBL(JGOBL0 + 1) ='NORM' TABOBL(JGOBL0 + 2) ='RAID' TABOBL(JGOBL0 + 3) ='JEU' TABOBL(JGOBL0 + 4) ='POIB' TABOBL(JGOBL0 + 5) ='ADHE' TABOBL(JGOBL0 + 6) ='RTAN' TABOBL(JGOBL0 + 7) ='ATAN' TABOBL(JGOBL0 + 8) ='GLIS' JGOBL0 = JGFAC JGFAC = JGOBL0 + 3 TABFAC(JGOBL0+1) = 'AMOR' TABFAC(JGOBL0+2) = 'LOIC' TABFAC(JGOBL0+3) = 'MODE' ELSEIF (iplac.eq.5) then *PO_PO_DP JGOBL0 = JGOBL JGOBL= JGOBL0 + 6 TABOBL(JGOBL0 + 1) ='NORM' TABOBL(JGOBL0 + 2) ='ECRO' TABOBL(JGOBL0 + 3) ='JEU' TABOBL(JGOBL0 + 4) ='POIB' TABOBL(JGOBL0 + 5) ='PERM' TABOBL(JGOBL0 + 6) ='LOIC' JGOBL0 = JGFAC JGFAC = JGOBL0 + 1 TABFAC(JGOBL0+1) = 'AMOR' ELSEIF (iplac.eq.6) then *PO_PO_RP JGOBL0 = JGOBL JGOBL= JGOBL0 + 6 TABOBL(JGOBL0 + 1) ='AXRO' TABOBL(JGOBL0 + 2) ='ECRO' TABOBL(JGOBL0 + 3) ='JEU' TABOBL(JGOBL0 + 4) ='POIB' TABOBL(JGOBL0 + 5) ='PERM' TABOBL(JGOBL0 + 6) ='LOIC' JGOBL0 = JGFAC JGFAC = JGOBL0 + 2 TABFAC(JGOBL0+1) = 'AMOR' TABFAC(JGOBL0+2) = 'ELAS' ELSEIF (iplac.eq.7) then *PO_PO JGOBL0 = JGOBL JGOBL= JGOBL0 + 5 TABOBL(JGOBL0 + 1) ='NORM' TABOBL(JGOBL0 + 2) ='RAID' TABOBL(JGOBL0 + 3) ='JEU' TABOBL(JGOBL0 + 4) ='POIB' TABOBL(JGOBL0 + 5) ='PERM' JGOBL0 = JGFAC JGFAC = JGOBL0 + 2 TABFAC(JGOBL0+1) = 'AMOR' TABFAC(JGOBL0+2) = 'LOIC' ELSEIF (iplac.eq.8) then *PO_CE_MO JGOBL0 = JGOBL JGOBL= JGOBL0 + 8 TABOBL(JGOBL0 + 1) ='NORM' TABOBL(JGOBL0 + 2) ='RAID' TABOBL(JGOBL0 + 3) ='PCER' TABOBL(JGOBL0 + 4) ='RAYO' TABOBL(JGOBL0 + 5) ='GLIS' TABOBL(JGOBL0 + 6) ='ADHE' TABOBL(JGOBL0 + 7) ='RTAN' TABOBL(JGOBL0 + 8) ='ATAN' JGOBL0 = JGFAC JGFAC= JGOBL0 + 2 TABFAC(JGOBL0+1) = 'CINT' TABFAC(JGOBL0+2) = 'AMOR' ELSEIF (iplac.eq.9) then *PO_CE_FR JGOBL0 = JGOBL JGOBL= JGOBL0 + 8 TABOBL(JGOBL0 + 1) ='NORM' TABOBL(JGOBL0 + 2) ='RAID' TABOBL(JGOBL0 + 3) ='EXCE' TABOBL(JGOBL0 + 4) ='RAYO' TABOBL(JGOBL0 + 5) ='GLIS' TABOBL(JGOBL0 + 6) ='ADHE' TABOBL(JGOBL0 + 7) ='RTAN' TABOBL(JGOBL0 + 8) ='ATAN' JGOBL0 = JGFAC JGFAC = JGOBL0 + 2 TABFAC(JGOBL0+1) = 'CINT' TABFAC(JGOBL0+2) = 'AMOR' ELSEIF (iplac.eq.10) then *PO_CE JGOBL0 = JGOBL JGOBL= JGOBL0 + 4 TABOBL(JGOBL0 + 1) ='NORM' TABOBL(JGOBL0 + 2) ='RAID' TABOBL(JGOBL0 + 3) ='EXCE' TABOBL(JGOBL0 + 4) ='RAYO' JGOBL0 = JGFAC JGFAC = JGOBL0 + 1 TABFAC(JGOBL0+1) = 'AMOR' ELSEIF (iplac.eq.11) then *CE_PL_FR JGOBL0 = JGOBL JGOBL= JGOBL0 + 8 TABOBL(JGOBL0 + 1) ='NORM' TABOBL(JGOBL0 + 2) ='RAID' TABOBL(JGOBL0 + 3) ='JEU' TABOBL(JGOBL0 + 4) ='RAYS' TABOBL(JGOBL0 + 5) ='GLIS' TABOBL(JGOBL0 + 6) ='ADHE' TABOBL(JGOBL0 + 7) ='RTAN' TABOBL(JGOBL0 + 8) ='ATAN' JGOBL0 = JGFAC JGFAC = JGOBL0+1 TABFAC(JGOBL0+1) = 'AMOR' ELSEIF (iplac.eq.12) then *CE_CE_FR JGOBL0 = JGOBL JGOBL= JGOBL0 + 9 TABOBL(JGOBL0 + 1) ='NORM' TABOBL(JGOBL0 + 2) ='RAID' TABOBL(JGOBL0 + 3) ='EXCE' TABOBL(JGOBL0 + 4) ='RAYS' TABOBL(JGOBL0 + 5) ='GLIS' TABOBL(JGOBL0 + 6) ='ADHE' TABOBL(JGOBL0 + 7) ='RTAN' TABOBL(JGOBL0 + 8) ='ATAN' TABOBL(JGOBL0 + 9) ='RAYB' JGOBL0 = JGFAC JGFAC = JGOBL0 + 2 TABFAC(JGOBL0+1) = 'AMOR' TABFAC(JGOBL0+2) = 'CINT' ELSEIF (iplac.eq.13.or.iplac.eq.14) then *PR_PR_IN ou PR_PR_EX JGOBL0 = JGOBL JGOBL= JGOBL0 + 5 TABOBL(JGOBL0 + 1) ='NORM' TABOBL(JGOBL0 + 2) ='RAID' TABOBL(JGOBL0 + 3) ='PFIX' TABOBL(JGOBL0 + 4) ='PMOB' TABOBL(JGOBL0 + 5) ='ERAI' ELSEIF (iplac.eq.15) then *LI_LI_FR JGOBL0 = JGOBL JGOBL= JGOBL0 + 8 TABOBL(JGOBL0 + 1) ='NORM' TABOBL(JGOBL0 + 2) ='LIMA' TABOBL(JGOBL0 + 3) ='LIES' TABOBL(JGOBL0 + 4) ='RAID' TABOBL(JGOBL0 + 5) ='GLIS' TABOBL(JGOBL0 + 6) ='ADHE' TABOBL(JGOBL0 + 7) ='RTAN' TABOBL(JGOBL0 + 8) ='ATAN' JGOBL0 = JGFAC JGFAC = JGOBL0 + 4 TABFAC(JGOBL0+1) = 'JEU' TABFAC(JGOBL0+2) = 'AMOR' TABFAC(JGOBL0+3) = 'RECH' TABFAC(JGOBL0+4) = 'SYME' ELSEIF (iplac.eq.16) then *LI_CE_FR JGOBL0 = JGOBL JGOBL= JGOBL0 + 8 TABOBL(JGOBL0 + 1) ='NORM' TABOBL(JGOBL0 + 2) ='LIMA' TABOBL(JGOBL0 + 3) ='LIES' TABOBL(JGOBL0 + 4) ='RAID' TABOBL(JGOBL0 + 5) ='GLIS' TABOBL(JGOBL0 + 6) ='ADHE' TABOBL(JGOBL0 + 7) ='RTAN' TABOBL(JGOBL0 + 8) ='ATAN' JGOBL0 = JGFAC JGFAC = JGOBL0 + 5 TABFAC(JGOBL0+1) = 'AMOR' TABFAC(JGOBL0+2) = 'RECH' TABFAC(JGOBL0+3) = 'RAYO' TABFAC(JGOBL0+4) = 'ACTN' TABFAC(JGOBL0+5) = 'INVE' ELSEIF (iplac.eq.17) then *PA_FL_RO JGOBL0 = JGOBL JGOBL= JGOBL0+10 TABOBL(JGOBL0 + 1) ='LONG' TABOBL(JGOBL0 + 2) ='RAYO' TABOBL(JGOBL0 + 3) ='VISC' TABOBL(JGOBL0 + 4) ='RHOF' TABOBL(JGOBL0 + 5) ='PADM' TABOBL(JGOBL0 + 6) ='VROT' TABOBL(JGOBL0 + 7) ='EPSI' TABOBL(JGOBL0 + 8) ='PHII' TABOBL(JGOBL0 + 9) ='AFFI' TABOBL(JGOBL0 + 10)='TLOB' JGOBL0 = JGFAC JGFAC = JGOBL0 + 1 TABFAC(JGOBL0+1) = 'AMOR' ELSEIF (iplac.eq.23) then *NEWMARK MODAL JGOBL0 = JGOBL JGOBL= JGOBL0+3 TABOBL(JGOBL0 + 1) ='JEU' TABOBL(JGOBL0 + 2) ='MASS' TABOBL(JGOBL0 + 3) ='FREQ' JGOBL0 = JGFAC JGFAC = JGOBL0 + 3 TABFAC(JGOBL0+1) = 'EXCE' TABFAC(JGOBL0+2) = 'FROT' TABFAC(JGOBL0+3) = 'MOFR' ENDIF * 'SORT' facultatif dans tous les cas JGOBL0 = JGFAC JGFAC= JGOBL0+1 TABFAC(JGOBL0+1) = 'SORT' GOTO 9999 ENDIF *-------------------------------------------------------------------- * CAS DE LA FORMULATION ELECTROSTATIQUE *-------------------------------------------------------------------- CALL PLACE(FORMOD,NFOR,IELEC,'ELECTROSTATIQUE') IF (IELEC.NE.0) THEN C -- Permittivite isotrope IF (IMATEE.EQ.1) THEN C* IF (CMATEE.EQ.'ISOTROPE') THEN C* IF (MATMOD(1).EQ.'ISOTROPE ') THEN JGOBL = 1 TABOBL(1)='PEL ' C -- Permittivite orthotrope ELSEIF (IMATEE.EQ.2) THEN C* ELSEIF (CMATEE.EQ.'ORTHOTRO') THEN C* ELSEIF (MATMOD(1).EQ.'ORTHOTROPE ') THEN C ---- Elements massifs bidimensionnels PLAN et AXISYMETRIQUE IF (IDIM.EQ.2) THEN IF (IFOMOD.NE.1) THEN JGOBL = 4 TABOBL(1) = 'PE1 ' TABOBL(2) = 'PE2 ' TABOBL(3) = 'V1X ' TABOBL(4) = 'V1Y ' C ---- Elements massifs bidimensionnels FOURIER ELSE JGOBL = 5 TABOBL(1) = 'PE1 ' TABOBL(2) = 'PE2 ' TABOBL(3) = 'PE3 ' TABOBL(4) = 'V1X ' TABOBL(5) = 'V1Y ' ENDIF C ---- Elements massifs TRIDimensionnels ELSEIF (IDIM.EQ.3) THEN JGOBL = 9 TABOBL(1) = 'PE1 ' TABOBL(2) = 'PE2 ' TABOBL(3) = 'PE3 ' TABOBL(4) = 'V1X ' TABOBL(5) = 'V1Y ' TABOBL(6) = 'V1Z ' TABOBL(7) = 'V2X ' TABOBL(8) = 'V2Y ' TABOBL(9) = 'V2Z ' ENDIF C -- Permittivite anisotrope ELSEIF (IMATEE.EQ.3) THEN C* ELSEIF (CMATEE.EQ.'ANISOTRO') THEN C* ELSEIF (MATMOD(1).EQ.'ANISOTROPE ') THEN C ---- Elements massifs bidimensionnels PLAN et AXISYMETRIQUE IF (IDIM.EQ.2) THEN IF (IFOMOD.NE.1) THEN JGOBL = 5 TABOBL(1) = 'PE11 ' TABOBL(2) = 'PE22 ' TABOBL(3) = 'PE21 ' TABOBL(4) = 'V1X ' TABOBL(5) = 'V1Y ' C ---- Elements massifs bidimensionnels FOURIER ELSE JGOBL = 6 TABOBL(1) = 'PE11 ' TABOBL(2) = 'PE22 ' TABOBL(3) = 'PE21 ' TABOBL(4) = 'PE33 ' TABOBL(5) = 'V1X ' TABOBL(6) = 'V1Y ' ENDIF C ---- Elements massifs TRIDimensionnels ELSEIF (IDIM.EQ.3) THEN JGOBL = 12 TABOBL( 1) = 'PE11 ' TABOBL( 2) = 'PE22 ' TABOBL( 3) = 'PE33 ' TABOBL( 4) = 'PE21 ' TABOBL( 5) = 'PE31 ' TABOBL( 6) = 'PE32 ' TABOBL( 7) = 'V1X ' TABOBL( 8) = 'V1Y ' TABOBL( 9) = 'V1Z ' TABOBL(10) = 'V2X ' TABOBL(11) = 'V2Y ' TABOBL(12) = 'V2Z ' ENDIF ELSE IRET = 0 CALL ERREUR(5) ENDIF GOTO 9999 ENDIF *----------------------------------------------------------------------- * CAS DE LA FORMULATION 'DIFFUSION' *----------------------------------------------------------------------- CALL PLACE(FORMOD,NFOR,IDIFF,'DIFFUSION') IF (IDIFF.NE.0) THEN JGFAC = 1 TABFAC(1)='CDIF' C- Diffusion isotrope IF (IMATEE .EQ. 1) THEN JGOBL = 1 C*8 TABOBL(1) = 'KDIFF ' TABOBL(1) = 'KD ' C- Diffusion orthotrope ELSEIF (IMATEE .EQ. 2) THEN C --- Elements massifs bidimensionnels PLAN et AXISYMETRIQUE IF (IDIM.EQ.2) THEN IF (IFOMOD.NE.1) THEN JGOBL = 4 TABOBL(1) = 'KD1 ' TABOBL(2) = 'KD2 ' TABOBL(3) = 'V1X ' TABOBL(4) = 'V1Y ' C --- Elements massifs bidimensionnels FOURIER ELSE JGOBL = 5 TABOBL(1) = 'KD1 ' TABOBL(2) = 'KD2 ' TABOBL(3) = 'KD3 ' TABOBL(4) = 'V1X ' TABOBL(5) = 'V1Y ' ENDIF C --- Elements massifs TRIDimensionnels ELSEIF (IDIM.EQ.3) THEN JGOBL = 9 TABOBL(1) = 'KD1 ' TABOBL(2) = 'KD2 ' TABOBL(3) = 'KD3 ' TABOBL(4) = 'V1X ' TABOBL(5) = 'V1Y ' TABOBL(6) = 'V1Z ' TABOBL(7) = 'V2X ' TABOBL(8) = 'V2Y ' TABOBL(9) = 'V2Z ' ENDIF C - Diffusion anisotrope ELSEIF (IMATEE.EQ.3) THEN C --- Elements massifs bidimensionnels PLAN et AXISYMETRIQUE IF (IDIM.EQ.2) THEN IF (IFOMOD.NE.1) THEN JGOBL = 5 TABOBL(1) = 'KD11 ' TABOBL(2) = 'KD22 ' TABOBL(3) = 'KD21 ' TABOBL(4) = 'V1X ' TABOBL(5) = 'V1Y ' C --- Elements massifs bidimensionnels FOURIER ELSE JGOBL = 6 TABOBL(1) = 'KD11 ' TABOBL(2) = 'KD22 ' TABOBL(3) = 'KD21 ' TABOBL(4) = 'KD33 ' TABOBL(5) = 'V1X ' TABOBL(6) = 'V1Y ' ENDIF C --- Elements massifs TRIDimensionnels ELSEIF (IDIM.EQ.3) THEN JGOBL = 12 TABOBL( 1) = 'KD11 ' TABOBL( 2) = 'KD22 ' TABOBL( 3) = 'KD33 ' TABOBL( 4) = 'KD21 ' TABOBL( 5) = 'KD31 ' TABOBL( 6) = 'KD32 ' TABOBL( 7) = 'V1X ' TABOBL( 8) = 'V1Y ' TABOBL( 9) = 'V1Z ' TABOBL(10) = 'V2X ' TABOBL(11) = 'V2Y ' TABOBL(12) = 'V2Z ' ENDIF ENDIF JGOBL0 = JGOBL JGFAC0 = JGFAC * Loi FICK : * ------------ IF (INATUU.EQ.0) THEN * Rien a ajouter * Loi SORET : * ------------- ELSEIF (INATUU.EQ.1) THEN C -- Diffusion isotrope IF (IMATEE.EQ.1) THEN JGOBL = JGOBL+1 C*8 TABOBL(JGOBL0+1) = 'KSORET ' TABOBL(JGOBL0+1) = 'KS ' C -- Diffusion orthotrope ELSEIF (IMATEE.EQ.2) THEN C ---- Elements massifs bidimensionnels PLAN et AXISYMETRIQUE IF (IFOMOD.LE.0) THEN JGOBL = JGOBL + 2 C*8 TABOBL(JGOBL0+1) = 'KSORET1 ' C*8 TABOBL(JGOBL0+2) = 'KSORET2 ' TABOBL(JGOBL0+1) = 'KS1 ' TABOBL(JGOBL0+2) = 'KS2 ' C ---- Elements massifs bidimensionnels FOURIER C ---- Elements massifs TRIDimensionnels ELSE JGOBL = JGOBL + 3 C*8 TABOBL(JGOBL0+1) = 'KSORET1 ' C*8 TABOBL(JGOBL0+2) = 'KSORET2 ' C*8 TABOBL(JGOBL0+3) = 'KSORET3 ' TABOBL(JGOBL0+1) = 'KS1 ' TABOBL(JGOBL0+2) = 'KS2 ' TABOBL(JGOBL0+3) = 'KS3 ' ENDIF C -- Diffusion anisotrope ELSEIF (IMATEE.EQ.3) THEN C ---- Elements massifs bidimensionnels PLAN et AXISYMETRIQUE IF (IFOMOD.LE.0) THEN JGOBL = JGOBL + 3 C*8 TABOBL(JGOBL0+1) = 'KSORET11' C*8 TABOBL(JGOBL0+2) = 'KSORET22' C*8 TABOBL(JGOBL0+3) = 'KSORET21' TABOBL(JGOBL0+1) = 'KS11 ' TABOBL(JGOBL0+2) = 'KS22 ' TABOBL(JGOBL0+3) = 'KS21 ' C ---- Elements massifs bidimensionnels FOURIER ELSEIF (IFOMOD.EQ.1) THEN JGOBL = JGOBL + 4 C*8 TABOBL(JGOBL0+1) = 'KSORET11' C*8 TABOBL(JGOBL0+2) = 'KSORET22' C*8 TABOBL(JGOBL0+3) = 'KSORET21' C*8 TABOBL(JGOBL0+4) = 'KSORET33' TABOBL(JGOBL0+1) = 'KS11 ' TABOBL(JGOBL0+2) = 'KS22 ' TABOBL(JGOBL0+3) = 'KS21 ' TABOBL(JGOBL0+4) = 'KS33 ' C ---- Elements massifs TRIDimensionnels ELSEIF (IFOMOD.EQ.2) THEN JGOBL = JGOBL + 6 C*8 TABOBL(JGOBL0+1) = 'KSORET11' C*8 TABOBL(JGOBL0+2) = 'KSORET22' C*8 TABOBL(JGOBL0+3) = 'KSORET33' C*8 TABOBL(JGOBL0+4) = 'KSORET21' C*8 TABOBL(JGOBL0+5) = 'KSORET31' C*8 TABOBL(JGOBL0+6) = 'KSORET32' TABOBL(JGOBL0+1) = 'KS11 ' TABOBL(JGOBL0+2) = 'KS22 ' TABOBL(JGOBL0+3) = 'KS33 ' TABOBL(JGOBL0+4) = 'KS21 ' TABOBL(JGOBL0+5) = 'KS31 ' TABOBL(JGOBL0+6) = 'KS32 ' ENDIF ELSE C -- Erreur ne devant pas survenir CALL ERREUR(261) RETURN ENDIF * Loi UTILISATEUR : * ------------------- * ELSEIF (INATUU.EQ.2) THEN * Par defaut pas de composantes autres que celles de l'utilisateur ELSEIF (INATUU.EQ.5) THEN * diffusion avec dissipation affine JGOBL = JGOBL+2 TABOBL(JGOBL0+1)='DAF0' TABOBL(JGOBL0+2)='DAF1' ELSEIF (INATUU.EQ.6) THEN * diffusion avec dissipation visqueuse JGOBL = JGOBL+2 TABOBL(JGOBL0+1)='DVQ0' TABOBL(JGOBL0+2)='DVQ1' * Loi inconnue : ERREUR * ---------------- ELSE CALL ERREUR(261) RETURN ENDIF * Composantes ADVECTION : * ------------------- CALL PLACE(MATMOD,NMAT,IADVE,'ADVECTION') if (iadve .ne. 0) then C Cas des Tuyaux 1D (MFR=79) C =========================== IF (MFR .EQ. 79) THEN JGOBL = JGOBL + 1 TABOBL(JGOBL0 + 1)='VITE' JGFAC = JGFAC + 1 TABFAC(JGFAC0 + 1)='DL' C Cas Diffusion Massif (MFR=73) C ============================ ELSEIF (MFR .EQ. 73) THEN C Bidimensionnel PLAN DPGE C =========================== IF (IFOUR.EQ.-3) THEN JGOBL = JGOBL + 3 TABOBL(JGOBL0 + 1)='VITX' TABOBL(JGOBL0 + 2)='VITY' TABOBL(JGOBL0 + 3)='VITZ' JGFAC = JGFAC + 3 TABFAC(JGFAC0 + 1)='DX' TABFAC(JGFAC0 + 2)='DY' TABFAC(JGFAC0 + 3)='DZ' C Bidimensionnel PLAN (CP/DP) C =========================== ELSEIF (IFOUR.EQ.-2 .OR. IFOUR.EQ.-1) THEN JGOBL = JGOBL + 2 TABOBL(JGOBL0 + 1)='VITX' TABOBL(JGOBL0 + 2)='VITY' JGFAC = JGFAC + 2 TABFAC(JGFAC0 + 1)='DX' TABFAC(JGFAC0 + 2)='DY' C Axisymetrie C =========================== ELSEIF (IFOUR .EQ. 0) THEN JGOBL = JGOBL + 2 TABOBL(JGOBL0 + 1)='VITR' TABOBL(JGOBL0 + 2)='VITZ' JGFAC = JGFAC + 2 TABFAC(JGFAC0 + 1)='DR' TABFAC(JGFAC0 + 2)='DZ' C Fourier C =========================== ELSEIF (IFOUR .EQ. 1) THEN CALL ERREUR(21) RETURN C JGOBL = JGOBL + 3 C TABOBL(JGOBL0 + 1)='VITR' C TABOBL(JGOBL0 + 2)='VITZ' C TABOBL(JGOBL0 + 3)='VITT' C C JGFAC = JGFAC + 3 C TABFAC(JGFAC0 + 1)='DR' C TABFAC(JGFAC0 + 2)='DZ' C TABFAC(JGFAC0 + 3)='DT' C Tridimensionnel C =========================== ELSEIF (IFOUR .EQ. 2) THEN JGOBL = JGOBL + 3 TABOBL(JGOBL0 + 1)='VITX' TABOBL(JGOBL0 + 2)='VITY' TABOBL(JGOBL0 + 3)='VITZ' JGFAC = JGFAC + 3 TABFAC(JGFAC0 + 1)='DX' TABFAC(JGFAC0 + 2)='DY' TABFAC(JGFAC0 + 3)='DZ' C Unidimensionnel (1D) C =========================== ELSEIF (IFOUR.GE.3 .AND. IFOUR.LE.15) THEN IF (IFOUR.LE.6) THEN JGOBL = JGOBL + 1 TABOBL(JGOBL0 + 1)='VITX' JGFAC = JGFAC + 1 TABFAC(JGFAC0 + 1)='DX' ELSEIF (IFOUR.EQ.7 .OR. IFOUR.EQ.8) THEN JGOBL = JGOBL + 2 TABOBL(JGOBL0 + 1)='VITX' TABOBL(JGOBL0 + 2)='VITY' JGFAC = JGFAC + 2 TABFAC(JGFAC0 + 1)='DX' TABFAC(JGFAC0 + 2)='DY' ELSEIF (IFOUR.EQ.9 .OR. IFOUR.EQ.10) THEN JGOBL = JGOBL + 2 TABOBL(JGOBL0 + 1)='VITX' TABOBL(JGOBL0 + 2)='VITZ' JGFAC = JGFAC + 2 TABFAC(JGFAC0 + 1)='DX' TABFAC(JGFAC0 + 2)='DZ' ELSEIF (IFOUR.EQ.11) THEN JGOBL = JGOBL + 3 TABOBL(JGOBL0 + 1)='VITX' TABOBL(JGOBL0 + 2)='VITY' TABOBL(JGOBL0 + 3)='VITZ' JGFAC = JGFAC + 3 TABFAC(JGFAC0 + 1)='DX' TABFAC(JGFAC0 + 2)='DY' TABFAC(JGFAC0 + 3)='DZ' ELSEIF (IFOUR.EQ.12.OR.IFOUR.EQ.13.OR.IFOUR.EQ.15) THEN JGOBL = JGOBL + 1 TABOBL(JGOBL0 + 1)='VITR' JGFAC = JGFAC + 1 TABFAC(JGFAC0 + 1)='DR' ELSEIF (IFOUR.EQ.14) THEN JGOBL = JGOBL + 2 TABOBL(JGOBL0 + 1)='VITR' TABOBL(JGOBL0 + 2)='VITZ' JGFAC = JGFAC + 2 TABFAC(JGFAC0 + 1)='DR' TABFAC(JGFAC0 + 2)='DZ' ENDIF ENDIF ENDIF ENDIF * WRITE(6,*) 'TABOBL',JGOBL,(TABOBL(i),i=1,JGOBL) * WRITE(6,*) 'TABFAC',JGFAC,(TABFAC(i),i=1,JGFAC) GOTO 9999 ENDIF *----------------------------------------------------------------------- * CAS DE LA FORMULATION 'CHARGEMENT' *----------------------------------------------------------------------- CALL PLACE(FORMOD,NFOR,ICHAR,'CHARGEMENT') IF (ICHAR.NE.0) THEN IPLAC = IMATEE IF (IPLAC.EQ.1) THEN C RAJOUTER DIFFERENTIATION EN FONCIONS DE LA FORMULATION MASSIF -> P C COQUE PINF PSUP JGOBL=1 TABOBL(1)='PR ' ELSE IRET = 0 CALL ERREUR(5) ENDIF GOTO 9999 ENDIF *-------------------------------------------------------------------- 9999 CONTINUE IF(IMECA.GT.0 .OR. IPORE.GT.0)THEN C CB215821 : Ajout de TREF et TALP à la fin des compostantes facultatives C pour les FORMULATION MECANIQUE, POREUX C Pour ne pas casser l'ordre dans COMP (com2/coml6/comval/comara/...) JGFAC=JGFAC+2 TABFAC(JGFAC-1) ='TREF' TABFAC(JGFAC) ='TALP' ENDIF C Erreur si JGOBL ou JGFAC sont superieurs a ITA C (Passage en FORTRAN 77 car la compilation depasse la memoire sur C Windows-32bits) IF ((JGOBL .GT. ITA) .OR. (JGFAC .GT. ITA)) THEN IRET = 0 CALL ERREUR(5) RETURN ENDIF NBROBL = JGOBL NBRFAC = JGFAC NOMID = 0 * SI PROBLEME (IRET = 0), ON SORT AVEC IPNOMC A 0 * IF (IRET.NE.0) THEN SEGINI,NOMID DO 100 IO = 1,NBROBL NOMID.LESOBL(IO) = TABOBL(IO) 100 CONTINUE DO 110 IO=1,NBRFAC NOMID.LESFAC(IO) = TABFAC(IO) 110 CONTINUE ENDIF IPNOMC = NOMID END