Télécharger la plaquette Cast3M


fr en

Télécharger visavi.eso

Retour à la liste

Numérotation des lignes : 

visavi

  1. C VISAVI    SOURCE    OF166741  25/11/04    21:16:11     12349          
  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.  
  11. -INC TECOU
  12.  
  13.       DIMENSION SIG0(*),DSIGT(*),VARIN0(*),SIGF(*),DEFP(*),VARINF(*),
  14.      . SIGMA(*),DSIGMA(*),SPHER(*),AUXIL(*),DSIGZE(*),SIGFIN(*),
  15.      . DEFPLA(*),CARAC(*)
  16. c
  17. c  mcod = 1  correspondance en entree
  18. c  mcod = 2  correspondance en sortie
  19. c
  20.       CHARACTER*(*) CMATE
  21.  
  22.       DIMENSION NNN(14)
  23.       DATA NNN / 6,6,3,3,6,4,6,1,6,3,6,6,6,3 /
  24.  
  25.       IFOURL = necou.IFOURB
  26. *      GO TO (9001,9002),MCOD
  27. c
  28. * 9001 CONTINUE
  29. c----------------------------------------------------------------------
  30. c  correspondance ( mfr,ifourl) et ityp
  31. czzzz   a completer
  32. c----------------------------------------------------------------------
  33. c       IF (MFR.EQ.1.OR.MFR.EQ.31) THEN
  34. c as :
  35.       IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.63) THEN
  36.         IF (IFOURL.EQ.-2) ITYP=6
  37.         IF (IFOURL.EQ.-3) ITYP=1
  38.         IF (IFOURL.GE.-1.AND.IFOURL.LE.2) ITYP=1
  39.         IF (IFOURL.GE.3.AND.IFOURL.LE.15) ITYP=14
  40.       ENDIF
  41. *
  42. *     test en cas de materiau unidirectionnel
  43. *
  44.       IF(CMATE.EQ.'UNIDIREC'.AND.MFR.EQ.1) ITYP=8
  45.       IF(MFR.EQ.33.AND.IFOURL.EQ.-2) ITYP=6
  46.       IF(MFR.EQ.33.AND.IFOURL.GE.-1) ITYP=1
  47.       IF(MFR.EQ.3.AND.IFOURL.NE.-2) ITYP=2
  48.       IF(MFR.EQ.3.AND.IFOURL.EQ.-2) ITYP=7
  49.       IF(MFR.EQ.5) ITYP=13
  50.       IF(MFR.EQ.7) ITYP=11
  51.       IF(MFR.EQ.9) ITYP= 2
  52. c  cas du coq4 : on ne travaille que sur les 6-eres composantes
  53.       IF(MFR.EQ.13) ITYP=12
  54.       IF(MFR.EQ.25) ITYP=3
  55.       IF(MFR.EQ.27.OR.MFR.EQ.49) ITYP=4
  56. c--------------------------------------------------------------------
  57. c  on commence par tout mettre a 0.
  58. c--------------------------------------------------------------------
  59.       IF(ITYP.EQ.0) RETURN
  60.       IBOU=NNN(ITYP)
  61.       IBM=NSTRS
  62.       IF(MFR.EQ.9.AND.IFOURL.GT.0) IBM=IBOU
  63.  
  64.       GO TO (9001,9002),MCOD
  65. c
  66.  9001 CONTINUE
  67. c
  68.       DO 8816 IB=1,IBOU
  69.         IF(IRELAX.NE.0) THEN
  70.           SIPLAD(IB)=0.D0
  71.           DSIGZE(IB)=0.D0
  72.         ENDIF
  73.         SIGMA(IB)=0.D0
  74.         DSIGMA(IB)=0.D0
  75.         IF(ICINE.EQ.0) GO TO 8816
  76.         SPHER(IB)=0.D0
  77.         IF(ICENT2.EQ.0) GO TO 8816
  78.         AUXIL(IB)=0.D0
  79.  8816 CONTINUE
  80. c
  81.       GO TO(101,102,101,104,105,101,102,101,109,110,
  82.      .      101,101,113,101),ITYP
  83. c
  84.  101  CONTINUE
  85.       IF(IRELAX.NE.0) THEN
  86.         DO 135 IB=1,NSTRS
  87.           SIPLAD(IB)=VARIN0(2)
  88.           DSIGZE(IB)=VARIN0(1+IB+2*NSTRS)
  89.   135   CONTINUE
  90.       ENDIF
  91. c
  92.       DO IB=1,IBM
  93.         SIGMA(IB)=SIG0(IB)
  94.         DSIGMA(IB)=DSIGT(IB)
  95.         IF(ICINE.EQ.0) GO TO 136
  96.         IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 136
  97.         SPHER(IB)=VARIN0(IB+1)
  98.         IF(ICENT2.EQ.0) GO TO 136
  99.         AUXIL(IB)=VARIN0(NSTRS+1+IB)
  100.         SPHER(IB)=SPHER(IB)+AUXIL(IB)
  101.   136   CONTINUE
  102.       ENDDO
  103.       GO TO 199
  104. c
  105.  102  CONTINUE
  106.       EP1=CARAC(1)
  107.       EP2=CARAC(1)*CARAC(1)/6.D0
  108.       IF(IFOURL.GT.0) GO TO 1870
  109.       IF(IRELAX.NE.0) THEN
  110.         JB=0
  111.         DO IB=1,IBOU
  112.           IF(IB.EQ.3.OR.IB.EQ.6) GO TO 1836
  113.           JB=JB+1
  114.           SIPLAD(IB)=VARIN0(2)
  115.  1836     CONTINUE
  116.           DSIGZE(IB)=VARIN0(1+JB+2*NSTRS)
  117.         ENDDO
  118.       ENDIF
  119. c
  120.       JB=0
  121.       IBO2=IBOU/2
  122.       JB2=NSTRS/2
  123.       DO 1838 IB=1,2
  124.       JB=JB+1
  125.       SIGMA(IB)=SIG0(JB)/EP1
  126.       SIGMA(IB+IBO2)=SIG0(JB+JB2)/EP2
  127.       DSIGMA(IB)=DSIGT(JB)/EP1
  128.       DSIGMA(IB+IBO2)=DSIGT(JB+JB2)/EP2
  129.       IF(ICINE.EQ.0) GO TO 1838
  130.       IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 1838
  131.       SPHER(IB)=VARIN0(JB+1)/EP1
  132.       SPHER(IB+IBO2)=VARIN0(JB+JB2+1)/EP2
  133.       IF(ICENT2.EQ.0) GO TO 1838
  134.       AUXIL(IB)=VARIN0(NSTRS+1+JB)/EP1
  135.       AUXIL(IB+IBO2)=VARIN0(NSTRS+1+JB+JB2)/EP2
  136.       SPHER(IB)=SPHER(IB)+AUXIL(IB)
  137.       SPHER(IB+IBO2)=SPHER(IB+IBO2)+AUXIL(IB+IBO2)
  138.  1838 CONTINUE
  139.       GO TO 199
  140. c
  141.  1870 CONTINUE
  142.       IF(IRELAX.NE.0) THEN
  143.       DO 137 IB=1,NSTRS
  144.         SIPLAD(IB)=VARIN0(2)
  145.         DSIGZE(IB)=VARIN0(1+IB+2*NSTRS)
  146.   137 CONTINUE
  147.       ENDIF
  148. c
  149.       IBO2=IBOU/2
  150.       DO 138 IB=1,IBO2
  151.       SIGMA(IB)=SIG0(IB)/EP1
  152.       SIGMA(IB+IBO2)=SIG0(IB+IBO2)/EP2
  153.       DSIGMA(IB)=DSIGT(IB)/EP1
  154.       DSIGMA(IB+IBO2)=DSIGT(IB+IBO2)/EP2
  155.       IF(ICINE.EQ.0) GO TO 138
  156.       IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 138
  157.       SPHER(IB)=VARIN0(IB+1)/EP1
  158.       SPHER(IB+IBO2)=VARIN0(IB+1+IBO2)/EP2
  159.       IF(ICENT2.EQ.0) GO TO 138
  160.       AUXIL(IB)=VARIN0(NSTRS+1+IB)/EP1
  161.       AUXIL(IB+IBO2)=VARIN0(NSTRS+1+IB+IBO2)/EP2
  162.       SPHER(IB)=SPHER(IB)+AUXIL(IB)
  163.       SPHER(IB+IBO2)=SPHER(IB+IBO2)+AUXIL(IB+IBO2)
  164.   138 CONTINUE
  165.       GO TO 199
  166. c
  167.  104  CONTINUE
  168.       IF(IRELAX.NE.0) THEN
  169.       SIPLAD(3)=VARIN0(2)
  170.       DSIGZE(3)=VARIN0(2+2*NSTRS)
  171.       ENDIF
  172. c
  173.       SIGMA(3)=SIG0(1)
  174.       DSIGMA(3)=DSIGT(1)
  175.       IF(ICINE.EQ.0) GO TO 436
  176.       IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 436
  177.       SPHER(3)=VARIN0(2)
  178.       IF(ICENT2.EQ.0) GO TO 436
  179.       AUXIL(3)=VARIN0(NSTRS+2)
  180.       SPHER(3)=SPHER(3)+AUXIL(3)
  181.   436 CONTINUE
  182.       GO TO 199
  183. c
  184.  105  CONTINUE
  185.       GO TO 199
  186. c
  187.  109  CONTINUE
  188.       GO TO 199
  189. c
  190.  110  CONTINUE
  191.       GO TO 199
  192. c
  193.  113  CONTINUE
  194.       IF(IRELAX.NE.0) THEN
  195.       JB=0
  196.       DO 166 IB=1,IBOU
  197.       IF(IB.EQ.3) GO TO 166
  198.       JB=JB+1
  199.       SIPLAD(IB)=VARIN0(2)
  200.       DSIGZE(IB)=VARIN0(1+JB+2*NSTRS)
  201. 166   continue
  202.       ENDIF
  203. c
  204.       JB=0
  205.       DO 168 IB=1,IBOU
  206.       IF(IB.EQ.3) GO TO 168
  207.       JB=JB+1
  208.       SIGMA(IB)=SIG0(JB)
  209.       DSIGMA(IB)=DSIGT(JB)
  210.       IF(ICINE.EQ.0) GO TO 168
  211.       IF(JFLUAG.EQ.1.AND.LFLUAG.EQ.1) GO TO 168
  212.       SPHER(IB)=VARIN0(JB+1)
  213.       IF(ICENT2.EQ.0) GO TO 168
  214.       AUXIL(IB)=VARIN0(NSTRS+1+JB)
  215.       SPHER(IB)=SPHER(IB)+AUXIL(IB)
  216.   168 CONTINUE
  217.       GO TO 199
  218. c
  219.  199  RETURN
  220. c
  221.  9002 CONTINUE
  222. c
  223.       GO TO(201,202,201,204,205,201,202,201,209,210,
  224.      .      201,201,213,201),ITYP
  225. c
  226.  201  CONTINUE
  227.       DO 281 IB=1,IBM
  228.       SIGF(IB)=SIGFIN(IB)
  229.       DEFP(IB)=DEFPLA(IB)
  230.       IF(ICINE.EQ.0) GO TO 281
  231.       IF(LFLUAG.EQ.1) GO TO 281
  232.       VARINF(1+IB)=SPHER(IB)
  233.       IF (ICENT2.NE.0) VARINF(NSTRS+1+IB)=AUXIL(IB)
  234.   281 CONTINUE
  235.       GO TO 299
  236. c
  237.  202  CONTINUE
  238.       EP1=CARAC(1)
  239.       EP2=CARAC(1)*CARAC(1)/6.D0
  240.       IF(IFOURL.GT.0) GO TO 2870
  241.       JB=0
  242.       IBO2=IBOU/2
  243.       JB2=NSTRS/2
  244.       DO 2282 IB=1,2
  245.       JB=JB+1
  246.       SIGF(JB)=SIGFIN(IB)*EP1
  247.       SIGF(JB+JB2)=SIGFIN(IB+IBO2)*EP2
  248.       DEFP(JB)=DEFPLA(IB)
  249.       DEFP(JB+JB2)=2*DEFPLA(IB+IBO2)/EP1
  250.       IF(ICINE.EQ.0) GO TO 2282
  251.       IF(LFLUAG.EQ.1) GO TO 2282
  252.       VARINF(1+JB)=SPHER(IB)*EP1
  253.       VARINF(1+JB+JB2)=SPHER(IB+IBO2)*EP2
  254.       IF(ICENT2.NE.0) THEN
  255.       VARINF(NSTRS+1+JB)=AUXIL(IB)*EP1
  256.       VARINF(NSTRS+1+JB+JB2)=AUXIL(IB+IBO2)*EP2
  257.       ENDIF
  258.  2282 CONTINUE
  259.       GO TO 299
  260. c
  261.  2870 CONTINUE
  262.       IBO2=IBOU/2
  263.       DO 282 IB=1,IBO2
  264.       SIGF(IB)=SIGFIN(IB)*EP1
  265.       SIGF(IB+IBO2)=SIGFIN(IB+IBO2)*EP2
  266.       DEFP(IB)=DEFPLA(IB)
  267.       DEFP(IB+IBO2)=2*DEFPLA(IB+IBO2)/EP1
  268.       IF(ICINE.EQ.0) GO TO 282
  269.       IF(LFLUAG.EQ.1) GO TO 282
  270.       VARINF(1+IB)=SPHER(IB)*EP1
  271.       VARINF(1+IB+IBO2)=SPHER(IB+IBO2)*EP2
  272.       IF(ICENT2.NE.0) THEN
  273.       VARINF(NSTRS+1+IB)=AUXIL(IB)*EP1
  274.       VARINF(NSTRS+1+IB+IBO2)=AUXIL(IB+IBO2)*EP2
  275.       ENDIF
  276.   282 CONTINUE
  277.       IF(MFR.NE.9) GO TO 299
  278.       IBM1=IBM+1
  279.       DO 2821 IB=IBM1,NSTRS
  280.       SIGF(IB)=SIG0(IB)+DSIGT(IB)
  281.       DEFP(IB)=0.D0
  282.       IF(ICINE.EQ.0) GO TO 2821
  283.       IF(LFLUAG.EQ.1) GO TO 2821
  284.       VARINF(1+IB)=0.D0
  285.       IF(ICENT2.NE.0) VARINF(NSTRS+1+IB)=0.D0
  286.  2821 CONTINUE
  287.       GO TO 299
  288. c
  289.  204  CONTINUE
  290.       SIGF(1)=SIGFIN(3)
  291.       DEFP(1)=DEFPLA(3)
  292.       IF(ICINE.EQ.0) GO TO 481
  293.       IF(LFLUAG.EQ.1) GO TO 481
  294.       VARINF(2)=SPHER(3)
  295.       IF(ICENT2.NE.0) VARINF(NSTRS+2)=AUXIL(3)
  296.   481 CONTINUE
  297.       GO TO 299
  298. c
  299.  205  CONTINUE
  300.       GO TO 299
  301. c
  302.  209  CONTINUE
  303.       GO TO 299
  304. c
  305.  210  CONTINUE
  306.       GO TO 299
  307. c
  308.  213  CONTINUE
  309.       JB=0
  310.       DO 681 IB=1,IBOU
  311.       IF(IB.EQ.3) GO TO 681
  312.       JB=JB+1
  313.       SIGF(JB)=SIGFIN(IB)
  314.       DEFP(JB)=DEFPLA(IB)
  315.       IF(ICINE.EQ.0) GO TO 681
  316.       IF(LFLUAG.EQ.1) GO TO 681
  317.       VARINF(1+JB)=SPHER(IB)
  318.       IF(ICENT2.NE.0) VARINF(NSTRS+1+JB)=AUXIL(IB)
  319.   681 CONTINUE
  320.       GO TO 299
  321. c
  322.  299  RETURN
  323.       END
  324.  
  325.  
  326.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales