C COML6 SOURCE FANDEUR 14/01/22 21:15:04 7891 SUBROUTINE COML6(iqmod,ipcon,ipinf,indeso,insupp,itruli, IRETOU) *-------------------------------------------------------------------- * coml6 : * boucle elements et point d integration * pretraite les caracteristiques et les donnees suivant * le modele, passe a la loi locale, signale les erreurs * d integration, prepare les resultats *---------------------------------------------------------------- IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC CCOPTIO -INC CCGEOME -INC CCHAMP -INC SMCHAML -INC SMELEME -INC SMCOORD -INC SMMODEL -INC SMINTE * segment deroulant le mcheml -INC DECHE SEGMENT INFO INTEGER INFELL(16) ENDSEGMENT * SEGMENT WRK2 REAL*8 TRAC(LTRAC) ENDSEGMENT * SEGMENT MWRKXE REAL*8 XEL(3,NBNN) ENDSEGMENT * SEGMENT WRK3 REAL*8 WORK(LW),WORK2(LW2bi) ENDSEGMENT * SEGMENT WRK6 REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS) REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS) REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS) ENDSEGMENT * SEGMENT WRK7 REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB) ENDSEGMENT * SEGMENT WRK8 REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS) REAL*8 DDINVp(NSTRS,NSTRS) ENDSEGMENT * SEGMENT WRK9 REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX) REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1) REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO) REAL*8 SIGY(NSIGY) INTEGER NKX(NNKX) ENDSEGMENT * SEGMENT WRK91 REAL*8 YOG1(NYOG1),YNU1(NYNU1),YALFT1(NYALFT1),YSMAX1(NYSMAX1) REAL*8 YN1(NYN1),YM1(NYM1),YKK1(NYKK1),YALF2(NYALF2) REAL*8 YBET2(NYBET2),YR1(NYR1),YA1(NYA1),YQ1(NYQ1),YRHO1(NYRHO1) REAL*8 SIGY1(NSIGY1) ENDSEGMENT * SEGMENT WR10 INTEGER IABLO1(NTABO1) REAL*8 TABLO2(NTABO2) ENDSEGMENT * SEGMENT WR11 INTEGER IABLO3(NTABO3) REAL*8 TABLO4(NTABO4) ENDSEGMENT * SEGMENT WRK12 real*8 bbet1,bbet2,bbet3,bbet4,bbet5,bbet6,bbet7,bbet8,bbet9 real*8 bbet10,bbet11,bbet12,bbet13,bbet14,bbet15,bbet16,bbet17 real*8 bbet18,bbet19,bbet20,bbet21,bbet22,bbet23,bbet24,bbet25 real*8 bbet26,bbet27,bbet28,bbet29,bbet30,bbet31,bbet32,bbet33 real*8 bbet34,bbet35,bbet36,bbet37,bbet38,bbet39,bbet40,bbet41 real*8 bbet42,bbet43,bbet44,bbet45,bbet46,bbet47,bbet48,bbet49 real*8 bbet50,bbet51,bbet52,bbet53,bbet54,bbet55 integer ibet1,ibet2,ibet3,ibet4,ibet5,ibet6,ibet7,ibet8 integer ibet9,ibet10,ibet11,ibet12,ibet13,ibet14,ibet15,ibet16 ENDSEGMENT segment wrkgur real*8 wgur1,wgur2,wgur3,wgur4,wgur5,wgur6,wgur7 real*8 wgur8,wgur9,wgur10,wgur11,wgur12(6) real*8 wgur13(7), wgur14 real*8 wgur15,wgur16,wgur17 endsegment C C Segment de travail pour la loi 'NON_LINEAIRE' 'UTILISATEUR' appelant C l'integrateur externe specifique UMAT C SEGMENT WKUMAT C Entrees/sorties de la routine UMAT REAL*8 DDSDDE(NTENS,NTENS), SSE, SPD, SCD, & RPL, DDSDDT(NTENS), DRPLDE(NTENS), DRPLDT, & TIME(2), DTIME, TEMP, DTEMP, DPRED(NPRED), & DROT(3,3), PNEWDT, DFGRD0(3,3), DFGRD1(3,3) CHARACTER*16 CMNAME INTEGER NDI, NSHR, NSTATV, NPROPS, & LAYER, KSPT, KSTEP, KINC C Variables de travail LOGICAL LTEMP, LPRED, LVARI, LDFGRD INTEGER NSIG0, NPARE0, NGRAD0 ENDSEGMENT C C Segment de travail pour les lois 'VISCO_EXTERNE' C SEGMENT WCREEP C Entrees/sorties constantes de la routine CREEP REAL*8 SERD CHARACTER*16 CMNAMC INTEGER LEXIMP, NSTTVC, LAYERC, KSPTC C Entrees/sorties de la routine CREEP pouvant varier REAL*8 STV(NSTV), STV1(NSTV), STVP1(NSTV), & STVP2(NSTV), STV12(NSTV), STVP3(NSTV), & STVP4(NSTV), STV13(NSTV), STVF(NSTV), & TMP12, TMP, TMP32, & DTMP12, DTMP, & PRD12(NPRD), PRD(NPRD), PRD32(NPRD), & DPRD12(NPRD), DPRD(NPRD) INTEGER KSTEPC C Autres indicateurs et variables de travail LOGICAL LTMP, LPRD, LSTV INTEGER IVIEX, NPAREC REAL*8 dTMPdt, dPRDdt(NPRD) ENDSEGMENT * Segment ECOU: sert de fourre-tout pour les tableaux * SEGMENT ECOU REAL*8 ecow00,ecow0, 1 ecow1,ecow2,ecow3(6),ecow4(9),ecow5(6), 2 ecow6(12),ecow7(6),ecow8(6),ecow9(6),ecow10(6),ecow11(6), 2 ecow12(6), 1 ecow13(6),ecow14(6),ecow15(12),ecow16(3), 2 ecow17(6),ecow18(6),ecow19,ecow20 ENDSEGMENT * * Segment NECOU utilisé dans ECOINC * SEGMENT NECOU INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO, . ITYP,IFOURB,IFLUAG, . ICINE,ITHER,IFLUPL,ICYCL,IBI, . JFLUAG,KFLUAG,LFLUAG, . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF ENDSEGMENT * * Segment IECOU: sert de fourre-tout pour les initialisations * d'entiers * SEGMENT IECOU INTEGER NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,NYALF1, . NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,NSOM,NINV, . NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,LTRAC,MFRBI, . IELE,NHRM,NBNNBI,NBELMB,ICARA,LW2BI,NDEF,NSTRSS, . MFR1,NBGMAT,NELMAT,MSOUPA,NUMAT1,LENDO,NBBB,NNVARI, . KERR1,MELEMB,NYOG1,NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1, . NYKK1,NYALF2,NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1 ENDSEGMENT * * Segment XECOU: sert de fourre-tout pour les initialisations * de réels * SEGMENT XECOU REAL*8 DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00 ENDSEGMENT character*16 modemo LOGICAL dimped, b_moda2 * * Liste des formulations SIMPLES (cf. MODELI.eso et NOMATE.eso) * PARAMETER (MFORMU=17) CHARACTER*16 LISFOR(MFORMU) DATA LISFOR / & 'THERMIQUE ','MECANIQUE ','LIQUIDE ', & 'CONVECTION ','POREUX ','DARCY ', & 'FROTTEMENT ','RAYONNEMENT ','MAGNETODYNAMIQUE', & 'NAVIER_STOKES ','MELANGE ','EULER ', & 'FISSURE ','LIAISON ','THERMOHYDRIQUE ', & 'ELECTROSTATIQUE ','DIFFUSION ' & / * wrk6 = 0 wrk8 = 0 wr10 = 0 wr11 = 0 wrk12 = 0 wrkgur=0 wkumat = 0 wcreep = 0 * c wrk53 reste ouvert en ecriture SEGINI,wrk53 iwrk53 = wrk53 * ecou=0 iecou=0 necou=0 xecou=0 SEGINI,ecou,iecou,necou,xecou * write(ioimp,*) ' coml6 ecou ie ne xe',ecou,iecou,necou,xecou KERRE=0 KERR1=0 c c moterr(1:6) = 'COML6 ' c moterr(7:15) = 'IMODEL' c interr(1) = iqmod c call erreur(-329) *------------------------------------------- imodel = iqmod segact imodel*nomod * MELE=NEFMOD MELEME=IMAMOD melemb=meleme ipmail = imamod CONM = CONMOD segact meleme*nomod NBNNbi=NUM(/1) NBELMb=NUM(/2) nbnn2=nbnnbi nbelem2=nbelmb nbnn=nbnnbi nbelem=nbelmb c c coque integree ou pas ? c IF(INFMOD(/1).NE.0)THEN NPINT=INFMOD(1) ELSE NPINT=0 ENDIF c NFOR=FORMOD(/2) NMAT=MATMOD(/2) c c Determination de la formulation du modele : c lformu = 0 IF (NFOR.EQ.1) THEN CALL PLACE(LISFOR,MFORMU,lformu,FORMOD(1)) ENDIF * write(ioimp,*) 'formulation :',lformu,NFOR,FORMOD(1) if (lformu.eq.0) then write(ioimp,*) ' Arret dans coml6 : formulation non prevue ici' call erreur(5) return endif c c nature du materiau c CMATE = CMATEE MATE = IMATEE INPLAS = INATUU c dimped=.false. do jmot = 1,nmat if (matmod(jmot).eq.'IMPEDANCE') dimped = .true. enddo b_moda2 = cmate.EQ.'MODAL' .OR. cmate.EQ.'STATIQUE' .OR. dimped * * write(ioimp,*) ' coml6 inplas ' , inplas * c____________________________________________________________________ c c information sur l'element fini c____________________________________________________________________ if(ipinf.ne.0) then INFO=IPINF c* segact info MFRbi =INFELL(13) NBG =INFELL(6) NBGS =INFELL(4) NSTRS=INFELL(16) LRE =INFELL(9) LHOOK=INFELL(10) c* IF (MELE.EQ.96) NBNO = INFELL(8) IPORE=INFELL(8) MINTE=INFELL(11) else MFRbi =INFELE(13) NBG =INFELE(6) NBGS =INFELE(4) NSTRS=INFELE(16) LRE =INFELE(9) LHOOK=INFELE(10) c* IF (MELE.EQ.96) NBNO = INFELE(8) IPORE=INFELE(8) MINTE=INFMOD(2+insupp) endif * MFR=MFRbi nstrss=nstrs * On active une fois pour toutes le segment MINTE : IPMINT = MINTE IF (IPMINT.GT.0) SEGACT,MINTE * IF (MFRbi.EQ.3.AND.NPINT.NE.0) LHOOK=4 LHOO2=LHOOK*LHOOK * IF (MFRbi.EQ.33) THEN NBNO=IPORE IPPORE=NBNNbi ELSE NBNO=NBNNE(NUMGEO(MELE)) IPPORE=0 ENDIF * LW =200 LW2bi =150 LW2=150 *------------------------------------------------- * NBPTEL=NBGS NEL=NBELMb * N1PTEL=NBPTEL N1EL=NEL N2PTEL=0 N2EL=0 c pour les variables internes seules IF (MFRbi.EQ.7.OR.MFRbi.EQ.13) THEN IF (CMATE.EQ.'SECTION') THEN C* IF (MATE.EQ.11) THEN <- Test equivalent ? N2PTEL=NBPTEL N2EL=NEL ENDIF ENDIF *------------------------------------------------- * ouverture de tous les melval * creation wrk52 qui reste ouvert en ecriture *------------------------------------------------- CALL COMOUW(iqmod,ipcon,indeso,ipil,iwrk52,iwrk53,iretou,iwr522) *------------------------------------------------- * complete wrk53 *------------------------------------------------- wrk52 = iwrk52 c segact wrk52 nmatt = xmat(/1) NUMAT = nmatt * ncarr = xcarb(/1) * NUCAR = ncarr nvart = var0(/1) C------------------------------------------------- C Petits tests de compatibilite des donnees C pour les lois externes C------------------------------------------------- IF (INPLAS.LT.0) THEN NTURE0 = TURE0(/1) IF (NTURE0.NE.0.AND.NTURE0.GT.1) THEN * write(ioimp,*) 'COML6 : test NTURE0 enleve',NTURE0 c* CALL ERREUR(963) c* RETURN ENDIF IF (INPLAS.EQ.-1) THEN NSIGM0 = SIG0(/1) NEPST0 = EPST0(/1) IF (NSIGM0.GT.0.AND.NEPST0.GT.0.AND.NSIGM0.NE.NEPST0) THEN CALL ERREUR(963) RETURN ENDIF ENDIF ENDIF *------------------------------------------------- * creation des deche en sortie *------------------------------------------------- CALL COMCRI(iqmod,ipcon,IPMINT,indeso,ipil,insupp,iwrk53,iretou) if (ierr.ne.0) return c liluc = ipil * pas de calcul de caracteristiques pour le melange parallele C* if (formod(1).eq.'MELANGE'.and.cmate.eq.'PARALLEL') goto 1998 if (lformu.eq.11) then if (cmate.eq.'PARALLEL') goto 1998 endif *------------------------------------------------- * verification du type des champs *------------------------------------------------- CALL COMTRI(iqmod,ipil,wrk53) if (ierr.ne.0) return c *------------------------------------------------- c Initialisations de variables *------------------------------------------------- c - mise à zéro des variables du commun NECOU si besoin c - modèles viscoplastiques: c . on récupère le pas de temps c . on récupère le nombre maximal de sous-pas c . on met IND=1 c - initialisation des dimensions des tableaux des segments c Sorties: en plus du commun NECOU, on range les autres données c initialisées dans les COMMON IECOU et XECOU CALL COMDEF(iwrk53,necou,iecou,xecou) IF (KERRE.EQ.999) RETURN c * write(ioimp,*) ' coml6 ,cmate,mfrbi,nbno,mele,npint' * & ,cmate,mfrbi,nbno,mele,npint IPTR1 = 0 IF (MFRbi.EQ. 1 .OR. MFRbi.EQ.31 .OR. MFRbi.EQ.33 .OR. & MFRbi.EQ.71 .OR. MFRbi.EQ.73) THEN IF (CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 1 CMATE.EQ.'UNIDIREC') THEN C* IF (MATE.EQ.2 .OR. MATE.EQ.3 .OR. MATE.EQ.4) THEN <- Test equivalent ? mele1 = MELE npint1 = NPINT nbno1 = NBNO ielei=iele CALL RESHPT(1,nbno1,IELEi,mele1,npint1,IPTR1,IRT1) if (ierr.ne.0) return MINTE2=IPTR1 SEGACT MINTE2 ENDIF ENDIF * * initialisation des segments de travail * SEGINI WRK2,WRK3 NBNN = nbnn2 SEGINI,MWRKXE IF (LOGVIS) SEGINI WRK8 IF(INPLAS.EQ.26)THEN SEGINI WRK6 ENDIF c segini wrk54 iwrk54 = wrk54 c ouverture du segment wrk12 ne sert que pour le modele beinsa inplas=66 if(inplas.eq.66) segini wrk12 C ouverture de wrkgur pour modele de gurson inplas=38 if(inplas.eq.38) segini wrkgur C Pour les modeles autres que non lineaires externes : C pas besoin des coordonnees du point d'integration courant c Pas besoin de la longueur caracteristique de l'element courant C On les met a zero une fois pour toutes COORGA(1)=0.0D0 COORGA(2)=0.0D0 COORGA(3)=0.0D0 LCARAC=0.0D0 C Objets de travail pour une loi non lineaire externe IF (INPLAS.LT.0) THEN IF (INPLAS.EQ.-1) THEN NTENS=SIG0(/1) NPRED=PAREX0(/1) SEGINI,WKUMAT IFORB=IFOURB CALL WKUMA0 ( iqmod, iwrk52, wkumat, IFORB ) C* ELSE IF (INPLAS.EQ.-2) THEN ELSE NSTV=VAR0(/1)-4 IF (NSTV.EQ.0) NSTV=1 NPRD=PAREX0(/1) SEGINI,WCREEP CALL WCREE0 ( iqmod, iwrk52, wcreep ) ENDIF C*TMP Deb On met dans wrk53.jecher le pointeur de la fonction externe C*TMP Voir plus tard pour affiner via segment wkumat/wcreep... wrk53.jecher = 0 nobmod = ivamod(/1) if (nobmod.gt.0) then noblib = 0 CALL PLACE(tymode,nobmod,noblib,'LMEEXT ') if (noblib.ne.0) then wrk53.jecher = ivamod(noblib) endif endif C*TMP Fin ENDIF * * write(6,*)'coml6 ,nel,nbptel,inplas,mfrbi,cmate,mate,ifour,mele' * write(6,*)'coml6 ',nel,nbptel,inplas,mfrbi,cmate,mate,ifour,mele * boucles ncourb=0 segini wrk7 NYOG=0 NYNU=0 NYALFA=0 NYSMAX=0 NYN=0 NYM=0 NYKK=0 NYALF1=0 NYBET1=0 NYR=0 NYA=0 NYKX=0 NYRHO=0 NSIGY=0 NNKX=0 segini wrk9 NYOG1=0 NYNU1=0 NYALFT1=0 NYSMAX1=0 NYN1=0 NYM1=0 NYKK1=0 NYALF2=0 NYBET2=0 NYR1=0 NYA1=0 NYQ1=0 NYRHO1=0 NSIGY1=0 segini wrk91 do 1000 ib=1,nel * (MWRKXE) Recuperation des coordonnees des noeuds de l'element CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XEL) * (WRK54) calcul des axes locaux CALL COMROT(iwrk53,IB,IPTR1,MWRKXE,iwrk54) if (ierr.ne.0) return * CALCUL DE LA LONGUEUR CARACTERISTIQUE DE L'éLéMENT COURANT * POUR MODèLE BETON URGC INSA IF ((INPLAS.GE.99.AND.INPLAS.LE.101).OR. 1 (INPLAS.GE.120.AND.INPLAS.LE.122)) THEN CALL LONGCA(IPMAIL,IB,BID(1)) ENDIF * Modeles non lineaires externes 'NON_LINEAIRE' 'UTILISATEUR' : * - Releve des coordonnees des noeuds de l'element courant, * - Calcul de la longueur caracteristique de l'element courant * - Releve de la matrice de passage DROT du repere local de l'element * fini massif au repere general du maillage IF (INPLAS.EQ.-1) THEN IF (IPTR1.NE.0) THEN DO 200 J=1,IDIM DO 200 I=1,IDIM DROT(I,J)=TXR(I,J) 200 CONTINUE ENDIF CALL LOCARA(IDIM,NBNN,XEL,LCARAC) ENDIF DO 100 igau =1,nbptel * -recuperation de valmat et de valcar * -on recupere les contraintes initiales * -on recupere les variables internes * -on recupere les deformations inelastiques initiales si besoin * -on recupere les increments de deformations totales * -on cherche la section de l'element ib * -prise en compte de l'epaisseur et de l'excentrement * dans le cas des coques minces avec ou sans cisaillement * transverse * * on recupere les constantes du materiau * calcul des contraintes effectives en milieu poreux * * --- remplissage de wrk52 * on recupere les caracteristiques geometriques CALL COMVAL(iqmod,indeso,ipil,iwrk52,iwrk53,ib,igau, & necou,iecou,xecou,iwr522) if (ierr.ne.0) return * *---- quelques arrangements CALL COMARA(IQMOD,IWRK52,IWRK53,IWRK54,wrk2,wr10,ib,igau, & iretou,necou,iecou,xecou,itruli) if (ierr.ne.0) return if (iretou.ne.0) goto 1990 * >>>>>>>>>> fin du traitement du materiau * C Pour les modeles non lineaires externes : calcul des coordonnees C du point d'integration courant IF (INPLAS.LT.0) THEN DO 101 IX=1,IDIM r_z = 0.0D0 DO 102 INO=1,NBNN r_z = r_z +XEL(IX,INO)*SHPTOT(1,INO,IGAU) 102 CONTINUE COORGA(IX) = r_z 101 CONTINUE ENDIF * * lois au point d integration c c traitement du modele c c Branchement suivant la formulation : c GOTO (9999,9002,9999,9999,9002,9999,9999,9999,9999,9999,9011,9999, & 9999,9014,9999,9999,9017),lformu 9999 CONTINUE c---- FORMULATION : THERMIQUE / LIQUIDE / CONVECTION / c DARCY / FROTTEMENT / RAYONNEMENT / c MAGNETODYNAMIQUE / NAVIER_STOKES / c EULER / FISSURE / THERMOHYDRIQUE / c ELECTROSTATIQUE / * write(ioimp,*) 'Formulation non implementee' RETURN c c---- FORMULATION : MECANIQUE / POREUX 9002 CONTINUE IF (b_moda2) THEN iforb=ifourb nbgmab=nbgmat nlmatb=nelmat xdt = dt CALL cmoda2(wrk52,wrk53,xdt,ib,igau,nbpgau,nbgmab,nlmatb,iforb) ifourb=iforb nbgmat=nbgmab nelmat=nlmatb ELSE jnppla=inplas+3 * Cas VISCO_EXTERNE (inplas = -2) et UMAT (inplas = -1) GOTO( 8, 8, * inplas 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 $ 7,7, 8, 7, 7, 7,111, 7,111, 8,111,111, 7,111, 8, 7, * 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 $ 8, 7, 8, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, * 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 $ 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 7, 7, 7, * 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 $ 111, 8, 8, 8, 8, 8, 8, 7, 8, 8, 8, 8, 8, 8, 8, * 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 $ 7, 8, 7, 8, 8, 8, 8, 8, 8, 7, 8, 8, 8, 8, 8, * 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 $ 7, 7, 8, 8, 8,111, 7,111, 7, 7, 7, 7, 8, 8, 7, * 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 $ 8, 8, 8, 7, 7, 8, 8, 8, 7, 7, 7, 7, 7, 8, 7, * 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 $ 8, 7, 8,111,111, 7, 7, 7,111,111,111,111, 8, 8, 7, * 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 $ 7, 7,111,111, 8, 8, 8, 8, 8, 7, 8, 8, 8, 8, 8, * 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 $ 7, 7, 7, 7, 8, 8, 8, 8, 12, 12, 12, 8, 111,111, 8, * 151 152 153 154 155 156 157 158 159 160 $ 8, 8, 12, 12, 8, 8, 12, 12, 12, 12 $ )jnppla 111 continue write(ioimp,*) ' stop dans coml6 : comportement pas prevu ici' write(ioimp,*) ' inplas jnppla ',inplas,jnppla CALL erreur(5) return 7 continue * if(ib.eq.1.and.igau.eq.1) write(ioimp,*) 'appel coml7' CALL coml7(iqmod,iwrk52,iwrk53,iwrk54,ib,igau, & wrk2,mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,wr11, & iretou,wrk12,wrkgur,wkumat,wcreep,ecou,iecou,necou,xecou) go to 2000 8 continue * if(ib.eq.1.and.igau.eq.1) write(ioimp,*) ' appel coml8' CALL coml8(iqmod,iwrk52,iwrk53,iwrk54,ib,igau, & wrk2,mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,wr11, & iretou,wrk12,wrkgur,wkumat,wcreep,ecou,iecou,necou,xecou) go to 2000 12 continue C if(ib.eq.1.and.igau.eq.1) write(ioimp,*) ' appel coml12' CALL coml12(iqmod,iwrk52,iwrk53,iwrk54,ib,igau, & wrk2,mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,wr11, & iretou,wrk12,wrkgur,wkumat,wcreep,ecou,iecou,necou,xecou) go to 2000 ENDIF GOTO 2000 c---- FORMULATION : MELANGE (microstructures) 9011 CONTINUE * IF (CMATE.EQ.'MGRAIN') THEN CALL mgrain(xmat0,ture0,xmatf,turef) ELSE if (CMATE.EQ.'CEREM') then * constituer en cas de besoin les nuages d interpolation ipnua1 = int(xmat0(16)) modemo = 'CEREMREFR' CALL copret(ipnua1,ilent1,modemo) if (ilent1.eq.0) then CALL chist(ipnua1,ilent1,iwrk52,modemo) if (ierr.ne.0) return call compre(ipnua1,ilent1,modemo) endif * modemo = 'CEREMCHAU' ipnua1 = int(xmat0(17)) call copret(ipnua1,ilent2,modemo) if (ilent2.eq.0) then call chist(ipnua1,ilent2,iwrk52,modemo) if (ierr.ne.0) return call compre(ipnua1,ilent2,modemo) endif * call CRPHA3(iwrk52,iwrk53,ilent1,ilent2,IB,igau) * ELSE if (CMATE.EQ.'LEBLOND') then call clebl3(iwrk52,IB,igau) * ELSE if (CMATE.EQ.'ZTMAX') then call cztmax(iwrk52,iwrk53, ib,igau) * ELSE if (CMATE.EQ.'TMM_LMT2') then call t4m(iwrk52,iwrk53, ib,igau) * ENDIF GOTO 2000 c---- FORMULATION : LIAISON 9014 CONTINUE if (itruli.le.0) then write(ioimp,*) ' stop dans coml6 : itruli <= 0' call erreur(5) return endif if (mate.ge.23) then call coml11(iqmod,wrk52,wrk53,ib,igau,itruli,iretou) else call coml10(iqmod,wrk52,wrk53,ib,igau,itruli,iretou) endif GOTO 2000 c----- FORMULATION : DIFFUSION 9017 CONTINUE write(ioimp,*) 'DIFFUSION : a faire !!!' GOTO 2000 * Erreurs * 2000 continue if (ierr.ne.0) return * * - problèmes de convergence * interr(3) = inplas CALL DEFER1(JNOID,KERR1,KERRE,LOGSUC) if (ierr.ne.0) return * * - autres problèmes * 1990 CONTINUE IF (kerre.NE.0) THEN jnplas = inplas jmfr = mfrbi jmele = mele jkerr1 = kerr1 jkerre = kerre if (jnplas.LT.0) MOTERR(5:20) = wkumat.cmname(1:16) CALL DEFER2(JNPLAS,JMFR,JMELE,IB,IGAU, jkerr1,jkerre) if (ierr.ne.0) return ENDIF c c remplissage des melval contenant les contraintes a la fin * ( rearrangement pour milieu poreux ), c les variables internes finales c et les increments de deformations plastiques c stocke pas de temps optimal c CALL COMSOR(iqmod,ipil,iwrk52,iwrk53,iwrk54,ib,igau,iecou,xecou) if (ierr.ne.0) return c C----------------------------------------------------------------------- c fin de la boucle sur les points de gauss 100 continue C----------------------------------------------------------------------- c c special poutres et tuyaux sauf timoschenko c if (.not.dimped) then CALL COMPOU(IB,mwrkxe,ipil,iwrk53) if (ierr.ne.0) return endif C----------------------------------------------------------------------- c fin de la boucle sur les elements 1000 continue C----------------------------------------------------------------------- * C Desactivation de segments IF (IPMINT.GT.0) SEGDES,MINTE IF (IPTR1.NE.0) THEN C* IF (MFRbi.EQ. 1 .OR. MFRbi.EQ.31 .OR. MFRbi.EQ.33 .OR. C* & MFRbi.EQ.71 .OR. MFRbi.EQ.73) THEN C* IF (CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. C* 1 CMATE.EQ.'UNIDIREC') THEN C*C* IF (MATE.EQ.2 .OR. MATE.EQ.3 .OR. MATE.EQ.4) THEN <- Test equivalent ? SEGDES MINTE2 C* ENDIF ENDIF c Destruction des segments de travail SEGSUP wrk7,wrk9,wrk91 SEGSUP WRK2,WRK3 SEGSUP MWRKXE IF (wrk6.NE.0) SEGSUP,WRK6 IF (LOGVIS) SEGSUP,WRK8 if (wr10.ne.0) segsup wr10 if (wr11.ne.0) segsup wr11 if (wrk12.ne.0) segsup wrk12 if (wrkgur.ne.0) segsup wrkgur IF (wkumat.ne.0) SEGSUP,WKUMAT IF (wcreep.ne.0) SEGSUP,WCREEP segsup wrk54 1998 CONTINUE segsup wrk53 segsup ecou,iecou,necou,xecou c Fermeture des melval & destruction des segments associes CALL COMFIN(ipil,iwrk52,iwr522) return end