Télécharger la plaquette Cast3M


fr en

Télécharger li2mas.eso

Retour à la liste

Numérotation des lignes : 

li2mas

  1. C LI2MAS    SOURCE    PV        20/09/26    21:18:37     10724          
  2.       SUBROUTINE LI2MAS(ICPCDB,ICDCDB,ICOGLO,
  3.      $     LMPCDB,LMDCDB,LMACDB,
  4.      $     MPCDB,MDCDB,IMTCDB,
  5.      $     IMPR,IRET)
  6.       IMPLICIT INTEGER(I-N)
  7.       IMPLICIT REAL*8 (A-H,O-Z)
  8. C***********************************************************************
  9. C NOM         : LI2MAS
  10. C DESCRIPTION : Transformation des listes indexées résultats en
  11. C               maillages et en matrices.
  12. C
  13. C
  14. C LANGAGE     : ESOPE
  15. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16. C               mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C APPELES          :  -
  19. C APPELE PAR       : PROMAT
  20. C***********************************************************************
  21. C ENTREES            : ICPCDB, ICDCDB, ICOGLO, LMPCDB, LMDCDB, LMACDB
  22. C SORTIES            : MPCDB, MDCDB, IMTCDB
  23. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  24. C***********************************************************************
  25. C VERSION    : v1, 16/02/2000, version initiale
  26. C HISTORIQUE : v1, 16/02/2000, création
  27. C HISTORIQUE :
  28. C HISTORIQUE :
  29. C***********************************************************************
  30. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  31. C en cas de modification de ce sous-programme afin de faciliter
  32. C la maintenance !
  33. C***********************************************************************
  34.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37. -INC SMELEME
  38.       INTEGER NBNN,NBELEM,NBSOUS,NBREF
  39.       POINTEUR MPCDB.MELEME
  40.       POINTEUR MDCDB.MELEME
  41.       POINTEUR SMPCDB.MELEME
  42.       POINTEUR SMDCDB.MELEME
  44.       INTEGER NBME
  45.       POINTEUR IMTCDB.IMATRI
  46.       INTEGER NBEL,NP,MP
  47.       POINTEUR SMTCDB.IZAFM
  48. -INC SMLMOTS
  49.       POINTEUR ICOGLO.MLMOTS
  50. -INC SMLENTI
  51.       POINTEUR ICPCDB.MLENTI
  52.       POINTEUR NPLPRI.MLENTI
  53.       POINTEUR NPLDUA.MLENTI
  54.       INTEGER JG
  55.       POINTEUR KCPLPD.MLENTI
  56. * Includes persos
  57. *     Segment LSTIND (liste séquentielle indexée)
  58.       SEGMENT LSTIND
  59.       INTEGER IDX(NBM+1)
  60.       INTEGER IVAL(NBTVAL)
  61.       ENDSEGMENT
  62. *-INC SLSTIND
  63.       POINTEUR ICDCDB.LSTIND
  64.       POINTEUR LMPCDB.LSTIND
  65.       POINTEUR LMDCDB.LSTIND
  66.       INTEGER NBM,NBTVAL
  67.       POINTEUR CPLEL.LSTIND
  68.       SEGMENT LSRIND
  69.       INTEGER IDXX(NBM+1)
  70.       REAL*8 XVAL(NBTVAL)
  71.       ENDSEGMENT
  72.       POINTEUR SMACDB.LSRIND
  73.       SEGMENT LLI
  74.       POINTEUR LISLI(NBME).LSRIND
  75.       ENDSEGMENT
  76.       POINTEUR LMACDB.LLI
  77. *
  78.       INTEGER IMPR,IRET
  79. *
  80.       INTEGER IBCLPD,ILCDB,IIPRI,IMP,INP
  81.       INTEGER NBCLPD,NLCDB,NIPRI
  82.       INTEGER IVPLEL,IVSTRT,IVSTOP
  83.       INTEGER IBME,IBSTRT,IBSTOP
  84.       INTEGER JVPCDB,JVSTRT,JVSTOP
  85.       INTEGER JVDCDB,JVPLEL
  86.       INTEGER KVSTRT
  87.       INTEGER NUEL,NUEL1,KICPD
  88.       INTEGER ICPD,NPPCDB,NPDCDB,NTCLPD
  89.       INTEGER      MXPCDB,MXDCDB
  90. *
  91. * Executable statements
  92. *
  93.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans li2mas.eso'
  94. *      SEGPRT,ICPCDB
  95. *      SEGPRT,ICDCDB
  96. *      SEGPRT,ICOGLO
  97. *      SEGPRT,LMPCDB
  98. *      SEGPRT,LMDCDB
  99. *      SEGPRT,LMACDB
  100. *      SEGACT LMACDB
  101. *      LSRIND=LMACDB.LISLI(1)
  102. *      SEGPRT,LSRIND
  103.  
  104. *
  105. * Il faut construire une partition de la matrice LMACDB
  106. * dont les supports primaux et duaux sont LMPCDB et LMDCDB
  107. *
  108. * Comptons le nb max. de points de LMPCDB et de LMDCDB pour
  109. * dimensionnement du tableau de repérage dans la partition :
  110. * On crée aussi les tableaux de nb. de points par éléments (plus
  111. * pratiques)
  112.       SEGACT LMPCDB
  113.       SEGACT LMDCDB
  114.       NLCDB=LMPCDB.IDX(/1)-1
  115. * D'abord, on crée les tableaux de nb. de points par éléments (plus
  116. * pratiques)
  117.       JG=NLCDB
  118.       SEGINI NPLPRI
  119.       SEGINI NPLDUA
  120.       MXPCDB=0
  121.       MXDCDB=0
  122.       DO 1 ILCDB=1,NLCDB
  123.          NPPCDB=LMPCDB.IDX(ILCDB+1)-LMPCDB.IDX(ILCDB)
  124.          NPLPRI.LECT(ILCDB)=NPPCDB
  125.          MXPCDB=MAX(MXPCDB,NPPCDB)
  126.          NPDCDB=LMDCDB.IDX(ILCDB+1)-LMDCDB.IDX(ILCDB)
  127.          NPLDUA.LECT(ILCDB)=NPDCDB
  128.          MXDCDB=MAX(MXDCDB,NPDCDB)
  129.  1    CONTINUE
  130.       SEGDES LMDCDB
  131.       SEGDES LMPCDB
  132. *      SEGPRT,NPLPRI
  133. *      SEGPRT,NPLDUA
  134. *      WRITE(IOIMP,*) 'MXPCDB=',MXPCDB
  135. *      WRITE(IOIMP,*) 'MXDCDB=',MXDCDB
  136. * Dimension de l'espace des couples (nb. points primaux, nb. points
  137. * duaux)
  138.       NTCLPD=MXPCDB*MXDCDB
  139.       JG=NTCLPD
  140.       SEGINI KCPLPD
  141. * Nb. de couples distincts et segment de repérage sur ces couples
  142.       IBCLPD=0
  143.       DO 2 ILCDB=1,NLCDB
  144.          ICPD=((NPLPRI.LECT(ILCDB)-1)*MXDCDB)
  145.      $        +NPLDUA.LECT(ILCDB)
  146.          IF (KCPLPD.LECT(ICPD).EQ.0) THEN
  147.             IBCLPD=IBCLPD+1
  148.             KCPLPD.LECT(ICPD)=IBCLPD
  149.          ENDIF
  150.  2    CONTINUE
  151.       NBCLPD=IBCLPD
  152. * Création d'une liste indexée :
  153. * A chaque couple repéré par son numéro d'ordre, on associe
  154. * les numéros d'éléments ILCDB
  155. * Dimensionnement de CPLEL
  156. * Pour l'instant CPLEL.IDX(IBCLPD+1)=nombre d'éléments associés au
  157. * IBCLPDème couple.
  158.       NBM=NBCLPD
  159.       NBTVAL=0
  160.       SEGINI CPLEL
  161.       DO 3 ILCDB=1,NLCDB
  162.          ICPD=((NPLPRI.LECT(ILCDB)-1)*MXDCDB)
  163.      $        +NPLDUA.LECT(ILCDB)
  164.          KICPD=KCPLPD.LECT(ICPD)
  165.          CPLEL.IDX(KICPD+1)=CPLEL.IDX(KICPD+1)+1
  166.  3    CONTINUE
  167. * CPLEL.IDX est transformé en la liste d'indexation sur CPLEL.IVAL
  168.       CPLEL.IDX(1)=1
  169.       DO 4 IBCLPD=1,NBCLPD
  170.          CPLEL.IDX(IBCLPD+1)=CPLEL.IDX(IBCLPD+1)+CPLEL.IDX(IBCLPD)
  171.  4    CONTINUE
  172.       NBM=NBCLPD
  173.       NBTVAL=CPLEL.IDX(NBCLPD+1)-1
  174.       SEGADJ,CPLEL
  175. * CPLEL.IDX est désormais la liste des index courants sur
  176. * CPLEL.IVAL que l'on remplit.
  177.       DO 5 ILCDB=1,NLCDB
  178.          ICPD=((NPLPRI.LECT(ILCDB)-1)*MXDCDB)
  179.      $        +NPLDUA.LECT(ILCDB)
  180.          KICPD=KCPLPD.LECT(ICPD)
  181.          CPLEL.IVAL(CPLEL.IDX(KICPD))=ILCDB
  182.          CPLEL.IDX(KICPD)=CPLEL.IDX(KICPD)+1
  183.  5    CONTINUE
  184. * On restaure les valeurs de CPLEL.IDX
  185.       DO 6 IBCLPD=NBCLPD,2,-1
  186.          CPLEL.IDX(IBCLPD)=CPLEL.IDX(IBCLPD-1)
  187.  6    CONTINUE
  188.       CPLEL.IDX(1)=1
  189. *
  190. * Création et remplissage de MPCDB
  191. *
  192.       SEGACT LMPCDB
  193.       NBNN=0
  194.       NBELEM=0
  195.       NBSOUS=NBCLPD
  196.       NBREF=0
  197. C      SEGINI MPCDB
  198.       SEGINI MPCDB
  199.       DO 7 IBCLPD=1,NBCLPD
  200.          IVSTRT=CPLEL.IDX(IBCLPD)
  201.          IVSTOP=CPLEL.IDX(IBCLPD+1)-1
  202.          NUEL1=CPLEL.IVAL(IVSTRT)
  203.          NBNN=NPLPRI.LECT(NUEL1)
  204.          NBELEM=IVSTOP-IVSTRT+1
  205.          NBSOUS=0
  206.          NBREF=0
  207.          SEGINI SMPCDB
  208. *     Type d'élément : POLY (cf. bdata.eso)
  209.          SMPCDB.ITYPEL=32
  210.          DO 72 IVPLEL=IVSTRT,IVSTOP
  211.             NUEL=CPLEL.IVAL(IVPLEL)
  212.             JVSTRT=LMPCDB.IDX(NUEL)
  213.             JVSTOP=LMPCDB.IDX(NUEL+1)-1
  214.             DO 722 JVPCDB=JVSTRT,JVSTOP
  215.                SMPCDB.NUM(JVPCDB-JVSTRT+1,IVPLEL-IVSTRT+1)=
  216.      $              LMPCDB.IVAL(JVPCDB)
  217.  722        CONTINUE
  218.  72      CONTINUE
  219.          SEGDES SMPCDB
  220.          MPCDB.LISOUS(IBCLPD)=SMPCDB
  221.  7    CONTINUE
  222.       IF (NBCLPD.EQ.1) THEN
  223.          SMPCDB=MPCDB.LISOUS(1)
  224.          SEGSUP MPCDB
  225.          MPCDB=SMPCDB
  226.       ELSE
  227.          SEGDES MPCDB
  228.       ENDIF
  229.       SEGDES LMPCDB
  230. *
  231. * Création et remplissage de MDCDB
  232. *
  233.       SEGACT LMDCDB
  234.       NBNN=0
  235.       NBELEM=0
  236.       NBSOUS=NBCLPD
  237.       NBREF=0
  238. C      SEGINI MDCDB
  239.       SEGINI MDCDB
  240.       DO 8 IBCLPD=1,NBCLPD
  241.          IVSTRT=CPLEL.IDX(IBCLPD)
  242.          IVSTOP=CPLEL.IDX(IBCLPD+1)-1
  243.          NUEL1=CPLEL.IVAL(IVSTRT)
  244.          NBNN=NPLDUA.LECT(NUEL1)
  245.          NBELEM=IVSTOP-IVSTRT+1
  246.          NBSOUS=0
  247.          NBREF=0
  248.          SEGINI SMDCDB
  249. *     Type d'élément : POLY (cf. bdata.eso)
  250.          SMDCDB.ITYPEL=32
  251.          DO 82 IVPLEL=IVSTRT,IVSTOP
  252.             NUEL=CPLEL.IVAL(IVPLEL)
  253.             JVSTRT=LMDCDB.IDX(NUEL)
  254.             JVSTOP=LMDCDB.IDX(NUEL+1)-1
  255.             DO 822 JVDCDB=JVSTRT,JVSTOP
  256.                SMDCDB.NUM(JVDCDB-JVSTRT+1,IVPLEL-IVSTRT+1)=
  257.      $              LMDCDB.IVAL(JVDCDB)
  258.  822        CONTINUE
  259.  82      CONTINUE
  260.          SEGDES SMDCDB
  261.          MDCDB.LISOUS(IBCLPD)=SMDCDB
  262.  8    CONTINUE
  263.       IF (NBCLPD.EQ.1) THEN
  264.          SMDCDB=MDCDB.LISOUS(1)
  265.          SEGSUP MDCDB
  266.          MDCDB=SMDCDB
  267.       ELSE
  268.          SEGDES MDCDB
  269.       ENDIF
  270.       SEGDES LMDCDB
  271. *
  272. * Création et remplissage de IMTCDB
  273. *
  274.       SEGACT ICOGLO
  275.       SEGACT ICPCDB
  276.       SEGACT ICDCDB
  277.       SEGACT LMPCDB
  278.       SEGACT LMDCDB
  279.       SEGACT LMACDB
  280.       NBME=ICDCDB.IVAL(/1)
  281.       NBSOUS=NBCLPD
  282.       SEGINI IMTCDB
  283.       NIPRI=ICPCDB.LECT(/1)
  284.       DO 9 IIPRI=1,NIPRI
  285.          IBSTRT=ICDCDB.IDX(IIPRI)
  286.          IBSTOP=ICDCDB.IDX(IIPRI+1)-1
  287.          DO 92 IBME=IBSTRT,IBSTOP
  288.             IMTCDB.LISPRI(IBME)=ICOGLO.MOTS(ICPCDB.LECT(IIPRI))
  289.             IMTCDB.LISDUA(IBME)=ICOGLO.MOTS(ICDCDB.IVAL(IBME))
  290.             SMACDB=LMACDB.LISLI(IBME)
  291.             SEGACT SMACDB
  292.             DO 922 IBCLPD=1,NBCLPD
  293.                JVSTRT=CPLEL.IDX(IBCLPD)
  294.                JVSTOP=CPLEL.IDX(IBCLPD+1)-1
  295.                NUEL1=CPLEL.IVAL(JVSTRT)
  296.                NBEL=JVSTOP-JVSTRT+1
  297.                NP=NPLPRI.LECT(NUEL1)
  298.                MP=NPLDUA.LECT(NUEL1)
  299.                SEGINI SMTCDB
  300.                DO 9222 JVPLEL=JVSTRT,JVSTOP
  301.                   NUEL=CPLEL.IVAL(JVPLEL)
  302.                   KVSTRT=SMACDB.IDXX(NUEL)
  303.                   DO 92222 IMP=1,MP
  304.                      DO 92224 INP=1,NP
  305.                         SMTCDB.AM(JVPLEL-JVSTRT+1,INP,IMP)=
  306.      $                       SMACDB.XVAL(KVSTRT)
  307.                         KVSTRT=KVSTRT+1
  308. 92224                CONTINUE
  309. 92222             CONTINUE
  310.  9222          CONTINUE
  311.                SEGDES SMTCDB
  312.                IMTCDB.LIZAFM(IBCLPD,IBME)=SMTCDB
  313.  922        CONTINUE
  314.             SEGDES SMACDB
  315.  92      CONTINUE
  316.  9    CONTINUE
  317.       SEGDES IMTCDB
  318.       SEGDES LMACDB
  319.       SEGDES LMDCDB
  320.       SEGDES LMPCDB
  321.       SEGDES ICDCDB
  322.       SEGDES ICPCDB
  323.       SEGDES ICOGLO
  324.       SEGSUP CPLEL
  325.       SEGSUP KCPLPD
  326.       SEGSUP NPLDUA
  327.       SEGSUP NPLPRI
  328. *      SEGPRT,MPCDB
  329. *      SEGPRT,MDCDB
  330. *      SEGPRT,IMTCDB
  331. *
  332. * Normal termination
  333. *
  334.       IRET=0
  335.       RETURN
  336. *
  337. * Format handling
  338. *
  339. *
  340. * Error handling
  341. *
  342.  9999 CONTINUE
  343.       IRET=1
  344.       WRITE(IOIMP,*) 'An error was detected in subroutine li2mas'
  345.       RETURN
  346. *
  347. * End of subroutine LI2MAS
  348. *
  349.       END
  350.  
  351.  
  352.  
  353.  
  354.  
  355.  
  356.  
  357.  
  358.  

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