Télécharger la plaquette Cast3M


fr en

Télécharger toch1.eso

Retour à la liste

Numérotation des lignes : 

toch1

  1. C TOCH1     SOURCE    SP204843  25/03/14    21:15:10     12201          
  2. C TOCH1
  3. C  CE SOUS PROGRAMME EST APPELE PAR PROPER.
  4. C  IL GERE LA ROTATION DES COMPOSANTES DES CHPOINT, MCHAML
  5. C  SOURCE MO + CHARRAS  97/07/29
  6. C  MODIF KICH 97/11
  7. C les differentes etapes sont commentees le long du programme.
  8.  
  9.       SUBROUTINE TOCH1 (IP1,MOTYPE,IRETO)
  10.  
  11.       IMPLICIT INTEGER(I-N)
  12.       IMPLICIT REAL*8 (A-H,O-Z)
  13.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. -INC SMCOORD
  17. -INC SMELEME
  18. -INC SMCHPOI
  19. -INC SMCHAML
  20. -INC TMTRAV
  21. -INC CCGEOME
  22. -INC CCTOURN
  23.  
  24.       REAL*8 SIGM(3,3),QRtQ(3,3),NSIG(3,3),RtQ(3,3)
  25.       CHARACTER*(LOCOMP) MOIC
  26.       CHARACTER*8        MOTYPE
  27.       CHARACTER*14       MESSER
  28.       CHARACTER*16       TYPIC
  29.       LOGICAL LAG
  30.  
  31.       SEGMENT ICPR(nbpts)
  32.       SEGMENT MSWBLO
  33.         CHARACTER*(LOCOMP) MOTDDL(0)
  34.       ENDSEGMENT
  35.  
  36.       SEGMENT MSWBL1
  37.         CHARACTER*(LOCOMP) MOZO(IZO,NOCO)
  38.         INTEGER            NOCCH1(IZO,NOCO)
  39.         INTEGER            TRIGO1(IZO,NOCO)
  40.       ENDSEGMENT
  41. *
  42.       CHARACTER*(LOCOMP) AAA(4,6)
  43.       CHARACTER*(LOCOMP) MODEPL(5)
  44.       CHARACTER*(LOCOMP) MODEDU(5)
  45.       CHARACTER*(LOCOMP) MORODU(5)
  46.       CHARACTER*(LOCOMP) MOROTA(5)
  47.       CHARACTER*(LOCOMP) MOCONT(6)
  48.       CHARACTER*(LOCOMP) MODEFO(6)
  49.  
  50. C  AAA(1,..)
  51.       DATA MODEPL(1)/'UX  '/
  52.       DATA MODEPL(2)/'UY  '/
  53.       DATA MODEPL(3)/'UZ  '/
  54.       DATA MODEPL(4)/'UR  '/
  55.       DATA MODEPL(5)/'UZ  '/
  56. C      DATA MODEPL(6)/'UT  '/
  57. C  AAA(2,..)
  58.       DATA MODEDU(1)/'FX  '/
  59.       DATA MODEDU(2)/'FY  '/
  60.       DATA MODEDU(3)/'FZ  '/
  61.       DATA MODEDU(4)/'FR  '/
  62.       DATA MODEDU(5)/'FZ  '/
  63. C  AAA(3,..)
  64.       DATA MOROTA(1)/'RX  '/
  65.       DATA MOROTA(2)/'RY  '/
  66.       DATA MOROTA(3)/'RZ  '/
  67.       DATA MOROTA(4)/'    '/
  68.       DATA MOROTA(5)/'    '/
  69. C  AAA(4,..)
  70.       DATA MORODU(1)/'MX  '/
  71.       DATA MORODU(2)/'MY  '/
  72.       DATA MORODU(3)/'MZ  '/
  73.       DATA MORODU(4)/'    '/
  74.       DATA MORODU(5)/'    '/
  75.  
  76.       DATA MOCONT(1)/'SMXX'/
  77.       DATA MOCONT(2)/'SMYY'/
  78.       DATA MOCONT(3)/'SMZZ'/
  79.       DATA MOCONT(4)/'SMXY'/
  80.       DATA MOCONT(5)/'SMXZ'/
  81.       DATA MOCONT(6)/'SMYZ'/
  82. C
  83.       DATA MODEFO(1)/'EPXX'/
  84.       DATA MODEFO(2)/'EPYY'/
  85.       DATA MODEFO(3)/'EPZZ'/
  86.       DATA MODEFO(4)/'GAXY'/
  87.       DATA MODEFO(5)/'GAXZ'/
  88.       DATA MODEFO(6)/'GAYZ'/
  89. C
  90.       IF (MOTYPE.EQ.'CHPOINT ') GOTO 100
  91.       IF (MOTYPE.EQ.'MCHAML  ') GOTO 200
  92.  
  93.  100  CONTINUE
  94.       MCHPO1 = IP1
  95.  
  96. C creation matrice aaa 4 col 5 lignes
  97.       DO I=1,5
  98.       AAA(1,I)=MODEPL(I)
  99.       AAA(2,I)=MODEDU(I)
  100.       AAA(3,I)=MOROTA(I)
  101.       AAA(4,I)=MORODU(I)
  102.       ENDDO
  103.  
  104.       NBMDDL=0
  105.       LDDLA=0
  106.       SEGACT MCHPO1
  107.       IZO=MCHPO1.IPCHP(/1)
  108.       NOCO=0
  109.       SEGINI MSWBLO,MSWBL1
  110.       DO 8 I=1,MCHPO1.IPCHP(/1)
  111.       NOC=0
  112.       MSOUP1=MCHPO1.IPCHP(I)
  113.       SEGACT MSOUP1
  114.           DO 7 IA=1,MSOUP1.NOCOMP(/2)
  115.           MOIC=MSOUP1.NOCOMP(IA)
  116. C B-1):lecture de chpo1 et test si correspondance entre
  117. C la composante moic du chpo1 et une du tableau aaa
  118. C si oui LAG vrai
  119.           LAG=.FALSE.
  120.              DO 3 ICO=1,4
  121.              DO 31 ILIGN=1,6
  122.              LAG=(MOIC.EQ.AAA(ICO,ILIGN))
  123.              IF (LAG) THEN
  124.                ICOL=ICO
  125.                GO TO 4
  126.                ENDIF
  127.  31          CONTINUE
  128.  3           CONTINUE
  129.  4           CONTINUE
  130.  
  131.           IF (LAG) THEN
  132.               IF(NOC.GE.1) THEN
  133. C la composante est elle deja existante dans cette zone?
  134.                 DO IAK= 1 ,NOCO
  135.                 IF(MOIC.EQ.MOZO(I,IAK)) GO TO 7
  136.                 ENDDO
  137.               ENDIF
  138.  
  139. C en sortie de boucle ico represente le type de ddl:
  140. C icol =1 --> DEPL, ico =2 --> FORCES
  141. C icol =3 --> ROTA, ico =4 --> MOMENT
  142.  
  143. C B-2) determination du nombre et de l appellation des ddl
  144. C a creer pour le chpo tourne selon type de calcul
  145. C  initialisations de depart
  146.            LDDLA=0
  147.            IPOSIA=0
  148.       IF(IFOUR.NE.-2.AND.IFOUR.NE.-1.AND.IFOUR.NE.-3) GOTO 101
  149.  
  150. C     DEFORMATIONS PLANES OU CONTRAINTES PLANES OU DEF PLANE GENE
  151. C     DEFO PLAN -1: UX UY
  152. C     OU CONT PLAN -2: UX UY
  153. C     OU DEF PLANE GENE -3:UX UY UZ
  154.            LDDLA=2
  155.            IPOSIA=0
  156.            GOTO 107
  157.   101 CONTINUE
  158.       IF(IFOUR.NE.0) GOTO 102
  159. C
  160. C     AXISYMETRIQUE  (IFOUR= 0)
  161. C      UR   UZ
  162.            LDDLA=2
  163.            IPOSIA=3
  164.            GOTO 107
  165.   102      CONTINUE
  166.       IF(IFOUR.NE.1) GOTO 103
  167. C
  168. C     FOURIER  (IFOUR= 1 )
  169. C     UR   UZ
  170.            LDDLA=2
  171.            IPOSIA=3
  172.            GOTO 107
  173.   103      CONTINUE
  174.            IF(IFOUR.NE.2) GOTO 104
  175. C
  176. C     TRIDIM  (IFOUR= 2 )
  177. C     UX   UY   UZ
  178. C     FX   FY   FZ
  179. C     RX   RY   RZ
  180. C     MX   MY   MZ
  181.            LDDLA=3
  182.            IPOSIA=0
  183.            GOTO 107
  184.   104 CONTINUE
  185. C
  186. C     DEFORMATIONS GENERALISEES
  187.            LDDLA=0
  188.            LDDLB=0
  189.            IPOSIA=0
  190.            IPOSIB=0
  191.  107  CONTINUE
  192. C
  193.            IF ((NOC+LDDLA).GT.NOCO) THEN
  194.              NOCO=NOC+LDDLA
  195.              SEGADJ  MSWBL1
  196.            ENDIF
  197.  
  198. C la composante envoyee est elle compatible avec le mode de calcul??
  199.            DO  IAA=1,LDDLA
  200.            IF(MOIC.EQ.AAA(ICOL,IPOSIA+IAA)) THEN
  201.            GO TO 108
  202.            ELSE
  203.              IF(IAA.EQ.LDDLA)THEN
  204.                IF(IFOUR.EQ.-1)MESSER='DEFO PLAN     '
  205.                IF(IFOUR.EQ.-2)MESSER='CONT PLAN     '
  206.                IF(IFOUR.EQ.-3)MESSER='DEF PLANE GENE'
  207.                IF(IFOUR.EQ.0)MESSER='AXISYMETRIQUE  '
  208.                IF(IFOUR.EQ.1)MESSER='FOURIER        '
  209.                IF(IFOUR.EQ.2)MESSER='TRIDIM         '
  210.                INTERR(1)=I
  211.                MOTERR(1:4)=MOIC
  212.                MOTERR(5:19)=MESSER
  213.                CALL ERREUR (805)
  214.                GO TO 999
  215.              ELSE
  216.              CONTINUE
  217.              ENDIF
  218.            ENDIF
  219.            ENDDO
  220.  108       CONTINUE
  221.  
  222. C on remplit motddl
  223.            DO  IAA=1,LDDLA
  224.              MOTDDL(**)=AAA(ICOL,IPOSIA+IAA)
  225.            ENDDO
  226.  
  227. C remplissage des tableaux,MOZO,TRIGO1 et NOCCH1
  228. C qui serviront a dimensionner le nouveau chpo
  229.  
  230. C MOZO contient pour chaque zone le nom des composantes
  231. C et peut aussi....contenir du '    'ce qui servira.
  232.  
  233. C NOCCH1 contient,pour chaque zone, le no d emplacement de
  234. C chaque composante dans le chpo d origine. si une composante
  235. C cree n existait pas dans le chpo de depart alors:
  236. C NOCCH1 (zone,no compos)=0
  237.  
  238. C TRIGO1 contient,pour chaque zone,et pour chaque composante
  239. C un nombre qui peut prendre les valeurs:
  240. C  -1 si la composante ne doit pas tourner
  241. C 0 si MOZO (I,nomcompos) ='    '
  242. C 3 2 ou 1 si elle doit tourner.la 1ere des ddl d une meme
  243. C famille est indicee a 2 (3 si 3d).
  244.  
  245.            IF ((NOC + LDDLA).GT.NOCO) THEN
  246.              NOCO=NOC+LDDLA
  247.              SEGADJ  MSWBL1
  248.            ENDIF
  249.            DO 6 IAA=NBMDDL+1,NBMDDL+LDDLA
  250.            NOC= NOC+1
  251.            MOZO (I,NOC)=MOTDDL(IAA)
  252.  
  253.            TRIGO1(I,NOC)=NBMDDL+LDDLA+1-IAA
  254.  
  255.              DO 5 IAB=IA,MSOUP1.NOCOMP(/2)
  256.              IF(MOTDDL(IAA).EQ.MSOUP1.NOCOMP(IAB))THEN
  257.                   NOCCH1 (I,NOC)=IAB
  258.              ELSE
  259.              IF(.NOT.LAG)NOCCH1 (I,NOC)=0
  260.              ENDIF
  261.  5           CONTINUE
  262.  6         CONTINUE
  263.            NBMDDL=NBMDDL+LDDLA
  264.  
  265.          ELSE
  266.          NOC= NOC+1
  267.          IF (NOC.GT.NOCO) THEN
  268.            NOCO= NOCO+ 1
  269.            SEGADJ  MSWBL1
  270.          ENDIF
  271.          MOZO(I,NOC)=MOIC
  272.          NOCCH1(I,NOC)=IA
  273.          TRIGO1(I,NOC)=-1
  274.  
  275.         ENDIF
  276.  7      CONTINUE
  277.  8    CONTINUE
  278.       SEGDES MSWBLO
  279.  
  280. C      print*,'en sortie: '
  281. C       print*,'NOCO= ',NOCO
  282. C      do iiw=1,NOCCH1 (/1)
  283. C      do ijl=1,NOCCH1 (/2)
  284. C      print*,'MOZO (',Iiw,',',ijl,')= ',MOZO(Iiw,ijl)
  285. C     #,'NOCCH1 (',Iiw,',',ijl,')= ',NOCCH1(Iiw,ijl)
  286. C     #,'TRIGO1 (',Iiw,',',ijl,')= ',TRIGO1(Iiw,ijl)
  287. C      enddo
  288. C      enddo
  289.  
  290. C mise a jour des valeurs de toutes les composantes du
  291. C nouveau chpo1 sans tenir compte des rotations
  292.       SEGACT, MCHPO1*MOD
  293.       MCHPO1.IFOPOI = IFOUR
  294.       DO 14 I=1,MCHPO1.IPCHP(/1)
  295.       MSOUP1=MCHPO1.IPCHP(I)
  296.           DO NC=1,NOCCH1(/2)
  297.           IF(MOZO(I,NC).EQ.'    ')GO TO 11
  298.           ENDDO
  299.  11       CONTINUE
  300.       NC=NC-1
  301.       SEGINI MSOUP3
  302.       MCHPO1.IPCHP(I)=MSOUP3
  303.       SEGACT MSOUP1
  304.       MSOUP3.IGEOC= MSOUP1.IGEOC
  305.       MPOVA1=MSOUP1.IPOVAL
  306.       SEGACT MPOVA1
  307.       N=MPOVA1.VPOCHA(/1)
  308.       SEGINI MPOVA3
  309.       MSOUP3.IPOVAL=MPOVA3
  310.          DO 13 IC=1,NC
  311.            MSOUP3.NOCOMP(IC)=MOZO(I,IC)
  312.            ICN= NOCCH1(I,IC)
  313.            IF(ICN.EQ.0) GO TO 13
  314. C si composante n existe pas dans le chpo initial
  315. C (car elle est cree pour chpo3) elle reste a 0
  316.               DO  IB=1,N
  317.            MPOVA3.VPOCHA(IB,IC)=MPOVA1.VPOCHA(IB,ICN)
  318.               ENDDO
  319.  13      CONTINUE
  320.       SEGSUP MPOVA1,MSOUP1
  321.  14   CONTINUE
  322. C fin mise a jour des valeurs sans rotations
  323.  
  324. C mise a jour des valeurs des composantes du
  325. C nouveau chpo1 necessitant la rotation
  326. C TRIGO1(I,IC)= 1 , 2 , 3  au max;
  327. C TRIGO1(I,IC)=-1 ou 0 pas de rotation
  328.  
  329.       SEGACT MCHPO1
  330.       DO 16 I=1,MCHPO1.IPCHP(/1)
  331.         MSOUP3=MCHPO1.IPCHP(I)
  332.         SEGACT MSOUP3
  333.         MPOVA3=MSOUP3.IPOVAL
  334.         SEGACT MPOVA3*MOD
  335.         ICC1=0
  336.         NC=MSOUP3.NOCOMP(/2)
  337.           DO 15 IC=1,NC
  338. C si les valeurs sont deja a jour :
  339.             IF(TRIGO1(I,IC).LT.0) GO TO 15
  340. C il y a TRIGO1(I,IC) ddl a traiter en meme temps:
  341. C incrementation de IC par les go to
  342.             IF(IC.LT.ICC1) GO TO 15
  343.             ICC1=IC+TRIGO1(I,IC)
  344.             N=MPOVA3.VPOCHA(/1)
  345.               DO  IB=1,N
  346.                 XD=MPOVA3.VPOCHA(IB, IC)
  347.                 YD=MPOVA3.VPOCHA(IB, IC+1)
  348.                 ZD=0.
  349.                 IF(IFOUR.EQ.2)ZD=MPOVA3.VPOCHA(IB,IC+2)
  350.                 CO=COS(ANGLE)
  351.                 SI=SIN(ANGLE)
  352.                 XE=XD*XV1+YD*YV1+ZD*ZV1
  353.                 YE=XD*XV2+YD*YV2+ZD*ZV2
  354.                 ZE=XD*XVEC+YD*YVEC+ZD*ZVEC
  355.                 XD=XE*CO-YE*SI
  356.                 YD=XE*SI+YE*CO
  357.                 ZD=ZE
  358. c nouveaux ux uy uz=
  359.          MPOVA3.VPOCHA(IB,IC) =XD*XV1+YD*XV2+ZD*XVEC
  360.          MPOVA3.VPOCHA(IB,IC+1)=XD*YV1+YD*YV2+ZD*YVEC
  361.          IF(IFOUR.EQ.2)
  362.      #MPOVA3.VPOCHA(IB,IC+2)=XD*ZV1+YD*ZV2+ZD*ZVEC
  363.                ENDDO
  364.  15       CONTINUE
  365.  16   CONTINUE
  366.       SEGDES MSWBL1
  367.  
  368. C ** partition
  369. C initialisation et ajustement du segment MTRAV
  370.       NNIN=0
  371.       NNNOE=0
  372.       SEGINI,MTRAV
  373.  
  374. C tri des composantes: elles ne doivent apparaitre
  375. C qu' 1 seule fois dans INCO
  376.       DO 22 I=1,MCHPO1.IPCHP(/1)
  377.       MSOUP3=MCHPO1.IPCHP(I)
  378.       SEGACT MSOUP3
  379.       NC=MSOUP3.NOCOMP(/2)
  380.         DO 21 IA=1,NC
  381.         MOIC=MSOUP3.NOCOMP(IA)
  382.         IF(NNIN.EQ.0)THEN
  383.               NNIN=1
  384.               SEGADJ,MTRAV
  385.               INCO(NNIN)= MOIC
  386.         ELSE
  387.            LAG=.TRUE.
  388.            DO IAA=1,NNIN
  389.            IF(MOIC.EQ.INCO(IAA))THEN
  390.            LAG=.FALSE.
  391.            GO TO 17
  392.            ENDIF
  393.            ENDDO
  394.  17        CONTINUE
  395.               IF(LAG)THEN
  396.               NNIN=NNIN + 1
  397.               SEGADJ,MTRAV
  398.               INCO(NNIN)=MOIC
  399.                  ENDIF
  400.         ENDIF
  401.  21     CONTINUE
  402.  22   CONTINUE
  403. C fin tri des composantes
  404.  
  405. C on passe de la numerotation globale a
  406. C la numerotation locale
  407.       SEGINI ICPR
  408.       DO 25 I=1,MCHPO1.IPCHP(/1)
  409.       MSOUP3=MCHPO1.IPCHP(I)
  410.       SEGACT MSOUP3
  411.       NC=MSOUP3.NOCOMP(/2)
  412.         DO 24 IA=1,NC
  413.            MELEME=MSOUP3.IGEOC
  414.            SEGACT MELEME
  415.            DO IAA=1,NUM(/2)
  416.            IAB =NUM(1,IAA)
  417.            ICPR(IAB)= 1
  418.            ENDDO
  419.  24     CONTINUE
  420.  25   CONTINUE
  421.  
  422.       NNNOE=0
  423.       DO I=1,ICPR(/1)
  424.         IF(ICPR(I).EQ.1) THEN
  425.         NNNOE= NNNOE+1
  426.         SEGADJ MTRAV
  427.         ICPR(I)=NNNOE
  428.         IGEO(NNNOE)=I
  429.         ENDIF
  430.       ENDDO
  431. C fin numerotation locale
  432. C NNNOE et NNNIN sont aux bonnes tailles et valeurs
  433.  
  434. C copie des valeurs aux noeuds + mise a jour de IBIN et NHAR
  435. C attention a la correspondance entre la composante en cours
  436. C de traitement et son homologue rangee dans INCO
  437.       DO 30 I=1,MCHPO1.IPCHP(/1)
  438.       MSOUP3=MCHPO1.IPCHP(I)
  439.       SEGACT MSOUP3
  440.          DO 29 IAB=1,MSOUP3.NOCOMP(/2)
  441.            MOIC=MSOUP3.NOCOMP(IAB)
  442.            MELEME=MSOUP3.IGEOC
  443.            MPOVA3=MSOUP3.IPOVAL
  444.            SEGACT MELEME,MPOVA3
  445.             DO 28 IA=1,NUM(/2)
  446.                DO IB=1,NNIN
  447.                IF (MOIC.EQ.INCO(IB)) THEN
  448.                BB(IB,ICPR(NUM(1,IA)))=MPOVA3.VPOCHA(IA,IAB)
  449.                IBIN(IB,ICPR(NUM(1,IA)))=1
  450.                NHAR(IB)=MSOUP3.NOHARM(IAB)
  451.                ELSE
  452.                CONTINUE
  453.                ENDIF
  454.                ENDDO
  455.  28         CONTINUE
  456.  29      CONTINUE
  457.  30    CONTINUE
  458.  
  459. C le segment MTRAV est entierement rempli
  460. C on l envoie a crechep
  461.       CALL CRECHP(MTRAV,KCHPOI)
  462.       IP1 = KCHPOI
  463.       GOTO 992
  464.  
  465. c cas du mchaml
  466.  200  CONTINUE
  467.       MCHEL1 = IP1
  468.  
  469. C creation matrice aaa 4 col 6 lignes
  470.       DO I=1,6
  471.       AAA(1,I)=MOCONT(I)
  472.       AAA(2,I)=MODEFO(I)
  473.       AAA(3,I)=MOCONT(I)
  474.       AAA(4,I)=MODEFO(I)
  475.       ENDDO
  476.  
  477.       NBMDDL=0
  478.       LDDLA=0
  479.       SEGACT MCHEL1
  480.       IZO=MCHEL1.ICHAML(/1)
  481.       NOCO=0
  482.       SEGINI MSWBLO,MSWBL1
  483.       DO 208 I=1,MCHEL1.ICHAML(/1)
  484.       NOC=0
  485.       MCHAM1=MCHEL1.ICHAML(I)
  486.       SEGACT MCHAM1
  487.           DO 207 IA=1,MCHAM1.NOMCHE(/2)
  488.           MOIC=MCHAM1.NOMCHE(IA)
  489.           TYPIC=MCHAM1.TYPCHE(IA)
  490. C B-1):lecture de chpo1 et test si correspondance entre
  491. C la composante moic du chpo1 et une du tableau aaa
  492. C si oui LAG vrai
  493. * controle que le type est bien reel
  494.           LAG=.FALSE.
  495.              DO 203 ICO=1,4
  496.              DO 2031 ILIGN=1,6
  497.              LAG=(MOIC.EQ.AAA(ICO,ILIGN)).AND.(TYPIC.EQ.'REAL*8')
  498.              IF (LAG) THEN
  499.                ICOL=ICO
  500.                GO TO 204
  501.                ENDIF
  502.  2031          CONTINUE
  503.  203           CONTINUE
  504.  204           CONTINUE
  505.  
  506.           IF (LAG) THEN
  507.               IF(NOC.GE.1) THEN
  508. C la composante est elle deja existante dans cette zone?
  509.                 DO IAK= 1 ,NOCO
  510.                 IF(MOIC.EQ.MOZO(I,IAK)) GO TO 207
  511.                 ENDDO
  512.               ENDIF
  513.  
  514. C en sortie de boucle icol represente le type de ddl:
  515. C icol =1 --> CONT massif, icol =2 --> DEFO massif
  516. C icol =3 --> CONT, icol =4 --> DEFO,
  517.  
  518. C B-2) determination du nombre et de l appellation des composantes
  519. C a creer pour le mchaml tourne selon type de calcul
  520. C  initialisations de depart
  521.            LDDLA=0
  522.            IPOSIA=0
  523.       IF(IFOUR.NE.-2.AND.IFOUR.NE.-1.AND.IFOUR.NE.-3) GOTO 211
  524.  
  525. C     DEFORMATIONS PLANES OU CONTRAINTES PLANES OU DEF PLANE GENE
  526. C     DEFO PLAN -1: UX UY  / SMXX SMYY SMZZ SMXY
  527. C     OU CONT PLAN -2: UX UY / idem
  528. C     OU DEF PLANE GENE -3:UX UY UZ / idem
  529.            LDDLA=4
  530.            IPOSIA=0
  531.            GOTO 217
  532.   211 CONTINUE
  533.       IF(IFOUR.NE.0) GOTO 212
  534. C
  535. C     AXISYMETRIQUE  (IFOUR= 0)
  536. C      UR   UZ / SMRR SMTT SMZZ SMRZ
  537.            LDDLA=4
  538.            IPOSIA=3
  539.            GOTO 217
  540.   212      CONTINUE
  541.       IF(IFOUR.NE.1) GOTO 213
  542. C
  543. C     FOURIER  (IFOUR= 1 )
  544. C     UR   UZ / SMXX SMYY SMZZ SMXY ?
  545.            LDDLA=4
  546.            IPOSIA=3
  547.            GOTO 217
  548.   213      CONTINUE
  549.            IF(IFOUR.NE.2) GOTO 214
  550. C
  551. C     TRIDIM  (IFOUR= 2 )
  552. C     UX   UY   UZ / SMXX SMYY SMZZ SMXY SMXZ SMYZ
  553.            LDDLA=6
  554.            IPOSIA=0
  555.            GOTO 217
  556.  214  CONTINUE
  557. C
  558. C     DEFORMATIONS GENERALISEES
  559.            LDDLA=0
  560.            LDDLB=0
  561.            IPOSIA=0
  562.            IPOSIB=0
  563.  217  CONTINUE
  564. C
  565.            IF ((NOC+LDDLA).GT.NOCO) THEN
  566.              NOCO=NOC+LDDLA
  567.              SEGADJ  MSWBL1
  568.            ENDIF
  569.  
  570. C la composante envoyee est elle compatible avec le mode de calcul??
  571.            DO  IAA=1,LDDLA
  572. * on semble impose les composantes du champ resultat : pb melange
  573.            IF(MOIC.EQ.AAA(ICOL,IPOSIA+IAA)) THEN
  574.            GO TO 218
  575.            ELSE
  576.              IF(IAA.EQ.LDDLA)THEN
  577.                IF(IFOUR.EQ.-1)MESSER='DEFO PLAN     '
  578.                IF(IFOUR.EQ.-2)MESSER='CONT PLAN     '
  579.                IF(IFOUR.EQ.-3)MESSER='DEF PLANE GENE'
  580.                IF(IFOUR.EQ.0)MESSER='AXISYMETRIQUE  '
  581.                IF(IFOUR.EQ.1)MESSER='FOURIER        '
  582.                IF(IFOUR.EQ.2)MESSER='TRIDIM         '
  583.                INTERR(1)=I
  584.                MOTERR(1:4)=MOIC
  585.                MOTERR(5:19)=MESSER
  586. *
  587.                CALL ERREUR (805)
  588.                GO TO 994
  589.              ELSE
  590.              CONTINUE
  591.              ENDIF
  592.            ENDIF
  593.            ENDDO
  594.  218       CONTINUE
  595.  
  596. C on remplit motddl
  597.            DO  IAA=1,LDDLA
  598.              MOTDDL(**)=AAA(ICOL,IPOSIA+IAA)
  599.            ENDDO
  600.  
  601. C remplissage des tableaux,MOZO,TRIGO1 et NOCCH1
  602. C qui serviront a dimensionner le nouveau mchaml
  603.  
  604. C MOZO contient pour chaque zone le nom des composantes
  605. C et peut aussi....contenir du '    'ce qui servira.
  606.  
  607. C NOCCH1 contient,pour chaque zone, le no d emplacement de
  608. C chaque composante dans le mchaml d origine. si une composante
  609. C cree n existait pas dans le mchaml de depart alors:
  610. C NOCCH1 (zone,no compos)=0
  611.  
  612. C TRIGO1 contient,pour chaque zone,et pour chaque composante
  613. C un nombre qui peut prendre les valeurs:
  614. C  -1 si la composante ne doit pas tourner
  615. C 0 si MOZO (I,nomcompos) ='    '
  616. C 3 2 ou 1 si elle doit tourner.la 1ere des composantes d une meme
  617. C famille est indicee a 2 (3 si 3d).
  618.  
  619.            IF ((NOC+LDDLA).GT.NOCO) THEN
  620.              NOCO=NOC+LDDLA
  621.              SEGADJ  MSWBL1
  622.            ENDIF
  623.            DO 206 IAA=NBMDDL+1,NBMDDL+LDDLA
  624.            NOC= NOC+1
  625.            MOZO (I,NOC)=MOTDDL(IAA)
  626.            TRIGO1(I,NOC)=NBMDDL+LDDLA+1-IAA
  627.  
  628.              DO 205 IAB=IA,MCHAM1.NOMCHE(/2)
  629.              IF(MOTDDL(IAA).EQ.MCHAM1.NOMCHE(IAB))THEN
  630.                   NOCCH1 (I,NOC)=IAB
  631.              ELSE
  632.              IF(.NOT.LAG)NOCCH1 (I,NOC)=0
  633.              ENDIF
  634.  205         CONTINUE
  635.  206       CONTINUE
  636.            NBMDDL=NBMDDL+LDDLA
  637.  
  638.          ELSE
  639.          NOC= NOC + 1
  640.          IF (NOC.GT.NOCO) THEN
  641.            NOCO= NOCO + 1
  642.            SEGADJ  MSWBL1
  643.          ENDIF
  644.          MOZO(I,NOC)=MOIC
  645.          NOCCH1(I,NOC)=IA
  646.          TRIGO1(I,NOC)=-1
  647.  
  648.         ENDIF
  649.  207    CONTINUE
  650.  208  CONTINUE
  651.       SEGDES MSWBLO
  652.  
  653. C mise a jour des valeurs de toutes les composantes du
  654. C nouveau mchaml sans tenir compte des rotations
  655.       SEGACT, MCHEL1*MOD
  656.       DO 224 I=1,MCHEL1.ICHAML(/1)
  657.       MCHAM1=MCHEL1.ICHAML(I)
  658.           DO NC=1,NOCCH1(/2)
  659.           IF(MOZO(I,NC).EQ.'    ')GO TO 221
  660.           ENDDO
  661.  221      CONTINUE
  662.       N2=NC-1
  663.       SEGINI MCHAM3
  664.       MCHEL1.ICHAML(I)=MCHAM3
  665. * chercher le dimensionnement max et apres tout faire ...
  666.       N1PTEL = 1
  667.       N1EL = 1
  668.       SEGACT MCHAM1
  669.       DO KN2=1,MCHAM1.IELVAL(/1)
  670.         MELVA1 = MCHAM1.IELVAL(KN2)
  671.         SEGACT MELVA1
  672.         N1PTEL = MAX(MELVA1.VELCHE(/1),N1PTEL)
  673.         N1EL = MAX(MELVA1.VELCHE(/2),N1EL)
  674.       ENDDO
  675.       DO 223 IC = 1,N2
  676.         MCHAM3.NOMCHE(IC)=MOZO(I,IC)
  677.         ICN= NOCCH1(I,IC)
  678.         IF(ICN.EQ.0) THEN
  679. C si composante n existe pas dans le mchaml initial
  680. C (car elle est cree pour mchel3) elle reste a 0
  681.           N2PTEL=0
  682.           N2EL=0
  683.           SEGINI MELVA3
  684.           MCHAM3.IELVAL(IC) = MELVA3
  685.           MCHAM3.TYPCHE(IC) = 'REAL*8'
  686.           GOTO 223
  687.         ENDIF
  688. c la composante existe
  689.         MELVA1=MCHAM1.IELVAL(ICN)
  690.         MCHAM3.TYPCHE(IC) = MCHAM1.TYPCHE(ICN)
  691.         IF (MCHAM1.TYPCHE(ICN).NE.'REAL*8') THEN
  692.           MCHAM3.IELVAL(IC) = MELVA1
  693.           GOTO 223
  694.         ENDIF
  695.         SEGACT MELVA1
  696.         N2PTEL=0
  697.         N2EL=0
  698.         SEGINI MELVA3
  699.         MCHAM3.IELVAL(IC)=MELVA3
  700.            DO INPT = 1,N1PTEL
  701.              DO IEL = 1,N1EL
  702.                IF (MELVA1.VELCHE(/1).EQ.1) THEN
  703.                 IF (MELVA1.VELCHE(/2).EQ.1) THEN
  704.            MELVA3.VELCHE(INPT,IEL) = MELVA1.VELCHE(1,1)
  705.                 ELSE
  706.            MELVA3.VELCHE(INPT,IEL) = MELVA1.VELCHE(1,IEL)
  707.                 ENDIF
  708.                ELSE
  709.            MELVA3.VELCHE(INPT,IEL) = MELVA1.VELCHE(INPT,IEL)
  710.                ENDIF
  711.              ENDDO
  712.            ENDDO
  713.          SEGSUP MELVA1
  714.  223     CONTINUE
  715.       SEGSUP MCHAM1
  716.  224  CONTINUE
  717. C fin mise a jour des valeurs sans rotations
  718.  
  719. * determine  QRtQ
  720.           CO=COS(ANGLE)
  721.           SI=SIN(ANGLE)
  722.         RtQ(1,1) = CO*XV1 - SI*XV2
  723.         RtQ(1,2) = CO*YV1 - SI*YV2
  724.         RtQ(1,3) = CO*ZV1 - SI*ZV2
  725.         RtQ(2,1) = SI*XV1 + CO*XV2
  726.         RtQ(2,2) = SI*YV1 + CO*YV2
  727.         RtQ(2,3) = SI*ZV1 + CO*ZV2
  728.         RtQ(3,1) = XVEC
  729.         RtQ(3,2) = YVEC
  730.         RtQ(3,3) = ZVEC
  731.  
  732.         QRtQ(1,1) = XV1*RtQ(1,1) + XV2*RtQ(2,1) + XVEC*RtQ(3,1)
  733.         QRtQ(1,2) = XV1*RtQ(1,2) + XV2*RtQ(2,2) + XVEC*RtQ(3,2)
  734.         QRtQ(1,3) = XV1*RtQ(1,3) + XV2*RtQ(2,3) + XVEC*RtQ(3,3)
  735.         QRtQ(2,1) = YV1*RtQ(1,1) + YV2*RtQ(2,1) + YVEC*RtQ(3,1)
  736.         QRtQ(2,2) = YV1*RtQ(1,2) + YV2*RtQ(2,2) + YVEC*RtQ(3,2)
  737.         QRtQ(2,3) = YV1*RtQ(1,3) + YV2*RtQ(2,3) + YVEC*RtQ(3,3)
  738.         QRtQ(3,1) = ZV1*RtQ(1,1) + ZV2*RtQ(2,1) + ZVEC*RtQ(3,1)
  739.         QRtQ(3,2) = ZV1*RtQ(1,2) + ZV2*RtQ(2,2) + ZVEC*RtQ(3,2)
  740.         QRtQ(3,3) = ZV1*RtQ(1,3) + ZV2*RtQ(2,3) + ZVEC*RtQ(3,3)
  741.  
  742. C mise a jour des valeurs des composantes du
  743. C nouveau mchaml necessitant la rotation
  744. C TRIGO1(I,IC)= 1 , 2 , 3  au max;
  745. C TRIGO1(I,IC)=-1 ou 0 pas de rotation
  746.       SEGACT MCHEL1
  747.       DO 236 I=1,MCHEL1.ICHAML(/1)
  748.         MCHAM3=MCHEL1.ICHAML(I)
  749.         SEGACT MCHAM3
  750.         ICC1=0
  751.         NC=MCHAM3.NOMCHE(/2)
  752.         DO 235 IC=1,NC
  753. C si les valeurs sont deja a jour :
  754.           IF(TRIGO1(I,IC).LT.0) GO TO 235
  755. C il y a TRIGO1(I,IC) ddl a traiter en meme temps:
  756. C incrementation de IC par les go to
  757.           IF(IC.LT.ICC1) GO TO 235
  758.           ICC1=IC+TRIGO1(I,IC)
  759. * calcul plan, axi ou Fourier
  760.           MELVA1=MCHAM3.IELVAL(IC)
  761.           MELVA2=MCHAM3.IELVAL(IC+1)
  762.           MELVA3=MCHAM3.IELVAL(IC+2)
  763.           MELVA4=MCHAM3.IELVAL(IC+3)
  764.           SEGACT, MELVA1*MOD,MELVA2*MOD,MELVA3*MOD,MELVA4*MOD
  765. * calcul 3D
  766.           IF (TRIGO1(I,IC).EQ.6) THEN
  767.             MELVA5=MCHAM3.IELVAL(IC+4)
  768.             MELVA6=MCHAM3.IELVAL(IC+5)
  769.             SEGACT, MELVA5*MOD,MELVA6*MOD
  770.           ENDIF
  771.             N1PTEL=MELVA1.VELCHE(/1)
  772.             N1EL = MELVA1.VELCHE(/2)
  773.             DO INPT = 1,N1PTEL
  774.               DO  IEL = 1,N1EL
  775.                 SIGM(1,1)=MELVA1.VELCHE(INPT,IEL)
  776.                 SIGM(2,2)=MELVA2.VELCHE(INPT,IEL)
  777.                 SIGM(1,2)=MELVA4.VELCHE(INPT,IEL)
  778.                 SIGM(2,1)=SIGM(1,2)
  779.                 SIGM(3,3)=MELVA3.VELCHE(INPT,IEL)
  780.                 IF (TRIGO1(I,IC).EQ.6) THEN
  781.                  SIGM(1,3)=MELVA5.VELCHE(INPT,IEL)
  782.                  SIGM(2,3)=MELVA6.VELCHE(INPT,IEL)
  783.                  SIGM(3,1)=SIGM(1,3)
  784.                  SIGM(3,2)=SIGM(2,3)
  785.                 ELSE
  786.                  SIGM(1,3)=0
  787.                  SIGM(2,3)=0
  788.                  SIGM(3,1)=0
  789.                  SIGM(3,2)=0
  790.                 ENDIF
  791. c nouvelles composantes = QRtQ SIGMA QtRtQ
  792.                 DO L=1,3
  793.                   DO M=1,3
  794.          NSIG(L,M)=SIGM(L,1)*QRtQ(M,1)+SIGM(L,2)*QRtQ(M,2)+
  795.      &             SIGM(L,3)*QRtQ(M,3)
  796.                   ENDDO
  797.                  ENDDO
  798.                 DO L=1,3
  799.                   DO M=1,3
  800.          SIGM(L,M)=NSIG(1,M)*QRtQ(L,1)+NSIG(2,M)*QRtQ(L,2)+
  801.      &             NSIG(3,M)*QRtQ(L,3)
  802.                   ENDDO
  803.                  ENDDO
  804.                 MELVA1.VELCHE(INPT,IEL)=SIGM(1,1)
  805.                 MELVA2.VELCHE(INPT,IEL)=SIGM(2,2)
  806.                 MELVA4.VELCHE(INPT,IEL)=SIGM(1,2)
  807.                 MELVA3.VELCHE(INPT,IEL)=SIGM(3,3)
  808.                 IF (TRIGO1(I,IC).EQ.6) THEN
  809.                  MELVA5.VELCHE(INPT,IEL)=SIGM(1,3)
  810.                  MELVA6.VELCHE(INPT,IEL)=SIGM(2,3)
  811.                 ENDIF
  812.                ENDDO
  813.              ENDDO
  814.  235    CONTINUE
  815.  236  CONTINUE
  816.       SEGDES MSWBL1
  817.  
  818. * on arrete la le traitement. Par rapport a la programmation
  819. * du cas chpoint, il y a encore des verifs a faire sur l unicite
  820. * des composantes. Mais comme a ce jour, la definition du ET sur
  821. * les MCHAML n est pas claire, il faut reflechir ... 11/97 KICH.
  822.       IP1 = MCHEL1
  823.       GOTO 994
  824.  
  825.  992  CONTINUE
  826.       SEGSUP MTRAV,ICPR
  827.  994  CONTINUE
  828.       SEGSUP MSWBLO, MSWBL1
  829.  999  CONTINUE
  830.       END
  831.  
  832.  
  833.  
  834.  
  835.  
  836.  
  837.  
  838.  

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