Télécharger la plaquette Cast3M


fr en

Télécharger cmaxoa.eso

Retour à la liste

Numérotation des lignes : 

cmaxoa

  1. C CMAXOA    SOURCE    PV        17/12/08    21:15:54     9660           
  2.       SUBROUTINE CMAXOA(wrk52,wrk53,wrk54,WR12,IB,IGAU,NBGMAT,
  3.      &                   NELMAT,NWA,NCHAIN,EPSFLU)
  4. *
  5. *      MODELE MAXOTT  : 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. -INC DECHE
  17. *
  18.       SEGMENT WR12
  19.         REAL*8  EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3))
  20.         REAL*8  EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6))
  21.         REAL*8  EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9))
  22.         REAL*8  SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS)
  23.         REAL*8  SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS)
  24.         REAL*8  SM8(NSTRS)
  25.       ENDSEGMENT
  26.  
  27.       DIMENSION NWA(9),IPX(9),IPY(9)
  28.       DIMENSION EPSFLU(8)
  29.  
  30. *
  31. *---------------------------------------
  32. * donnees materielles de type evolution
  33. *---------------------------------------
  34.  
  35.              DO JC=1,9
  36.                NWA(JC)=0
  37.                IPX(JC)=0
  38.                IPY(JC)=0
  39.              END DO
  40. * offsets pour caracteristiques de type 'evolution'
  41. *
  42. * deformations planes / axisymetrique
  43. *
  44.       IF ((IFOMOD.EQ.-1.AND.IFOUR.NE.-2).OR.
  45.      &        (IFOMOD.EQ.0.OR.IFOMOD.EQ.1)) THEN
  46.         IMAXOBL = 10
  47.         IMAXFAC = 51
  48. *
  49. * contraintes planes / 3D coques minces
  50. *
  51.       ELSE IF((IFOMOD.EQ.-1.AND.IFOUR.EQ.-2).OR.
  52.      &        (IFOMOD.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9))) THEN
  53.         IMAXOBL = 10
  54.         IMAXFAC = 46
  55. *
  56. * tridimensionnelle massive
  57. *
  58.       ELSE
  59.         IMAXOBL = 15
  60.         IMAXFAC = 57
  61.       ENDIF
  62. *
  63. *     em0
  64. *
  65.  
  66.       MEVOLL=NINT(XMAT(IMAXOBL))
  67.       SEGACT MEVOLL
  68.       KEVOLL=IEVOLL(1)
  69.       SEGACT KEVOLL
  70.       MLREEL=IPROGX
  71.       IPX(1)=IPROGX
  72.       IPY(1)=IPROGY
  73.       SEGACT MLREEL
  74.       NWA(1)=PROG(/1)
  75.       SEGDES KEVOLL*NOMOD
  76.       SEGDES MEVOLL*NOMOD
  77.  
  78. *
  79. *     em1 a em4
  80. *
  81.       KED=IMAXOBL+1
  82.       DO JC=2,5
  83.         MEVOLL=NINT(XMAT(KED))
  84.         KED=KED+2
  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.         SEGDES KEVOLL*NOMOD
  94.         SEGDES MEVOLL*NOMOD
  95.       END DO
  96.  
  97. *
  98. *       em5 a em8
  99. *
  100.       NCHAIN=5
  101.       KED=IMAXFAC
  102.       DO JC=6,9
  103.         MEVOLL=NINT(XMAT(KED))
  104.         KED=KED+2
  105.         IF(MEVOLL.GT.0) THEN
  106.           SEGACT MEVOLL
  107.           KEVOLL=IEVOLL(1)
  108.           SEGACT KEVOLL
  109.           MLREEL=IPROGX
  110.           IPX(JC)=IPROGX
  111.           IPY(JC)=IPROGY
  112.           SEGACT MLREEL
  113.           NWA(JC)=PROG(/1)
  114.           NCHAIN=NCHAIN+1
  115.           SEGDES KEVOLL*NOMOD
  116.           SEGDES MEVOLL*NOMOD
  117.         ENDIF
  118.       END DO
  119.  
  120.  
  121. *------------------------------------
  122. *     creation du segment de travail
  123. *------------------------------------
  124.              IF (WR12.NE. 0) SEGINI WR12
  125. *
  126. *     recuperation des caracteristiques
  127. *     materielles et des variables internes
  128. *     D'abord les composantes obligatoires
  129. *
  130. * tridimensionnelle massive
  131. *
  132.              IF(IFOUR.EQ.2.AND.MFR.EQ.1) THEN
  133.                MXVREE = 22
  134. *
  135. * deformations planes / axisymetrique
  136. *
  137.              ELSE IF(IFOUR.EQ.-1.OR.IFOUR.EQ.-3
  138.      &         .OR.IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN
  139.                MXVREE = 17
  140. *
  141. * contraintes planes / 3D coques minces
  142. *
  143.              ELSE
  144.                MXVREE = 14
  145.              ENDIF
  146. *
  147.              DO JC=0,5
  148.                IF(JC.NE.0) THEN
  149.                  MLREEL=IPX(JC)
  150.                  MLREE1=IPY(JC)
  151.                  SEGACT MLREE1
  152.                ENDIF
  153.                MLREE2=NINT(VAR0(JC+MXVREE))
  154.                SEGACT MLREE2
  155.                IF(JC.EQ.0) THEN
  156.                  DO JD=1,NSTRS
  157.                    EPSFLU(JD)=MLREE2.PROG(JD)
  158.                  END DO
  159.                ELSE IF(JC.EQ.1) THEN
  160.                  DO JD=1,NWA(1)
  161.                    EM0(1,JD)=PROG(JD)
  162.                    EM0(2,JD)=MLREE1.PROG(JD)
  163.                  END DO
  164.                  DO JD=1,NSTRS
  165.                    SM0(JD)=MLREE2.PROG(JD)
  166.                  END DO
  167.                ELSE IF(JC.EQ.2) THEN
  168.                  DO JD=1,NWA(2)
  169.                    EM1(1,JD)=PROG(JD)
  170.                    EM1(2,JD)=MLREE1.PROG(JD)
  171.                  END DO
  172.                  DO JD=1,NSTRS
  173.                    SM1(JD)=MLREE2.PROG(JD)
  174.                  END DO
  175.                ELSE IF(JC.EQ.3) THEN
  176.                  DO JD=1,NWA(3)
  177.                    EM2(1,JD)=PROG(JD)
  178.                    EM2(2,JD)=MLREE1.PROG(JD)
  179.                  END DO
  180.                  DO JD=1,NSTRS
  181.                    SM2(JD)=MLREE2.PROG(JD)
  182.                  END DO
  183.                ELSE IF(JC.EQ.4) THEN
  184.                  DO JD=1,NWA(4)
  185.                    EM3(1,JD)=PROG(JD)
  186.                    EM3(2,JD)=MLREE1.PROG(JD)
  187.                  END DO
  188.                  DO JD=1,NSTRS
  189.                    SM3(JD)=MLREE2.PROG(JD)
  190.                  END DO
  191.                ELSE IF(JC.EQ.5) THEN
  192.                  DO JD=1,NWA(5)
  193.                    EM4(1,JD)=PROG(JD)
  194.                    EM4(2,JD)=MLREE1.PROG(JD)
  195.                  END DO
  196.                  DO JD=1,NSTRS
  197.                    SM4(JD)=MLREE2.PROG(JD)
  198.                  END DO
  199.                ENDIF
  200.              END DO
  201. *
  202. *       traitement des composantes facultatives
  203. *
  204.              DO JC=6,9
  205.                IF(IPX(JC).NE.0) THEN
  206.                  MLREEL=IPX(JC)
  207.                  MLREE1=IPY(JC)
  208.                  SEGACT MLREE1
  209.                  MLREE2=NINT(VAR0(JC+MXVREE))
  210.                  SEGACT MLREE2
  211.                  IF(JC.EQ.6) THEN
  212.                    DO JD=1,NWA(6)
  213.                      EM5(1,JD)=PROG(JD)
  214.                      EM5(2,JD)=MLREE1.PROG(JD)
  215.                    END DO
  216.                    DO JD=1,NSTRS
  217.                      SM5(JD)=MLREE2.PROG(JD)
  218.                    END DO
  219.                  ELSE IF(JC.EQ.7) THEN
  220.                    DO JD=1,NWA(7)
  221.                      EM6(1,JD)=PROG(JD)
  222.                      EM6(2,JD)=MLREE1.PROG(JD)
  223.                    END DO
  224.                    DO JD=1,NSTRS
  225.                      SM6(JD)=MLREE2.PROG(JD)
  226.                    END DO
  227.                 ELSE IF(JC.EQ.8) THEN
  228.                    DO JD=1,NWA(8)
  229.                      EM7(1,JD)=PROG(JD)
  230.                      EM7(2,JD)=MLREE1.PROG(JD)
  231.                    END DO
  232.                    DO JD=1,NSTRS
  233.                      SM7(JD)=MLREE2.PROG(JD)
  234.                    END DO
  235.                  ELSE IF(JC.EQ.9) THEN
  236.                    DO JD=1,NWA(9)
  237.                      EM8(1,JD)=PROG(JD)
  238.                      EM8(2,JD)=MLREE1.PROG(JD)
  239.                    END DO
  240.                    DO JD=1,NSTRS
  241.                      SM8(JD)=MLREE2.PROG(JD)
  242.                    END DO
  243.                  ENDIF
  244.                ENDIF
  245.              END DO
  246.  
  247. *
  248. *      DESACTIVATION DES SEGMENTS PROG
  249. *
  250.             DO  10 JC=0,9
  251.               IF (IPX(JC).EQ.0) GO TO 10
  252.               IF (JC.NE.0) THEN
  253.                 MLREEL=IPX(JC)
  254.                 SEGDES MLREEL*NOMOD
  255.                 MLREE1=IPY(JC)
  256.                 SEGDES MLREE1*NOMOD
  257.               ENDIF
  258.               MLREE2=NINT(VAR0(JC+MXVREE))
  259.               SEGDES MLREE2*NOMOD
  260.   10        CONTINUE
  261.  
  262. *
  263.       RETURN
  264.       END
  265.  
  266.  
  267.  
  268.  

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