Télécharger la plaquette Cast3M


fr en

Télécharger tumu.eso

Retour à la liste

Numérotation des lignes : 

tumu

  1. C TUMU      SOURCE    FANDEUR   22/01/03    21:15:53     11237          
  2.       SUBROUTINE TUMU(LCH1,IRIG1,DFLO,IRIG2)
  3. ************************************************************************
  4. * NOM         : TUMU
  5. ************************************************************************
  6. * DESCRIPTION : Realise le produit tU*M*U ou M est une matrice carree
  7. *               et U est une matrice rectangle dont les colonnes sont
  8. *               donnees par un objet LISTCHPO
  9. *
  10. *               Les multiplicateurs de Lagrange sont ignores
  11. *
  12. *               Les inconnues duales de M doivent avoir ete definies
  13. *               dans la liste NOMDU de l'include CCHAMP pour savoir
  14. *               comment effectuer la multiplication a gauche
  15. *            ***********************************************************
  16. *
  17. *
  18. *                                                         U[N;L]
  19. *                                                            |
  20. *                                                            |
  21. *                                                            V
  22. *                                  +-----------+   +---+---+---+---+
  23. *                                  |           |   | C | C |   | C |
  24. *                                  |     M     |   | H | H | . | H |
  25. *                                  |           |   | P | P | . | P |  
  26. *                    tU[L;N]       |   [N;N]   |   | # | # | . | # |
  27. *                      |           |           |   | 1 | 2 |   | L |
  28. *                      |           +-----------+   +---+---+---+---+        
  29. *                      V                                     
  30. *                  +-----------+   +-----------+   +---------------+  
  31. *                  | CHPOINT#1 |   | CHP#1 * M |   |               |
  32. *                  +-----------+   +-----------+   |               |
  33. *                  | CHPOINT#2 |   | CHP#2 * M |   |     TUMU      |
  34. *                  +-----------+   +-----------+   |               |
  35. *                  |    ...    |   |    ...    |   |     [L;L]     |
  36. *                  +-----------+   +-----------+   |               |
  37. *                  | CHPOINT#L |   | CHP#L * M |   |               |
  38. *                  +-----------+   +-----------+   +---------------+
  39. *
  40. *
  41. *                  avec :  L = nombre de champs
  42. *                          N = nombre d'inconnues
  43. *                              (triplet noeud/composante/harmonique)
  44. *
  45. ************************************************************************
  46. * APPELE PAR : pod.eso
  47. ************************************************************************
  48. * ENTREES :: LCH1  = POINTEUR VERS UN OBJET LISTCHPO
  49. *            IRIG1 = POINTEUR VERS UN OBJET RIGIDITE
  50. *            DFLO  = COEFFICIENT MULTIPLICATEUR
  51. * SORTIES :: IRIG2 = POINTEUR VERS UN OBJET RIGIDITE
  52. ************************************************************************
  53.  
  54.       IMPLICIT INTEGER(I-N)
  55.       IMPLICIT REAL*8 (A-H,O-Z)
  56.  
  57. -INC PPARAM
  58. -INC CCOPTIO
  59. -INC SMCOORD
  60. -INC SMCHPOI
  61. -INC SMLCHPO
  62. -INC SMELEME
  63. -INC SMRIGID
  64. -INC CCHAMP
  65. -INC CCREEL
  66.  
  67. *
  68. *     ICPR(I) EST LE NUMERO LOCAL (DANS LE SUPPORT GEOMETRIQUE DU
  69. *     LISTCHPO LCH1) DU I-EME NOEUD GLOBAL (DANS LA TABLE XCOORD)
  70.       SEGMENT/TICPR/(ICPR(NOMAX))
  71. *
  72. *     TINCO(I) = [MCOMP(I) ; IHARM(I)]
  73. *     TINCO DEFINIT LES NBINC INCONNUES DE LA MATRICE IRIG1
  74. *     ********************************
  75. *     MCOMP(I) EST LE NOM DE COMPOSANTE DE LA I-EME INCONNUE
  76. *     IHARM(I) EST LE NUMERO D'HARMONIQUE DE LA I-EME INCONNUE
  77.       SEGMENT,TCOMP
  78.          CHARACTER*(LOCOMP) MCOMP(0)
  79.       ENDSEGMENT
  80.       SEGMENT,IHARM(0)
  81. *
  82. *     IMAI(I) EST LE MAILLAGE ASSOCIE AU I-EME SOUPO DU PREMIER CHPOINT
  83. *     IGLO(I,J) EST L'INCONNUE DE TINCO QUI CORRESPOND A L'INCONNUE
  84. *               I DU SOUPO J DU PREMIER CHPOINT
  85. *     IPOV(I,J) EST LE MPOVAL DU SOUPO DU J-EME CHPOINT QUI CORRESPOND
  86. *               AU I-EME SOUPO DU PREMIER CHPOINT (IPOV=0 SI LE SOUPO
  87. *               EST ASSOCIE AUX MULT. DE LAGRANGE)
  88. *     LA COMPOSANTE I DU SOUPO J DU PREMIER CHPOINT EST EN POSITION
  89. *     IINC(I,J,K) DANS LE SOUPO CORRESPONDANT DU K-EME CHPOINT
  90.       SEGMENT TRAV1
  91.          INTEGER IMAI(NBSOU)
  92.          INTEGER IGLO(NXMAX,NBSOU)
  93.          INTEGER IPOV(NBSOU,NBCHP)
  94.          INTEGER IINC(NXMAX,NBSOU,NBCHP)
  95.       ENDSEGMENT
  96. *
  97. *     VPO(I,J,K) EST LA VALEUR DU K-EME CHPOINT PRISE POUR LE I-EME
  98. *                NOEUD LOCAL ET POUR LA J-EME INCONNUE DE TINCO
  99. *     CC(I) ET DD(I) SONT LES VALEURS EXTRAITES DE VPO POUR FORMER LES
  100. *                    VECTEURS ELEMENTAIRES (ASSOCIES A L'ELEMENT IEL)
  101. *                    QUI SERONT MULTIPLIES PAR LE TABLEAU RE(*,*,IEL)
  102. *     IPOSP(I) DONNE LA POSITION DANS TINCO DE LA I-EME INCONNUE PRIMALE
  103. *              D'UNE MATRICE ELEMENTAIRE
  104. *     IPOSD(I) DONNE LA POSITION DANS TINCO DE LA I-EME INCONNUE DUALE
  105. *              D'UNE MATRICE ELEMENTAIRE
  106.       SEGMENT TRAV2
  107.          REAL*8  VPO(NBPOI,NBINC,NBCHP)
  108.          REAL*8  CC(NLIGMA),DD(NLIGMA)
  109.          INTEGER IPOSP(NLIGMA)
  110.          INTEGER IPOSD(NLIGMA)
  111.       ENDSEGMENT
  112. *
  113.       CHARACTER*(LOCOMP) MOCOMP
  114. *
  115. *
  116. *
  117. *     +---------------------------------------------------------------+ 
  118. *     |                                                               |
  119. *     |            T R A V A I L   P R E L I M I N A I R E            |
  120. *     |                                                               |
  121. *     +---------------------------------------------------------------+
  122. *
  123.       MLCHPO=LCH1                                                               
  124.       SEGACT,MLCHPO  
  125. *      
  126. *     ==========================================================
  127. *     CONSTRUCTION DE LA LISTE DES INCONNUES DE LA MATRICE IRIG1
  128. *     (= COUPLE NOM_DE_COMPOSANTE_PRIMALE + NUMERO_HARMONIQUE)
  129. *     ==========================================================
  130. *
  131.       MRIGID=IRIG1
  132.       SEGACT,MRIGID
  133.       NRIGEL=IRIGEL(/2)
  134. *
  135.       SEGINI,TCOMP,IHARM
  137. *
  138. *     BOUCLE SUR LES RIGIDITES ELEMENTAIRES
  139.       NLIGMA=0
  140.       DO IRI=1,NRIGEL
  141.          DESCR=IRIGEL(3,IRI)
  142.          NUHAR=IRIGEL(5,IRI)
  143.          SEGACT,DESCR
  144.          NLIGRE=LISINC(/2)
  145.          IF (NLIGRE.GT.NLIGMA) NLIGMA=NLIGRE
  146.          DO 1 I1=1,NLIGRE
  147.             MOCOMP=LISINC(I1)
  148.             DO 2 I2=1,NBINC
  149.                IF (MOCOMP.NE.MCOMP(I2)) GOTO 2
  150.                IF (NUHAR .EQ.IHARM(I2)) GOTO 1
  151.   2         CONTINUE
  152.             MCOMP(**)=MOCOMP
  153.             IHARM(**)=NUHAR
  155.   1      CONTINUE
  156.       ENDDO
  157. *
  158. *
  159. *     ===================================
  160. *     NOMBRE DE CHPOINTS DANS LE LISTCHPO
  161. *     ===================================
  162. *
  163.       NBCHP=ICHPOI(/1)
  164.       IF (NBCHP.EQ.0) THEN
  165.          MOTERR(1:8)='LISTCHPO'
  166.          INTERR(1)=LCH1
  167.          CALL ERREUR(356)
  168.          RETURN
  169.       ENDIF
  170. *
  171. *
  172. *     ===============================================================
  173. *     CORRESPONDANCE ENTRE LES INCONNUES DU PREMIER CHPOINT ET CELLES
  174. *     DES CHPOINTS SUIVANTS + CORRESPONDANCE AVEC LA LISTE GLOBALE
  175. *     TINCO DES INCONNUES DE LA MATRICE (REMPLISSAGE DE TRAV1)
  176. *     CORRESPONDANCE ENTRE LES NUMEROTATIONS LOCALE ET GLOBALE
  177. *     (REMPLISSAGE DE ICPR)
  178. *     ===============================================================
  179. *
  180.       MCHPO1=ICHPOI(1)
  181.       SEGACT,MCHPO1
  182. *
  183.       NBSOU=MCHPO1.IPCHP(/1)
  184.       IF (NBSOU.EQ.0) THEN
  185.          MOTERR(1:8)='CHPOINT'
  186.          CALL ERREUR(1027)
  187.          RETURN
  188.       ENDIF
  189. *
  190.       NXMAX=3
  191.       SEGINI,TRAV1
  192. *     
  193.       segact mcoord*mod
  194.       NOMAX=nbpts
  195.       SEGINI,TICPR
  196.       NBPOI=0
  197. *   
  198. *
  199. *     **************************************
  200. *     BOUCLE 1 SUR LES SOUPOS DU 1ER CHPOINT
  201. *     **************************************
  202.       DO 10 IS1=1,NBSOU              
  203.          MSOUP1=MCHPO1.IPCHP(IS1)                                                   
  204.          SEGACT,MSOUP1
  205. *
  206. *        ON IGNORE LES MULTIPLICATEURS DE LAGRANGE
  207.          NX1=MSOUP1.NOCOMP(/2)
  208.          MOCOMP=MSOUP1.NOCOMP(1)
  209.          IF (MOCOMP.EQ.'LX'.OR.MOCOMP.EQ.'FLX') THEN
  210.             SEGDES,MSOUP1
  211.             GOTO 10
  212.          ENDIF
  213. *
  214.          IF (NX1.GT.NXMAX) THEN
  215.             NXMAX=NX1
  216.             SEGADJ,TRAV1
  217.          ENDIF
  218. *
  219. *        CORRESPONDANCE ENTRE LES INCONNUES DU SOUPO ET CELLES DE TINCO
  220.          DO IX1=1,NX1
  221.             MOCOMP=MSOUP1.NOCOMP(IX1)
  222.             NOHA  =MSOUP1.NOHARM(IX1)
  223.             DO 11 IX2=1,NBINC
  224.                IF (MOCOMP.NE.MCOMP(IX2)) GOTO 11
  225.                IF (NOHA  .NE.IHARM(IX2)) GOTO 11
  226.                IGLO(IX1,IS1)=IX2
  227.   11        CONTINUE
  228.             IINC(IX1,IS1,1)=IX1
  229.          ENDDO
  230. *
  231. *        ON VERIFIE QUE LE MAILLAGE N'EST PAS VIDE
  232.          IGEO1=MSOUP1.IGEOC
  233.          IF (IGEO1.LE.0) THEN
  234.             MOTERR(1:8)='CHPOINT'
  235.             CALL ERREUR(1027)
  236.             RETURN
  237.          ENDIF
  238.          IMAI(IS1)=IGEO1
  239.          IPT1=IGEO1
  240.          SEGACT,IPT1
  241.          NNO1=IPT1.NUM(/2)
  242.          IF (NNO1.EQ.0) GOTO 10        
  243. *
  244. *        CONSTRUCTION DE LA TABLE ICPR
  245. *        (NUMEROTATION GLOBALE <=> LOCALE)
  246.          DO 12 I1=1,NNO1
  247.             K1=IPT1.NUM(1,I1)
  248.             IF (ICPR(K1).NE.0) GOTO 12
  249.             NBPOI=NBPOI+1
  250.             ICPR(K1)=NBPOI
  251.   12     CONTINUE
  252.          SEGDES,IPT1
  253. *
  254. *        POINTEUR DIRECT VERS LE SEGMENT MPOVAL
  255.          IPOV(IS1,1)=MSOUP1.IPOVAL
  256. *
  257. *
  258. *        ********************************
  259. *        BOUCLE 2 SUR LES AUTRES CHPOINTS
  260. *        ********************************
  261.          DO 14 ICH=2,NBCHP
  262.             MCHPO2=ICHPOI(ICH)
  263.             SEGACT,MCHPO2
  264.             NS2=MCHPO2.IPCHP(/1)         
  265. *           
  266. *           **********************************************
  267. *           ON VA CHERCHER LE SOUPO CORRESPONDANT A MSOUP1
  268. *           => BOUCLE 3 SUR LES SOUPOS DE MCHPO2
  269. *           **********************************************
  270.             DO 13 IS2=1,NS2                                                           
  271.                MSOUP2=MCHPO2.IPCHP(IS2)                                                   
  272.                SEGACT,MSOUP1,MSOUP2
  273. *
  274. *              MEME MAILLAGE ?
  275.                IGEO2=MSOUP2.IGEOC
  276.                IF (IGEO1.NE.IGEO2) THEN
  277.                   SEGDES,MSOUP2
  278.                   GOTO 13
  279.                ENDIF
  280. *
  281. *              MEME NOMBRE DE COMPOSANTES ?
  282.                NX2=MSOUP2.NOCOMP(/2)
  283.                MOCOMP=MSOUP1.NOCOMP(1)
  284.                IF (MOCOMP.EQ.'LX'.OR.MOCOMP.EQ.'FLX'.OR.NX1.NE.NX2) THEN
  285.                   SEGDES,MSOUP2
  286.                   GOTO 13
  287.                ENDIF
  288.                IF (NX2.GT.NXMAX) THEN
  289.                   NXMAX=NX2
  290.                   SEGADJ,TRAV1
  291.                ENDIF
  292. *
  293. *              MEMES LISTES DE COMPOSANTES ?
  294. *              => ON FAIT LA CORRESPONDANCE ENTRE LES COMPOSANTES DES
  295. *                 2 SOUPOS
  296.                DO 15 IX1=1,NX1
  297.                   MOCOMP=MSOUP1.NOCOMP(IX1)
  298.                   DO 16 IX2=1,NX2
  299.                      IF (MOCOMP.NE.MSOUP2.NOCOMP(IX2)) GOTO 16
  300.                      IF (MSOUP1.NOHARM(IX1).EQ.MSOUP2.NOHARM(IX2)) THEN
  301.                         IINC(IX1,IS1,ICH)=IX2
  302.                         GOTO 15
  303.                      ENDIF
  304.   16              CONTINUE
  305.                   GOTO 19
  306.   15           CONTINUE
  307. *
  308. *              POINTEUR DIRECT VERS LE SEGMENT MPOVAL
  309.                IPOV(IS1,ICH)=MSOUP2.IPOVAL
  310. *
  311. *              (CHPOINT SUIVANT)
  312.                SEGDES,MSOUP2,MCHPO2
  313.                GOTO 14
  314. *
  315.   13        CONTINUE
  316. *                                                                                     
  317. *           MESSAGE D'ERREUR                                                          
  318. *           ****************
  319.   19        CONTINUE
  320.             WRITE(MOTERR(1:16),FMT='(2I8)') MCHPO1,MCHPO2
  321.             CALL ERREUR(135)                                                          
  322.             RETURN                                                                                                                          
  323. *        
  324.   14     CONTINUE
  325.          SEGDES,MSOUP1
  326. *
  327.   10  CONTINUE
  328.       SEGDES,MCHPO1,MLCHPO
  329. *
  330. *
  331. *     ========================================================
  332. *     STOCKAGE DES VALEURS DU LISTCHPO DANS UN TABLEAU ORDONNE
  333. *     SELON LA GEOMETRIE LOCALE (ICPR) ET SELON LES INCONNUES
  334. *     DE LA MATRICE D'ENTREE (TINCO) => REMPLISSAGE DE TRAV2
  335. *     ========================================================
  336. *
  337.       SEGINI,TRAV2
  338.       DO ICH=1,NBCHP
  339.          DO 20 ISOU=1,NBSOU
  340.             IPO1=IPOV(ISOU,ICH)
  341.             IF (IPO1.EQ.0) GOTO 20
  342.             MPOVAL=IPO1
  343.             MELEME=IMAI(ISOU)
  344.             SEGACT,MELEME,MPOVAL
  345.             NNO=VPOCHA(/1)
  346.             NIX=VPOCHA(/2)
  347.             DO 21 IX=1,NIX
  348.                IX1=IGLO(IX,ISOU)
  349.                IF (IX1.EQ.0) GOTO 21
  350.                IIX=IINC(IX,ISOU,ICH)
  351.                DO INO=1,NNO
  352.                   N1=ICPR(NUM(1,INO))
  353.                   VPO(N1,IX1,ICH)=VPOCHA(INO,IIX)
  354.                ENDDO
  355.   21        CONTINUE
  356.             SEGDES,MELEME,MPOVAL
  357.   20     CONTINUE
  358.       ENDDO
  359.       SEGSUP,TRAV1
  360. *
  361. *
  362. *
  363. *     +---------------------------------------------------------------+
  364. *     |                                                               |
  365. *     |       C R E A T I O N   D U   S U P E R - E L E M E N T       |
  366. *     |                                                               |
  367. *     +---------------------------------------------------------------+
  368. *
  369.       NBSOUS=0
  370.       NBELEM=1
  371.       NBNN=NBCHP
  372.       NBREF=0
  373.       SEGINI,IPT1
  374.       IPT1.ITYPEL=28
  375.       segact mcoord*mod
  376.       NBPT1=nbpts
  377.       NBPTS=NBPT1+NBNN
  378.       SEGADJ,MCOORD
  379.       DO K=1,NBNN
  380.          K1=(NBPT1+K-1)*(IDIM+1)
  381.          XCOOR(K1+1)=K
  382.          XCOOR(K1+2)=0
  383.          IF (IDIM.EQ.3) XCOOR(K1+3)=0
  384.          IPT1.NUM(K,1)=NBPT1+K
  385.       ENDDO
  386.       SEGDES,IPT1
  387. *
  388. *
  389. *
  390. *     +---------------------------------------------------------------+
  391. *     |                                                               |
  392. *     |       D E S C R I P T E U R   D E   L A   M A T R I C E       |
  393. *     |                                                               |
  394. *     +---------------------------------------------------------------+
  395. *
  396.       NLIGRP=NBCHP
  397.       NLIGRD=NBCHP
  398.       SEGINI,DES1
  399.       DO K=1,NBCHP
  400.          DES1.LISINC(K)='ALFA'
  401.          DES1.LISDUA(K)='FALF'
  402.          DES1.NOELEP(K)=K
  403.          DES1.NOELED(K)=K
  404.       ENDDO
  405.       SEGDES,DES1
  406. *
  407. *
  408. *
  409. *     +---------------------------------------------------------------+
  410. *     |                                                               |
  411. *     |          R E M P L I S S A G E   D U   C O N T E N U          |
  412. *     |                                                               |
  413. *     +---------------------------------------------------------------+
  414. *
  415.       NELRIG=1
  416.       SEGINI,XMATR1
  417. *
  418.       ISYM1=IRIGEL(7,1)
  419. *
  420. *     (BOUCLE 1 SUR LES SOUS-MATRICES)
  421.       DO 30 IRI=1,NRIGEL
  422.          MELEME=IRIGEL(1,IRI)
  423.          SEGACT,MELEME
  424.          IF (ITYPEL.EQ.22) GOTO 30
  425. *
  426.          DESCR=IRIGEL(3,IRI)
  427.          SEGACT,DESCR
  428.          NINCP=LISINC(/2)
  429.          NINCD=LISDUA(/2)
  430. *        ON VERIFIE QUE LA MATRICE EST CARREE
  431.          IF (NINCP.NE.NINCD) THEN
  432.             CALL ERREUR(21)
  433.             RETURN
  434.          ENDIF
  435. * *       ON VERIFIE LA CORRESPONDANCE ENTRE LA LIGNE ET LA COLONNE D'UN
  436. * *       NOEUD DONNE
  437. *         DO K=1,NINCP
  438. *            IF (NOELED(K).NE.NOELEP(K)) THEN
  439. *               CALL ERREUR(21)
  440. *               RETURN
  441. *            ENDIF
  442. *         ENDDO
  443. *
  444.          NUHAR=IRIGEL(5,IRI)
  445. *
  446.          ISYME=IRIGEL(7,IRI)
  447.          IF (ISYME.NE.ISYM1) ISYM1=2
  448. *
  449. *
  450. *        =========================================================
  451. *        CORRESPONDANCE ENTRE LES INCONNUES PRIMALES DE LA MATRICE
  452. *        ELEMENTAIRE ET LES INCONNUES "GLOBALES" DU SEGMENT TINCO
  453. *        (SELON LESQUELLES SONT ORDONNES TOUS LES VPOCHA)
  454. *        =========================================================
  455. *
  456.          DO 31 IN1=1,NINCP
  457.             MOCOMP=LISINC(IN1)
  458.             DO 32 IN2=1,NBINC
  459.                IF (MOCOMP.NE.MCOMP(IN2)) GOTO 32
  460.                IF (NUHAR .EQ.IHARM(IN2)) THEN
  461.                   IPOSP(IN1)=IN2
  462.                   GOTO 31
  463.                ENDIF
  464.   32        CONTINUE
  465.   31     CONTINUE
  466. *      
  467. *
  468. *        ========================================================
  469. *        CORRESPONDANCE ENTRE LES INCONNUES DUALES DE LA MATRICE
  470. *        ELEMENTAIRE ET LES INCONNUES "GLOBALES" DU SEGMENT TINCO
  471. *        L'ASSOCIATION EST FAITE GRACE AUX LISTES DEFINIES DANS
  472. *        L'INCLUDE CCHAMP
  473. *        ========================================================
  474. *
  475.          DO 33 IN1=1,NINCD
  476.             MOCOMP=LISDUA(IN1)
  477.  
  478. *           ON CHERCHE LA PRIMALE ASSOCIEE A LA DUALE NUMERO IN1
  479.             DO IC1=1,LNOMDU
  480.                IF (MOCOMP.EQ.NOMDU(IC1)) GOTO 34
  481.             ENDDO
  482.  
  483. *           ERREUR : COMPOSANTE NON REFERENCEE DANS CCHAMP
  484.             MOTERR=MOCOMP
  485.             CALL ERREUR(108)
  486.             RETURN
  487.  
  488.   34        CONTINUE
  489.             MOCOMP=NOMDD(IC1)
  490.             DO 35 IN2=1,NBINC
  491.                IF (MOCOMP.NE.MCOMP(IN2)) GOTO 35
  492.                IF (NUHAR .EQ.IHARM(IN2)) THEN
  493.                   IPOSD(IN1)=IN2
  494.                   GOTO 33
  495.                ENDIF
  496.   35        CONTINUE
  497.  
  498.             CALL ERREUR(21)
  499.             RETURN
  500.   33     CONTINUE
  501. *      
  502. *
  503. *        ================================================
  504. *        CALCUL DES PRODUITS MATRICE/VECTEUR ELEMENTAIRES
  505. *        ================================================
  506. *
  507.          NNO=NUM(/1)
  508.          NEL=NUM(/2)
  509.          COER=COERIG(IRI)
  510.          XMATRI=IRIGEL(4,IRI)
  511.          SEGACT,XMATRI
  512. *
  513. *        ********************************************
  514. *        BOUCLE 2 SUR LES ELEMENTS DE LA SOUS-MATRICE
  515. *        ********************************************
  516.          DO 36 IEL=1,NEL
  517. *
  518. *           ON VERIFIE QUE LA RIGIDITE ELEMENTAIRE POSSEDE UN SUPPORT
  519. *           GEOMETRIQUE COMPATIBLE AVEC LE LISTCHPO
  520.             DO INO=1,NNO
  521.                IF (ICPR(NUM(INO,IEL)).NE.0) GOTO 37
  522.             ENDDO
  523.             GOTO 36
  524.   37        CONTINUE
  525. *
  526. *           ************************************
  527. *           BOUCLE 3 SUR LES CHPOINTS "A DROITE"
  528. *           ************************************
  529.             DO ICH=1,NBCHP
  530. *
  531. *              FABRICATION DU VECTEUR ELEMENTAIRE POUR LA
  532. *              MULTIPLICATION A DROITE
  533.                DO INP=1,NINCP
  534.                   I1=ICPR(NUM(NOELEP(INP),IEL))                                               
  535.                   IF (I1.EQ.0) THEN
  536.                      CC(INP)=0.D0
  537.                   ELSE
  538.                      I2=IPOSP(INP)                                                               
  539.                      CC(INP)=VPO(I1,I2,ICH) 
  540.                   ENDIF
  541.                ENDDO
  542. *        
  543. *              REMPLISSAGE DE LA DIAGONALE
  544.                VA=XTMXMU(CC,RE(1,1,IEL),NINCP,ISYME)*COER
  545.                XMATR1.RE(ICH,ICH,1)=XMATR1.RE(ICH,ICH,1)+VA
  546. *
  547. *
  548. *              REMPLISSAGE DU TRIANGLE SUPERIEUR
  549. *              ************************************
  550. *              BOUCLE 4 SUR LES CHPOINTS "A GAUCHE"
  551. *              ************************************
  552.                DO JCH=ICH+1,NBCHP
  553. *
  554. *                 FABRICATION DU VECTEUR ELEMENTAIRE POUR LA
  555. *                 MULTIPLICATION A GAUCHE
  556.                   DO IND=1,NINCD
  557.                      I1=ICPR(NUM(NOELED(IND),IEL))                                               
  558.                      IF (I1.EQ.0) THEN
  559.                         DD(IND)=0.D0
  560.                      ELSE
  561.                         I2=IPOSD(IND)                                                               
  562.                         DD(IND)=VPO(I1,I2,JCH)
  563.                      ENDIF
  564.                   ENDDO
  565. *
  566. *
  567. *                 *********************************************
  568. *                 BOUCLES 5 ET 6 SUR LES LIGNES ET LES COLONNES
  569. *                 DE LA MATRICE ELEMENTAIRE
  570. *                 *********************************************
  571.                   VA=0.D0
  572. *
  573. *                 MATRICE ELEMENTAIRE SYMETRIQUE
  574. *                 => ON MULTIPLIE PLUTOT PAR LA MATRICE TRANSPOSEE CAR
  575. *                    C'EST PLUS PERFORMANT EN FORTRAN
  576.                   IF (ISYME.EQ.0) THEN
  577.                      DO IND=1,NINCD
  578.                         IF (ABS(DD(IND)).GT.XPETIT) THEN
  579.                            VB=0.D0
  580.                            DO INP=1,NINCP
  581.                               VB=VB+RE(INP,IND,IEL)*CC(INP)
  582.                            ENDDO
  583.                            VA=VA+DD(IND)*VB
  584.                         ENDIF
  585.                      ENDDO
  586. *
  587. *                 MATRICE ELEMENTAIRE DIAGONALE
  588.                   ELSEIF (ISYME.EQ.3) THEN
  589.                      DO IN=1,NINCP
  590.                         VA=VA+DD(IN)*RE(IN,IN,IEL)*CC(IN)
  591.                      ENDDO
  592. *
  593. *                 MATRICE ELEMENTAIRE ANTI-SYMETRIQUE OU QUELCONQUE
  594.                   ELSE
  595.                      DO IND=1,NINCD
  596.                         IF (ABS(DD(IND)).GT.XPETIT) THEN
  597.                            VB=0.D0
  598.                            DO INP=1,NINCP
  599.                               VB=VB+RE(IND,INP,IEL)*CC(INP)
  600.                            ENDDO
  601.                            VA=VA+DD(IND)*VB
  602.                         ENDIF
  603.                      ENDDO
  604.                   ENDIF
  605. *
  606.                   XMATR1.RE(ICH,JCH,1)=XMATR1.RE(ICH,JCH,1)+COER*VA
  607. *
  608.                ENDDO
  609.             ENDDO
  610.   36     CONTINUE
  611. *
  612.          SEGDES,XMATRI,DESCR,MELEME
  613. *        
  614.   30  CONTINUE
  615. *
  616.       SEGDES,MRIGID
  617.       SEGSUP,TRAV2,TCOMP,IHARM,TICPR
  618. *
  619. *
  620. *     =================================
  621. *     REMPLISSAGE DU TRIANGLE INFERIEUR
  622. *     =================================
  623.       DO ICH=1,NBCHP
  624.          DO JCH=ICH+1,NBCHP
  625.             XMATR1.RE(JCH,ICH,1)=XMATR1.RE(ICH,JCH,1)
  626.          ENDDO
  627.       ENDDO
  628. *   
  629. *
  630. *
  631. *
  632. *     +---------------------------------------------------------------+ 
  633. *     |                                                               |
  634. *     |               C H A P E A U   D U   M R I G I D               |
  635. *     |                                                               |
  636. *     +---------------------------------------------------------------+
  637. *
  638.       NRIGEL=1
  639.       SEGINI,MRIGID
  640.       IRIG2=MRIGID
  641.       MTYMAT='RIGIDITE'
  642.       COERIG(1)=DFLO
  643.       IRIGEL(1,1)=IPT1
  644.       IRIGEL(2,1)=0
  645.       IRIGEL(3,1)=DES1
  646.       IRIGEL(4,1)=XMATR1
  647.       IRIGEL(5,1)=0
  648.       IRIGEL(6,1)=0
  649.       IRIGEL(7,1)=ISYM1
  650.       xmatr1.symre=isym1
  651.       SEGDES,XMATR1
  652.       ICHOLE=0
  653.       IMGEO1=0
  654.       IMGEO2=0
  655.       IFORIG=IFOUR
  656.       ISUPEQ=0
  657.       JRCOND=0
  658.       JRDEPP=0
  659.       JRDEPD=0
  660.       JRELIM=0
  661.       JRGARD=0
  662.       JRTOT=0
  663.       IMLAG=0
  664.       IPROFO=0
  665.       IVECRI=0    
  666.       SEGDES,MRIGID
  667. *
  668. *
  669.       RETURN
  670. *
  671.       END
  672. *
  673. * 
  674.  
  675.  
  676.  
  677.  
  678.  
  679.  

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