Télécharger la plaquette Cast3M


fr en

Télécharger prmcp2.eso

Retour à la liste

Numérotation des lignes : 

prmcp2

  1. C PRMCP2    SOURCE    CB215821  20/11/25    13:37:06     10792          
  2.       SUBROUTINE PRMCP2(MMLPRI,MMLDUA,MMATEL,MSOPRI,
  3.      $     MSODUA,
  4.      $     IMPR,IRET)
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM         : PRMCP2
  9. C DESCRIPTION : Produit matrices élémentaires * msoupo primal
  10. C                       -> msoupo dual.
  11. C
  12. C
  13. C LANGAGE     : ESOPE
  14. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15. C               mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES          : PRMCP3, PRMCP4, PRMCP5, KRIPEE, KRIPME,
  18. C                    RPENEN, EXENEN, IUNIQ,  MLUNIQ
  19. C APPELE PAR       : PRDMCP
  20. C***********************************************************************
  21. C ENTREES            : MMLPRI, MMLDUA, MMATEL, MSOPRI
  22. C ENTREES/SORTIES    : -
  23. C SORTIES            : MSODUA
  24. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  25. C***********************************************************************
  26. C VERSION    : v1, 18/04/2000, version initiale
  27. C HISTORIQUE : v1, 18/04/2000, création
  28. C HISTORIQUE :
  29. C HISTORIQUE :
  30. C***********************************************************************
  31. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  32. C en cas de modification de ce sous-programme afin de faciliter
  33. C la maintenance !
  34. C***********************************************************************
  35.  
  36. -INC PPARAM
  37. -INC CCOPTIO
  38. -INC SMCOORD
  39. -INC SMELEME
  40.       POINTEUR MMLPRI.MELEME
  41.       POINTEUR MMLDUA.MELEME
  42.       POINTEUR MLCPRI.MELEME
  43.       POINTEUR MLCDUA.MELEME
  45.       POINTEUR MMATEL.IMATRI
  46. -INC SMCHPOI
  47.       POINTEUR MSOPRI.MSOUPO
  48.       POINTEUR MSODUA.MSOUPO
  49.       INTEGER N,NC
  50.       POINTEUR MPOPRI.MPOVAL
  51.       POINTEUR MPODUA.MPOVAL
  52. -INC SMLMOTS
  53.       POINTEUR ICOGLO.MLMOTS
  54. -INC SMLENTI
  55.       INTEGER JG
  56.       POINTEUR ICMPRI.MLENTI
  57.       POINTEUR ICMDUA.MLENTI
  58.       POINTEUR ICCPRI.MLENTI
  59.       POINTEUR ICCDUA.MLENTI
  60.       POINTEUR ICOPRI.MLENTI
  61.       POINTEUR KRIPRI.MLENTI
  62.       POINTEUR KICPRI.MLENTI
  63.       POINTEUR KICDUA.MLENTI
  64.       POINTEUR KMCPRI.MLENTI
  65.       POINTEUR KMCDUA.MLENTI
  66.       POINTEUR LNBME.MLENTI
  67. *
  68. * Includes persos
  69. *
  70.       INTEGER NBMEL
  71.       SEGMENT MELS
  72.       POINTEUR LISMEL(NBMEL).MELEME
  73.       ENDSEGMENT
  74.       POINTEUR GPMELS.MELS
  75. *
  76.       INTEGER ICDUA
  77.       INTEGER NCDUA
  78.       INTEGER NBDUAL,NBDUA2,NIPRI,NIUNIQ,NTOTPO,NPODUA
  79.       INTEGER IMPR,IRET
  80. *
  81. * Executable statements
  82. *
  83.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prmcp2.eso'
  84. *
  85. * On s'occupe d'abord des inconnues
  86. *
  87. * Repérage global des inconnues : ICOGLO (LISTMOTS)
  88. * Numéros des inconnues primales et duales de la matrice exprimées
  89. * dans ce repérage : ICMPRI, ICMDUA
  90. * Numéros des inconnues du chpoint primal : ICCPRI
  91. * i.e.
  92. * ICOGLO: MLMOTS qui contient les inconnues primales,
  93. *         duales et les composantes du CHPOINT
  94. *         que un seul fois
  95. * ICMPRI.LECT(i) = position de l'inconnue MMATEL.LISPRI(i)
  96. *                  dans ICOGLO
  97. * ICMDUA.LECT(i) = position de l'inconnue MMATEL.LISDUA(i)
  98. *                  dans ICOGLO
  99. * ICCPRI.LECT(i) = position de l'inconnue MSOPRI.COMP(i)
  100. *                  dans ICCPRI
  101. *
  102. * In PRMCP3 : SEGINI ICOGLO
  103. * In PRMCP3 : SEGINI ICMPRI
  104. * In PRMCP3 : SEGINI ICMDUA
  105. * In PRMCP3 : SEGINI ICCPRI
  106.       CALL PRMCP3(MMATEL,MSOPRI,
  107.      $     ICOGLO,ICMPRI,ICMDUA,ICCPRI,
  108.      $     IMPR,IRET)
  109.  
  110.       IF (IRET.NE.0) GOTO 9999
  111.       SEGACT ICOGLO
  112.       NIUNIQ=ICOGLO.MOTS(/2)
  113.       SEGDES ICOGLO
  114. *
  115. * Construction de ICOPRI (LISTENTI), liste des inconnues
  116. * appartenant à la fois à ICMPRI et ICCPRI
  117. * i.e.
  118. * ICOPRI.LECT(/1) = nombre d'inconnues communes
  119. * ICOGLO.MOTS(ICOPRI.LECT(i)) = les inconnues communes
  120. *
  121. * In PRCMP4 : SEGINI ICOPRI
  122.       CALL PRMCP4(ICMPRI,ICCPRI,NIUNIQ,
  123.      $     ICOPRI,
  124.      $     IMPR,IRET)
  125.       IF (IRET.NE.0) GOTO 9999
  126. * Bien sur, si ICOPRI est vide, il n'y a pas d'inconnues
  127. * communes; donc on sort prématurément
  128.       SEGACT ICOPRI
  129.       NIPRI=ICOPRI.LECT(/1)
  130.       SEGDES ICOPRI
  131.       IF (NIPRI.EQ.0) THEN
  132. *         SEGINI ICOPRI
  133. *         SEGINI ICCPRI
  134. *         SEGINI ICMDUA
  135. *         SEGINI ICMPRI
  136. *         SEGINI ICOGLO
  137.          SEGSUP ICOPRI
  138.          SEGSUP ICCPRI
  139.          SEGSUP ICMDUA
  140.          SEGSUP ICMPRI
  141.          SEGSUP ICOGLO
  142.          GOTO 9998
  143.       ENDIF
  144. * Sinon, on construit KRIPRI où on a repéré les inconnues de ICOPRI
  145. * dans le segment des inconnues globales
  146. * i.e.
  147. * KRIPRI.LECT(j) = 0 si ICOGLO.MOTS(j) n'est pas une inconnue
  148. * commune; sinon
  149. * KRIPRI.LECT(ICOPRI.LECT(i)) = i
  150. *
  151. * In KRIPEE : SEGINI KRIPRI
  152.       CALL KRIPEE(ICOPRI,NIUNIQ,
  153.      $     KRIPRI,
  154.      $     IMPR,IRET)
  155.       IF (IRET.NE.0) GOTO 9999
  156.       SEGSUP ICOPRI
  157. * On repère les inconnues de ICMPRI qui sont dans ICOPRI
  158. * i.e.
  159. * LNBME.LECT(/1) = nombre d'inconnues de MMATEL.LISPRI
  160. *                  qui sont dedans ICOGLO
  161. * LNBME.LECT(i) = inconnues de MMATEL.LISPRI en ICOGLO
  162. *
  163. * In RPENEN : SEGINI LNBME
  164.       CALL RPENEN(ICMPRI,KRIPRI,
  165.      $     LNBME,
  166.      $     IMPR,IRET)
  167.       IF (IRET.NE.0) GOTO 9999
  168.  
  169.       SEGSUP KRIPRI
  170. *
  171. * Ceci permet de construire les inconnues du chpo. dual
  172. *
  173. * ICCDUA.LECT(/1) = LNBME.LECT(/1)
  174. * ICCDUA.LECT(i) = les inconnues duales qui correspondent
  175. *                  aux inconnues primales en ICOGLO
  176. * Donc on extrait de ICCDUA (i.e. de MMATEL.LISDUA)
  177. * les seules composantes qui interviennent dans la
  178. * multiplication.
  179. *
  180. * In EXENEN : SEGINI ICCDUA
  181. *
  182.       CALL EXENEN(ICMDUA,LNBME,
  183.      $     ICCDUA,
  184.      $     IMPR,IRET)
  185.       IF (IRET.NE.0) GOTO 9999
  186. * On y supprimme le doublons en ICCDUA
  187.       SEGACT ICCDUA*MOD
  188.       NBDUA2=ICCDUA.LECT(/1)
  189.       CALL IUNIQ(ICCDUA.LECT,NBDUA2,
  190.      $     ICCDUA.LECT,NBDUAL,IMPR,IRET)
  191.       IF (IRET.NE.0) GOTO 9999
  192.       JG=NBDUAL
  193.       SEGADJ ICCDUA
  194.       SEGDES ICCDUA
  195. * On construit KICPRI où on a repéré les inconnues de ICCPRI
  196. * dans le segment des inconnues globales
  197. * In KRIPEE : SEGINI KICPRI
  198.       CALL KRIPEE(ICCPRI,NIUNIQ,
  199.      $     KICPRI,
  200.      $     IMPR,IRET)
  201.       IF (IRET.NE.0) GOTO 9999
  202.       SEGSUP ICCPRI
  203. * On construit KICDUA où on a repéré les inconnues de ICCDUA
  204. * dans le segment des inconnues globales
  205. * In KRIPEE : SEGINI KICDUA
  206.       CALL KRIPEE(ICCDUA,NIUNIQ,
  207.      $     KICDUA,
  208.      $     IMPR,IRET)
  209.       IF (IRET.NE.0) GOTO 9999
  210. *
  211. * On s'occupe des maillages
  212. *
  213.       NTOTPO=nbpts
  214. * Le support géométrique de MSODUA sera le maillage des points
  215. * de MMLDUA
  216.       NBMEL=1
  217.       SEGINI GPMELS
  218.       GPMELS.LISMEL(1)=MMLDUA
  219.       CALL MLUNIQ(GPMELS,MLCDUA,IMPR,IRET)
  220.       IF (IRET.NE.0) GOTO 9999
  221.       SEGSUP GPMELS
  222.       SEGACT MSOPRI
  223.       MLCPRI=MSOPRI.IGEOC
  224.       MPOPRI=MSOPRI.IPOVAL
  225. * On construit KMCPRI où on a repéré les points de MLCPRI
  226. * dans le segment des points globaux
  227. * In KRIPME : SEGINI KMCPRI
  228.       CALL KRIPME(MLCPRI,NTOTPO,
  229.      $     KMCPRI,
  230.      $     IMPR,IRET)
  231.       IF (IRET.NE.0) GOTO 9999
  232. * On construit KMCDUA où on a repéré les points de MLCDUA
  233. * dans le segment des points globaux
  234. * In KRIPME : SEGINI KMCDUA
  235.       CALL KRIPME(MLCDUA,NTOTPO,
  236.      $     KMCDUA,
  237.      $     IMPR,IRET)
  238.       IF (IRET.NE.0) GOTO 9999
  239. * On initialise le chpoint dual
  240. * Inconnues
  241.       SEGACT ICOGLO
  242.       SEGACT ICCDUA
  243.       NCDUA=ICCDUA.LECT(/1)
  244.       NC=NCDUA
  245.       SEGINI MSODUA
  246.       DO 3 ICDUA=1,NCDUA
  247.          MSODUA.NOCOMP(ICDUA)=ICOGLO.MOTS(ICCDUA.LECT(ICDUA))(1:4)
  248.  3    CONTINUE
  249. *      SEGDES ICCDUA
  250.       SEGSUP ICCDUA
  251. *      SEGDES ICOGLO
  252.       SEGSUP ICOGLO
  253. * Maillage
  254.       SEGACT MLCDUA
  255.       NPODUA=MLCDUA.NUM(/2)
  256.       SEGDES MLCDUA
  257.       MSODUA.IGEOC=MLCDUA
  258.       NC=NCDUA
  259.       N=NPODUA
  260.       SEGINI MPODUA
  261.       MSODUA.IPOVAL=MPODUA
  262. *
  263. * On effectue le produit (remplissage de MPODUA)
  264. *
  265.       CALL PRMCP5(MMLPRI,MMLDUA,MMATEL,ICMPRI,ICMDUA,LNBME,
  266.      $     MPOPRI,KICPRI,KMCPRI,
  267.      $            KICDUA,KMCDUA,
  268.      $     MPODUA,
  269.      $     IMPR,IRET)
  270.       IF (IRET.NE.0) GOTO 9999
  271.       SEGSUP KMCDUA
  272.       SEGSUP KMCPRI
  273.       SEGSUP KICDUA
  274.       SEGSUP KICPRI
  275.       SEGSUP LNBME
  276.       SEGSUP ICMPRI
  277.       SEGSUP ICMDUA
  278. *
  279. * Normal termination
  280. *
  281.       IRET=0
  282.       RETURN
  283. *
  284. * Format handling
  285. *
  286. *
  287. * Error handling
  288. *
  289. * Pas une erreur proprement dite, mais il n'y avait pas de composantes communes
  290.  9998 CONTINUE
  291.       MSODUA=0
  292.       IRET=0
  293.       RETURN
  294.  9999 CONTINUE
  295.       IRET=1
  296.       WRITE(IOIMP,*) 'An error was detected in subroutine prmcp2'
  297.       RETURN
  298. *
  299. * End of subroutine PRMCP2
  300. *
  301.       END
  302.  
  303.  
  304.  
  305.  
  306.  
  307.  
  308.  
  309.  
  310.  
  311.  
  312.  
  313.  

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