C COMVAL SOURCE PV 12/04/11 21:15:03 7351 SUBROUTINE COMVAL(iqmod,indeso,ililuc,iwrk52,iwrk53,ib,igau, & necou,iecou,xecou,iwr522) *- * remplit les tableaux de travail pour la loi au point d integration *- ********************************************************************** * SORTIES ********************************************************************** * SECT : section de l'élément IB (éventuel) * EPAIST : épaisseur et excentrement ( éventuel) * ********************************************************************** * IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) * -INC CCOPTIO -INC CCGEOME -INC SMCHAML -INC SMELEME -INC SMCOORD -INC SMMODEL -INC SMINTE -INC CCHAMP -INC SMEVOLL -INC SMNUAGE * segment deroulant le mcheml -INC DECHE * * 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 * melval=0 imodel = iqmod liluc = ililuc nbluc1 = liluc(/1) wrk52 = iwrk52 c segact wrk52*mod wrk53 = iwrk53 c segact wrk53*mod wrk522=iwr522 * write(6,*) ' entree dans comval wrk522',wrk522 *------------------------------------------------- * initialisations particulieres N2EL = 0 N2PTEL=0 * tuyaux (attention ajout de caracteristiques facultatives telles que DENS) IF (mfrbi.eq.13) THEN do ic = 1,5 xcarb(ic) = 0.d0 enddo do ic=6,10 xcarb(ic) = -1.d0 enddo do ic=11,xcarb(/1) xcarb(ic) = 0.d0 enddo ENDIF IF( ib+igau.ne.2) then if( mkkalz.EQ.1)then do 701 ma=1,mkkal0(/1) if(mkkal0(ma).eq.0) go to 701 deche =mkkal0(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) scal0(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) scal0(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 701 continue do 7011 ma=1,mkklaf(/1) if(mkklaf(ma).eq.0) go to 7011 deche =mkklaf(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) scalf(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) scalf(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 7011 continue endif if(mkktp0.ne.0) then deche = mkktp0 melval=ieldec IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) temp0=VELCHE(IGMN,IBMN) endif if(mkktpf.ne.0) then deche = mkktpf melval=ieldec IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) tempf=VELCHE(IGMN,IBMN) endif if( mkkplz.EQ.1)then do 706 ma=1,mkkpl0(/1) if(mkkpl0(ma).eq.0) go to 706 deche =mkkpl0(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) depl0(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) depl0(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 706 continue do 7061 ma=1,mkkplf(/1) if(mkkplf(ma).eq.0) go to 7061 deche =mkkplf(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) deplf(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) deplf(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 7061 continue endif if(mkkrcz.eq.1) then do 707 ma=1,mkkrc0(/1) if(mkkrc0(ma).eq.0) go to 707 deche =mkkrc0(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) forc0(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) forc0(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 707 continue do 7071 ma=1,mkkrcf(/1) if(mkkrcf(ma).eq.0) go to 7071 deche =mkkrcf(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) forcf(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) forcf(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 7071 continue endif if(mkkadz.eq.1) then do 710 ma=1,mkkad0(/1) if(mkkad0(ma).eq.0) go to 710 deche =mkkad0(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) grad0(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) grad0(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 710 continue do 7101 ma=1,mkkadf(/1) if(mkkadf(ma).eq.0) go to 7101 deche =mkkadf(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) gradf(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) gradf(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 7101 continue endif if(mkkigz.eq.1) then do 711 ma=1,mkkig0(/1) if(mkkig0(ma).eq.0) go to 711 deche =mkkig0(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) sig0(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) sig0(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 711 continue do 7111 ma=1,mkkigf(/1) if(mkkigf(ma).eq.0) go to 7111 deche =mkkigf(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) sigf(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) sigf(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 7111 continue endif if(mkkstz.eq.1) then do 712 ma=1,mkkst0(/1) if(mkkst0(ma).eq.0) go to 712 deche =mkkst0(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) epst0(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) epst0(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 712 continue do 7121 ma=1,mkkstf(/1) if(mkkstf(ma).eq.0) go to 7121 deche =mkkstf(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) epstf(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) epstf(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 7121 continue endif * * pour les materiaux et dls caracteristiques on passe dans * l'ancienne programmation if( mkkrez.eq.1) then do 715 ma=1,mkkre0(/1) if(mkkre0(ma).eq.0) go to 715 deche =mkkre0(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) ture0(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) ture0(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 715 continue do 7151 ma=1,mkkref(/1) if(mkkref(ma).eq.0) go to 7151 deche =mkkref(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) turef(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) turef(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 7151 continue endif if( mkkinz.eq.1) then do 716 ma=1,mkkin0(/1) if(mkkin0(ma).eq.0) go to 716 deche =mkkin0(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) prin0(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) prin0(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 716 continue do 7161 ma=1,mkkinf(/1) if(mkkinf(ma).eq.0) go to 7161 deche =mkkinf(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) prinf(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) prinf(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 7161 continue endif if(mkkhoz.eq.1) then do 717 ma=1,mkkho0(/1) if(mkkho0(ma).eq.0) go to 717 deche =mkkho0(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) maho0(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) maho0(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 717 continue do 7171 ma=1,mkkhof(/1) if(mkkhof(ma).eq.0) go to 7171 deche =mkkhof(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) mahof(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) mahof(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 7171 continue endif if(mkktaz.eq.1) then do 718 ma=1,mkkta0(/1) if(mkkta0(ma).eq.0) go to 718 deche =mkkta0(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) hota0(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) hota0(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 718 continue do 7181 ma=1,mkktaf(/1) if(mkktaf(ma).eq.0) go to 7181 deche =mkktaf(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) hotaf(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) hotaf(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 7181 continue endif if(mkkvrz.eq.1) then do 720 ma=1,mkkvr0(/1) if(mkkvr0(ma).eq.0) go to 720 deche =mkkvr0(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) var0(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) var0(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 720 continue do 7201 ma=1,mkkvrf(/1) if(mkkvrf(ma).eq.0) go to 7201 deche =mkkvrf(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) varf(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) varf(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 7201 continue endif if( mkkafz.eq.1) then do 721 ma=1,mkkaf0(/1) if(mkkaf0(ma).eq.0) go to 721 deche =mkkaf0(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) graf0(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) graf0(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 721 continue do 7211 ma=1,mkkaff(/1) if(mkkaff(ma).eq.0) go to 7211 deche =mkkaff(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) graff(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) graff(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 7211 continue endif if(mkkasz.eq.1) then do 723 ma=1,mkkas0(/1) if(mkkas0(ma).eq.0) go to 723 deche =mkkas0(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) rhas0(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) rhas0(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 723 continue do 7231 ma=1,mkkasf(/1) if(mkkasf(ma).eq.0) go to 7231 deche =mkkasf(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) rhasf(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) rhasf(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 7231 continue endif if(mkkpnz.eq.1) then do 724 ma=1,mkkpn0(/1) if(mkkpn0(ma).eq.0) go to 724 deche =mkkpn0(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) epin0(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) epin0(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 724 continue do 7241 ma=1,mkkpnf(/1) if(mkkpnf(ma).eq.0) go to 7241 deche =mkkpnf(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) epinf(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) epinf(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 7241 continue endif if (mkkexz.eq.1) then do 725 ma=1,mkkex0(/1) if(mkkex0(ma).eq.0) go to 725 deche =mkkex0(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) parex0(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) parex0(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 725 continue do 7251 ma=1,mkkexf(/1) if(mkkexf(ma).eq.0) go to 7251 deche =mkkexf(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) parexf(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) parexf(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 7251 continue endif if(mkkvxz.eq.1) then do 726 ma=1,mkkvx0(/1) if(mkkvx0(ma).eq.0) go to 726 deche =mkkvx0(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) exova0(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) exova0(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 726 continue do 7261 ma=1,mkkvx1(/1) if(mkkvx1(ma).eq.0) go to 7261 deche =mkkvx1(ma) melval=ieldec if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) exova1(ma)=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) exova1(ma)=DBLE(IELCHE(IGMN,IBMN)) endif 7261 continue endif endif *------------------------------------------------- if( ib+IGAu.eq.2) THEN idepup=1 ifinup=nbluc1 else idepup=13 ifinup=14 endif * copie les valeurs au point d integration dans wrk52 do 1000 ino = idepup,ifinup domdec = liluc(ino) c segact domdec*nomod nomid = jnomid c segact nomid pilnec = jilnec if (pilnec.le.0) goto 1000 c segact pilnec*nomod mran = pilobl(/2) mobl = pilobl(/1) mfac = pilfac(/1) if (mran.le.0) goto 1000 do 3000 ir = 1,mran deche=0 if (mobl.le.0) goto 101 do 100 ic = 1,mobl passe1= 0.d0 ipilo1 = pilobl(ic,ir) * attention les valeurs induites par deche (nomdec, typdec)ne sont pas effacees if (pilobl(ic,ir).gt.0) then deche = pilobl(ic,ir) c segact deche * on evite les deche crees pour le modele * write(6,*) ino,ir,ic,deche,nomdec,typdec,condec if (ir.eq.indeso.and.condec.eq.conmod) goto 100 melval = ieldec c segact melval if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) passe1=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) passe1=DBLE(IELCHE(IGMN,IBMN)) endif endif * * AIGUILLAGE SUIVANT MOT CLE * if (ino.gt.nmot) goto 98 GOTO ( 1, 2, 99, 99, 99, 6, 7,99,99,10,11,12,13,14,15,16, 17,18, 1 99,20,21,99,23,24,25) ino * 99 CONTINUE c pas de composantes pour ce champ RETURN * 1 if (ipilo1.le.0) goto 100 if (ir.eq.1) then scal0(ic) = passe1 mkkal0(ic)=deche else if (ir.ge.(mran -1)) then scalf(ic) = passe1 mkklaf(ic)=deche endif if(deche.ne.0) mkkalz=1 GOTO 120 * 2 continue if (ipilo1.le.0) goto 100 if (ir.eq.1) then temp0 = passe1 mkktp0=deche else if (ir.ge.(mran -1)) then tempf = passe1 mkktpf=deche endif if (tempf.lt.temp0 .and. ir.gt.1) then * pas de temps negatif constituant m1%8 * write(ioimp,*) 'pas de temps negatif constituant ', condec, * & deche,temp0, tempf C* moterr(1:8) = condec call erreur(414) return endif GOTO 120 * * 6 if (ipilo1.le.0) goto 100 if (ir.eq.1) then depl0(ic) = passe1 mkkpl0(ic)=deche else if (ir.ge.(mran -1)) then deplf(ic) = passe1 mkkplf(ic)=deche endif if(deche.ne.0) mkkplz=1 GOTO 120 * 7 if (ipilo1.le.0) goto 100 if (ir.eq.1) then forc0(ic) = passe1 mkkrc0(ic)=deche else if (ir.ge.(mran -1)) then forcf(ic) = passe1 mkkrcf(ic)=deche endif if(deche.ne.0) mkkrcz=1 GOTO 120 * 10 if (ipilo1.le.0) goto 100 if (ir.eq.1) then grad0(ic) = passe1 mkkad0(ic)=deche else if (ir.ge.(mran -1)) then gradf(ic) = passe1 mkkadf(ic)=deche endif if(deche.ne.0) mkkadz=1 GOTO 120 * 11 if (ipilo1.le.0) goto 100 if (ir.eq.1) then SIG0(ic) = passe1 mkkig0(ic)=deche else if (ir.ge.(mran -1)) then SIGF(ic) = passe1 mkkigf(ic)=deche endif if(deche.ne.0) mkkigz=1 GOTO 120 * 12 if (ipilo1.le.0) goto 100 if (ir.eq.1) then epst0(ic) = passe1 mkkst0(ic) =deche else if (ir.gt.1.and.ir.le.mran) then epstf(ic) = passe1 mkkstf(ic) = deche endif if(deche.ne.0) mkkstz=1 GOTO 120 * caracteristiques materiau 13 continue if (igau.eq.1.and.ib.eq.1.and.ir.eq.1) then commat(ic) = lesobl(ic) tyval(ic) = 'REAL*8 ' endif if (ir.gt.1) then if (ir.eq.1) > write (6,*) ' dans comval ivalma mobl ic ',ivalma(/1),mobl,ic ivalma(ic) = 0 if (ipilo1.gt.0) ivalma(ic) = ieldec endif if (ipilo1.le.0) goto 100 if (ir.eq.1) then valma0(ic) = passe1 mkkva0(ic)=deche elseif (ir.gt.1.and.ir.le.(mran -1)) then VALMAT(ic) = passe1 mkkvat(ic)=deche tyval (ic)= typdec xmatf(ic) = passe1 mkkatf(ic)=deche else if (ir.eq.mran ) then xmatf(ic) = passe1 mkkatf(ic)=deche endif if (igau.eq.1.and.ib.eq.1) 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 GOTO 120 * caracteristiques geometriques 14 if (igau.eq.1.and.ib.eq.1.and.ir.eq.1) then comcar(ic) = lesobl(ic) tycar(ic) = 'REAL*8 ' endif mblcar=mobl if (ipilo1.le.0.and.mfrbi.ne.9.and.mfrbi.ne.3) goto 100 if (ir.eq.1) then xcar0(ic) = passe1 mkkar0(ic)=deche elseif (ir.gt.1.and.ir.le.(mran-1)) then tycar(ic) = typdec XCARB(ic) = passe1 mkkarb(ic)=deche xcarbf(ic) = passe1 mkkrbf(ic)=deche * * tuyaux * IF (mfrbi.eq.13) THEN C C Poutre 3D C ELSE IF(MFRbi.EQ.7.AND.IDIM.EQ.3)THEN C C Poutre 2D C ELSEIF(IDIM.EQ.2) THEN if (ipilo1.le.0.and.ic.eq.2) then IF(MFRbi.EQ.3.OR.MFRbi.EQ.9) THEN XCARB(IC)=0.66666666666666D0 ENDIF endif ELSE * cas des coques minces : défaut de alfah IF (ipilo1.le.0.and.IC.EQ.2.AND. & (MFRbi.EQ.3.OR.MFRbi.EQ.9)) THEN XCARB(IC)=0.666666666666666D0 ENDIF C ENDIF else if (ir.eq.mran) then xcarbf(ic) = passe1 mkkrbf(ic)=deche endif if(deche.ne.0) mkkarz=1 GOTO 120 * 15 if (ipilo1.le.0) goto 100 if (ir.eq.1) then ture0(ic) = passe1 mkkre0(ic)=deche else if (ir.ge.(mran -1)) then turef(ic) = passe1 mkkref(ic)=deche endif if(deche.ne.0) mkkrez=1 GOTO 120 * 16 if (ipilo1.le.0) goto 100 if (ir.eq.1) then prin0(ic) = passe1 mkkin0(ic)=deche else if (ir.ge.(mran -1)) then prinf(ic) = passe1 mkkinf(ic)=deche endif if(deche.ne.0) mkkinz=1 GOTO 120 * 17 if (ipilo1.le.0) goto 100 if (ir.eq.1) then maho0(ic) = passe1 mkkho0(ic)=deche else if (ir.ge.(mran -1)) then mahof(ic) = passe1 mkkhof(ic)=deche endif if(deche.ne.0) mkkhoz=1 GOTO 120 * 18 if (ipilo1.le.0) goto 100 if (ir.eq.1) then hota0(ic) = passe1 mkkta0(ic)=deche else if (ir.ge.(mran -1)) then hotaf(ic) = passe1 mkktaf(ic)=deche endif if(deche.ne.0) mkktaz=1 GOTO 120 * 20 if (ipilo1.le.0) goto 100 if (ir.eq.1) then VAR0(ic) = passe1 mkkvr0(ic)=deche else if (ir.ge.(mran -1)) then VARF(ic) = passe1 mkkvrf(ic)=deche endif if(deche.ne.0) mkkvrz=1 GOTO 120 * 21 if (ipilo1.le.0) goto 100 if (ir.eq.1) then graf0(ic) = passe1 mkkaf0(ic)=deche else if (ir.ge.(mran -1)) then graff(ic) = passe1 mkkaff(ic)=deche endif if(deche.ne.0) mkkafz=1 GOTO 120 * 23 if (ipilo1.le.0) goto 100 if (ir.eq.1) then rhas0(ic) = passe1 mkkas0(ic)=deche else if (ir.ge.(mran -1)) then rhasf(ic) = passe1 mkkasf(ic)=deche endif if(deche.ne.0) mkkasz=1 GOTO 120 * 24 if (ipilo1.le.0) goto 100 if (ir.eq.1) then EPIN0(ic) = passe1 mkkpn0(ic)=deche else if (ir.ge.(mran -1)) then EPINF(ic) = passe1 mkkpnf(ic)=deche endif if(deche.ne.0) mkkpnz=1 GOTO 120 * 25 if (ipilo1.le.0) goto 100 if (ir.eq.1) then PAREX0(ic) = passe1 mkkex0(ic)=deche else if (ir.ge.(mran -1)) then PAREXF(ic) = passe1 mkkexf(ic)=deche endif if(deche.ne.0) mkkexz=1 GOTO 120 * 98 if (ipilo1.le.0) goto 100 if (ir.eq.1) then exova0(ic) = passe1 mkkvx0(ic)=deche else if (ir.ge.(mran -1)) then exova1(ic) = passe1 mkkvx1(ic)=deche endif if (nomexo(ic).eq.'STEP') istep = int(exova0(ic)) if(deche.ne.0) mkkvxz=1 GOTO 120 * 120 CONTINUE * 100 continue 101 continue * * if (mfac.le.0) goto 301 do 200 ic = 1,mfac passe1= 0.d0 ipilo2 = pilfac(ic,ir) if (pilfac(ic,ir).gt.0) then deche = pilfac(ic,ir) c segact deche * on evite les deche crees pour le modele * if (ib.eq.1.and.igau.eq.1) * & write(6,*) ino,ir,ic,deche,nomdec,typdec,condec if (ir.eq.indeso.and.condec.eq.conmod) goto 200 melval = ieldec c segact melval if (typdec.eq.'REAL*8') then IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) passe1=VELCHE(IGMN,IBMN) else IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) passe1=DBLE(IELCHE(IGMN,IBMN)) endif endif * * AIGUILLAGE SUIVANT MOT CLE * if (ino.gt.nmot) goto 298 GOTO ( 201,202,299,299,299,206, 207,299,299,210,211, & 212,213,214,215,216, 217,218,299,220,221,299,223,224,299) ino * 299 CONTINUE c pas de composantes pour ce champ RETURN * 201 if (ipilo2.le.0) goto 200 if (ir.eq.1) then scal0(mobl+ic) = passe1 mkkal0(ic+mobl)=deche else if (ir.ge.(mran -1)) then scalf(mobl+ic) = passe1 mkklaf(ic+mobl)=deche endif if(deche.ne.0) mkkalz=1 GOTO 320 * 202 if (ipilo2.le.0) goto 200 * bizarre de passer la ... GOTO 320 * 206 if (ipilo2.le.0) goto 200 if (ir.eq.1) then depl0(mobl+ic) = passe1 mkkpl0(ic+mobl)=deche else if (ir.ge.(mran -1)) then deplf(mobl+ic) = passe1 mkkplf(ic+mobl)=deche endif if(deche.ne.0) mkkplz=1 GOTO 320 * 207 if (ipilo2.le.0) goto 200 if (ir.eq.1) then forc0(mobl+ic) = passe1 mkkrc0(ic+mobl)=deche else if (ir.ge.(mran -1)) then forcf(mobl+ic) = passe1 mkkrcf(ic+mobl)=deche endif if(deche.ne.0) mkkrcz=1 GOTO 320 * 210 if (ipilo2.le.0) goto 200 if (ir.eq.1) then grad0(mobl+ic) = passe1 mkkad0(ic+mobl)=deche else if (ir.ge.(mran -1)) then gradf(mobl+ic) = passe1 mkkadf(ic+mobl)=deche endif if(deche.ne.0) mkkadz=1 GOTO 320 * 211 if (ipilo2.le.0) goto 200 if (ir.eq.1) then SIG0(mobl+ic) = passe1 mkkig0(ic+mobl)=deche else if (ir.ge.(mran -1)) then SIGF(mobl+ic) = passe1 mkkigf(ic+mobl)=deche endif if(deche.ne.0) mkkigz=1 GOTO 320 * 212 if (ipilo2.le.0) goto 200 if (ir.eq.1) then epst0(mobl+ic) = passe1 mkkst0(ic+mobl) =deche else if (ir.gt.1.and.ir.le.mran) then epstf(mobl+ic) = passe1 mkkstf(ic+mobl) = deche endif if(deche.ne.0) mkkstz=1 GOTO 320 * 213 continue if (igau.eq.1.and.ib.eq.1.and.ir.eq.1) then commat(mobl+ic) = lesfac(ic) tyval(mobl+ic) = 'REAL*8 ' endif if (ir.gt.1) then ivalma(mobl+ic) = 0 if (ipilo2.gt.0) ivalma(mobl+ic) = ieldec endif if (ipilo2.le.0) goto 200 if (ir.eq.1) then valma0(mobl+ic) = passe1 mkkva0(ic+mobl)=deche elseif (ir.gt.1.and.ir.le.(mran - 1)) then VALMAT(mobl+ic) = passe1 mkkvat(ic+mobl)=deche tyval(mobl+ic) = typdec xmatf(mobl+ic) = passe1 mkkatf(ic+mobl)=deche if ((inplas.eq.26.or.inplas.eq.29.or.inplas.eq.142) & .and.nomdec(1:4).eq.'ALPH') then if (typdec(1:8).eq.'REAL*8 '.or.typdec(1:8).eq.'POINTEUR') & ITHHER=1 endif else if (ir.eq.mran) then xmatf(mobl+ic) = passe1 mkkatf(ic+mobl)=deche endif if (igau.eq.1.and.ib.eq.1) 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 GOTO 320 * 214 if (ib.eq.1.and.igau.eq.1.and.ir.eq.1) then comcar(mobl+ic)=lesfac(ic) tycar(mobl+ic)='REAL*8 ' endif if (ipilo2.le.0.and.mfrbi.ne.9.and.mfrbi.ne.3) goto 200 if (ir.eq.1) then xcar0(mobl+ic) = passe1 mkkar0(ic+mobl)=deche else if (ir.gt.1.and.ir.le.(mran -1)) then XCARB(mobl+ic) = passe1 mkkarb(ic+mobl)=deche xcarbf(mobl+ic) = passe1 tycar(mobl+ic) = typdec * * tuyaux * IF (mfrbi.eq.13) THEN * composante VECT if (ipilo2.ne.0.and.comcar(mobl+ic).eq.'VECT') then ip = int(passe1) mkkarb(ic+mobl)=deche IREF=(IP-1)*(IDIM+1) * on range les coordonnees en fin de tableau <> pas comme dans DEFCAR DO 3208 IC2=1,IDIM XCARB(ncarr+IC2)=XCOOR(IREF+IC2) 3208 continue else DO 3209 IC2=1,IDIM XCARB(ncarr+IC2)=0.d0 3209 continue endif C C Poutre 3D C ELSE IF(MFRbi.EQ.7.AND.IDIM.EQ.3)THEN * composante VECT if (ipilo2.ne.0.and.comcar(mobl+ic).eq.'VECT') then IP=int(passe1) mkkarb(ic+mobl)=deche IREF=(IP-1)*(IDIM+1) * on range les coordonnees en fin de tableau <> pas comme dans DEFCAR DO 4208 IC2=1,IDIM XCARB(ncarr+IC2)=XCOOR(IREF+IC2) 4208 continue else DO 4209 IC2=1,IDIM XCARB(ncarr+IC2)=0.D0 4209 continue endif C C Poutre 2D C ELSEIF(IDIM.EQ.2) THEN if (ipilo2.le.0.and.mobl+ic.eq.2) then IF(MFRbi.EQ.3.OR.MFRbi.EQ.9) THEN XCARB(mobl+IC)=0.66666666666666D0 ENDIF endif ELSE * cas des coques minces : défaut de alfah IF (ipilo2.le.0.and.mobl+IC.EQ.2.AND. & (MFRbi.EQ.3.OR.MFRbi.EQ.9)) THEN XCARB(mobl+IC)=0.666666666666666D0 ENDIF C C ENDIF else if (ir.ge.mran) then xcarbf(mobl+ic) = passe1 mkkrbf(ic+mobl)=deche endif if(deche.ne.0) mkkarz=1 GOTO 320 * 215 if (ipilo2.le.0) goto 200 if (ir.eq.1) then ture0(mobl+ic) = passe1 mkkre0(ic+mobl)=deche else if (ir.ge.(mran -1)) then turef(mobl+ic) = passe1 mkkref(ic+mobl)=deche endif if(deche.ne.0) mkkrez=1 GOTO 320 * 216 if (ipilo2.le.0) goto 200 if (ir.eq.1) then prin0(mobl+ic) = passe1 mkkin0(ic+mobl)=deche else if (ir.ge.(mran -1)) then prinf(mobl+ic) = passe1 mkkinf(ic+mobl)=deche endif if(deche.ne.0) mkkinz=1 GOTO 320 * 217 if (ipilo2.le.0) goto 200 if (ir.eq.1) then maho0(mobl+ic) = passe1 mkkho0(ic+mobl)=deche else if (ir.ge.(mran -1)) then mahof(mobl+ic) = passe1 mkkhof(ic+mobl)=deche endif if(deche.ne.0) mkkhoz=1 GOTO 320 * 218 if (ipilo2.le.0) goto 200 if (ir.eq.1) then hota0(mobl+ic) = passe1 mkkta0(ic+mobl)=deche else if (ir.ge.(mran -1)) then hotaf(mobl+ic) = passe1 mkktaf(ic+mobl)=deche endif if(deche.ne.0) mkktaz=1 GOTO 320 * 220 if (ipilo2.le.0) goto 200 if (ir.eq.1) then VAR0(mobl+ic) = passe1 mkkvr0(ic+mobl)=deche else if (ir.ge.(mran -1)) then VARF(mobl+ic) = passe1 mkkvrf(ic+mobl)=deche endif if(deche.ne.0) mkkvrz=1 GOTO 320 * 221 if (ipilo2.le.0) goto 200 if (ir.eq.1) then graf0(mobl+ic) = passe1 mkkaf0(ic+mobl)=deche else if (ir.ge.(mran -1)) then graff(mobl+ic) = passe1 mkkaff(ic+mobl)=deche endif if(deche.ne.0) mkkafz=1 GOTO 320 * 223 if (ipilo2.le.0) goto 200 if (ir.eq.1) then rhas0(mobl+ic) = passe1 mkkas0(ic+mobl)=deche else if (ir.ge.(mran -1)) then rhasf(mobl+ic) = passe1 mkkasf(ic+mobl)=deche endif if(deche.ne.0) mkkasz=1 GOTO 320 * 224 if (ipilo2.le.0) goto 200 if (ir.eq.1) then EPIN0(mobl+ic) = passe1 mkkpn0(ic+mobl)=deche else if (ir.ge.(mran -1)) then EPINF(mobl+ic) = passe1 mkkpnf(ic+mobl)=deche endif if(deche.ne.0) mkkpnz=1 GOTO 320 * 298 if (ipilo2.le.0) goto 200 exova0(mobl + ic) = passe1 mkkvx0(ic+mobl)=deche if(deche.ne.0) mkkvxz=1 GOTO 320 * 320 CONTINUE 200 continue 301 continue 3000 continue * 1000 continue 1001 continue * dt = tempf - temp0 * if (igau.eq.1.and.ib.eq.1) then IF (N2PTEL.EQ.1.OR.NBG.EQ.1) THEN N2PTEL=1 ELSE N2PTEL=NBG ENDIF endif * do ig = 1, depst(/1) DEPST(ig)= epstf(ig) - epst0(ig) enddo * nucar = xcarb(/1) IF((MFRbi.EQ.7.OR.MFRbi.EQ.13.OR.MFRbi.EQ.15.OR.MFRbi.EQ.17) 1 .AND. CMATE.NE.'SECTION') THEN * IF (MFRbi.EQ.15) THEN NUCAR=NUCAR/2 IE=1 domdec = liluc(14) c segact domdec*nomod pilnec = jilnec c segact pilnec*nomod mobl = pilobl(/1) mfac = pilfac(/1) DO 1007 IC=1,3,2 DO 1007 ICOMP=1,min(NUCAR,mobl) deche = pilobl(icomp,2) if (deche.gt.0) then c segact deche melval = ieldec c segact melval IAUX=MELVAL IF (IAUX.NE.0) THEN IGMN=MIN(IC,VELCHE(/1)) IBMN=MIN(IB,VELCHE(/2)) VALCAR(IE)=VELCHE(IGMN,IBMN) ELSE VALCAR(IE)=0.D0 ENDIF else VALCAR(IE)=0.D0 endif IE=IE+1 1007 CONTINUE DO 1009 IC=1,3,2 DO 1009 ICOMP=1,mfac deche = pilfac(icomp,2) if (deche.gt.0) then c segact deche melval = ieldec c segact melval IAUX=MELVAL IF (IAUX.NE.0) THEN IGMN=MIN(IC,VELCHE(/1)) IBMN=MIN(IB,VELCHE(/2)) VALCAR(IE)=VELCHE(IGMN,IBMN) ELSE VALCAR(IE)=0.D0 ENDIF else VALCAR(IE)=0.D0 endif IE=IE+1 1009 CONTINUE * ELSE if (inplas.ne.73) then * pour la loi de cisaillement 73, valcar ne sert a rien domdec = liluc(14) c segact domdec*nomod pilnec = jilnec c segact pilnec*nomod mobl = pilobl(/1) mfac = pilfac(/1) DO 1010 ICOMP=1,pilobl(/1) VALCAR(ICOMP)=0.D0 deche = pilobl(icomp,2) if (deche.gt.0) then c segact deche melval = ieldec c segact melval IAUX=MELVAL DO 1008 IAUX1=1,NBPTEL IF (IAUX.NE.0) THEN IBMN=MIN(IB ,VELCHE(/2)) IGMN=MIN(IAUX1,VELCHE(/1)) VALCAR(ICOMP)=VALCAR(ICOMP)+VELCHE(IGMN,IBMN) ENDIF IF(IAUX1.EQ.NBPTEL) VALCAR(ICOMP)=VALCAR(ICOMP)/NBPTEL 1008 CONTINUE endif 1010 CONTINUE DO 1012 ICOMP=1,pilfac(/1) VALCAR(mobl+ICOMP)=0.D0 deche = pilfac(icomp,2) if (deche.gt.0) then c segact deche melval = ieldec c segact melval IAUX=MELVAL DO 1011 IAUX1=1,NBPTEL IF (IAUX.NE.0) THEN * write (6,*) ' ielche velche ',ielche(/2),velche(/2) * write (6,*) ' mfrbi ifour icomp ',mfrbi,ifour,icomp IF (ielche(/2).ne.0) THEN IBMN=MIN(IB ,IELCHE(/2)) IGMN=MIN(IAUX1,IELCHE(/1)) VALCAR(mobl+ICOMP)=VALCAR(mobl+ICOMP)+IELCHE(IGMN,IBMN) ELSE IBMN=MIN(IB ,VELCHE(/2)) IGMN=MIN(IAUX1,VELCHE(/1)) VALCAR(mobl+ICOMP)=VALCAR(mobl+ICOMP)+VELCHE(IGMN,IBMN) ENDIF ENDIF IF(IAUX1.EQ.NBPTEL) VALCAR(mobl+ICOMP)=VALCAR(mobl+ICOMP)/NBPTEL 1011 CONTINUE endif 1012 CONTINUE ENDIF else if (nucar.gt.0) then do ip = 1,nucar valcar(ip) = xcarb(ip) enddo endif ENDIF * IF(MFRbi.EQ.27.OR.MFRbi.EQ.49) THEN * * on cherche la section de l'element ib * domdec = liluc(14) c segact domdec*nomod pilnec = jilnec * segact pilnec deche=0 if (pilobl(/2).ge.2.and.pilobl(/1).ge.1) deche = pilobl(1,2) IF( deche.eq.0) then sect=0.d0 ELSE c segact deche melval = ieldec c segact melval IAUX=MELVAL IF (IAUX.NE.0) THEN IBMN=MIN(IB ,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) SECT=VELCHE(IGMN,IBMN) ELSE SECT=0.D0 ENDIF ENDIF ENDIF * * prise en compte de l'epaisseur et de l'excentrement * dans le cas des coques minces avec ou sans cisaillement * transverse * IF (MFRbi.EQ.3.OR.MFRbi.EQ.9) THEN IF (CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'.OR. 1 CMATE.EQ.'UNIDIREC') THEN domdec = liluc(14) c segact domdec*nomod pilnec = jilnec * segact pilnec deche = pilobl(1,2) c segact deche deche=0 if (pilobl(/2).ge.2.and.pilobl(/1).ge.1) deche = pilobl(1,2) melval = ieldec c segact melval IAUX=MELVAL IF (IAUX.NE.0) THEN IBMN=MIN(IB ,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) EPAIST=VELCHE(IGMN,IBMN) ELSE EPAIST=0.D0 ENDIF ENDIF ENDIF ** c on veut travailler sur tous les pgauss sans economie NBGMAT = NBPTEL NELMAT = NEL * on traite le materiau dependant de la temperature pour lemaitre endommageable if (inplas.eq.26.or.inplas.eq.29.or.inplas.eq.142) then do ic = 1,tyval(/2) if (tyval(ic)(9:16).EQ.'EVOLUTIO') then MEVOLL=nint(valmat(ic)) IF(MEVOLL.EQ.0) THEN KERRE=37 RETURN ENDIF SEGACT MEVOLL KEVOLL=IEVOLL(1) SEGACT KEVOLL if (nomevx.eq.'T ') ITHHER = 2 * on ne desactive pas les segments pour reduire la contention sur esope en // *** segdes kevoll,mevoll if (ithher.eq.2) goto 4010 endif if (tyval(ic)(9:16).EQ.'NUAGE ') then MNUAGE=nint(valmat(ic)) SEGACT MNUAGE IF(MNUAGE.EQ.0) THEN MOTERR(1:8)='NUAGE ' CALL ERREUR(37) KERRE=37 RETURN ENDIF NVAR=NUANOM(/2) IF(NVAR.LE.1) THEN * on ne desactive pas les segments pour reduire la contention sur esope en // *** SEGDES MNUAGE INTERR(1)=MNUAGE INTERR(2)=2 INTERR(3)=2 CALL ERREUR(628) KERRE=628 RETURN ENDIF if (nuanom(1).eq.'T ') ITHHER = 2 * on ne desactive pas les segments pour reduire la contention sur esope en // *** segdes mnuage if (ithher.eq.2) goto 4010 endif enddo 4010 continue * ---> PLastique endommageable de Lemaitre IF ( INPLAS .EQ. 26 ) THEN C* Test refait juste apres C* IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN C* TREFA = 20. C* ENDIF PRECIS = 1.d-8 ENDIF endif ** IF (INPLAS.NE.43) THEN IF (ITHHER.EQ.1.OR.ITHHER.EQ.2) THEN TREFA= 20.D0 ENDIF ENDIF ** RETURN END