Télécharger la plaquette Cast3M


fr en

Télécharger cmct1.eso

Retour à la liste

Numérotation des lignes : 

cmct1

  1. C CMCT1     SOURCE    FANDEUR   22/03/01    21:15:02     11301          
  2.       SUBROUTINE CMCT1(ICHP,IRIG,IRIG2)
  3. *_______________________________________________________________________
  4. c
  5. c      opérateur cmct
  6. c
  7. c entrée
  8. c   ICHP : champ par point qui stocke la masse inversée
  9. c   IRIG : rigidité contenant les blocages
  10. c
  11. c sortie
  12. c   IRIG2 : rigidité contenant la matrice condensée
  13. c
  14. *_______________________________________________________________________
  15.  
  16.       IMPLICIT INTEGER(I-N)
  17.       IMPLICIT REAL*8(A-H,O-Z)
  18. *
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC SMRIGID
  23. -INC SMELEME
  24. -INC SMCOORD
  25. -INC SMCHPOI
  26. *  stockage des noms de tous les composantes primales.
  27.       SEGMENT LSINCP
  28.          CHARACTER*(LOCOMP) LISINP(NLIGP)
  29.       ENDSEGMENT
  30. * correspondance entre les noms de composantes locale LISINC
  31. * et les nom de composantes dans LSINCP
  32.       SEGMENT CORES1
  33.          INTEGER IPCOR2(NRIGEL)
  34.       ENDSEGMENT
  35.       SEGMENT CORES2
  36.          INTEGER COR2(NLIGRP)
  37.       ENDSEGMENT
  38. * tableau pour dire en chaque point si la composante du tableau LISINP
  39. * est implquée
  40.       SEGMENT MTOPTS
  41. *               nombre d'occurence de la compoosante
  42.                 INTEGER ITOPTS(NBPTS,NLIGP)
  43. *               valeur de l'inverse la masse en ce point
  44.                 REAL*8  XTOPTS(NBPTS,NLIGP+1)
  45.       ENDSEGMENT
  46. *
  47. * tableau pour pointer vers MCOEF à partir du nombre d'inconnues
  48. *
  49.       SEGMENT LSINCO
  50.           INTEGER LESINC(NINC,2)
  51.           REAL*8  XMAS(NINC)
  52.       ENDSEGMENT
  53. *
  54. *  tableau des coefficient de la matrice C
  55. *  ordonné dans l'ordre des inconnues
  56.       SEGMENT MCOEF
  57. *        numero du noeud support du multiplicateur ligne 1
  58. *        est il en marié avec un autre multiplicateur ligne 2
  59.          INTEGER ICOEF(2,NCOEF)
  60. *         valeur des coefficients
  61.          REAL*8 XCOEF(NCOEF)
  62.       ENDSEGMENT
  63. *
  64. *_______________________________________________________________________
  65. *
  66. *   la première etape consiste à établir la liste de tous les noms
  67. *   d'inconnue primale dans la rigidité
  68. *   cette liste est stockée dans LSINCP
  69. *   la correspondance locale -> globale dans CORES1
  70. *
  71. *    la rigidité est déjà active (cmct)
  72.       MRIGID = IRIG
  73.       NRIGEL = IRIGEL(/2)
  74.       SEGINI CORES1
  75. *   NLIGP1 est la taille effective de LSINCP
  76. *   on évite ainsi de faire trop de segadj
  77.       NLIGP1 = 0
  78.       NLIGP = 0
  79.       NCOEF = 0
  80.  
  81.  
  82.       DO 50 I=1,NRIGEL
  83.          DESCR = IRIGEL(3,I)
  84.          SEGACT  DESCR*NOMOD
  85.          NLIGRP = LISINC(/2)
  86.          NLIGP = NLIGP + NLIGRP
  87.          MELEME = IRIGEL(1,I)
  88.          NCOEF = NCOEF + (NUM(/2) * NLIGRP)
  89. *      les coeffficients sur les multiplicateurs
  90. *      ne nous interessent pas
  91.          IF (ITYPEL .EQ. 22) NCOEF=NCOEF-NUM(/2)
  92.  50   CONTINUE
  93. *
  94.       SEGINI  LSINCP
  95.       DO 300 I=1,NRIGEL
  96.          DESCR = IRIGEL(3,I)
  97.          NLIGRP = LISINC(/2)
  98.          MELEME = IRIGEL(1,I)
  99.          IMULT=1
  100.          IF (ITYPEL .EQ.22) IMULT = 2
  101.          SEGINI CORES2
  102.          DO 200 J=IMULT,NLIGRP
  103.              DO 100 K=1,NLIGP
  104.                IF (LISINC(J) .EQ.  LISINP(K)) THEN
  105.                   COR2(J) = K
  106.                   GOTO 200
  107.                ENDIF
  108.  100         CONTINUE
  109.              NLIGP1 = NLIGP1 + 1
  110.              LISINP(NLIGP1) = LISINC(J)
  111.              COR2(J) = NLIGP1
  112.  200     CONTINUE
  113.          IPCOR2(I) = CORES2
  114.  300  CONTINUE
  115. *
  116. *  ajustement de la taille de LSINCP
  117. *  on purrait suprimer cette ligne
  118.       NLIGP = NLIGP1
  119.       SEGADJ LSINCP
  120. *
  121. *
  122. *_______________________________________________________________________
  123. *  on remplit maintenant le tableau itopts en bouclant sur les sous zones de
  124. *  la rigidité
  125. *
  126.       SEGINI MTOPTS
  127. *
  128.       DO 600 I=1,NRIGEL
  129. *   les maillages sont actifs depuis cmct
  130.           MELEME = IRIGEL(1,I)
  131.           imult=1
  132.           IF (ITYPEL .EQ.22) IMULT = 2
  133.           DESCR = IRIGEL(3,I)
  134.           CORES2 = IPCOR2(I)
  135.           DO 500 K=1,NUM(/2)
  136.             DO 400 J=IMULT,NOELEP(/1)
  137.              ITOPTS(NUM(NOELEP(J),K),COR2(J)) =
  138.      &            ITOPTS(NUM(NOELEP(J),K),COR2(J)) + 1
  139.  400        CONTINUE
  140.  500     CONTINUE
  141.  600  CONTINUE
  142. *
  143. *   on remplit maintenant la masse inversée
  144. *
  145.       MCHPOI = ICHP
  146.       SEGACT MCHPOI*NOMOD
  147. *  boucle sur les sous zones du champ par point
  148.       DO 1100 I=1,IPCHP(/1)
  149.          MSOUPO = IPCHP(I)
  150.          SEGACT  MSOUPO
  151.          MELEME = IGEOC
  152.          SEGACT MELEME
  153.          MPOVAL = IPOVAL
  154.          SEGACT MPOVAL
  155. *      boucle sur les composantes de la sous zone
  156.          DO 1000 J=1,NOCOMP(/2)
  157. *      recuperation du numéro de la composante dans LISINP
  158.            DO 700 K=1,NLIGP
  159.                IF (NOCOMP(J) .EQ. LISINP(K)) THEN
  160.                    IDK = K
  161.                    GOTO 800
  162.                ENDIF
  163.  700       CONTINUE
  164.            IDK = NLIGP + 1
  165. *
  166.  800       CONTINUE
  167. *       boucle sur les points de la sous zone
  168.            DO 900 K=1,NUM(/2)
  169.                XTOPTS(NUM(1,K),IDK) = VPOCHA(K,J)
  170.  900       CONTINUE
  171. *
  172.  1000    CONTINUE
  173.          SEGDES MPOVAL,MELEME,MSOUPO
  174.  1100 CONTINUE
  175. *
  176.       SEGDES MCHPOI
  177. *
  178. *_______________________________________________________________________
  179. *
  180. *    calcul du nombre d'inconnues et creation de LESINC
  181. *    correspondance entre les inconnues et MCOEF
  182. *
  183. *
  184.       NINC = 0
  185.       DO 1300 I=1,NLIGP
  186.          DO 1200 J=1,NBPTS
  187.             NINC = NINC + SIGN(1,(ITOPTS(J,I)-1))
  188.  1200    CONTINUE
  189.  1300 CONTINUE
  190.       NINC = ((NLIGP * NBPTS) + NINC )/ 2
  191. **
  192. *    on remplit LSINCO
  193.       SEGINI LSINCO
  194.       IND1 = 1
  195.       IDUM = 1
  196.       DO 1600 I=1,NRIGEL
  197.           MELEME = IRIGEL(1,I)
  198.           imult=1
  199.           IF (ITYPEL .EQ.22) IMULT = 2
  200.           DESCR = IRIGEL(3,I)
  201.           CORES2 = IPCOR2(I)
  202.           DO 1500 K=1,NUM(/2)
  203.             DO 1400 J=IMULT,NOELEP(/1)
  204.                IF ( ITOPTS(NUM(NOELEP(J),K),COR2(J)) .GT. 0 ) THEN
  205.                  LESINC(IND1,1) = IDUM
  206.                  IDUM = IDUM +  ITOPTS(NUM(NOELEP(J),K),COR2(J))
  207. *      ITOPTS va desormais contenir le numéro de l'inconnue dans LESINC
  208.                  ITOPTS(NUM(NOELEP(J),K),COR2(J)) = -1 * IND1
  209.                  XMAS(IND1) = XTOPTS(NUM(NOELEP(J),K),COR2(J))
  210.                  IND1 = IND1 + 1
  211.                ENDIF
  212.  1400       CONTINUE
  213.  1500   CONTINUE
  214.  1600 CONTINUE
  215. *=====
  216. *      if ( (IND1-1) .NE. NINC ) then
  217. *          write(*,*) 'erreur dans boucle lsinco'
  218. *      endif
  219. *======
  220. *
  221. *
  222. *_______________________________________________________________________
  223. * remplissage de MCOEF
  224. *
  225.       SEGINI MCOEF
  226.       DO 1900 I=1,NRIGEL
  227.           MELEME = IRIGEL(1,I)
  228.           imult=1
  229.           IF (ITYPEL .EQ.22) IMULT = 2
  230.           DESCR = IRIGEL(3,I)
  231.           CORES2 = IPCOR2(I)
  232.           xMATRI = IRIGEL(4,I)
  233.           SEGACT xMATRI
  234.           DO 1800 K=1,NUM(/2)
  235. *             XMATRI = IMATTT(K)
  236. *             SEGACT XMATRI
  237.              DO 1700 J=IMULT,NOELEP(/1)
  238.                 NNINC = -1 * ITOPTS(NUM(NOELEP(J),K),COR2(J))
  239.                 IDMCOE = LESINC(NNINC,1)+LESINC(NNINC,2)
  240.                 LESINC(NNINC,2) = LESINC(NNINC,2) + 1
  241.                 ICOEF(1,IDMCOE)=NUM(1,K)
  242.                 XCOEF(IDMCOE)=RE(1,J,k)*COERIG(I)
  243.  1700        CONTINUE
  244. *             SEGDES XMATRI
  245.  1800     CONTINUE
  246. *  on referme la boutique
  247.           SEGDES xMATRI,MELEME,DESCR
  248.           SEGSUP CORES2
  249.  1900  CONTINUE
  250.        SEGSUP  CORES1,LSINCP,MTOPTS
  251. *
  252. *=====
  253. *      do 2001 i=1,ninc
  254. *        write(*,2003) i,lesinc(i,1),lesinc(i,2),xmas(i)
  255. * 2001 continue
  256. * 2003 format(I3,1X,I3,1X,I3,2X,E12.5)
  257. *
  258. *      do 2005 i=1,ncoef
  259. *         write(*,2003) i,icoef(1,i),icoef(2,i),xcoef(i)
  260. * 2005 continue
  261. *=====
  262. *_______________________________________________________________________
  263. *
  264. *   il ne reste plus qu' a creer les matrices élémentaires
  265. *
  266.       CALL CMCT2(MCOEF,LSINCO,IRIG2)
  267.       IF (IERR .NE.0 ) RETURN
  268.  
  269.       SEGSUP LSINCO,MCOEF
  270.  
  271.       RI2 = IRIG2
  272.       SEGACT,RI2*MOD
  273.       RI2.MTYMAT = MRIGID.MTYMAT
  274.       RI2.IFORIG = MRIGID.IFORIG
  275.       SEGDES,RI2
  276. *
  277. *_______________________________________________________________________
  278.       RETURN
  279.       END
  280.  
  281.  
  282.  

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