Télécharger la plaquette Cast3M


fr en

Télécharger cmaxta.eso

Retour à la liste

Numérotation des lignes : 

cmaxta

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

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