1 : C COMEFF SOURCE CHAT 11/03/16 21:17:17 6902 2 : SUBROUTINE COMEFF(IQMOD,IWRK52,IWRK53,IWRK54,IECOU,ICAS,IRETOU) 3 : *---------------------------------------------------------- 4 : * cas des milieux poreux isotropes: 5 : * 6 : * appele par COMARA et COMSOR 7 : * 8 : * rearrangement dans XMAT 9 : * passage en contraintes effectives et reciproquement 10 : * 11 : * pb: IRETOU=1 12 : *---------------------------------------------------------- 13 : IMPLICIT INTEGER(I-N) 14 : IMPLICIT REAL*8(A-H,O-Z) 15 : -INC CCOPTIO 16 : -INC SMMODEL 17 : -INC SMCHAML 18 : -INC DECHE 19 : * 20 : * SEGMENT IECOU: sert de fourre-tout pour les initialisations 21 : * d'entiers 22 : * 23 : SEGMENT IECOU 24 : INTEGER NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK, 25 : . NYALF1,NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND, 26 : . NSOM,NINV,NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT, 27 : . LTRAC,MFRbi,IELE,NHRM,NBNNbi,NBELMb,ICARA, 28 : . LW2bi,NDEF,NSTRSS,MFR1,NBGMAT,NELMAT,MSOUPA, 29 : . NUMAT1,LENDO,NBBB,NNVARI,KERR1,MELEME 30 : INTEGER NYOG1,NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1, 31 : . NYKK1,NYALF2,NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1 32 : ENDSEGMENT 33 : * 34 : * 35 : imodel = iqmod 36 : wrk52 = iwrk52 37 : ****** segact wrk52*mod 38 : wrk53 = iwrk53 39 : ******** segact wrk53*mod 40 : * write(6,*) 'comeff ', mfrbi, idim,mele, ifour,icara,xcarb(/1) 41 : * write(6,*) 'comeff ', MFR, MFRBI, NSTRS 42 : ncara = xmat(/1) 43 : wrk54=iwrk54 44 : IRETOU=1 45 : NSTMU=2 46 : IF(IFOUR.GE.0) NSTMU=3 47 : 48 : * 49 : * CAS MODELE EXTERIEUR 50 : * 51 : IF(INPLAS.LT.0) GO TO 1990 52 : 53 : 54 : * 55 : *--------------------------------------------------------------------- 56 : * 57 : IF(ICAS.EQ.1) THEN 58 : * 59 : * 60 : * milieu poreux cas elastique isotrope 61 : * 62 : IF (MFRbi.EQ.33.AND.MATE.EQ.1) THEN 63 : 64 : * 65 : * CAS DES JOINTS 66 : * 67 : IF(MELE.GE.108.AND.MELE.LE.110)THEN 68 : NSTMU=2 69 : IF(IFOUR.GE.0) NSTMU=3 70 : * 71 : * rearrangement 72 : * 73 : LIND=3 74 : COB=XMAT(LIND) 75 : XMOB=XMAT(LIND+1) 76 : 77 : DO 1991 IC=1,NMATT-LIND-1 78 : XMAT(LIND-1+IC)=XMAT(LIND+1+IC) 79 : XMAT0(LIND-1+IC)=XMAT0(LIND+1+IC) 80 : 1991 CONTINUE 81 : * 82 : 83 : * PRINT *,'NMATT=',NMATT 84 : * DO IJ=1,NMATT 85 : * WRITE(6,77882) XMAT(IJ) 86 : *77882 FORMAT(2X,1PE12.5) 87 : * ENDDO 88 : 89 : XMAT(NMATT-1)=COB 90 : XMAT0(NMATT-1)=COB 91 : XMAT(NMATT)=XMOB 92 : XMAT0(NMATT)=XMOB 93 : * 94 : * calcul des contraintes effectives 95 : * 96 : SIG0(NSTMU) =SIG0(NSTMU) + COB* EPST0(NSTRS) 97 : C 98 : ELSE 99 : * 100 : * CAS MASSIF ISOTROPE 101 : * 102 : C 103 : IF(IFOUR.EQ.-3.OR.IFOUR.EQ.1) THEN 104 : KERR0=99 105 : GO TO 1000 106 : ENDIF 107 : * 108 : * rearrangement 109 : * 110 : LIND=5 111 : COB=XMAT(LIND) 112 : XMOB=XMAT(LIND+1) 113 : DO 1992 IC=1,NMATT-LIND-1 114 : XMAT(LIND-1+IC)=XMAT(LIND+1+IC) 115 : XMAT0(LIND-1+IC)=XMAT0(LIND+1+IC) 116 : 1992 CONTINUE 117 : * 118 : XMAT(NMATT-1)=COB 119 : XMAT0(NMATT-1)=COB 120 : XMAT(NMATT)=XMOB 121 : XMAT0(NMATT)=XMOB 122 : 123 : 124 : * PRINT *,'NMATT=',NMATT 125 : * DO IJ=1,NMATT 126 : * WRITE(6,77882) XMAT(IJ) 127 : *77882 FORMAT(2X,1PE12.5) 128 : * ENDDO 129 : 130 : * 131 : * calcul des contraintes effectives 132 : * 133 : DO 1993 IC=1,3 134 : IF(IFOUR.EQ.-2.AND.IC.EQ.3) GO TO 1993 135 : SIG0(IC) =SIG0(IC) + COB* EPST0(NSTRS) 136 : 1993 continue 137 : ENDIF 138 : * 139 : ELSE 140 : * 141 : * CAS NON PREVU 142 : * 143 : GO TO 1000 144 : 145 : ENDIF 146 : * 147 : GO TO 1990 148 : ENDIF 149 : 150 : * 151 : *--------------------------------------------------------------------- 152 : * calcul des contraintes totales 153 : * 154 : IF(ICAS.EQ.2) THEN 155 : 156 : IF (MFRbi.EQ.33.AND.MATE.EQ.1) THEN 157 : * 158 : * attention : a prendre dans XMAT0 et pas XMAT 159 : * 160 : 161 : * 162 : * CAS DES JOINTS 163 : * 164 : IF(MELE.GE.108.AND.MELE.LE.110)THEN 165 : * 166 : NSTMU=2 167 : IF(IFOUR.GE.0) NSTMU=3 168 : COB= XMAT0(NMATT-1) 169 : XMOB=XMAT0(NMATT) 170 : IF(XMOB.EQ.0.D0) THEN 171 : UNSURM=0.D0 172 : ELSE 173 : UNSURM=1.D0/XMOB 174 : ENDIF 175 : * 176 : * PRINT *, 'COB=',COB,' XMOB=',XMOB 177 : * PRINT *, 'NSTMU=',NSTMU 178 : * PRINT *, 'NSTRS=',NSTRS 179 : * PRINT *, 'SIG0(NSTRS)=',SIG0(NSTRS) 180 : * PRINT *, 'DEPST(NSTRS)=',DEPST(NSTRS) 181 : SIGF(NSTRS) = SIG0(NSTRS)+DEPST(NSTRS)*UNSURM 182 : & +COB*DEPST(NSTMU) 183 : SIGF(NSTMU) = SIGF(NSTMU) 184 : & -COB*(EPST0(NSTRS)+DEPST(NSTRS)) 185 : 186 : ELSE 187 : 188 : * 189 : * CAS MASSIF ISOTROPE 190 : * 191 : COB= XMAT0(NMATT-1) 192 : XMOB=XMAT0(NMATT) 193 : IF(XMOB.EQ.0.D0) THEN 194 : UNSURM=0.D0 195 : ELSE 196 : UNSURM=1.D0/XMOB 197 : ENDIF 198 : * PRINT *,' COB=', COB 199 : * IRETOU=1 200 : * GO TO 1000 201 : 202 : SIGF(NSTRS) = SIG0(NSTRS)+DEPST(NSTRS)*UNSURM 203 : DO 1994 IC=1,3 204 : IF(IFOUR.EQ.-2.AND.IC.EQ.3) GO TO 1994 205 : SIGF(IC) = SIGF(IC) 206 : & -COB*(EPST0(NSTRS)+DEPST(NSTRS)) 207 : * 208 : * 209 : SIGF(NSTRS) = SIGF(NSTRS) 210 : & +COB*DEPST(IC) 211 : 212 : 1994 CONTINUE 213 : ENDIF 214 : * 215 : ELSE 216 : * 217 : * CAS NON PREVU 218 : * 219 : GO TO 1000 220 : 221 : ENDIF 222 : 223 : GO TO 1990 224 : ENDIF 225 : 226 : 227 : * 228 : 229 : 1000 CONTINUE 230 : RETURN 231 : * 232 : 1990 CONTINUE 233 : 234 : 235 : 236 : IRETOU=0 237 : RETURN 238 : END 239 : 240 : 241 : 242 : 243 : 244 : 245 : 246 : 247 : 248 : 249 : 250 : 251 :
© Cast3M 2003 - All rights reserved.
Disclaimer