1 : C COML12 SOURCE CHAT 12/08/06 21:15:13 7479 2 : SUBROUTINE COML12(iqmod,wrk52,wrk53,wrk54,IB,igau,wrk2, 3 : & mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,wr11, 4 : & iretou,wrk12,wrkgur,wkumat,wcreep,ecou,iecou,necou,xecou) 5 : 6 : *---------------------------------------------------------------- 7 : * lois locales pour la mecanique 8 : * decrites au point d integration 9 : *---------------------------------------------------------------- 10 : IMPLICIT INTEGER(I-N) 11 : IMPLICIT REAL*8(A-H,O-Z) 12 : -INC CCOPTIO 13 : -INC CCGEOME 14 : -INC SMMODEL 15 : -INC SMELEME 16 : -INC SMINTE 17 : -INC CCHAMP 18 : -INC SMCOORD 19 : * segment deroulant le mcheml 20 : -INC DECHE 21 : * 22 : SEGMENT WRK2 23 : REAL*8 TRAC(LTRAC) 24 : ENDSEGMENT 25 : * 26 : SEGMENT MWRKXE 27 : REAL*8 XEL(3,NBNNbi) 28 : ENDSEGMENT 29 : * 30 : SEGMENT WRK3 31 : REAL*8 WORK(LW),WORK2(LW2) 32 : ENDSEGMENT 33 : * 34 : SEGMENT WRK6 35 : REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS) 36 : REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS) 37 : REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS) 38 : ENDSEGMENT 39 : * 40 : SEGMENT WRK7 41 : REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB) 42 : ENDSEGMENT 43 : * 44 : SEGMENT WRK8 45 : REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS) 46 : REAL*8 DDINVp(NSTRS,NSTRS) 47 : ENDSEGMENT 48 : * 49 : SEGMENT WRK9 50 : REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX) 51 : REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1) 52 : REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO) 53 : REAL*8 SIGY(NSIGY) 54 : INTEGER NKX(NNKX) 55 : ENDSEGMENT 56 : * 57 : SEGMENT WRK91 58 : REAL*8 YOG1(NYOG1),YNU1(NYNU1),YALFT1(NYALFT1),YSMAX1(NYSMAX1) 59 : REAL*8 YN1(NYN1),YM1(NYM1),YKK1(NYKK1),YALF2(NYALF2) 60 : REAL*8 YBET2(NYBET2),YR1(NYR1),YA1(NYA1),YQ1(NYQ1),YRHO1(NYRHO1) 61 : REAL*8 SIGY1(NSIGY1) 62 : ENDSEGMENT 63 : * 64 : SEGMENT WR10 65 : INTEGER IABLO1(NTABO1) 66 : REAL*8 TABLO2(NTABO2) 67 : ENDSEGMENT 68 : * 69 : SEGMENT WR11 70 : INTEGER IABLO3(NTABO3) 71 : REAL*8 TABLO4(NTABO4) 72 : ENDSEGMENT 73 : * 74 : SEGMENT WR12 75 : REAL*8 EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3)) 76 : REAL*8 EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6)) 77 : REAL*8 EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9)) 78 : REAL*8 SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS) 79 : REAL*8 SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS) 80 : REAL*8 SM8(NSTRS) 81 : ENDSEGMENT 82 : SEGMENT WRK12 83 : real*8 bbet1,bbet2,bbet3,bbet4,bbet5,bbet6,bbet7,bbet8,bbet9 84 : real*8 bbet10,bbet11,bbet12,bbet13,bbet14,bbet15,bbet16,bbet17 85 : real*8 bbet18,bbet19,bbet20,bbet21,bbet22,bbet23,bbet24,bbet25 86 : real*8 bbet26,bbet27,bbet28,bbet29,bbet30,bbet31,bbet32,bbet33 87 : real*8 bbet34,bbet35,bbet36,bbet37,bbet38,bbet39,bbet40,bbet41 88 : real*8 bbet42,bbet43,bbet44,bbet45,bbet46,bbet47,bbet48,bbet49 89 : real*8 bbet50,bbet51,bbet52,bbet53,bbet54,bbet55 90 : integer ibet1,ibet2,ibet3,ibet4,ibet5,ibet6,ibet7,ibet8 91 : integer ibet9,ibet10,ibet11,ibet12,ibet13,ibet14,ibet15,ibet16 92 : ENDSEGMENT 93 : segment wrkgur 94 : real*8 wgur1,wgur2,wgur3,wgur4,wgur5,wgur6,wgur7 95 : real*8 wgur8,wgur9,wgur10,wgur11,wgur12(6) 96 : real*8 wgur13(7), wgur14 97 : real*8 wgur15,wgur16,wgur17 98 : endsegment 99 : C 100 : C Segment de travail pour la loi 'NON_LINEAIRE' 'UTILISATEUR' appelant 101 : C l'integrateur externe specifique UMAT 102 : C 103 : SEGMENT WKUMAT 104 : C Entrees/sorties de la routine UMAT 105 : REAL*8 DDSDDE(NTENS,NTENS), SSE, SPD, SCD, 106 : & RPL, DDSDDT(NTENS), DRPLDE(NTENS), DRPLDT, 107 : & TIME(2), DTIME, TEMP, DTEMP, DPRED(NPRED), 108 : & DROT(3,3), PNEWDT, DFGRD0(3,3), DFGRD1(3,3) 109 : CHARACTER*16 CMNAME 110 : INTEGER NDI, NSHR, NSTATV, NPROPS, 111 : & LAYER, KSPT, KSTEP, KINC 112 : C Variables de travail 113 : LOGICAL LTEMP, LPRED, LVARI, LDFGRD 114 : INTEGER NSIG0, NPARE0, NGRAD0 115 : ENDSEGMENT 116 : C 117 : C Segment de travail pour les lois 'VISCO_EXTERNE' 118 : C 119 : SEGMENT WCREEP 120 : C Entrees/sorties constantes de la routine CREEP 121 : REAL*8 SERD 122 : CHARACTER*16 CMNAMC 123 : INTEGER LEXIMP, NSTTVC, LAYERC, KSPTC 124 : C Entrees/sorties de la routine CREEP pouvant varier 125 : REAL*8 STV(NSTV), STV1(NSTV), STVP1(NSTV), 126 : & STVP2(NSTV), STV12(NSTV), STVP3(NSTV), 127 : & STVP4(NSTV), STV13(NSTV), STVF(NSTV), 128 : & TMP12, TMP, TMP32, 129 : & DTMP12, DTMP, 130 : & PRD12(NPRD), PRD(NPRD), PRD32(NPRD), 131 : & DPRD12(NPRD), DPRD(NPRD) 132 : INTEGER KSTEPC 133 : C Autres indicateurs et variables de travail 134 : LOGICAL LTMP, LPRD, LSTV 135 : INTEGER IVIEX, NPAREC 136 : REAL*8 dTMPdt, dPRDdt(NPRD) 137 : ENDSEGMENT 138 : * 139 : SEGMENT ENDO0 140 : REAL*8 ENDO(LENDO),RAPP(LENDO) 141 : ENDSEGMENT 142 : * 143 : DIMENSION NWA(9) 144 : DIMENSION SIG01(8),VAR01(37) 145 : DIMENSION EPSFLU(8) 146 : 147 : SEGMENT ECOU 148 : REAL*8 ecow00,ecow0, 149 : C REAL*8 TEST, ALFAH, 150 : 1 ecow1,ecow2,ecow3(6),ecow4(9),ecow5(6), 151 : C 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6), 152 : 2 ecow6(12),ecow7(6),ecow8(6),ecow9(6),ecow10(6),ecow11(6), 153 : 2 ecow12(6), 154 : C 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6), 155 : 1 ecow13(6),ecow14(6),ecow15(12),ecow16(3), 156 : C 1 DALPHA(6),EPSPLA(6),E(12),XINV(3), 157 : 2 ecow17(6),ecow18(6),ecow19,ecow20 158 : C 2 SIPLAD(6),DSIGP0(6),TET,TETI 159 : ENDSEGMENT 160 : * 161 : * Segment NECOU utilisé dans ECOINC 162 : * 163 : SEGMENT NECOU 164 : INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 165 : . ITYP,IFOURB,IFLUAG, 166 : . ICINE,ITHER,IFLUPL,ICYCL,IBI, 167 : . JFLUAG,KFLUAG,LFLUAG, 168 : . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF 169 : ENDSEGMENT 170 : * 171 : * Segment IECOU: sert de fourre-tout pour les initialisations 172 : * d'entiers 173 : * 174 : SEGMENT IECOU 175 : INTEGER NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,NYALF1, 176 : . NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,NSOM,NINV, 177 : . NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,LTRAC,MFRBI, 178 : . IELE,NHRM,NBNNBI,NBELMB,ICARA,LW2BI,NDEF,NSTRSS, 179 : . MFR1,NBGMAT,NELMAT,MSOUPA,NUMAT1,LENDO,NBBB,NNVARI, 180 : . KERR1,MELEMB,NYOG1,NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1, 181 : . NYKK1,NYALF2,NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1 182 : ENDSEGMENT 183 : * 184 : * Segment XECOU: sert de fourre-tout pour les initialisations 185 : * de réels 186 : * 187 : SEGMENT XECOU 188 : REAL*8 DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00 189 : ENDSEGMENT 190 : C----------------------------------------------------------------------- 191 : C 192 : c moterr(1:6) = 'COML12 ' 193 : c moterr(7:15) = 'element ' 194 : c interr(1) = ib 195 : c interr(2) = igau 195 : c call erreur(-329) 196 : * write(6,*) ' entrée dans coml12 iecou ', iecou 197 : imodel = iqmod 198 : c 199 : c traitement du modele 200 : c 201 : NBPGAU = nbgs 202 : NVARI = NVART 203 : TETA1 = ture0(1) 204 : TETA2 = turef(1) 205 : SUCC1 = -1.D35 206 : SUCC2 = -1.D35 207 : nexo = exova0(/1) 208 : if (nexo.gt.0) then 209 : do 1296 inex = 1,nexo 210 : if ((nomexo(inex).eq.'SUCC').and.(conexo(inex).eq.CONM)) then 211 : SUCC1 = exova0(inex) 212 : SUCC2 = exova1(inex) 213 : goto 1295 214 : endif 215 : 1296 continue 216 : endif 217 : 1295 continue 218 : *---------------------- traitement des modeles 219 : 220 : IF (INPLAS.EQ.144) THEN 221 : * modele RICRAG 222 : if(ifour.ne.2) then 222 : CALL RIC2NL(wrk52,wrk53,wrk54,nvari,iecou) 223 : else 223 : CALL RIC3NL(wrk52,wrk53,wrk54,nvari,iecou) 224 : endif 225 : 226 : * modele INTIMP 227 : ELSE IF (INPLAS.EQ.145 .AND. mfrbi.eq.7) THEN 228 : nstrbi=nstrss 229 : icarbi=icara 229 : CALL CBIFLE(wrk52,wrk53,wrk54,NSTRbi,NVARI,ICARbi) 230 : nstrss=nstrbi 231 : icara=icarbi 232 : 233 : c modele RICJOI 234 : ELSE IF (INPLAS.EQ.146) then 235 : * write(6,*) ' ifour ',ifour 236 : * if(ib+igau.eq.2) write(6,*)'sig0', (SIG0 (iou),iou=1,nstrs) 237 : * if(ib+igau.eq.2) write(6,*)'depst', (DEPST (iou),iou=1,nstrs) 238 : if(ifour.ne.2) then 238 : CALL RICJ2(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB, 239 : & XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE) 240 : else 240 : CALL RICJ3(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB, 241 : & TETA1,TETA2, 242 : & XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE) 243 : endif 244 : * if(ib+igau.eq.2) write(6,*)'SIGF', (SIGF(iou),iou=1,nstrs) 245 : 246 : 247 : 248 : C +BR 249 : ELSEIF(INPLAS.EQ.157) then 250 : C Modele GLRC_DM 251 : 251 : CALL LCGLDM(XMAT,VAR0,VARF,SIG0,SIGF,DEPST,XCARB) 252 : 253 : RETURN 254 : 255 : ELSEIF(INPLAS.EQ.158) then 256 : C Modele RICBET 257 : 257 : CALL RICBET(wrk52,wrk53,wrk54,nvari,iecou) 258 : 259 : RETURN 260 : 261 : ELSEIF(INPLAS.EQ.159) then 262 : C Modele RICCOQ 263 : 263 : CALL ELOCRAK1(wrk52,wrk53,wrk54,nvari,iecou) 264 : 265 : RETURN 266 : C -BR 267 : 268 : 269 : C 270 : C Ecoulement pour le modele de Symonds & Cowper 271 : ELSE IF (INPLAS.EQ.153.OR.INPLAS.EQ.154) then 272 : c write(6,*) ' dans coml12 envoi dans coulesyc',inplas,dt 273 : * 274 : C on recupere la courbe de traction 275 : C 276 : nccor=ncourb 276 : call CCOTRA(WRK52,WRK2,NCCOR,WRK53) 277 : ncourb= nccor 278 : C 279 : C meme maniere de proceder que dans ecoin0 280 : nccor=ncourb 281 : iforb=ifourb 282 : 282 : CALL SYCO12(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU, 283 : & NBPGAU,NCcor,IFORB,iecou,xecou) 284 : C 285 : ncourb=nccor 286 : ifourb=iforb 287 : 288 : ELSE 289 : write(ioimp,*) 'Branchement incorrect dans COML12' 289 : CALL ERREUR(5) 290 : ENDIF 291 : 292 : RETURN 293 : end 294 : 295 : 296 : 297 :
© Cast3M 2003 - All rights reserved.
Disclaimer