1 : C VISAVI SOURCE BP208322 09/03/25 21:16:09 6343 2 : SUBROUTINE VISAVI(SIG0,DSIGT,VARIN0,SIGMA,DSIGMA,SPHER,AUXIL, 3 : .SIGF,DEFP,VARINF,SIGFIN,DEFPLA,DSIGZE,ICENT2,MCOD,IBOU,MFR, 4 : .NSTRS,CARAC,CMATE,ecou,necou) 5 : c-------------------------------------------------------------------- 6 : c correspondance ca2000 - inca 7 : c-------------------------------------------------------------------- 8 : IMPLICIT INTEGER(I-N) 9 : IMPLICIT REAL*8(A-H,O-Z) 10 : DIMENSION SIG0(*),DSIGT(*),VARIN0(*),SIGF(*),DEFP(*),VARINF(*), 11 : . SIGMA(*),DSIGMA(*),SPHER(*),AUXIL(*),DSIGZE(*),SIGFIN(*), 12 : . DEFPLA(*),CARAC(*) 13 : c 14 : c mcod = 1 correspondance en entree 15 : c mcod = 2 correspondance en sortie 16 : c 17 : SEGMENT ECOU 18 : *** COMMON/ECOU/TEST,ALFAH, 19 : REAL*8 TEST, ALFAH, 20 : 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6), 21 : 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6), 22 : 1 DALPHA(6),DSIGO(6),E(12),XINV(3), 23 : 2 SIPLAD(6),DSIGP0(6),TET,TETI 24 : ENDSEGMENT 25 : C COMMON/ECOU/TEST,ALFAH, 26 : C 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6), 27 : C 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6), 28 : C 1 DALPHA(6),DSIGO(6),E(12),XINV(3), 29 : C 2 SIPLAD(6),DSIGP0(6),TET,TETI 30 : c 31 : SEGMENT NECOU 32 : * COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 33 : INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 34 : . ITYP,IFOUR,IFLUAG, 35 : . ICINE,ITHER,IFLUPL,ICYCL,IBI, 36 : . JFLUAG,KFLUAG,LFLUAG, 37 : . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF 38 : ENDSEGMENT 39 : C COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO, 40 : C . ITYP,IFOUR,IFLUAG, 41 : C . ICINE,ITHER,IFLUPL,ICYCL,IBI, 42 : C . JFLUAG,KFLUAG,LFLUAG, 43 : C . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF 44 : * 45 : CHARACTER*8 CMATE 46 : * 47 : 48 : DIMENSION NNN(14) 49 : DATA NNN / 6,6,3,3,6,4,6,1,6,3,6,6,6,3 / 50 : 51 : * GO TO (9001,9002),MCOD 52 : c 53 : * 9001 CONTINUE 54 : c---------------------------------------------------------------------- 55 : c correspondance ( mfr,ifour) et ityp 56 : czzzz a completer 57 : c---------------------------------------------------------------------- 58 : c IF (MFR.EQ.1.OR.MFR.EQ.31) THEN 59 : c as : 60 : IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.63) THEN 61 : IF (IFOUR.EQ.-2) ITYP=6 62 : IF (IFOUR.EQ.-3) ITYP=1 63 : IF (IFOUR.GE.-1.AND.IFOUR.LE.2) ITYP=1 64 : IF (IFOUR.GE.3.AND.IFOUR.LE.15) ITYP=14 65 : ENDIF 66 : * 67 : * test en cas de materiau unidirectionnel 68 : * 69 : IF(CMATE.EQ.'UNIDIREC'.AND. 70 : $ MFR.EQ.1) ITYP=8 71 : IF(MFR.EQ.33.AND.IFOUR.EQ.-2) ITYP=6 72 : IF(MFR.EQ.33.AND.IFOUR.GE.-1) ITYP=1 73 : IF(MFR.EQ.3.AND.IFOUR.NE.-2) ITYP=2 74 : IF(MFR.EQ.3.AND.IFOUR.EQ.-2) ITYP=7 75 : IF(MFR.EQ.5) ITYP=13 76 : IF(MFR.EQ.7) ITYP=11 77 : IF(MFR.EQ.9) ITYP= 2 78 : c cas du coq4 : on ne travaille que sur les 6-eres composantes 79 : IF(MFR.EQ.13) ITYP=12 80 : IF(MFR.EQ.25) ITYP=3 81 : IF(MFR.EQ.27.OR.MFR.EQ.49) ITYP=4 82 : c-------------------------------------------------------------------- 83 : c on commence par tout mettre a 0. 84 : c-------------------------------------------------------------------- 85 : IF(ITYP.EQ.0) RETURN 86 : IBOU=NNN(ITYP) 87 : IBM=NSTRS 88 : IF(MFR.EQ.9.AND.IFOUR.GT.0) IBM=IBOU 89 : 90 : 91 : GO TO (9001,9002),MCOD 92 : c 93 : 9001 CONTINUE 94 : c 95 : DO 8816 IB=1,IBOU 96 : IF(IRELAX.NE.0) THEN 97 : SIPLAD(IB)=0.D0 98 : DSIGZE(IB)=0.D0 99 : ENDIF 100 : SIGMA(IB)=0.D0 101 : DSIGMA(IB)=0.D0 102 : IF(ICINE.EQ.0) GO TO 8816 103 : SPHER(IB)=0.D0 104 : IF(ICENT2.EQ.0) GO TO 8816 105 : AUXIL(IB)=0.D0 106 : 8816 CONTINUE 107 : c 108 : GO TO(101,102,101,104,105,101,102,101,109,110, 109 : . 101,101,113,101),ITYP 110 : c 111 : 101 CONTINUE 112 : IF(IRELAX.NE.0) THEN 113 : DO 135 IB=1,NSTRS 114 : SIPLAD(IB)=VARIN0(2) 115 : 135 DSIGZE(IB)=VARIN0(1+IB+2*NSTRS) 116 : ENDIF 117 : c 118 : DO 136 IB=1,IBM 119 : SIGMA(IB)=SIG0(IB) 120 : DSIGMA(IB)=DSIGT(IB) 121 : IF(ICINE.EQ.0) GO TO 136 122 : IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 136 123 : SPHER(IB)=VARIN0(IB+1) 124 : IF(ICENT2.EQ.0) GO TO 136 125 : AUXIL(IB)=VARIN0(NSTRS+1+IB) 126 : SPHER(IB)=SPHER(IB)+AUXIL(IB) 127 : 136 CONTINUE 128 : GO TO 199 129 : c 130 : 102 CONTINUE 131 : EP1=CARAC(1) 132 : EP2=CARAC(1)*CARAC(1)/6.D0 133 : IF(IFOUR.GT.0) GO TO 1870 134 : IF(IRELAX.NE.0) THEN 135 : JB=0 136 : DO 1836 IB=1,IBOU 137 : IF(IB.EQ.3.OR.IB.EQ.6) GO TO 1836 138 : JB=JB+1 139 : SIPLAD(IB)=VARIN0(2) 140 : 1836 DSIGZE(IB)=VARIN0(1+JB+2*NSTRS) 141 : ENDIF 142 : c 143 : JB=0 144 : IBO2=IBOU/2 145 : JB2=NSTRS/2 146 : DO 1838 IB=1,2 147 : JB=JB+1 148 : SIGMA(IB)=SIG0(JB)/EP1 149 : SIGMA(IB+IBO2)=SIG0(JB+JB2)/EP2 150 : DSIGMA(IB)=DSIGT(JB)/EP1 151 : DSIGMA(IB+IBO2)=DSIGT(JB+JB2)/EP2 152 : IF(ICINE.EQ.0) GO TO 1838 153 : IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 1838 154 : SPHER(IB)=VARIN0(JB+1)/EP1 155 : SPHER(IB+IBO2)=VARIN0(JB+JB2+1)/EP2 156 : IF(ICENT2.EQ.0) GO TO 1838 157 : AUXIL(IB)=VARIN0(NSTRS+1+JB)/EP1 158 : AUXIL(IB+IBO2)=VARIN0(NSTRS+1+JB+JB2)/EP2 159 : SPHER(IB)=SPHER(IB)+AUXIL(IB) 160 : SPHER(IB+IBO2)=SPHER(IB+IBO2)+AUXIL(IB+IBO2) 161 : 1838 CONTINUE 162 : GO TO 199 163 : c 164 : 1870 CONTINUE 165 : IF(IRELAX.NE.0) THEN 166 : DO 137 IB=1,NSTRS 167 : SIPLAD(IB)=VARIN0(2) 168 : 137 DSIGZE(IB)=VARIN0(1+IB+2*NSTRS) 169 : ENDIF 170 : c 171 : IBO2=IBOU/2 172 : DO 138 IB=1,IBO2 173 : SIGMA(IB)=SIG0(IB)/EP1 174 : SIGMA(IB+IBO2)=SIG0(IB+IBO2)/EP2 175 : DSIGMA(IB)=DSIGT(IB)/EP1 176 : DSIGMA(IB+IBO2)=DSIGT(IB+IBO2)/EP2 177 : IF(ICINE.EQ.0) GO TO 138 178 : IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 138 179 : SPHER(IB)=VARIN0(IB+1)/EP1 180 : SPHER(IB+IBO2)=VARIN0(IB+1+IBO2)/EP2 181 : IF(ICENT2.EQ.0) GO TO 138 182 : AUXIL(IB)=VARIN0(NSTRS+1+IB)/EP1 183 : AUXIL(IB+IBO2)=VARIN0(NSTRS+1+IB+IBO2)/EP2 184 : SPHER(IB)=SPHER(IB)+AUXIL(IB) 185 : SPHER(IB+IBO2)=SPHER(IB+IBO2)+AUXIL(IB+IBO2) 186 : 138 CONTINUE 187 : GO TO 199 188 : c 189 : 104 CONTINUE 190 : IF(IRELAX.NE.0) THEN 191 : SIPLAD(3)=VARIN0(2) 192 : DSIGZE(3)=VARIN0(2+2*NSTRS) 193 : ENDIF 194 : c 195 : SIGMA(3)=SIG0(1) 196 : DSIGMA(3)=DSIGT(1) 197 : IF(ICINE.EQ.0) GO TO 436 198 : IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 436 199 : SPHER(3)=VARIN0(2) 200 : IF(ICENT2.EQ.0) GO TO 436 201 : AUXIL(3)=VARIN0(NSTRS+2) 202 : SPHER(3)=SPHER(3)+AUXIL(3) 203 : 436 CONTINUE 204 : GO TO 199 205 : c 206 : 105 CONTINUE 207 : GO TO 199 208 : c 209 : 109 CONTINUE 210 : GO TO 199 211 : c 212 : 110 CONTINUE 213 : GO TO 199 214 : c 215 : 113 CONTINUE 216 : IF(IRELAX.NE.0) THEN 217 : JB=0 218 : DO 166 IB=1,IBOU 219 : IF(IB.EQ.3) GO TO 166 220 : JB=JB+1 221 : SIPLAD(IB)=VARIN0(2) 222 : DSIGZE(IB)=VARIN0(1+JB+2*NSTRS) 223 : 166 continue 224 : ENDIF 225 : c 226 : JB=0 227 : DO 168 IB=1,IBOU 228 : IF(IB.EQ.3) GO TO 168 229 : JB=JB+1 230 : SIGMA(IB)=SIG0(JB) 231 : DSIGMA(IB)=DSIGT(JB) 232 : IF(ICINE.EQ.0) GO TO 168 233 : IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 168 234 : SPHER(IB)=VARIN0(JB+1) 235 : IF(ICENT2.EQ.0) GO TO 168 236 : AUXIL(IB)=VARIN0(NSTRS+1+JB) 237 : SPHER(IB)=SPHER(IB)+AUXIL(IB) 238 : 168 CONTINUE 239 : GO TO 199 240 : c 241 : 199 RETURN 242 : c 243 : 9002 CONTINUE 244 : c 245 : GO TO(201,202,201,204,205,201,202,201,209,210, 246 : . 201,201,213,201),ITYP 247 : c 248 : 201 CONTINUE 249 : DO 281 IB=1,IBM 250 : SIGF(IB)=SIGFIN(IB) 251 : DEFP(IB)=DEFPLA(IB) 252 : IF(ICINE.EQ.0) GO TO 281 253 : IF(LFLUAG.EQ.1) GO TO 281 254 : VARINF(1+IB)=SPHER(IB) 255 : IF (ICENT2.NE.0) VARINF(NSTRS+1+IB)=AUXIL(IB) 256 : 281 CONTINUE 257 : GO TO 299 258 : c 259 : 202 CONTINUE 260 : EP1=CARAC(1) 261 : EP2=CARAC(1)*CARAC(1)/6.D0 262 : IF(IFOUR.GT.0) GO TO 2870 263 : JB=0 264 : IBO2=IBOU/2 265 : JB2=NSTRS/2 266 : DO 2282 IB=1,2 267 : JB=JB+1 268 : SIGF(JB)=SIGFIN(IB)*EP1 269 : SIGF(JB+JB2)=SIGFIN(IB+IBO2)*EP2 270 : DEFP(JB)=DEFPLA(IB) 271 : DEFP(JB+JB2)=2*DEFPLA(IB+IBO2)/EP1 272 : IF(ICINE.EQ.0) GO TO 2282 273 : IF(LFLUAG.EQ.1) GO TO 2282 274 : VARINF(1+JB)=SPHER(IB)*EP1 275 : VARINF(1+JB+JB2)=SPHER(IB+IBO2)*EP2 276 : IF(ICENT2.NE.0) THEN 277 : VARINF(NSTRS+1+JB)=AUXIL(IB)*EP1 278 : VARINF(NSTRS+1+JB+JB2)=AUXIL(IB+IBO2)*EP2 279 : ENDIF 280 : 2282 CONTINUE 281 : GO TO 299 282 : c 283 : 2870 CONTINUE 284 : IBO2=IBOU/2 285 : DO 282 IB=1,IBO2 286 : SIGF(IB)=SIGFIN(IB)*EP1 287 : SIGF(IB+IBO2)=SIGFIN(IB+IBO2)*EP2 288 : DEFP(IB)=DEFPLA(IB) 289 : DEFP(IB+IBO2)=2*DEFPLA(IB+IBO2)/EP1 290 : IF(ICINE.EQ.0) GO TO 282 291 : IF(LFLUAG.EQ.1) GO TO 282 292 : VARINF(1+IB)=SPHER(IB)*EP1 293 : VARINF(1+IB+IBO2)=SPHER(IB+IBO2)*EP2 294 : IF(ICENT2.NE.0) THEN 295 : VARINF(NSTRS+1+IB)=AUXIL(IB)*EP1 296 : VARINF(NSTRS+1+IB+IBO2)=AUXIL(IB+IBO2)*EP2 297 : ENDIF 298 : 282 CONTINUE 299 : IF(MFR.NE.9) GO TO 299 300 : IBM1=IBM+1 301 : DO 2821 IB=IBM1,NSTRS 302 : SIGF(IB)=SIG0(IB)+DSIGT(IB) 303 : DEFP(IB)=0.D0 304 : IF(ICINE.EQ.0) GO TO 2821 305 : IF(LFLUAG.EQ.1) GO TO 2821 306 : VARINF(1+IB)=0.D0 307 : IF(ICENT2.NE.0) VARINF(NSTRS+1+IB)=0.D0 308 : 2821 CONTINUE 309 : GO TO 299 310 : c 311 : 204 CONTINUE 312 : SIGF(1)=SIGFIN(3) 313 : DEFP(1)=DEFPLA(3) 314 : IF(ICINE.EQ.0) GO TO 481 315 : IF(LFLUAG.EQ.1) GO TO 481 316 : VARINF(2)=SPHER(3) 317 : IF(ICENT2.NE.0) VARINF(NSTRS+2)=AUXIL(3) 318 : 481 CONTINUE 319 : GO TO 299 320 : c 321 : 205 CONTINUE 322 : GO TO 299 323 : c 324 : 209 CONTINUE 325 : GO TO 299 326 : c 327 : 210 CONTINUE 328 : GO TO 299 329 : c 330 : 213 CONTINUE 331 : JB=0 332 : DO 681 IB=1,IBOU 333 : IF(IB.EQ.3) GO TO 681 334 : JB=JB+1 335 : SIGF(JB)=SIGFIN(IB) 336 : DEFP(JB)=DEFPLA(IB) 337 : IF(ICINE.EQ.0) GO TO 681 338 : IF(LFLUAG.EQ.1) GO TO 681 339 : VARINF(1+JB)=SPHER(IB) 340 : IF(ICENT2.NE.0) VARINF(NSTRS+1+JB)=AUXIL(IB) 341 : 681 CONTINUE 342 : GO TO 299 343 : c 344 : 299 RETURN 345 : END 346 : 347 : 348 : 349 : 350 : 351 : 352 : 353 : 354 : 355 : 356 : 357 :
© Cast3M 2003 - All rights reserved.
Disclaimer