Télécharger la plaquette Cast3M


fr en

Télécharger tuu.eso

Retour à la liste

Numérotation des lignes : 

tuu

  1. C TUU       SOURCE    FANDEUR   22/01/03    21:15:54     11237          
  2.       SUBROUTINE TUU(LCH1,DFLO,IRIG)
  3. ************************************************************************
  4. * NOM         : TUU
  5. ************************************************************************
  6. * DESCRIPTION : Realise le produit tU*U ou U est une matrice rectangle
  7. *               dont les colonnes sont donnees par un objet LISTCHPO
  8. *
  9. *               Les multiplicateurs de Lagrange sont ignores
  10. *            ***********************************************************
  11. *
  12. *               
  13. *                                          +---+---+---+---+
  14. *                             U[N;L] --->  | C | C |   | C |
  15. *                                          | H | H | . | H |
  16. *                                          | P | P | . | P |  
  17. *                          tU[L;N]         | # | # | . | # |
  18. *                            |             | 1 | 2 |   | L |
  19. *                            |             +---+---+---+---+
  20. *                            V                 
  21. *                          +-----------+   +---------------+               
  22. *                          | CHPOINT#1 |   |               |
  23. *                          +-----------+   |               |
  24. *                          | CHPOINT#2 |   |      TUU      |
  25. *                          +-----------+   |               |
  26. *                          |    ...    |   |     [L;L]     |
  27. *                          +-----------+   |               |
  28. *                          | CHPOINT#L |   |               |
  29. *                          +-----------+   +---------------+
  30. *
  31. *
  32. *                  avec :  L = nombre de champs
  33. *                          N = nombre d'inconnues
  34. *                              (triplet noeud/composante/harmonique)
  35. *
  36. ************************************************************************
  37. * APPELE PAR : pod.eso
  38. ************************************************************************
  39. * ENTREES :: LCH1 = POINTEUR VERS UN OBJET LISTCHPO
  40. *            DFLO = COEFFICIENT MULTIPLICATEUR
  41. * SORTIES :: IRIG = POINTEUR VERS UN OBJET RIGIDITE
  42. ************************************************************************  
  43.       IMPLICIT INTEGER(I-N)
  44.       IMPLICIT REAL*8 (A-H,O-Z)     
  45.  
  46. -INC PPARAM
  47. -INC CCOPTIO
  48. -INC SMCOORD
  49. -INC SMCHPOI
  50. -INC SMLCHPO
  51. -INC SMELEME
  52. -INC SMRIGID
  53. *
  54. *     IPOV(I,J) = POINTEUR VERS LE MPOVAL DU SOUPO DU J-EME CHPOINT QUI
  55. *                 CORRESPOND AU I-EME SOUPO DU PREMIER CHPOINT (IPOV=0
  56. *                 SI LE SOUPO EST ASSOCIE AUX MULT. DE LAGRANGE)
  57. *     IINC(I,J,K) = L'INCONNUE I DU SOUPO J DU PREMIER CHPOINT EST EN
  58. *                   POSITION IINC(I,J,K) DANS LE SOUPO CORRESPONDANT DU
  59. *                   K-EME CHPOINT
  60.       SEGMENT TTRAV
  61.          INTEGER IPOV(NS1,NCH)
  62.          INTEGER IINC(NXMAX,NS1,NCH)
  63.       ENDSEGMENT
  64. *
  65.       CHARACTER*(LOCOMP) MOCOMP
  66. *
  67. *
  68. *
  69. *     +---------------------------------------------------------------+ 
  70. *     |            T R A V A I L   P R E L I M I N A I R E            |
  71. *     +---------------------------------------------------------------+
  72. *
  73.       MLCHPO=LCH1                                                               
  74.       SEGACT,MLCHPO  
  75. *
  76. *
  77. *     ***********************************
  78. *     NOMBRE DE CHPOINTS DANS LE LISTCHPO
  79. *     ***********************************
  80.       NCH=ICHPOI(/1)
  81.       IF (NCH.EQ.0) THEN
  82.          MOTERR(1:8)='LISTCHPO'
  83.          INTERR(1)=LCH1
  84.          CALL ERREUR(356)
  85.          RETURN
  86.       ENDIF
  87. *
  88. *      
  89. *     ************************************************************
  90. *     CORRESPONDANCE ENTRE LES SOUPO ET LES COMPOSANTES DU PREMIER
  91. *     CHPOINT ET DES CHPOINTS SUIVANTS => REMPLISSAGE DE TTRAV
  92. *     ************************************************************
  93.       MCHPO1=ICHPOI(1)
  94.       SEGACT,MCHPO1
  95. *
  96.       NS1=MCHPO1.IPCHP(/1)
  97.       IF (NS1.EQ.0) THEN
  98.          MOTERR(1:8)='CHPOINT'
  99.          CALL ERREUR(1027)
  100.          RETURN
  101.       ENDIF
  102. *     
  103.       NXMAX=3
  104.       SEGINI,TTRAV
  105. *  
  106. *     BOUCLE 1 SUR LES SOUPOS DU 1ER CHPOINT
  107. *     ======================================
  108.       DO 10 IS1=1,NS1              
  109.          MSOUP1=MCHPO1.IPCHP(IS1)                                                   
  110.          SEGACT,MSOUP1
  111. *
  112. *        ON IGNORE LES MULTIPLICATEURS DE LAGRANGE
  113.          NX1   =MSOUP1.NOCOMP(/2)
  114.          MOCOMP=MSOUP1.NOCOMP(1)
  115.          IF (MOCOMP.EQ.'LX'.OR.MOCOMP.EQ.'FLX') THEN
  116.             SEGDES,MSOUP1
  117.             GOTO 10
  118.          ENDIF
  119. *
  120. *        ON VERIFIE QUE LE MAILLAGE N'EST PAS VIDE
  121.          IGEO1=MSOUP1.IGEOC
  122.          IF (IGEO1.LE.0) THEN
  123.             MOTERR(1:8)='CHPOINT'
  124.             CALL ERREUR(1027)
  125.             RETURN
  126.          ENDIF
  127. *
  128. *        POINTEUR DIRECT VERS LE SEGMENT MPOVAL
  129.          IPOV(IS1,1)=MSOUP1.IPOVAL
  130. *
  131. *        BOUCLE 2 SUR LES AUTRES CHPOINTS
  132. *        ================================
  133.          DO 11 ICH=2,NCH
  134.             MCHPO2=ICHPOI(ICH)
  135.             SEGACT,MCHPO2
  136.             NS2=MCHPO2.IPCHP(/1)         
  137. *           
  138. *           ON VA CHERCHER LE SOUPO CORRESPONDANT A MSOUP1
  139. *           => BOUCLE 3 SUR LES SOUPOS DE MCHPO2
  140. *           ==============================================
  141.             DO 12 IS2=1,NS2                                                           
  142.                MSOUP2=MCHPO2.IPCHP(IS2)                                                   
  143.                SEGACT,MSOUP1,MSOUP2
  144. *
  145. *              MEME MAILLAGE ?
  146.                IGEO2=MSOUP2.IGEOC
  147.                IF (IGEO1.NE.IGEO2) THEN
  148.                   SEGDES,MSOUP2
  149.                   GOTO 12
  150.                ENDIF
  151. *
  152. *              MEME NOMBRE DE COMPOSANTES ?
  153.                NX2   =MSOUP2.NOCOMP(/2)
  154.                MOCOMP=MSOUP1.NOCOMP(1)
  155.                IF (MOCOMP.EQ.'LX'.OR.MOCOMP.EQ.'FLX'.OR.NX1.NE.NX2) THEN
  156.                   SEGDES,MSOUP2
  157.                   GOTO 12
  158.                ENDIF
  159.                IF (NX2.GT.NXMAX) THEN
  160.                   NXMAX=NX2
  161.                   SEGADJ,TTRAV
  162.                ENDIF
  163. *
  164. *              MEMES LISTES DE COMPOSANTES ?
  165. *              => ON FAIT LA CORRESPONDANCE ENTRE LES COMPOSANTES DES
  166. *                 2 SOUPOS
  167.                DO 13 IX1=1,NX1
  168.                   MOCOMP=MSOUP1.NOCOMP(IX1)
  169.                   DO IX2=1,NX2
  170.                      IF (MOCOMP.EQ.MSOUP2.NOCOMP(IX2)) THEN
  171.                         IINC(IX1,IS1,ICH)=IX2
  172.                         GOTO 13
  173.                      ENDIF
  174.                   ENDDO
  175.                   GOTO 19
  176.   13           CONTINUE
  177. *        
  178. *              POINTEUR DIRECT VERS LE SEGMENT MPOVAL
  179.                IPOV(IS1,ICH)=MSOUP2.IPOVAL
  180. *
  181. *              (CHPOINT SUIVANT)
  182.                SEGDES,MSOUP2,MCHPO2
  183.                GOTO 11
  184. *
  185.   12        CONTINUE
  186. *                                                                                     
  187. *           MESSAGE D'ERREUR                                                          
  188. *           ****************
  189.   19        CONTINUE
  190.             WRITE(MOTERR(1:16),FMT='(2I8)') MCHPO1,MCHPO2
  191.             CALL ERREUR(135)                                                          
  192.             RETURN                                                                                                                          
  193. *        
  194.   11     CONTINUE
  195.          SEGDES,MSOUP1
  196. *
  197.   10  CONTINUE
  198.       SEGDES,MCHPO1
  199. *
  200. *
  201. *
  202. *     +---------------------------------------------------------------+ 
  203. *     |       C R E A T I O N   D U   S U P E R - E L E M E N T       |
  204. *     +---------------------------------------------------------------+
  205. *
  206.       NBSOUS=0
  207.       NBELEM=1
  208.       NBNN=NCH
  209.       NBREF=0
  210.       SEGINI,MELEME
  211.       ITYPEL=28
  212.       segact mcoord*mod
  213.       NBPT1=nbpts
  214.       NBPTS=NBPT1+NBNN
  215.       SEGADJ,MCOORD
  216.       DO K=1,NBNN
  217.          K1=(NBPT1+K-1)*(IDIM+1)
  218.          XCOOR(K1+1)=K
  219.          XCOOR(K1+2)=0
  220.          IF (IDIM.EQ.3) XCOOR(K1+3)=0
  221.          NUM(K,1)=NBPT1+K
  222.       ENDDO
  223.       SEGDES,MELEME
  224. *
  225. *
  226. *
  227. *     +---------------------------------------------------------------+ 
  228. *     |       D E S C R I P T E U R   D E   L A   M A T R I C E       |
  229. *     +---------------------------------------------------------------+
  230. *
  231.       NLIGRP=NCH
  232.       NLIGRD=NCH
  233.       SEGINI,DESCR
  234.       DO K=1,NCH
  235.          LISINC(K)='ALFA'
  236.          LISDUA(K)='FALF'
  237.          NOELEP(K)=K
  238.          NOELED(K)=K
  239.       ENDDO
  240.       SEGDES,DESCR
  241. *
  242. *
  243. *     +---------------------------------------------------------------+ 
  244. *     |          R E M P L I S S A G E   D U   C O N T E N U          |
  245. *     +---------------------------------------------------------------+
  246. *
  247.       NELRIG=1
  248.       SEGINI,XMATRI
  249. *
  250.       DO ICH=1,NCH
  251.          DO 20 ISOU=1,NS1
  252.             IPO1=IPOV(ISOU,ICH)
  253.             IF (IPO1.EQ.0) GOTO 20
  254.             MPOVA1=IPO1
  255.             SEGACT,MPOVA1
  256.             NNO=MPOVA1.VPOCHA(/1)
  257.             NIX=MPOVA1.VPOCHA(/2)
  258. *
  259. *           REMPLISSAGE DE LA DIAGONALE
  260. *           ===========================
  261.             XVAL=0.
  262.             DO IIX=1,NIX
  263.                DO INO=1,NNO
  264.                   XX=MPOVA1.VPOCHA(INO,IIX)
  265.                   XVAL=XVAL+XX*XX
  266.                ENDDO
  267.             ENDDO
  268.             RE(ICH,ICH,1)=RE(ICH,ICH,1)+XVAL
  269. *
  270. *           REMPLISSAGE DU TRIANGLE SUPERIEUR
  271. *           =================================
  272.             DO 21 JCH=ICH+1,NCH
  273.                IPO2=IPOV(ISOU,JCH)
  274.                IF (IPO2.EQ.0) GOTO 21
  275.                MPOVA2=IPO2
  276.                SEGACT,MPOVA1,MPOVA2
  277. *          
  278.                XVAL=0.
  279.                DO IIX=1,NIX
  280.                   JIX=IINC(IIX,ISOU,JCH)
  281.                   DO INO=1,NNO
  282.                      XVAL=XVAL+MPOVA1.VPOCHA(INO,IIX)
  283.      &                        *MPOVA2.VPOCHA(INO,JIX)
  284.                   ENDDO
  285.                ENDDO
  286.                RE(ICH,JCH,1)=RE(ICH,JCH,1)+XVAL
  287. *               
  288.                SEGDES,MPOVA2
  289.   21        CONTINUE
  290. *
  291.             SEGDES,MPOVA1
  292.   20     CONTINUE
  293. *
  294. *        REMPLISSAGE DU TRIANGLE INFERIEUR
  295. *        =================================
  296.          DO JCH=ICH+1,NCH
  297.             RE(JCH,ICH,1)=RE(ICH,JCH,1)
  298.          ENDDO
  299. *
  300.       ENDDO
  301. *
  302. *
  303.       SEGSUP,TTRAV  
  304.       SEGDES,MLCHPO,XMATRI
  305. *
  306. *
  307. *
  308. *     +---------------------------------------------------------------+ 
  309. *     |               C H A P E A U   D U   M R I G I D               |
  310. *     +---------------------------------------------------------------+
  311. *
  312.       NRIGEL=1
  313.       SEGINI,MRIGID
  314.       IRIG=MRIGID
  315.       MTYMAT='RIGIDITE'
  316.       COERIG(1)=DFLO
  317.       IRIGEL(1,1)=MELEME
  318.       IRIGEL(2,1)=0
  319.       IRIGEL(3,1)=DESCR
  320.       IRIGEL(4,1)=XMATRI
  321.       IRIGEL(5,1)=0
  322.       IRIGEL(6,1)=0
  323.       IRIGEL(7,1)=0
  324.       ICHOLE=0
  325.       IMGEO1=0
  326.       IMGEO2=0
  327.       IFORIG=IFOUR
  328.       ISUPEQ=0
  329.       JRCOND=0
  330.       JRDEPP=0
  331.       JRDEPD=0
  332.       JRELIM=0
  333.       JRGARD=0
  334.       JRTOT=0
  335.       IMLAG=0
  336.       IPROFO=0
  337.       IVECRI=0    
  338.       SEGDES,MRIGID
  339. *
  340. *
  341.       RETURN
  342. *
  343.       END                                                                       
  344. *
  345. * 
  346.  
  347.  
  348.  
  349.  
  350.  

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