C ECOUL1 SOURCE OF166741 25/02/21 21:16:07 12166 SUBROUTINE ECOUL1(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCHE4,IPCHE6, & IPCAR,IPCH1,IPCH2,IPCH3,IPCH4,IPCH5,ITHHER,IFI,PRECIS, & IPOTAB,JECHER,ISTEP,JNOID,LOGSUC,IPCHE7,IPCHE8,IPCHE9) ********************************************************************** * * ecoulement inelastique * ********************************************************************** * * entrees: * * ipmodl = pointeur sur un objet mmodel * ipche1 = pointeur sur un mchaml de contraintes initiales * ipche2 = pointeur sur un mchaml de variables internes initiales * ipche3 = pointeur sur un mchaml de deformations inelastiques initiale * ipche4 = pointeur sur un mchaml d'increment elastique de deformations * ipche5 = pointeur sur un mchaml de deformations * ipcar = pointeur sur un mchaml de caracteristiques * ipch1 = pointeur sur un mchaml de temperatures au debut du pas * ipch2 = pointeur sur un mchaml de temperatures a la fin du pas * ipch3 = pointeur sur un mchaml de temperatures de reference c mistral : * ipch4 = pointeur sur un mchaml de flux neutronique au debut du pas pou * ipch5 = pointeur sur un mchaml de flux neutronique a la fin du pas pou * ifi = 0 pas de flux neutronique; = 1 existence de flux neutronique ( c mistral. * ithher = 0 si pas de chargement thermique * = 1 si chargement thermique mais materiau constant * = 2 si chargement thermique et mat. dependant de la temperature * ipch1,ipch2,ipch3,ithher ne servent que pour les materiaux * endommageables de lemaitre quand ils dependent de la temperature * precis = precision des iterations internes * ipotab = pointeur sur une table * jecher = flag valant 0 ou 1(pour action dans ecoule) * istep =indicateur d'action pour calcul nonlocal * =0 dans le cas d'un calcul local (normal) * =1 ou 2 dans le cas d'un calcul nonlocal * =1 pour calcul des fonctions seuil uniquement * =2 pour calcul des variables dissipatives a partir * des fonctions seuil moyennees prealablement par nloc * jnoid = flag valant 0 ou 1(pour action dans ecoul1) * * sorties: * * logsuc = logique pour indication de pb de convergence * ipche7 = pointeur sur un mchaml de contraintes * ipche8 = pointeur sur un mchaml de variables internes * ipche9 = pointeur sur un mchaml de deformations * ************************************************************************ IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCGEOME -INC CCHAMP -INC SMCHAML c mistral : POINTEUR MCHEL7.MCHELM,MCHEL8.MCHELM c mistral. -INC SMELEME -INC SMCOORD -INC SMMODEL Pointeur nomid1.nomid -INC SMINTE -INC TMPTVAL SEGMENT NOTYPE CHARACTER*16 TYPE(NBTYPE) ENDSEGMENT CHARACTER*8 CMATE CHARACTER*(NCONCH) CONM LOGICAL LOGSUC,lsupva,lsupco,lsupde,lsupma,lsupdd PARAMETER ( NINF=3 ) INTEGER INFOS(NINF) lsupva=.false. lsupde=.false. lsupdd=.false. c NHRM=NIFOUR c c verification du lieu support du mchaml de contraintes c CALL QUESUP(IPMODL,IPCHE1,5,0,ISUP1,IRET1) IF (ISUP1.GT.1) RETURN * * verification du lieu support du mchaml de variables internes * CALL QUESUP(IPMODL,IPCHE2,5,0,ISUP2,IRET2) IF (ISUP2.GT.1) RETURN c c verification du lieu support du mchaml de defor. inelastique init. c IF(IPCHE3.NE.0)THEN CALL QUESUP(IPMODL,IPCHE3,5,0,ISUP3,IRET3) IF (ISUP3.GT.1) RETURN ELSE ISUP3=0 ENDIF c c verification du lieu support du mchaml de defor. totales c IF(IPCHE6.NE.0)THEN CALL QUESUP(IPMODL,IPCHE6,5,0,ISUP6,IRET6) IF (ISUP6.GT.1) RETURN ELSE ISUP6=0 ENDIF c c verification du lieu support du mchaml des incr. deformat totales c CALL QUESUP(IPMODL,IPCHE4,5,0,ISUP4,IRET4) IF (ISUP4.GT.1) RETURN c c verification du lieu support du mchaml de caracteristiques c CALL QUESUP(IPMODL,IPCAR,3,0,ISUP5,IRET5) IF (ISUP5.GT.1) RETURN c c activation du modele c MMODEL=IPMODL SEGACT MMODEL NSOUS=KMODEL(/1) c c creation des 3 mchelms c N1=NSOUS L1=11 N3=6 SEGINI MCHELM TITCHE='CONTRAINTES' IFOCHE=IFOUR IPCHE7=MCHELM L1=18 SEGINI MCHEL1 MCHEL1.TITCHE='VARIABLES INTERNES' MCHEL1.IFOCHE=IFOUR IPCHE8=MCHEL1 L1=12 SEGINI MCHEL2 MCHEL2.TITCHE='DEFORMATIONS INELASTIQUES' MCHEL2.IFOCHE=IFOUR IPCHE9=MCHEL2 c c traitement des champs de temperature pour les materiaux c endommageables de lemaitre c IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN MCHEL3=IPCH1 MCHEL4=IPCH2 MCHEL5=IPCH3 SEGACT MCHEL3 SEGACT MCHEL4 SEGACT MCHEL5 ENDIF *********************** * SPECIAL SUCCION * IF (ITHHER.EQ.3) THEN MCHEL3=IPCH1 MCHEL4=IPCH2 SEGACT MCHEL3 SEGACT MCHEL4 ENDIF *********************** c mistral : IF (IFI.EQ.1) THEN MCHEL7=IPCH4 MCHEL8=IPCH5 SEGACT MCHEL7 SEGACT MCHEL8 ENDIF c mistral. * * deformations totales * IF(IPCHE6.NE.0) THEN MCHEL6=IPCHE6 SEGACT MCHEL6 ENDIF c____________________________________________________________________ c c debut de la boucle sur les differentes zones c____________________________________________________________________ c DO 1000 ISOUS=1,NSOUS * * initialisation * NSTR=0 MOSTRS=0 IVASTR=0 MOVARI=0 NVARI=0 NVARF=0 IVARI=0 MOEPSI=0 MODEIN=0 NDEF=0 NDEIN=0 IVADEF=0 IVADET=0 IVADS=0 NCARA=0 NCARF=0 MOCARA=0 IVACAR=0 NMATF=0 NMATR=0 MOMATR=0 IVAMAT=0 IVASTF=0 IVARIF=0 IVADEP=0 KERRE=0 KERR1=0 MCHAML=0 MCHAM1=0 MCHAM2=0 lsupma=.true. c c on recupere l information generale c IMODEL=KMODEL(ISOUS) SEGACT IMODEL IPMAIL=IMAMOD CONM =CONMOD IMACHE(ISOUS)=IPMAIL CONCHE(ISOUS)=CONMOD MCHEL1.IMACHE(ISOUS)=IPMAIL MCHEL1.CONCHE(ISOUS)=CONMOD MCHEL2.IMACHE(ISOUS)=IPMAIL MCHEL2.CONCHE(ISOUS)=CONMOD * MELE=NEFMOD MELEME=IMAMOD SEGACT MELEME NBNN=NUM(/1) NBELEM=NUM(/2) c c coque integree ou pas ? NPINT=INFMOD(1) c c traitement du modele c NFOR=FORMOD(/2) NMAT=MATMOD(/2) c c nature du materiau c CMATE = CMATEE MATE = IMATEE INPLAS = INATUU c____________________________________________________________________ c c information sur l'element fini c____________________________________________________________________ c MFR =INFELE(13) NBG =INFELE(6) NBGS =INFELE(4) NSTRS=INFELE(16) LRE =INFELE(9) IPPORE=0 IF(MFR.EQ.33) IPPORE=NBNN LW =200 LW2 =150 LHOOK=INFELE(10) * IF (MFR.EQ.3.AND.NPINT.NE.0) LHOOK=4 * LHOO2=LHOOK*LHOOK * MINTE=INFELE(11) minte=infmod(7) IPMINT=MINTE IPORE=INFELE(8) NBNO=NBNNE(NUMGEO(MELE)) IF (MELE.EQ.96) NBNO = INFELE(8) IF (MFR.EQ.33) NBNO=IPORE * * remplissage des tableaux infche * INFCHE(ISOUS,1)=0 INFCHE(ISOUS,2)=0 INFCHE(ISOUS,3)=NHRM INFCHE(ISOUS,4)=MINTE INFCHE(ISOUS,5)=0 INFCHE(ISOUS,6)=5 * MCHEL1.INFCHE(ISOUS,1)=0 MCHEL1.INFCHE(ISOUS,2)=0 MCHEL1.INFCHE(ISOUS,3)=NHRM MCHEL1.INFCHE(ISOUS,4)=MINTE MCHEL1.INFCHE(ISOUS,5)=0 MCHEL1.INFCHE(ISOUS,6)=5 * MCHEL2.INFCHE(ISOUS,1)=0 MCHEL2.INFCHE(ISOUS,2)=0 MCHEL2.INFCHE(ISOUS,3)=NHRM MCHEL2.INFCHE(ISOUS,4)=MINTE MCHEL2.INFCHE(ISOUS,5)=0 MCHEL2.INFCHE(ISOUS,6)=5 c c creation du tableau infos c CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD) IF (IRTD.EQ.0)THEN SEGDES IMODEL*NOMOD,MMODEL*NOMOD SEGSUP MCHELM,MCHEL1,MCHEL2 RETURN ENDIF * * traitement du champ de contraintes * if(lnomid(4).ne.0) then nomid=lnomid(4) segact nomid mostrs=nomid nstr=lesobl(/2) nfac=lesfac(/2) lsupco=.false. else lsupco=.true. CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC) endif IF (MOSTRS.EQ.0) THEN MOTERR(1:4)='CONT' MOTERR(5:8)=NOMTP(MELE) CALL ERREUR (76) SEGDES IMODEL*NOMOD,MMODEL*NOMOD SEGSUP MCHELM,MCHEL1,MCHEL2 RETURN ENDIF NBTYPE=1 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR) IF(IERR.NE.0)THEN SEGSUP NOTYPE KERRE=999 GOTO 9990 ENDIF * IF (ISUP1.EQ.1) THEN CALL VALCHE(IVASTR,NSTR,IPMINT,IPPORE,MOSTRS,MELE) IF(IERR.NE.0)THEN SEGSUP NOTYPE KERRE=999 ISUP1=0 GOTO 9990 ENDIF ENDIF * * traitement du champ de variables internes * MOTYVA=NOTYPE * * cas particulier poutre a fibres * IF(MFR.EQ.7.AND.CMATE.EQ.'SECTION') THEN NBTYPE=1 SEGINI NOTYPE MOTYVA=NOTYPE TYPE(1)='POINTEURMCHAML ' * * cas particulier modele de maxwell * ELSE IF(INPLAS.EQ.74) THEN NBTYPE=10 SEGINI NOTYPE MOTYVA=NOTYPE TYPE(1)='REAL*8' DO IC=2,10 TYPE(IC)='POINTEURLISTREEL' END DO ENDIF if(lnomid(10).ne.0) then nomid=lnomid(10) segact nomid movari=nomid nvari=lesobl(/2) nvarf=lesfac(/2) lsupva=.false. else lsupva=.true. CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF) endif IF (MOVARI.EQ.0) THEN MOTERR(1:4)='VARI' MOTERR(5:8)=NOMTP(MELE) CALL ERREUR (76) KERRE=999 SEGSUP NOTYPE GOTO 9990 ENDIF * CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYVA,1,INFOS,3,IVARI) IF(IERR.NE.0)THEN NOTYPE=MOTYVA SEGSUP NOTYPE KERRE=999 GOTO 9990 ENDIF * NVART=NVARI+NVARF * IF (ISUP2.EQ.1) THEN CALL VALCHE(IVARI,NVART,IPMINT,IPPORE,MOVARI,MELE) IF(IERR.NE.0)THEN SEGSUP NOTYPE KERRE=999 ISUP2=0 GOTO 9990 ENDIF ENDIF * * traitement du champ de deformations inelastiques * if(lnomid(5).ne.0)then nomid1=lnomid(5) segini,nomid=nomid1 ndef=lesobl(/2) nfac=lesfac(/2) moepsi=nomid lsupde=.false. else lsupde=.true. CALL IDDEFO(IMODEL,IFOUR,MOEPSI,NDEF,NFAC) endif if(lnomid(13).ne.0) then nomid=lnomid(13) segact nomid modein=nomid ndein=lesobl(/2) nfac=lesfac(/2) lsupdd=.false. else lsupdd=.true. CALL IDDEIN(IMODEL,IFOUR,MODEIN,NDEIN,NFAC) endif if (NDEF.NE.NDEIN) then c.. en principe meme nombre de composantes pour deformations et def inelas call erreur(5) return endif IF (MODEIN.EQ.0) THEN MOTERR(1:4)='DEIN' MOTERR(5:8)=NOMTP(MELE) CALL ERREUR (76) KERRE=999 SEGSUP NOTYPE GOTO 9990 ENDIF * IF(IPCHE3.NE.0)THEN CALL KOMCHA(IPCHE3,IPMAIL,CONM,MODEIN,MOTYPE & ,1,INFOS,3,IVADEF) IF(IERR.NE.0)THEN SEGSUP NOTYPE KERRE=999 GOTO 9990 ENDIF * IF (ISUP3.EQ.1) THEN CALL VALCHE(IVADEF,NDEF,IPMINT,IPPORE,MODEIN,MELE) IF(IERR.NE.0)THEN SEGSUP NOTYPE KERRE=999 ISUP3=0 GOTO 9990 ENDIF ENDIF ENDIF * * traitement du champ de deformations totales * IF(IPCHE6.NE.0)THEN CALL KOMCHA(IPCHE6,IPMAIL,CONM,MOEPSI,MOTYPE & ,1,INFOS,3,IVADET) IF(IERR.NE.0)THEN SEGSUP NOTYPE KERRE=999 GOTO 9990 ENDIF * IF (ISUP6.EQ.1) THEN CALL VALCHE(IVADET,NDEF,IPMINT,IPPORE,MOEPSI,MELE) IF(IERR.NE.0)THEN SEGSUP NOTYPE KERRE=999 ISUP6=0 GOTO 9990 ENDIF ENDIF ENDIF * * traitement du champ d'increments de deformations * CALL KOMCHA(IPCHE4,IPMAIL,CONM,MOEPSI, 1 MOTYPE,1,INFOS,3,IVADS) *********SEGSUP NOTYPE IF(IERR.NE.0)THEN SEGSUP NOTYPE KERRE=999 GOTO 9990 ENDIF * IF (ISUP4.EQ.1) THEN CALL VALCHE(IVADS,NDEF,IPMINT,IPPORE,MOEPSI,MELE) IF(IERR.NE.0)THEN SEGSUP NOTYPE KERRE=999 ISUP4=0 GOTO 9990 ENDIF ENDIF * * traitement du champ de caracteristiques materielles * if(lnomid(6).ne.0) then nomid=lnomid(6) segact nomid momatr=nomid nmatr=lesobl(/2) nmatf=lesfac(/2) lsupma=.false. else lsupma=.true. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF) endif IF (MOMATR.EQ.0) THEN MOTERR(1:4)='MATE' MOTERR(5:8)=NOMTP(MELE) CALL ERREUR (76) KERRE=999 GOTO 9990 ENDIF * IF(MATE.EQ.1.AND.(INPLAS.EQ.5.OR.INPLAS.EQ.87))THEN IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN NBTYPE=6 ELSE NBTYPE=5 ENDIF SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='POINTEUREVOLUTIO' TYPE(4)='REAL*8' TYPE(5)='REAL*8' IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33). + AND.IFOUR.EQ.-2) TYPE(6)='REAL*8' C ELSE IF(MATE.EQ.4.AND.INPLAS.EQ.5)THEN IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN NBTYPE=7 ELSE NBTYPE=6 ENDIF SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='REAL*8' TYPE(4)='POINTEUREVOLUTIO' TYPE(5)='REAL*8' TYPE(6)='REAL*8' IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33). + AND.IFOUR.EQ.-2) TYPE(7)='REAL*8' C ELSE IF(MATE.EQ.1.AND.INPLAS.EQ.51)THEN IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN NBTYPE=8 ELSE NBTYPE=7 ENDIF SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='POINTEUREVOLUTIO' TYPE(4)='POINTEUREVOLUTIO' TYPE(5)='POINTEUREVOLUTIO' TYPE(6)='REAL*8' TYPE(7)='REAL*8' IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33). + AND.IFOUR.EQ.-2) TYPE(8)='REAL*8' C ELSE IF(MATE.EQ.4.AND.INPLAS.EQ.51)THEN IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN NBTYPE=9 ELSE NBTYPE=8 ENDIF SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='REAL*8' TYPE(4)='POINTEUREVOLUTIO' TYPE(5)='POINTEUREVOLUTIO' TYPE(6)='POINTEUREVOLUTIO' TYPE(7)='REAL*8' TYPE(8)='REAL*8' IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33). + AND.IFOUR.EQ.-2) TYPE(9)='REAL*8' C ELSE IF(MATE.EQ.1.AND.INPLAS.EQ.62)THEN IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN NBTYPE=6 ELSE NBTYPE=5 ENDIF SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='POINTEUREVOLUTIO' TYPE(4)='REAL*8' TYPE(5)='REAL*8' IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33). + AND.IFOUR.EQ.-2) TYPE(6)='REAL*8' C ELSE IF(MATE.EQ.1.AND.INPLAS.EQ.64)THEN IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN NBTYPE=15 ELSE NBTYPE=14 ENDIF SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='POINTEUREVOLUTIO' TYPE(4)='REAL*8' TYPE(5)='REAL*8' TYPE(6)='REAL*8' TYPE(7)='REAL*8' TYPE(8)='REAL*8' TYPE(9)='REAL*8' TYPE(10)='REAL*8' TYPE(11)='REAL*8' TYPE(12)='REAL*8' TYPE(13)='REAL*8' TYPE(14)='REAL*8' IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33). + AND.IFOUR.EQ.-2) TYPE(15)='REAL*8' C ELSE IF (MATE.EQ.1.AND.INPLAS.EQ.14) THEN IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN NBTYPE=10 ELSE NBTYPE=9 ENDIF NBTYPE=9 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='REAL*8' TYPE(4)='REAL*8' TYPE(5)='REAL*8' TYPE(6)='POINTEUREVOLUTIO' TYPE(7)='POINTEUREVOLUTIO' TYPE(8)='REAL*8' TYPE(9)='REAL*8' IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33). + AND.IFOUR.EQ.-2) TYPE(10)='REAL*8' C ELSE IF (MATE.EQ.1.AND.INPLAS.EQ.26) THEN IF (ITHHER.EQ.2) THEN NBTYPE=0 SEGINI NOTYPE MOTYPE=NOTYPE ELSE IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN NBTYPE=9 ELSE NBTYPE=8 ENDIF SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='POINTEUREVOLUTIO' TYPE(4)='REAL*8' TYPE(5)='REAL*8' TYPE(6)='REAL*8' TYPE(7)='REAL*8' TYPE(8)='REAL*8' IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33). + AND.IFOUR.EQ.-2) TYPE(9)='REAL*8' ENDIF C ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.29)THEN IF (ITHHER.EQ.2) THEN NBTYPE=0 SEGINI NOTYPE MOTYPE=NOTYPE ELSE IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN NBTYPE=14 ELSE NBTYPE=13 ENDIF SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='REAL*8' TYPE(4)='REAL*8' TYPE(5)='REAL*8' TYPE(6)='REAL*8' TYPE(7)='REAL*8' TYPE(8)='REAL*8' TYPE(9)='REAL*8' TYPE(10)='POINTEUREVOLUTIO' TYPE(11)='REAL*8' TYPE(12)='REAL*8' TYPE(13)='REAL*8' IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33). + AND.IFOUR.EQ.-2) TYPE(14)='REAL*8' ENDIF C ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.16)THEN IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN NBTYPE=8 ELSE NBTYPE=7 ENDIF SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='POINTEUREVOLUTIO' TYPE(4)='REAL*8' TYPE(5)='REAL*8' TYPE(6)='REAL*8' TYPE(7)='REAL*8' C ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.2)THEN IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN NBTYPE=7 ELSE NBTYPE=6 ENDIF SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='REAL*8' TYPE(4)='POINTEUREVOLUTIO' TYPE(5)='REAL*8' TYPE(6)='REAL*8' IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33). + AND.IFOUR.EQ.-2) TYPE(7)='REAL*8' C ELSE IF(MATE.EQ.1.AND.INPLAS.EQ.32)THEN IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN NBTYPE=10 ELSE NBTYPE=19 ENDIF SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='REAL*8' TYPE(4)='REAL*8' TYPE(5)='POINTEUREVOLUTIO' TYPE(6)='POINTEUREVOLUTIO' TYPE(7)='POINTEUREVOLUTIO' TYPE(8)='POINTEUREVOLUTIO' TYPE(9)='POINTEUREVOLUTIO' IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33). + AND.IFOUR.EQ.-2) TYPE(10)='REAL*8' C ELSE IF(MATE.EQ.1.AND.INPLAS.EQ.44)THEN IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN NBTYPE=21 ELSE NBTYPE=20 ENDIF SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='REAL*8' TYPE(4)='REAL*8' TYPE(5)='REAL*8' TYPE(6)='REAL*8' TYPE(7)='REAL*8' TYPE(8)='REAL*8' TYPE(9)='REAL*8' TYPE(10)='REAL*8' TYPE(11)='REAL*8' TYPE(12)='REAL*8' TYPE(13)='REAL*8' TYPE(14)='REAL*8' TYPE(15)='REAL*8' TYPE(16)='REAL*8' TYPE(17)='REAL*8' TYPE(18)='REAL*8' TYPE(19)='REAL*8' TYPE(20)='REAL*8' IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33). + AND.IFOUR.EQ.-2) TYPE(21)='REAL*8' C ELSE IF(MATE.EQ.1.AND.INPLAS.EQ.45)THEN IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN NBTYPE=28 ELSE NBTYPE=27 ENDIF SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='REAL*8' TYPE(4)='REAL*8' TYPE(5)='REAL*8' TYPE(6)='REAL*8' TYPE(7)='REAL*8' TYPE(8)='REAL*8' TYPE(9)='REAL*8' TYPE(10)='REAL*8' TYPE(11)='REAL*8' TYPE(12)='REAL*8' TYPE(13)='REAL*8' TYPE(14)='REAL*8' TYPE(15)='REAL*8' TYPE(16)='REAL*8' TYPE(17)='REAL*8' TYPE(18)='REAL*8' TYPE(19)='REAL*8' TYPE(20)='REAL*8' TYPE(21)='REAL*8' TYPE(22)='REAL*8' TYPE(23)='REAL*8' TYPE(24)='REAL*8' TYPE(25)='REAL*8' TYPE(26)='REAL*8' TYPE(27)='REAL*8' IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33). + AND.IFOUR.EQ.-2) TYPE(28)='REAL*8' C ELSE IF(MFR.EQ.7.AND.CMATE.EQ.'SECTION')THEN NBTYPE=3 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='POINTEURMMODEL ' TYPE(2)='POINTEURMCHAML ' TYPE(3)='POINTEURLISTREEL' C ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.54)THEN NBTYPE=15 SEGINI NOTYPE MOTYPE=NOTYPE DO I=1,NBTYPE TYPE(I)='REAL*8' ENDDO TYPE(10)='POINTEUREVOLUTIO' TYPE(11)='POINTEUREVOLUTIO' C C JOINT_SOFT C ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.56)THEN NBTYPE=10 SEGINI NOTYPE MOTYPE=NOTYPE DO I=1,NBTYPE TYPE(I)='REAL*8' ENDDO TYPE(6)='POINTEUREVOLUTIO' TYPE(7)='POINTEUREVOLUTIO' TYPE(8)='POINTEUREVOLUTIO' C C Note: Il s'agit des parametres obligatoires. 1 et 2 sont par defaut C YOUN et NU, 3, 4 et 5 (d'apres idplas.eso modele plastique 35) C PNOR, CPLG, BETA, puis viennent les 3 courbes 6, 7 et 8, c.a.d C C ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.119)THEN C C JOINT_COAT C NBTYPE=2+3 SEGINI NOTYPE MOTYPE=NOTYPE DO I=1,NBTYPE TYPE(I)='REAL*8' ENDDO TYPE(2)='POINTEUREVOLUTIO' C C Note: Il s'agit des parametres obligatoires. 1 est par defaut C KS, 2 (d'apres idplas.eso modele plastique 49) la courbe SJSB C SJCB, SJSB et SJTB. C C+PPm ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.126)THEN C C MUR_SHEAR C C 2004 NBTYPE=13+4 NBTYPE=14+4 SEGINI NOTYPE MOTYPE=NOTYPE DO I=1,NBTYPE TYPE(I)='REAL*8' ENDDO DO I=3,8 TYPE(I)='POINTEUREVOLUTIO' ENDDO C Note: Il s'agit des parametres obligatoires. 1 et 2 sont par defaut C YOUN et NU, 3 a 8 (d'apres idplas.eso modele plastique 63) les C courbes CUFP, CUKP, CULP, CUFM, CUKM, CULM C+PPm C C C ANCRAGE_ELIGEHAUSEN ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.91)THEN NBTYPE=11 SEGINI NOTYPE MOTYPE=NOTYPE DO I=1,NBTYPE TYPE(I)='REAL*8' ENDDO C C PARFAIT_ANCRAGE C ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.92)THEN NBTYPE=14 SEGINI NOTYPE MOTYPE=NOTYPE DO I=1,NBTYPE TYPE(I)='REAL*8' ENDDO C C ACIER_ANCRAGE C ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.93)THEN NBTYPE=24 SEGINI NOTYPE MOTYPE=NOTYPE DO I=1,NBTYPE TYPE(I)='REAL*8' ENDDO C C TAKEDA C ELSEIF(MATE.EQ.1.AND.(INPLAS.EQ.59.OR.INPLAS.EQ.60))THEN NBTYPE=11 SEGINI NOTYPE MOTYPE=NOTYPE DO I=1,NBTYPE TYPE(I)='REAL*8' ENDDO TYPE(3)='POINTEUREVOLUTIO' C C INFILL_UNI C ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.72)THEN NBTYPE=12 SEGINI NOTYPE MOTYPE=NOTYPE DO I=1,NBTYPE TYPE(I)='REAL*8' ENDDO TYPE(10)='POINTEUREVOLUTIO' C C CISAIL_NL C ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.73)THEN NBTYPE=13 SEGINI NOTYPE MOTYPE=NOTYPE DO I=1,NBTYPE TYPE(I)='REAL*8' ENDDO TYPE(10)='POINTEUREVOLUTIO' TYPE(11)='POINTEUREVOLUTIO' C ELSEIF(MATE.EQ.1.AND.INPLAS.EQ.74)THEN IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN NBTYPE=22 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='POINTEUREVOLUTIO' TYPE(4)='POINTEUREVOLUTIO' TYPE(5)='REAL*8' TYPE(6)='POINTEUREVOLUTIO' TYPE(7)='REAL*8' TYPE(8)='POINTEUREVOLUTIO' TYPE(9)='REAL*8' TYPE(10)='POINTEUREVOLUTIO' TYPE(11)='REAL*8' TYPE(12)='REAL*8' TYPE(13)='REAL*8' TYPE(14)='REAL*8' TYPE(15)='POINTEUREVOLUTIO' TYPE(16)='REAL*8' TYPE(17)='POINTEUREVOLUTIO' TYPE(18)='REAL*8' TYPE(19)='POINTEUREVOLUTIO' TYPE(20)='REAL*8' TYPE(21)='POINTEUREVOLUTIO' TYPE(22)='REAL*8' ELSE NBTYPE=21 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='POINTEUREVOLUTIO' TYPE(4)='POINTEUREVOLUTIO' TYPE(5)='REAL*8' TYPE(6)='POINTEUREVOLUTIO' TYPE(7)='REAL*8' TYPE(8)='POINTEUREVOLUTIO' TYPE(9)='REAL*8' TYPE(10)='POINTEUREVOLUTIO' TYPE(11)='REAL*8' TYPE(12)='REAL*8' TYPE(13)='REAL*8' TYPE(14)='POINTEUREVOLUTIO' TYPE(15)='REAL*8' TYPE(16)='POINTEUREVOLUTIO' TYPE(17)='REAL*8' TYPE(18)='POINTEUREVOLUTIO' TYPE(19)='REAL*8' TYPE(20)='POINTEUREVOLUTIO' TYPE(21)='REAL*8' ENDIF C ELSEIF(MATE.EQ.4.AND.INPLAS.EQ.74)THEN IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN NBTYPE=23 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='REAL*8' TYPE(4)='POINTEUREVOLUTIO' TYPE(5)='POINTEUREVOLUTIO' TYPE(6)='REAL*8' TYPE(7)='POINTEUREVOLUTIO' TYPE(8)='REAL*8' TYPE(9)='POINTEUREVOLUTIO' TYPE(10)='REAL*8' TYPE(11)='POINTEUREVOLUTIO' TYPE(12)='REAL*8' TYPE(13)='REAL*8' TYPE(14)='REAL*8' TYPE(15)='REAL*8' TYPE(16)='POINTEUREVOLUTIO' TYPE(17)='REAL*8' TYPE(18)='POINTEUREVOLUTIO' TYPE(19)='REAL*8' TYPE(20)='POINTEUREVOLUTIO' TYPE(21)='REAL*8' TYPE(22)='POINTEUREVOLUTIO' TYPE(23)='REAL*8' ELSE IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.2) THEN NBTYPE=26 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='REAL*8' TYPE(4)='REAL*8' TYPE(5)='REAL*8' TYPE(6)='REAL*8' TYPE(7)='REAL*8' TYPE(8)='POINTEUREVOLUTIO' TYPE(9)='POINTEUREVOLUTIO' TYPE(10)='REAL*8' TYPE(11)='POINTEUREVOLUTIO' TYPE(12)='REAL*8' TYPE(13)='POINTEUREVOLUTIO' TYPE(14)='REAL*8' TYPE(15)='POINTEUREVOLUTIO' TYPE(16)='REAL*8' TYPE(17)='REAL*8' TYPE(18)='REAL*8' TYPE(19)='POINTEUREVOLUTIO' TYPE(20)='REAL*8' TYPE(21)='POINTEUREVOLUTIO' TYPE(22)='REAL*8' TYPE(23)='POINTEUREVOLUTIO' TYPE(24)='REAL*8' TYPE(25)='POINTEUREVOLUTIO' TYPE(26)='REAL*8' ELSE NBTYPE=22 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='REAL*8' TYPE(4)='POINTEUREVOLUTIO' TYPE(5)='POINTEUREVOLUTIO' TYPE(6)='REAL*8' TYPE(7)='POINTEUREVOLUTIO' TYPE(8)='REAL*8' TYPE(9)='POINTEUREVOLUTIO' TYPE(10)='REAL*8' TYPE(11)='POINTEUREVOLUTIO' TYPE(12)='REAL*8' TYPE(13)='REAL*8' TYPE(14)='REAL*8' TYPE(15)='POINTEUREVOLUTIO' TYPE(16)='REAL*8' TYPE(17)='POINTEUREVOLUTIO' TYPE(18)='REAL*8' TYPE(19)='POINTEUREVOLUTIO' TYPE(20)='REAL*8' TYPE(21)='POINTEUREVOLUTIO' TYPE(22)='REAL*8' ENDIF C ELSEIF(INPLAS.EQ.67) THEN NBTYPE=NMATR+NMATF SEGINI NOTYPE MOTYPE=NOTYPE IM2=NMATR-2 DO IC=1,IM2 TYPE(IC)='REAL*8' ENDDO TYPE(NMATR-1)='POINTEUREVOLUTIO' TYPE(NMATR) ='POINTEUREVOLUTIO' DO IC=NMATR+1,NBTYPE TYPE(IC)='REAL*8' ENDDO C ELSEIF(MATE.EQ.4.AND.INPLAS.EQ.5)THEN NBTYPE=6 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='REAL*8' TYPE(4)='POINTEUREVOLUTIO' TYPE(5)='REAL*8' TYPE(6)='REAL*8' C c mistral : ELSEIF (INPLAS.EQ.94) THEN NBTYPE=NMATR+NMATF SEGINI NOTYPE MOTYPE=NOTYPE DO 11 ITYP=1,NBTYPE TYPE(ITYP)='REAL*8' 11 CONTINUE c pour le modèle mistral il y a 10 composantes non linéaires qui sont des listes de réels NLDEB=NMATR-9 DO 13 ITYP=NLDEB,NMATR TYPE(ITYP)='POINTEURLISTREEL' 13 CONTINUE c mistral. C ELSE IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR. + EQ.31.OR.MFR.EQ.33).AND.IFOUR.EQ.-2) THEN NBTYPE=2 ELSE NBTYPE=1 ENDIF SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' IF ((MFR.EQ.1.OR.MFR.EQ.3.OR.MFR.EQ.31.OR.MFR.EQ.33). + AND.IFOUR.EQ.-2) TYPE(2)='REAL*8' C ENDIF CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1, & INFOS,3,IVAMAT) SEGSUP NOTYPE C IF(IERR.NE.0)THEN KERRE=999 GOTO 9990 ENDIF NMATT=NMATR+NMATF * IF (ISUP5.EQ.1) THEN CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE) IF(IERR.NE.0)THEN KERRE=999 ISUP5=0 GOTO 9990 ENDIF ENDIF * * traitement du champ de caracteristiques geometriques * NBROBL=0 NBRFAC=0 MOCARA=0 * * coques minces * IF (MFR.EQ.3.OR.MFR.EQ.9) THEN NBROBL=1 NBRFAC=2 SEGINI NOMID MOCARA=NOMID LESOBL(1)='EPAI' LESFAC(1)='CALF' LESFAC(2)='EXCE' * NBTYPE=1 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' ELSEIF (MFR.EQ.5) THEN NBROBL=1 NBRFAC=1 SEGINI NOMID MOCARA=NOMID LESOBL(1)='EPAI' LESFAC(1)='EXCE' * NBTYPE=1 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' * * section pour les barres * ELSE IF (MFR.EQ.27) THEN NBROBL=1 SEGINI NOMID MOCARA=NOMID LESOBL(1)='SECT' * NBTYPE=1 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' * * section, excentrements et orientation pour les barres excentrees * ELSE IF (MFR.EQ.49) THEN NBROBL=6 SEGINI NOMID MOCARA=NOMID LESOBL(1)='SECT' LESOBL(2)='EXCZ' LESOBL(3)='EXCY' LESOBL(4)='VX ' LESOBL(5)='VY ' LESOBL(6)='VZ ' * NBTYPE=1 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' * * raideurs locales pour l'element LIA2 de liaison a 2 noeuds * ELSE IF (MFR.EQ.51) THEN NBROBL=9 SEGINI NOMID MOCARA=NOMID LESOBL(1)='RLUX' LESOBL(2)='RLUY' LESOBL(3)='RLUZ' LESOBL(4)='RLRX' LESOBL(5)='RLRY' LESOBL(6)='RLRZ' LESOBL(7)='VX ' LESOBL(8)='VY ' LESOBL(9)='VZ ' * NBTYPE=1 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' * ELSE IF (MFR.EQ.7 ) THEN * * cas des poutres en formulation section * IF (CMATE.EQ.'SECTION') THEN NBROBL=0 NBRFAC=3 SEGINI NOMID MOCARA=NOMID LESFAC(1)='VX' LESFAC(2)='VY' LESFAC(3)='VZ' * NBTYPE=3 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='REAL*8' * * Cas des poutres 2D * ELSE IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN NBRFAC=1 NBROBL=2 SEGINI NOMID MOCARA=NOMID LESOBL(1)= 'SECT' LESOBL(2)= 'INRZ' LESFAC(1)= 'SECY' * NBTYPE=1 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' * * cas des poutres 3D * ELSE * * cas des autres poutres * NBROBL=4 NBRFAC=8 SEGINI NOMID MOCARA=NOMID LESOBL(1)='TORS' LESOBL(2)='INRY' LESOBL(3)='INRZ' LESOBL(4)='SECT' LESFAC(1)='SECY' LESFAC(2)='SECZ' LESFAC(3)='DX ' LESFAC(4)='DY ' LESFAC(5)='DZ ' LESFAC(6)='VX' LESFAC(7)='VY' LESFAC(8)='VZ' * NBTYPE=12 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='REAL*8' TYPE(4)='REAL*8' TYPE(5)='REAL*8' TYPE(6)='REAL*8' TYPE(7)='REAL*8' TYPE(8)='REAL*8' TYPE(9)='REAL*8' TYPE(9)='REAL*8' TYPE(10)='REAL*8' TYPE(11)='REAL*8' TYPE(11)='REAL*8' TYPE(12)='REAL*8' ENDIF * * caracteristiques pour les tuyaux * ELSE IF (MFR.EQ.13) THEN NBROBL=2 NBRFAC=11 SEGINI NOMID MOCARA=NOMID LESOBL(1)='EPAI' LESOBL(2)='RAYO' LESFAC(1)='RACO' LESFAC(2)='PRES' LESFAC(3)='CISA' LESFAC(4)='CFFX' LESFAC(5)='CFMX' LESFAC(6)='CFMY' LESFAC(7)='CFMZ' LESFAC(8)='CFPR' LESFAC(9)='VX' LESFAC(10)='VY' LESFAC(11)='VZ' * NBTYPE=13 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' TYPE(2)='REAL*8' TYPE(3)='REAL*8' TYPE(4)='REAL*8' TYPE(5)='REAL*8' TYPE(6)='REAL*8' TYPE(7)='REAL*8' TYPE(8)='REAL*8' TYPE(9)='REAL*8' TYPE(10)='REAL*8' TYPE(11)='REAL*8' TYPE(12)='REAL*8' TYPE(13)='REAL*8' * * caracteristiques pour les linespring * ELSE IF (MFR.EQ.15) THEN NBROBL=5 SEGINI NOMID MOCARA=NOMID LESOBL(1)='EPAI' LESOBL(2)='FISS' LESOBL(3)='VX ' LESOBL(4)='VY ' LESOBL(5)='VZ ' * NBTYPE=1 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' * * caracteristiques pour les tuyaux fissures * ELSE IF (MFR.EQ.17) THEN NBROBL=9 SEGINI NOMID MOCARA=NOMID LESOBL(1)='RAYO' LESOBL(2)='EPAI' LESOBL(3)='VX ' LESOBL(4)='VY ' LESOBL(5)='VZ ' LESOBL(6)='VXF ' LESOBL(7)='VYF ' LESOBL(8)='VZF ' LESOBL(9)='ANGL' * NBTYPE=1 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' * * caracteristiques des elements homogeneises * ELSE IF (MFR.EQ.37) THEN IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN NBROBL=4 SEGINI NOMID MOCARA=NOMID LESOBL(1)='SCEL' LESOBL(2)='SFLU' LESOBL(3)='EPS ' LESOBL(4)='XINE' ELSE NBROBL=3 SEGINI NOMID MOCARA=NOMID LESOBL(1)='SCEL' LESOBL(2)='SFLU' LESOBL(3)='EPS ' ENDIF * NBTYPE=1 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' ENDIF * IF(MOCARA.NE.0)THEN CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1, & INFOS,3,IVACAR) SEGSUP NOTYPE IF(IERR.NE.0)THEN KERRE=999 GOTO 9990 ENDIF ENDIF NCARA=NBROBL NCARF=NBRFAC NCARR=NCARA+NCARF * IF (ISUP5.EQ.1.AND.MOCARA.NE.0) THEN CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE) IF(IERR.NE.0)THEN KERRE=999 ISUP5=0 GOTO 9990 ENDIF ENDIF * *------------------------------------------------- * creation des mchamls de la sous zone *------------------------------------------------- * NBPTEL=NBGS NEL=NBELEM * N1PTEL=NBPTEL N1EL=NEL N2PTEL=0 N2EL=0 * * contraintes * N2=NSTRS SEGINI MCHAML ICHAML(ISOUS)=MCHAML NSR=1 NCOSOR=NSTRS SEGINI MPTVAL IVASTF=MPTVAL NOMID=MOSTRS SEGACT NOMID DO 1100 ICOMP=1,NSTRS NOMCHE(ICOMP)=LESOBL(ICOMP) TYPCHE(ICOMP)='REAL*8' SEGINI MELVAL IELVAL(ICOMP)=MELVAL IVAL(ICOMP)=MELVAL 1100 continue SEGDES NOMID * * variables internes * IF((MFR.EQ.7.OR.MFR.EQ.13).AND.CMATE.EQ.'SECTION')THEN N2PTEL=NBPTEL N2EL=NEL ENDIF * N2=NVART SEGINI MCHAM1 MCHEL1.ICHAML(ISOUS)=MCHAM1 NSR=1 NCOSOR=NVART SEGINI MPTVAL IVARIF=MPTVAL NOMID=MOVARI SEGACT NOMID * * composantes obligatoires * DO 1200 ICOMP=1,NVARI MCHAM1.NOMCHE(ICOMP)=LESOBL(ICOMP) IF(MFR.EQ.7.AND.CMATE.EQ.'SECTION')THEN MCHAM1.TYPCHE(ICOMP)='POINTEURMCHAML ' N1PTEL=0 N1EL=0 ELSE IF(INPLAS.EQ.74.AND.ICOMP.GT.1) THEN MCHAM1.TYPCHE(ICOMP)='POINTEURLISTREEL' N1PTEL=0 N1EL=0 N2PTEL=NBPTEL N2EL=NEL ELSE MCHAM1.TYPCHE(ICOMP)='REAL*8' N2PTEL=0 N2EL=0 ENDIF SEGINI MELVAL MCHAM1.IELVAL(ICOMP)=MELVAL IVAL(ICOMP)=MELVAL 1200 continue * * composantes facultatives * DO 1201 ICOMP=1,NVARF JCOMP=ICOMP+NVARI MCHAM1.NOMCHE(JCOMP)=LESFAC(ICOMP) IF(INPLAS.EQ.74) THEN MCHAM1.TYPCHE(JCOMP)='POINTEURLISTREEL' N1PTEL=0 N1EL=0 ELSE MCHAM1.TYPCHE(JCOMP)='REAL*8' N2PTEL=0 N2EL=0 ENDIF SEGINI MELVAL MCHAM1.IELVAL(JCOMP)=MELVAL IVAL(JCOMP)=MELVAL 1201 continue SEGDES NOMID * * deformations inelastiques * N1PTEL=NBPTEL N1EL=NEL N2=NDEF SEGINI MCHAM2 MCHEL2.ICHAML(ISOUS)=MCHAM2 NSR=1 NCOSOR=NDEF SEGINI MPTVAL IVADEP=MPTVAL NOMID=MODEIN SEGACT NOMID DO 1300 ICOMP=1,NDEF MCHAM2.NOMCHE(ICOMP)=LESOBL(ICOMP) MCHAM2.TYPCHE(ICOMP)='REAL*8' N2PTEL=0 N2EL=0 SEGINI MELVAL MCHAM2.IELVAL(ICOMP)=MELVAL IVAL(ICOMP)=MELVAL 1300 continue SEGDES NOMID * * traitement des champs de temperature pour les materiaux * endommageables de lemaitre * IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN IPH1=MCHEL3.ICHAML(ISOUS) IPH2=MCHEL4.ICHAML(ISOUS) IPH3=MCHEL5.ICHAML(ISOUS) ENDIF * * traitement des champs de flux neutronique pour le modèle MISTRAL c mistral : IF (IFI.EQ.1) THEN IPH4=MCHEL7.ICHAML(ISOUS) IPH5=MCHEL8.ICHAML(ISOUS) ENDIF c mistral. *ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ * A PROPOS DE CE QUI EST FAIT JUSTE AU DESSUS ..... * * MLR : DANGEREUX : ON ACCEDE DIRECTEMENT AUX SOUS-ZONES * ALORS QU'IL CONVIENDRAIT DE PASSER PAR KOMCHA * EN ATTENDANT LA CORRECTION, ON OBLIGE * LA DONNEE DE CHPOINTS ( CF ECOULE) * DANS LE CAS DE LA SUCCION *ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ * *********************** * SPECIAL SUCCION * * traitement des champs de SUCCION * IF (ITHHER.EQ.3) THEN IPH1=MCHEL3.ICHAML(ISOUS) IPH2=MCHEL4.ICHAML(ISOUS) ENDIF *********************** * * recherche des pointeurs imat et icar * NUMAT=0 NUCAR=0 IRET = 1 IF (INPLAS.NE.26.AND.INPLAS.NE.29) THEN CALL CARMAT(IMODEL,IPCAR,IPMAIL,MFR,MELE,CMATE, 1 ISUP5,INFOS,CONM,IMAT,ICAR,NUMAT,NUCAR,IRET) ENDIF IF(IRET.EQ.0) THEN CALL ERREUR(715) GOTO 9990 ENDIF * * recherche des dimensions du melval de hooke * N2PTEL=0 N2EL=0 MPTVAL=IVAMAT DO 40 IO=1,NMATT MELVAL=IVAL(IO) IF(MELVAL.NE.0)THEN IF (CMATE.EQ.'SECTION') THEN N2PTEL=MAX(N2PTEL,IELCHE(/1)) N2EL =MAX(N2EL ,IELCHE(/2)) ELSE N2PTEL=MAX(N2PTEL,VELCHE(/1)) N2EL =MAX(N2EL ,VELCHE(/2)) ENDIF ENDIF 40 CONTINUE IF (N2PTEL.EQ.1.OR.NBG.EQ.1) THEN N2PTEL=1 ELSE N2PTEL=NBG ENDIF * ***************************************************** * appel a l'ecoulement proprement dit ***************************************************** * * On appel les modèles élastiques linéaires * et les modèles PLASTIQUES intégrés par * ECOINC * IF (INPLAS.EQ.0.OR. 1 INPLAS.EQ.1.OR. 2 INPLAS.EQ.3.OR. 2 INPLAS.EQ.4.OR. 3 INPLAS.EQ.5.OR. 4 INPLAS.EQ.7.OR. 5 INPLAS.EQ.11.OR. 7 INPLAS.EQ.12.OR. 7 INPLAS.EQ.13.OR. 9 INPLAS.EQ.15.OR. INPLAS.EQ.87) THEN CALL ECOU10(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR, 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET, 1 IVADS,IVAMAT,IVACAR, 2 IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR, 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC, 4 N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE) * * On appelle les modèles VISCOPLASTIQUES et FLUAGE * intégrés par le 'moule' d'intégration CONSTI * L'intégration est effectuée suivant une méthode * de Runge-Kutta * ELSE IF (INPLAS.EQ.17.OR. 1 INPLAS.EQ.19.OR. 2 INPLAS.EQ.20.OR. 3 INPLAS.EQ.61.OR. 3 INPLAS.EQ.63.OR. 4 INPLAS.EQ.21.OR. 5 INPLAS.EQ.22.OR. 6 INPLAS.EQ.23.OR. 7 INPLAS.EQ.24.OR. 8 INPLAS.EQ.25.OR. 9 INPLAS.EQ.53.OR. INPLAS.EQ.76.OR. 9 INPLAS.EQ.44.OR. INPLAS.EQ.77.OR. 1 INPLAS.EQ.45.OR. INPLAS.EQ.102.OR. 2 INPLAS.EQ.70.OR. 3 INPLAS.EQ.84.OR. 5 INPLAS.EQ.85.OR. 4 INPLAS.EQ.86) THEN CALL ECOU20(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR, 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET, 1 IVADS,IVAMAT,IVACAR, 2 IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR, 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC, 4 N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE) * * On appelle les modèles VISCOPLASTIQUES et FLUAGE * NON INTEGRES par CONSTI * ELSE IF (INPLAS.EQ.43.OR.INPLAS.EQ.82.OR. 1 INPLAS.EQ.90.OR.INPLAS.EQ.94.OR. 1 INPLAS.EQ.95.OR.INPLAS.EQ.100) THEN CALL ECOU25(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR, 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET, 1 IVADS,IVAMAT,IVACAR,IPH1,IPH2,IPH3,IPH4,IPH5, 2 ITHHER,IFI,LHOOK,NSTRS,NVART,NMATT,NMATR,NCARR, 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC, 4 N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE) ELSE IF (INPLAS.EQ.65.OR.INPLAS.EQ.74) THEN CALL ECOU21(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR, 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET, 1 IVADS,IVAMAT,IVACAR, 2 IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR, 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC, 4 N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE) * * On appele les modeles de materiaux endommageables de Lemaitre * Ce sont des matériaux plastiques (26) et viscoplastiques (29) * intégré par CONSTI * ELSE IF (INPLAS.EQ.26.OR. 9 INPLAS.EQ.29) THEN CALL ECOU29(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR, 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET, 1 IVADS,IVAMAT,IVACAR, 2 IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR, 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC, 4 N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE) * * On appelle les matériaux ENDOMMAGEABLE * ELSE IF (INPLAS.EQ.30.OR. 1 INPLAS.EQ.31.OR.INPLAS.EQ.37.OR. 2 INPLAS.EQ.88.OR.INPLAS.EQ.89.OR. 3 INPLAS.EQ.96.OR.INPLAS.EQ.97.OR. 3 INPLAS.EQ.98.OR.INPLAS.EQ.118.OR. 4 INPLAS.EQ.134.OR.INPLAS.EQ.135.OR.INPLAS.EQ.141) THEN CALL ECOU40(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR, 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET, 1 IVADS,IVAMAT,IVACAR, 2 IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR, 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC, 4 N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE) * * On appelle les matériaux PLASTIQUE_ENDOM(MAGEABLE) * ELSE IF (INPLAS.EQ.51.OR. 1 INPLAS.EQ.62.OR. 2 INPLAS.EQ.64.OR. 3 INPLAS.EQ.75) THEN CALL ECOU50(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR, 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET, 1 IVADS,IVAMAT,IVACAR, 2 IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR, 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC, 4 N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE) * * On appelle les matériaux PLASTIQUES qui ne sont pas * intégrés dans ECOINC * * ELSE IF (INPLAS.EQ.2.OR.INPLAS.EQ.27.OR. 3 INPLAS.EQ.9.OR.INPLAS.EQ.14.OR. 6 INPLAS.EQ.18.OR.INPLAS.EQ.16.OR. 8 INPLAS.EQ.28.OR.INPLAS.EQ.32.OR. 8 INPLAS.EQ.33.OR.INPLAS.EQ.38.OR. 8 INPLAS.EQ.34.OR.INPLAS.EQ.35.OR. 8 INPLAS.EQ.36.OR.INPLAS.EQ.39.OR. 8 INPLAS.EQ.40.OR.INPLAS.EQ.41.OR. 8 INPLAS.EQ.50.OR.INPLAS.EQ.49.OR. 8 INPLAS.EQ.48.OR.INPLAS.EQ.42.OR. 8 INPLAS.EQ.47.OR.INPLAS.EQ.52.OR. 8 INPLAS.EQ.54.OR.INPLAS.EQ.55.OR. 8 INPLAS.EQ.56.OR.INPLAS.EQ.57.OR. 8 INPLAS.EQ.58.OR.INPLAS.EQ.59.OR. 9 INPLAS.EQ.60.OR.INPLAS.EQ.78.OR. 9 INPLAS.EQ.79.OR.INPLAS.EQ.80.OR. 9 INPLAS.EQ.91.OR.INPLAS.EQ.92.OR. 9 INPLAS.EQ.93.OR.INPLAS.EQ.119.OR.INPLAS.EQ.126) THEN CALL ECOU60(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR, 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET, 1 IVADS,IVAMAT,IVACAR, 2 IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NCARR, 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC, 4 N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE) * * * On appelle les matériaux PLASTIQUES qui ne sont pas * integres dans ECOINC - SUITE de ECOU60 * ELSE IF (INPLAS.EQ.66.OR.INPLAS.EQ.67.OR. 1 INPLAS.EQ.68.OR.INPLAS.EQ.69.OR. 2 INPLAS.EQ.71.OR.INPLAS.EQ.72.OR. 2 INPLAS.EQ.73.OR.INPLAS.EQ.99.OR. 3 INPLAS.EQ.101) THEN CALL ECOU70(MATE,INPLAS,MELE,IPMAIL,NBPTEL,IMAT,ICAR, 1 NUMAT,NUCAR,IVASTR,IVARI,IVADEF,IVADET, 1 IVADS,IVAMAT,IVACAR, 2 IPH1,IPH2,IPH3,ITHHER,LHOOK,NSTRS,NVART,NMATT,NMATR,NCARR, 3 CMATE,PRECIS,JECHER,IPOTAB,ISTEP,NPINT,JNOID,LOGSUC, 4 N2EL,N2PTEL,NBNO,NBGS,LW,IVASTF,IVARIF,IVADEP,KERRE) * ELSE KERRE=99 ENDIF * *************************************************** * Fin de l'appel aux modeles d'ecoulement *************************************************** 9990 CONTINUE * * desactivation des segments * SEGDES MELEME*NOMOD,IMODEL*NOMOD SEGDES,MINTE * IF(ISUP1.EQ.1)THEN CALL DTMVAL (IVASTR,3) ELSE CALL DTMVAL (IVASTR,1) ENDIF IF(ISUP2.EQ.1)THEN CALL DTMVAL (IVARI,3) ELSE CALL DTMVAL (IVARI,1) ENDIF IF(ISUP3.EQ.1)THEN CALL DTMVAL (IVADEF,3) ELSE CALL DTMVAL (IVADEF,1) ENDIF IF(ISUP4.EQ.1)THEN CALL DTMVAL (IVADS,3) ELSE CALL DTMVAL (IVADS,1) ENDIF IF(ISUP5.EQ.1)THEN CALL DTMVAL (IVAMAT,3) ELSE CALL DTMVAL (IVAMAT,1) ENDIF IF(ISUP5.EQ.1)THEN CALL DTMVAL (IVACAR,3) ELSE CALL DTMVAL (IVACAR,1) ENDIF IF(ISUP6.EQ.1)THEN CALL DTMVAL (IVADET,3) ELSE IF(IPCHE6.NE.0) THEN CALL DTMVAL (IVADET,1) ENDIF IF (KERRE.EQ.0) THEN CALL DTMVAL (IVASTF,1) CALL DTMVAL (IVARIF,1) CALL DTMVAL (IVADEP,1) SEGDES MCHAML,MCHAM1,MCHAM2 ELSE CALL DTMVAL (IVASTF,3) CALL DTMVAL (IVARIF,3) CALL DTMVAL (IVADEP,3) IF (MCHAML.NE.0) SEGSUP MCHAML IF (MCHAM1.NE.0) SEGSUP MCHAM1 IF (MCHAM2.NE.0) SEGSUP MCHAM2 END IF * IF (MOCARA.NE.0) THEN NOMID=MOCARA SEGSUP NOMID END IF * IF (MOMATR.NE.0) THEN NOMID=MOMATR if(lsupma)SEGSUP NOMID END IF * IF (MOVARI.NE.0) THEN NOMID=MOVARI if(lsupva)SEGSUP NOMID END IF * IF (MOSTRS.NE.0) THEN NOMID=MOSTRS if(lsupco)SEGSUP NOMID END IF * IF (MOEPSI.NE.0) THEN NOMID=MOEPSI if(lsupde)SEGSUP NOMID END IF IF (MODEIN.NE.0) THEN NOMID=MODEIN if(lsupdd)SEGSUP NOMID END IF * * IF (IPINF .NE.0) THEN * INFO=IPINF * SEGSUP INFO * END IF * IF(KERRE.NE.0)GO TO 888 1000 continue * 888 CONTINUE * * traitement des champs de temperature pour les materiaux * endommageables de lemaitre * IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN SEGDES MCHEL3,MCHEL4,MCHEL5 ENDIF c mistral : IF (IFI.EQ.1) THEN SEGDES MCHEL7,MCHEL8 ENDIF c mistral. *********************** * SPECIAL SUCCION * IF (ITHHER.EQ.3) THEN SEGDES MCHEL3,MCHEL4 ENDIF *********************** IF(IPCHE6.NE.0) THEN SEGDES MCHEL6 ENDIF SEGDES MMODEL*NOMOD IF(KERRE.EQ.0)THEN SEGDES MCHELM,MCHEL1,MCHEL2 ELSE SEGSUP MCHELM,MCHEL1,MCHEL2 ENDIF RETURN END