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  24/03/15    21:15:09     11871          
  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.  
  22.       REAL*8 SIGM(3,3),QRtQ(3,3),NSIG(3,3),RtQ(3,3)
  23.       CHARACTER*(LOCOMP) MOIC
  24.       CHARACTER*8        MOTYPE
  25.       CHARACTER*14       MESSER
  26.       CHARACTER*16       TYPIC
  27.       LOGICAL LAG
  28.       COMMON /CTOURN/XPT1,YPT1,ZPT1,XV1,YV1,ZV1,XV2,YV2,ZV2,XVEC,YVEC,
  29.      #   ZVEC,ANGLE,ICLE,XP1,YP1,ZP1
  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.  

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