C VISAVI SOURCE OF166741 25/11/04 21:16:11 12349 SUBROUTINE VISAVI(SIG0,DSIGT,VARIN0,SIGMA,DSIGMA,SPHER,AUXIL, .SIGF,DEFP,VARINF,SIGFIN,DEFPLA,DSIGZE,ICENT2,MCOD,IBOU,MFR, .NSTRS,CARAC,CMATE,ecou,necou) c-------------------------------------------------------------------- c correspondance ca2000 - inca c-------------------------------------------------------------------- IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC TECOU DIMENSION SIG0(*),DSIGT(*),VARIN0(*),SIGF(*),DEFP(*),VARINF(*), . SIGMA(*),DSIGMA(*),SPHER(*),AUXIL(*),DSIGZE(*),SIGFIN(*), . DEFPLA(*),CARAC(*) c c mcod = 1 correspondance en entree c mcod = 2 correspondance en sortie c CHARACTER*(*) CMATE DIMENSION NNN(14) DATA NNN / 6,6,3,3,6,4,6,1,6,3,6,6,6,3 / IFOURL = necou.IFOURB * GO TO (9001,9002),MCOD c * 9001 CONTINUE c---------------------------------------------------------------------- c correspondance ( mfr,ifourl) et ityp czzzz a completer c---------------------------------------------------------------------- c IF (MFR.EQ.1.OR.MFR.EQ.31) THEN c as : IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.63) THEN IF (IFOURL.EQ.-2) ITYP=6 IF (IFOURL.EQ.-3) ITYP=1 IF (IFOURL.GE.-1.AND.IFOURL.LE.2) ITYP=1 IF (IFOURL.GE.3.AND.IFOURL.LE.15) ITYP=14 ENDIF * * test en cas de materiau unidirectionnel * IF(CMATE.EQ.'UNIDIREC'.AND.MFR.EQ.1) ITYP=8 IF(MFR.EQ.33.AND.IFOURL.EQ.-2) ITYP=6 IF(MFR.EQ.33.AND.IFOURL.GE.-1) ITYP=1 IF(MFR.EQ.3.AND.IFOURL.NE.-2) ITYP=2 IF(MFR.EQ.3.AND.IFOURL.EQ.-2) ITYP=7 IF(MFR.EQ.5) ITYP=13 IF(MFR.EQ.7) ITYP=11 IF(MFR.EQ.9) ITYP= 2 c cas du coq4 : on ne travaille que sur les 6-eres composantes IF(MFR.EQ.13) ITYP=12 IF(MFR.EQ.25) ITYP=3 IF(MFR.EQ.27.OR.MFR.EQ.49) ITYP=4 c-------------------------------------------------------------------- c on commence par tout mettre a 0. c-------------------------------------------------------------------- IF(ITYP.EQ.0) RETURN IBOU=NNN(ITYP) IBM=NSTRS IF(MFR.EQ.9.AND.IFOURL.GT.0) IBM=IBOU GO TO (9001,9002),MCOD c 9001 CONTINUE c DO 8816 IB=1,IBOU IF(IRELAX.NE.0) THEN SIPLAD(IB)=0.D0 DSIGZE(IB)=0.D0 ENDIF SIGMA(IB)=0.D0 DSIGMA(IB)=0.D0 IF(ICINE.EQ.0) GO TO 8816 SPHER(IB)=0.D0 IF(ICENT2.EQ.0) GO TO 8816 AUXIL(IB)=0.D0 8816 CONTINUE c GO TO(101,102,101,104,105,101,102,101,109,110, . 101,101,113,101),ITYP c 101 CONTINUE IF(IRELAX.NE.0) THEN DO 135 IB=1,NSTRS SIPLAD(IB)=VARIN0(2) DSIGZE(IB)=VARIN0(1+IB+2*NSTRS) 135 CONTINUE ENDIF c DO IB=1,IBM SIGMA(IB)=SIG0(IB) DSIGMA(IB)=DSIGT(IB) IF(ICINE.EQ.0) GO TO 136 IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 136 SPHER(IB)=VARIN0(IB+1) IF(ICENT2.EQ.0) GO TO 136 AUXIL(IB)=VARIN0(NSTRS+1+IB) SPHER(IB)=SPHER(IB)+AUXIL(IB) 136 CONTINUE ENDDO GO TO 199 c 102 CONTINUE EP1=CARAC(1) EP2=CARAC(1)*CARAC(1)/6.D0 IF(IFOURL.GT.0) GO TO 1870 IF(IRELAX.NE.0) THEN JB=0 DO IB=1,IBOU IF(IB.EQ.3.OR.IB.EQ.6) GO TO 1836 JB=JB+1 SIPLAD(IB)=VARIN0(2) 1836 CONTINUE DSIGZE(IB)=VARIN0(1+JB+2*NSTRS) ENDDO ENDIF c JB=0 IBO2=IBOU/2 JB2=NSTRS/2 DO 1838 IB=1,2 JB=JB+1 SIGMA(IB)=SIG0(JB)/EP1 SIGMA(IB+IBO2)=SIG0(JB+JB2)/EP2 DSIGMA(IB)=DSIGT(JB)/EP1 DSIGMA(IB+IBO2)=DSIGT(JB+JB2)/EP2 IF(ICINE.EQ.0) GO TO 1838 IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 1838 SPHER(IB)=VARIN0(JB+1)/EP1 SPHER(IB+IBO2)=VARIN0(JB+JB2+1)/EP2 IF(ICENT2.EQ.0) GO TO 1838 AUXIL(IB)=VARIN0(NSTRS+1+JB)/EP1 AUXIL(IB+IBO2)=VARIN0(NSTRS+1+JB+JB2)/EP2 SPHER(IB)=SPHER(IB)+AUXIL(IB) SPHER(IB+IBO2)=SPHER(IB+IBO2)+AUXIL(IB+IBO2) 1838 CONTINUE GO TO 199 c 1870 CONTINUE IF(IRELAX.NE.0) THEN DO 137 IB=1,NSTRS SIPLAD(IB)=VARIN0(2) DSIGZE(IB)=VARIN0(1+IB+2*NSTRS) 137 CONTINUE ENDIF c IBO2=IBOU/2 DO 138 IB=1,IBO2 SIGMA(IB)=SIG0(IB)/EP1 SIGMA(IB+IBO2)=SIG0(IB+IBO2)/EP2 DSIGMA(IB)=DSIGT(IB)/EP1 DSIGMA(IB+IBO2)=DSIGT(IB+IBO2)/EP2 IF(ICINE.EQ.0) GO TO 138 IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 138 SPHER(IB)=VARIN0(IB+1)/EP1 SPHER(IB+IBO2)=VARIN0(IB+1+IBO2)/EP2 IF(ICENT2.EQ.0) GO TO 138 AUXIL(IB)=VARIN0(NSTRS+1+IB)/EP1 AUXIL(IB+IBO2)=VARIN0(NSTRS+1+IB+IBO2)/EP2 SPHER(IB)=SPHER(IB)+AUXIL(IB) SPHER(IB+IBO2)=SPHER(IB+IBO2)+AUXIL(IB+IBO2) 138 CONTINUE GO TO 199 c 104 CONTINUE IF(IRELAX.NE.0) THEN SIPLAD(3)=VARIN0(2) DSIGZE(3)=VARIN0(2+2*NSTRS) ENDIF c SIGMA(3)=SIG0(1) DSIGMA(3)=DSIGT(1) IF(ICINE.EQ.0) GO TO 436 IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 436 SPHER(3)=VARIN0(2) IF(ICENT2.EQ.0) GO TO 436 AUXIL(3)=VARIN0(NSTRS+2) SPHER(3)=SPHER(3)+AUXIL(3) 436 CONTINUE GO TO 199 c 105 CONTINUE GO TO 199 c 109 CONTINUE GO TO 199 c 110 CONTINUE GO TO 199 c 113 CONTINUE IF(IRELAX.NE.0) THEN JB=0 DO 166 IB=1,IBOU IF(IB.EQ.3) GO TO 166 JB=JB+1 SIPLAD(IB)=VARIN0(2) DSIGZE(IB)=VARIN0(1+JB+2*NSTRS) 166 continue ENDIF c JB=0 DO 168 IB=1,IBOU IF(IB.EQ.3) GO TO 168 JB=JB+1 SIGMA(IB)=SIG0(JB) DSIGMA(IB)=DSIGT(JB) IF(ICINE.EQ.0) GO TO 168 IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 168 SPHER(IB)=VARIN0(JB+1) IF(ICENT2.EQ.0) GO TO 168 AUXIL(IB)=VARIN0(NSTRS+1+JB) SPHER(IB)=SPHER(IB)+AUXIL(IB) 168 CONTINUE GO TO 199 c 199 RETURN c 9002 CONTINUE c GO TO(201,202,201,204,205,201,202,201,209,210, . 201,201,213,201),ITYP c 201 CONTINUE DO 281 IB=1,IBM SIGF(IB)=SIGFIN(IB) DEFP(IB)=DEFPLA(IB) IF(ICINE.EQ.0) GO TO 281 IF(LFLUAG.EQ.1) GO TO 281 VARINF(1+IB)=SPHER(IB) IF (ICENT2.NE.0) VARINF(NSTRS+1+IB)=AUXIL(IB) 281 CONTINUE GO TO 299 c 202 CONTINUE EP1=CARAC(1) EP2=CARAC(1)*CARAC(1)/6.D0 IF(IFOURL.GT.0) GO TO 2870 JB=0 IBO2=IBOU/2 JB2=NSTRS/2 DO 2282 IB=1,2 JB=JB+1 SIGF(JB)=SIGFIN(IB)*EP1 SIGF(JB+JB2)=SIGFIN(IB+IBO2)*EP2 DEFP(JB)=DEFPLA(IB) DEFP(JB+JB2)=2*DEFPLA(IB+IBO2)/EP1 IF(ICINE.EQ.0) GO TO 2282 IF(LFLUAG.EQ.1) GO TO 2282 VARINF(1+JB)=SPHER(IB)*EP1 VARINF(1+JB+JB2)=SPHER(IB+IBO2)*EP2 IF(ICENT2.NE.0) THEN VARINF(NSTRS+1+JB)=AUXIL(IB)*EP1 VARINF(NSTRS+1+JB+JB2)=AUXIL(IB+IBO2)*EP2 ENDIF 2282 CONTINUE GO TO 299 c 2870 CONTINUE IBO2=IBOU/2 DO 282 IB=1,IBO2 SIGF(IB)=SIGFIN(IB)*EP1 SIGF(IB+IBO2)=SIGFIN(IB+IBO2)*EP2 DEFP(IB)=DEFPLA(IB) DEFP(IB+IBO2)=2*DEFPLA(IB+IBO2)/EP1 IF(ICINE.EQ.0) GO TO 282 IF(LFLUAG.EQ.1) GO TO 282 VARINF(1+IB)=SPHER(IB)*EP1 VARINF(1+IB+IBO2)=SPHER(IB+IBO2)*EP2 IF(ICENT2.NE.0) THEN VARINF(NSTRS+1+IB)=AUXIL(IB)*EP1 VARINF(NSTRS+1+IB+IBO2)=AUXIL(IB+IBO2)*EP2 ENDIF 282 CONTINUE IF(MFR.NE.9) GO TO 299 IBM1=IBM+1 DO 2821 IB=IBM1,NSTRS SIGF(IB)=SIG0(IB)+DSIGT(IB) DEFP(IB)=0.D0 IF(ICINE.EQ.0) GO TO 2821 IF(LFLUAG.EQ.1) GO TO 2821 VARINF(1+IB)=0.D0 IF(ICENT2.NE.0) VARINF(NSTRS+1+IB)=0.D0 2821 CONTINUE GO TO 299 c 204 CONTINUE SIGF(1)=SIGFIN(3) DEFP(1)=DEFPLA(3) IF(ICINE.EQ.0) GO TO 481 IF(LFLUAG.EQ.1) GO TO 481 VARINF(2)=SPHER(3) IF(ICENT2.NE.0) VARINF(NSTRS+2)=AUXIL(3) 481 CONTINUE GO TO 299 c 205 CONTINUE GO TO 299 c 209 CONTINUE GO TO 299 c 210 CONTINUE GO TO 299 c 213 CONTINUE JB=0 DO 681 IB=1,IBOU IF(IB.EQ.3) GO TO 681 JB=JB+1 SIGF(JB)=SIGFIN(IB) DEFP(JB)=DEFPLA(IB) IF(ICINE.EQ.0) GO TO 681 IF(LFLUAG.EQ.1) GO TO 681 VARINF(1+JB)=SPHER(IB) IF(ICENT2.NE.0) VARINF(NSTRS+1+JB)=AUXIL(IB) 681 CONTINUE GO TO 299 c 299 RETURN END