Télécharger la plaquette Cast3M


fr en

Télécharger maxtra.eso

Retour à la liste

Numérotation des lignes : 

maxtra

  1. C MAXTRA    SOURCE    BP208322  17/03/01    21:17:53     9325           
  2.       SUBROUTINE MAXTRA(WRK0,WRK1,WRK5,WR12,WTRAV,IB,IGAU,NBGMAT,
  3.      &   NELMAT,NPINT,NWA,NSTRS,NCHAIN,CMATE,MFR)
  4. *
  5. *      MODELE DE MAXWELL  : RECUPERATION DES INFORMATIONS
  6. *
  7.       IMPLICIT INTEGER(I-N)
  8.       IMPLICIT REAL*8(A-H,O-Z)
  9. *
  10.  
  11. -INC PPARAM
  12. -INC CCOPTIO
  13. -INC SMEVOLL
  14. -INC SMLREEL
  15. -INC CCHAMP
  16. *
  17.       SEGMENT WRK0
  18.         REAL*8 XMAT(NCXMAT)
  19.       ENDSEGMENT
  20. *
  21.       SEGMENT WRK1
  22.         REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  23.         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  24.         REAL*8 DEFP(NSTRS),XCAR(ICARA)
  25.       ENDSEGMENT
  26. *
  27.       SEGMENT WRK5
  28.         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  29.       ENDSEGMENT
  30. *
  31.       SEGMENT WR12
  32.         REAL*8  EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3))
  33.         REAL*8  EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6))
  34.         REAL*8  EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9))
  35.         REAL*8  SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS)
  36.         REAL*8  SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS)
  37.         REAL*8  SM8(NSTRS)
  38.       ENDSEGMENT
  39. *
  40.       SEGMENT WTRAV
  41.         REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  42.         REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  43.         REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  44.         REAL*8 XLOC(3,3),XGLOB(3,3)
  45.         REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  46.       ENDSEGMENT
  47. *
  48.  
  49.  
  50.  
  51.       DIMENSION NWA(9),IPX(9),IPY(9)
  52.         CHARACTER*8 CMATE
  53. *
  54.             ncxmat=xmat(/1)
  55.              DO JC=1,9
  56.                NWA(JC)=0
  57.                IPX(JC)=0
  58.                IPY(JC)=0
  59.              END DO
  60. *
  61. ******* Cas d'une formulation isotrope
  62.       IF(CMATE.EQ.'ISOTROPE') THEN
  63. *            em0
  64.              MEVOLL=NINT(XMAT(3))
  65.              SEGACT MEVOLL
  66.              KEVOLL=IEVOLL(1)
  67.              SEGACT KEVOLL
  68.              MLREEL=IPROGX
  69.              IPX(1)=IPROGX
  70.              IPY(1)=IPROGY
  71.              SEGACT MLREEL
  72.              NWA(1)=PROG(/1)
  73.              SEGDES KEVOLL*NOMOD
  74.              SEGDES MEVOLL*NOMOD
  75. *
  76. *            em1 a em4
  77. *
  78.              KED=4
  79.              DO JC=2,5
  80.                MEVOLL=NINT(XMAT(KED))
  81.                KED=KED+2
  82.                SEGACT MEVOLL
  83.                KEVOLL=IEVOLL(1)
  84.                SEGACT KEVOLL
  85.                MLREEL=IPROGX
  86.                IPX(JC)=IPROGX
  87.                IPY(JC)=IPROGY
  88.                SEGACT MLREEL
  89.                NWA(JC)=PROG(/1)
  90.                SEGDES KEVOLL*NOMOD
  91.                SEGDES MEVOLL*NOMOD
  92.              END DO
  93. *
  94.              NCHAIN=5
  95.              JED=0
  96.              IF(IFOUR.EQ.-2) JED=1
  97.              KED=14+JED
  98.              DO JC=6,9
  99.                MEVOLL=NINT(XMAT(KED))
  100.                KED=KED+2
  101.                IF(MEVOLL.GT.0) THEN
  102.                  SEGACT MEVOLL
  103.                  KEVOLL=IEVOLL(1)
  104.                  SEGACT KEVOLL
  105.                  MLREEL=IPROGX
  106.                  IPX(JC)=IPROGX
  107.                  IPY(JC)=IPROGY
  108.                  SEGACT MLREEL
  109.                  NWA(JC)=PROG(/1)
  110.                  NCHAIN=NCHAIN+1
  111.                  SEGDES KEVOLL*NOMOD
  112.                  SEGDES MEVOLL*NOMOD
  113.                ENDIF
  114.              END DO
  115. *
  116. ******* Cas d'une formulation unidirectionnelle
  117.         ELSE IF(CMATE.EQ.'UNIDIREC') THEN
  118. *
  119.              JED=0
  120.              IF(IFOUR.EQ.2) JED=4
  121.  
  122. *            em0
  123.              MEVOLL=NINT(XMAT(4+JED))
  124.              SEGACT MEVOLL
  125.              KEVOLL=IEVOLL(1)
  126.              SEGACT KEVOLL
  127.              MLREEL=IPROGX
  128.              IPX(1)=IPROGX
  129.              IPY(1)=IPROGY
  130.              SEGACT MLREEL
  131.              NWA(1)=PROG(/1)
  132.              SEGDES KEVOLL*NOMOD
  133.              SEGDES MEVOLL*NOMOD
  134. *
  135. *            em1 a em4
  136. *
  137.              KED=5+JED
  138.              DO JC=2,5
  139.                MEVOLL=NINT(XMAT(KED))
  140.                KED=KED+2
  141.                SEGACT MEVOLL
  142.                KEVOLL=IEVOLL(1)
  143.                SEGACT KEVOLL
  144.                MLREEL=IPROGX
  145.                IPX(JC)=IPROGX
  146.                IPY(JC)=IPROGY
  147.                SEGACT MLREEL
  148.                NWA(JC)=PROG(/1)
  149.                SEGDES KEVOLL*NOMOD
  150.                SEGDES MEVOLL*NOMOD
  151.              END DO
  152. *
  153.              NCHAIN=5
  154.              JED=0
  155.              IF(IFOUR.EQ.-2) JED=1
  156.              IF(IFOUR.EQ. 2) JED=4
  157.              KED=15+JED
  158.              DO JC=6,9
  159.                MEVOLL=NINT(XMAT(KED))
  160.                KED=KED+2
  161.                IF(MEVOLL.GT.0) THEN
  162.                  SEGACT MEVOLL
  163.                  KEVOLL=IEVOLL(1)
  164.                  SEGACT KEVOLL
  165.                  MLREEL=IPROGX
  166.                  IPX(JC)=IPROGX
  167.                  IPY(JC)=IPROGY
  168.                  SEGACT MLREEL
  169.                  NWA(JC)=PROG(/1)
  170.                  NCHAIN=NCHAIN+1
  171.                  SEGDES KEVOLL*NOMOD
  172.                  SEGDES MEVOLL*NOMOD
  173.                ENDIF
  174.              END DO
  175.         ENDIF
  176. *
  177. *     creation du segment de travail
  178. *
  179.              SEGINI WR12
  180. *
  181. *     recuperation des proprietes materielles
  182. *     et des variables internes
  183. *     D'abord les composantes obligatoires
  184. *
  185.              DO JC=1,5
  186.                MLREEL=IPX(JC)
  187.                MLREE1=IPY(JC)
  188.                SEGACT MLREE1
  189.  
  190.                MLREE2=NINT(VAR0(JC+1))
  191.                SEGACT MLREE2
  192.                IF(JC.EQ.1) THEN
  193.                  DO JD=1,NWA(1)
  194.                    EM0(1,JD)=PROG(JD)
  195.                    EM0(2,JD)=MLREE1.PROG(JD)
  196.                  END DO
  197.                  DO JD=1,NSTRS
  198.                    SM0(JD)=MLREE2.PROG(JD)
  199.                  END DO
  200.                ELSE IF(JC.EQ.2) THEN
  201.                  DO JD=1,NWA(2)
  202.                    EM1(1,JD)=PROG(JD)
  203.                    EM1(2,JD)=MLREE1.PROG(JD)
  204.                  END DO
  205.                  DO JD=1,NSTRS
  206.                    SM1(JD)=MLREE2.PROG(JD)
  207.                  END DO
  208.                ELSE IF(JC.EQ.3) THEN
  209.                  DO JD=1,NWA(3)
  210.                    EM2(1,JD)=PROG(JD)
  211.                    EM2(2,JD)=MLREE1.PROG(JD)
  212.                  END DO
  213.                  DO JD=1,NSTRS
  214.                    SM2(JD)=MLREE2.PROG(JD)
  215.                  END DO
  216.                ELSE IF(JC.EQ.4) THEN
  217.                  DO JD=1,NWA(4)
  218.                    EM3(1,JD)=PROG(JD)
  219.                    EM3(2,JD)=MLREE1.PROG(JD)
  220.                  END DO
  221.                  DO JD=1,NSTRS
  222.                    SM3(JD)=MLREE2.PROG(JD)
  223.                  END DO
  224.                ELSE IF(JC.EQ.5) THEN
  225.                  DO JD=1,NWA(5)
  226.                    EM4(1,JD)=PROG(JD)
  227.                    EM4(2,JD)=MLREE1.PROG(JD)
  228.                  END DO
  229.                  DO JD=1,NSTRS
  230.                    SM4(JD)=MLREE2.PROG(JD)
  231.                  END DO
  232.                ENDIF
  233.              END DO
  234. *
  235. *       traitement des composantes facultatives
  236. *
  237.              DO JC=6,9
  238.                IF(IPX(JC).NE.0) THEN
  239.                  MLREEL=IPX(JC)
  240.                  MLREE1=IPY(JC)
  241.                  SEGACT MLREE1
  242.                  MLREE2=NINT(VAR0(JC+1))
  243.                  SEGACT MLREE2
  244.                  IF(JC.EQ.6) THEN
  245.                    DO JD=1,NWA(6)
  246.                      EM5(1,JD)=PROG(JD)
  247.                      EM5(2,JD)=MLREE1.PROG(JD)
  248.                    END DO
  249.                    DO JD=1,NSTRS
  250.                      SM5(JD)=MLREE2.PROG(JD)
  251.                    END DO
  252.                  ELSE IF(JC.EQ.7) THEN
  253.                    DO JD=1,NWA(7)
  254.                      EM6(1,JD)=PROG(JD)
  255.                      EM6(2,JD)=MLREE1.PROG(JD)
  256.                    END DO
  257.                    DO JD=1,NSTRS
  258.                      SM6(JD)=MLREE2.PROG(JD)
  259.                    END DO
  260.                 ELSE IF(JC.EQ.8) THEN
  261.                    DO JD=1,NWA(8)
  262.                      EM7(1,JD)=PROG(JD)
  263.                      EM7(2,JD)=MLREE1.PROG(JD)
  264.                    END DO
  265.                    DO JD=1,NSTRS
  266.                      SM7(JD)=MLREE2.PROG(JD)
  267.                    END DO
  268.                  ELSE IF(JC.EQ.9) THEN
  269.                    DO JD=1,NWA(9)
  270.                      EM8(1,JD)=PROG(JD)
  271.                      EM8(2,JD)=MLREE1.PROG(JD)
  272.                    END DO
  273.                    DO JD=1,NSTRS
  274.                      SM8(JD)=MLREE2.PROG(JD)
  275.                    END DO
  276.                  ENDIF
  277.                ENDIF
  278.              END DO
  279. *
  280. *   ROTATION DES TENSEURS SI BESOIN
  281. *
  282. *
  283. ******* Cas d'une formulation unidirectionnelle
  284. *
  285.  
  286.         IF(CMATE.EQ.'UNIDIREC') THEN
  287.  
  288.  
  289.           IF(MFR.EQ.1.OR.MFR.EQ.33) THEN
  290.              CALL MAXROT(WTRAV,MFR,IB,IGAU,NBGMAT,NELMAT,NPINT)
  291.              IF(IERR.NE.0) RETURN
  292.  
  293.              ICAS=1
  294.              CALL MAXRO2(ICAS,WTRAV,WRK1,WRK5,WR12,NCHAIN)
  295.  
  296.           ELSE
  297.              CALL ERREUR(251)
  298.              RETURN
  299.           ENDIF
  300.  
  301.         ENDIF
  302.  
  303. *
  304. *      DESACTIVATION DES SEGMENTS PROG
  305. *
  306.             DO  10 JC=1,9
  307. C# MC : la dimension est définie au départ = 9
  308.               IF (IPX(JC).EQ.0) GO TO 10
  309.                MLREEL=IPX(JC)
  310.                SEGDES MLREEL*NOMOD
  311.                MLREE1=IPY(JC)
  312.                SEGDES MLREE1*NOMOD
  313.                MLREE2=NINT(VAR0(JC+1))
  314.                SEGDES MLREE2*NOMOD
  315.   10        CONTINUE
  316. *
  317.       RETURN
  318.       END
  319.  
  320.  
  321.  
  322.  
  323.  
  324.  
  325.  
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  
  338.  
  339.  
  340.  
  341.  
  342.  
  343.  
  344.  

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