1 : C CMODA2 SOURCE KICH 11/08/11 21:15:20 7079 2 : SUBROUTINE CMODA2(wrk52,wrk53,xdt, 3 : & IB,IGAU,NBPGAU,NBGMAT,NELMAT,IFOURB) 4 : * 5 : * 6 : * 7 : IMPLICIT INTEGER(I-N) 8 : IMPLICIT REAL*8 (A-H,O-Z) 9 : -INC CCOPTIO 10 : -INC CCREEL 11 : -INC DECHE 12 : -INC SMLREEL 13 : -INC SMEVOLL 14 : -INC SMLMOTS 15 : -INC SMELEME 16 : -INC SMCHPOI 17 : 18 : CHARACTER*4 lesinc(7),lesdua(7) 19 : DATA lesinc/'UX','UY','UZ','RX','RY','RZ','UR'/ 20 : DATA lesdua/'FX','FY','FZ','MX','MY','MZ','FR'/ 21 : * 22 : IF (cmate.eq.'MODAL') THEN 23 : c caracteristiques freq, mass 24 : freq1 = valmat(1) 25 : xmass1 = valmat(2) 26 : omeg1 = 2. * xpi * freq1 27 : xamor1 = valmat(4) 28 : * 29 : do jj = 1,epstf(/1) 30 : if (jj.eq.1) jjsi = 1 31 : if (jj.eq.2) jjsi = 3 32 : effx = epstf(jj) 33 : sigf(jjsi) = effx * xmass1 * omeg1 * omeg1 34 : if (ifomod.eq.6.) then 35 : omef = 2.*xpi*tempf 36 : sigf(jjsi) = sigf(jjsi) - (effx * xmass1 * omef * omef) 37 : * write(6,*) sigf(1), effx, xmass1 , (omef*omef) 38 : if (jj.eq.2) sigf(jjsi) = sigf(jjsi) * (-1) 39 : if (xamor1.ne.0..and.epstf(/1).gt.1) then 40 : if (jj.eq.1) j2 = 2 41 : if (jj.eq.2) j2 = 1 42 : sigf(jjsi) = sigf(jjsi) + omef*xamor1*omeg1*xmass1*epstf(j2) 43 : endif 44 : endif 45 : enddo 46 : ENDIF 47 : 48 : IF (cmate.eq.'STATIQUE'.or.cmate.eq.'MODAL') THEN 49 : 50 : IPCHPO = 0 51 : if (cmate.eq.'STATIQUE') then 52 : if (valmat(5).gt.0) then 53 : lricr = nint(valmat(5)) 54 : ipmmod = nint(valmat(6)) 55 : ipmsta = nint(valmat(7)) 56 : lmacr = nint(valmat(8)) 57 : lamcr = nint(valmat(9)) 58 : else 58 : call erreur(26) 59 : return 60 : endif 61 : elseif(cmate.eq.'MODAL') then 62 : if (valmat(7).gt.0) then 63 : lricr = nint(valmat(7)) 64 : ipmmod = 0 65 : ipmsta = nint(valmat(8)) 66 : lmacr = nint(valmat(9)) 67 : lamcr = nint(valmat(10)) 68 : else 69 : return 70 : endif 71 : endif 72 : mlreel = lricr 73 : segact mlreel 74 : 75 : if(ifomod.eq.6) then 76 : mlree1 = lmacr 77 : segact mlree1 78 : omef = 2.*xpi*tempf 79 : if (mlree1.prog(/1).le.0)then 79 : call erreur(5) 80 : return 81 : endif 82 : if (lamcr.gt.0) then 83 : mlree2 = lamcr 84 : segact mlree2 85 : endif 86 : endif 87 : * 88 : if (prog(/1).le.0) then 88 : call erreur(5) 89 : return 90 : endif 91 : 92 : JG0 = 0 93 : DO 212 jj = 1,epstf(/1) 94 : if (jj.eq.1) jjsi = 1 95 : if (jj.eq.2) jjsi = 3 96 : if (jj.eq.1) j2 = 2 97 : if (jj.eq.2) j2 = 1 98 : effx = epstf(jj) 99 : sigf(2) = 0 100 : c write(6,*) 'c2',prog(/1),mlree1.prog(/1),lamcr,effx 101 : 102 : IF (cmate.eq.'STATIQUE') THEN 103 : if (prog(/1).eq.1) then 104 : sigf(jjsi) = effx * prog(1) 105 : if(ifomod.eq.6) then 106 : sigf(jjsi) = sigf(jjsi) - (effx * mlree1.prog(1) * omef * omef) 107 : if (jj.eq.2) sigf(jjsi) = sigf(jjsi) * (-1) 108 : if (lamcr.gt.0) then 109 : if (mlree2.prog(1).ne.0..and.epstf(/1).gt.1) then 110 : sigf(jjsi) = sigf(jjsi) + omef*mlree2.prog(1)*epstf(j2) 111 : endif 112 : endif 113 : endif 114 : goto 212 115 : if (jj.eq.epstf(/1)) then 116 : segdes mlreel 117 : if (ifomod.eq.6) then 118 : segdes mlree1 119 : if (lamcr.gt.0) segdes mlree2 120 : endif 121 : return 122 : endif 123 : else 124 : sigf(jjsi) = 0.d0 125 : endif 126 : ENDIF 127 : 128 : * 129 : if (jj.eq.1) then 130 : NSOUPO = 1 131 : if(ipmmod.gt.0.and.ipmsta.gt.0) NSOUPO = 2 132 : NAT=1 133 : SEGINI,MCHPOI 134 : IPCHPO = MCHPOI 135 : MTYPOI = 'FMODSTA' 136 : IFOPOI = IFOUR 137 : * nature diffuse 138 : JATTRI(1) = 1 139 : nmo0 = 0 140 : KIPCHP = 0 141 : if (ipmmod.gt.0) then 142 : NC = epstf(/1) 143 : SEGINI,MSOUPO 144 : KIPCHP = KIPCHP + 1 145 : IPCHP(KIPCHP) = MSOUPO 146 : NOCOMP(1) = 'FALF' 147 : NOHARM(1) = NIFOUR 148 : if (epstf(/1).eq.2) then 149 : NOCOMP(2) = 'IFAL' 150 : NOHARM(2) = NIFOUR 151 : endif 152 : IGEOC = ipmmod 153 : ipt1 = ipmmod 154 : segact ipt1 155 : N = ipt1.num(/2) 156 : nmo0 = N 157 : JG0 = JG0 + N 158 : SEGINI,MPOVAL 159 : IPOVAL = MPOVAL 160 : ipomo0 = ipoval 161 : endif 162 : endif 163 : * 164 : if (ipmmod.gt.0) then 165 : N = nmo0 166 : mpoval = ipomo0 167 : do ii = 1,N 168 : c write(6,*) 'cc',vpocha(/1),vpocha(/2),ii,jj,prog(/1) 169 : vpocha(ii,jj) = prog(ii)*effx 170 : if (ifomod.eq.6) then 171 : vpocha(ii,jj) = vpocha(ii,jj) - (effx*mlree1.prog(ii)*omef*omef) 172 : if (jj.eq.2) vpocha(ii,jj) = vpocha(ii,jj) * (-1) 173 : if (lamcr.gt.0) then 174 : if (mlree2.prog(ii).ne.0..and.epstf(/1).gt.1) then 175 : vpocha(ii,jj) = vpocha(ii,jj) + omef*mlree2.prog(ii)*epstf(j2) 176 : endif 177 : endif 178 : endif 179 : * write(6,*)'m',effx,ii,ipt1.num(1,ii),mlree1.prog(ii),vpocha(ii,1) 180 : enddo 181 : 182 : if (jj.eq.epstf(/1)) SEGDES,MPOVAL,MSOUPO 183 : endif 184 : 185 : if (jj.eq.1) then 186 : if (ipmsta.gt.0) then 187 : NC = epstf(/1) 188 : SEGINI,MSOUPO 189 : KIPCHP = KIPCHP + 1 190 : IPCHP(KIPCHP) = MSOUPO 191 : NOCOMP(1) = 'FBET' 192 : NOHARM(1) = NIFOUR 193 : if (epstf(/1).eq.2) then 194 : NOCOMP(2) = 'IFBE' 195 : NOHARM(2) = NIFOUR 196 : endif 197 : IGEOC = ipmsta 198 : ipt1 = ipmsta 199 : segact ipt1 200 : N = ipt1.num(/2) 201 : nst0 = N 202 : SEGINI,MPOVAL 203 : IPOVAL = MPOVAL 204 : ipost0 = ipoval 205 : endif 206 : endif 207 : * 208 : if (ipmsta.gt.0) then 209 : N = nst0 210 : mpoval = ipost0 211 : do ii = 1,N 212 : vpocha(ii,jj) = prog(JG0 + ii)*effx 213 : if (ifomod.eq.6) then 214 : vpocha(ii,jj) = vpocha(ii,jj) - 215 : & (effx*mlree1.prog(JG0 + ii)*omef*omef) 216 : if (jj.eq.2) vpocha(ii,jj) = vpocha(ii,jj) * (-1) 217 : if (lamcr.gt.0) then 218 : if (mlree2.prog(JG0 + ii).ne.0..and.epstf(/1).gt.1) then 219 : vpocha(ii,jj) = vpocha(ii,jj) + 220 : &omef*mlree2.prog(JG0 + ii)*epstf(j2) 221 : endif 222 : endif 223 : endif 224 : c write(6,*)'s',effx,ii,ipt1.num(1,ii),mlree2.prog(JG0 +ii), 225 : c &vpocha(ii,1),ipchpo 226 : enddo 227 : c write(6,*)'s',(mlree2.prog(JG0+ii),ii=1,N),(vpocha(ii,jj),ii=1,N) 228 : if (jj.eq.epstf(/1)) SEGDES,MPOVAL 229 : endif 230 : 231 : 212 CONTINUE 232 : * ENDDO 233 : 234 : if (IPCHPO.gt.0) segdes MCHPOI 235 : sigf(2) = IPCHPO 236 : c write(6,*) cmate,epstf(/1),epstf(1),epstf(2) 237 : c write(6,*)'c2',cmate,sigf(/1),jj,(sigf(ll),ll = 1,sigf(/1)) 238 : segdes mlreel 239 : if (ifomod.eq.6) then 240 : segdes mlree1 241 : if (lamcr.gt.0) segdes mlree2 242 : endif 243 : return 244 : ENDIF 245 : 246 : 247 : IF (cmate.EQ.'IMPELAST'.or.cmate.eq.'IMPVOIGT') THEN 248 : xraid = xmat(1) 249 : 250 : do ig = 1,epstf(/1) 251 : sigf(ig) = xraid * epstf(ig) 252 : enddo 253 : c write(6,*) 'cmoda2', (sigf(ll), ll = 1,3) 254 : IF (cmate.eq.'IMPVOIGT') THEN 255 : xvisc = xmat(2) 256 : do ig = 1,epstf(/1) 257 : sigf(ig) = sigf(ig) + (xvisc* (epstf(ig) - epst0(ig)) / xdt) 258 : enddo 259 : ENDIF 260 : IF (mele.eq.45) THEN 261 : ENDIF 262 : ENDIF 263 : 264 : 265 : IF (cmate.EQ.'IMPMAXWE') THEN 266 : xraid = xmat(1) 267 : xvisc = xmat(2) 268 : do ig = 1,epstf(/1) 269 : xepe0 = var0(ig) 270 : 271 : if (xdt.ne.0) then 272 : xx = (epstf(ig) - epst0(ig) + xepe0) * xvisc / xdt 273 : yy = (xraid + (xvisc /xdt)) 274 : varf(ig) = xx / yy 275 : sigf(ig) = varf(ig) * xraid 276 : else 277 : varf(ig) = var0(ig) 278 : sigf(ig) = xraid * epstf(ig) 279 : endif 280 : enddo 281 : c write(6,*) 'cmoda2',ib,igau, xraid,xvisc,epst0(1),xdt,sigf(1),varf(1) 282 : ENDIF 283 : 284 : if(ifomod.eq.6) then 285 : IF (cmate.EQ.'IMPCOMPL') THEN 286 : xraid = xmat(2) 287 : xamo1 = xmat(3) 288 : xmass1 = xmat(4) 289 : omef = 2.*xpi*tempf 290 : c write(6,*) 'ccompl', xraid,xamo1,xmass1,epstf(/1),sigf(/1) 291 : do ig = 1,epstf(/1) 292 : if (ig.eq.1) j2 = 2 293 : if (ig.eq.2) j2 = 1 294 : effx = epstf(ig) 295 : sigf(ig) = xraid * epstf(ig) 296 : if(xmass1.gt.0) then 297 : sigf(1) = sigf(1) - (effx * xmass1 * omef * omef) 298 : * write(6,*) sigf(1), effx, xmass1 , (omef*omef) 299 : endif 300 : if (ig.eq.2) sigf(ig) = sigf(ig)*(-1) 301 : if (xamo1.ne.0.) sigf(ig) = sigf(ig) + xamo1*omef*epstf(j2) 302 : enddo 303 : c write(6,*) (epstf(ij),ij=1,2),(sigf(ij),ij=1,2) 304 : ENDIF 305 : endif 306 : 307 : RETURN 308 : END 309 : 310 : 311 : 312 : 313 : 314 : 315 : 316 : 317 : 318 : 319 :
© Cast3M 2003 - All rights reserved.
Disclaimer