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    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.  
  358.  

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