Télécharger la plaquette Cast3M


fr en

Télécharger prmcp5.eso

Retour à la liste

Numérotation des lignes : 

prmcp5

  1. C PRMCP5    SOURCE    GOUNAND   24/11/06    21:15:16     12073          
  2.       SUBROUTINE PRMCP5(MMLPRI,MMLDUA,MMATEL,ICMPRI,ICMDUA,LNBME,
  3.      $     MPOPRI,KICPRI,KMCPRI,
  4.      $            KICDUA,KMCDUA,
  5.      $     MPODUA,
  6.      $     IMPR,IRET)
  7.       IMPLICIT INTEGER(I-N)
  8.       IMPLICIT REAL*8 (A-H,O-Z)
  9. C***********************************************************************
  10. C NOM         : PRMCP5
  11. C DESCRIPTION : Produit matrices élémentaires * mpoval primal
  12. C                       -> mpoval dual.
  13. C
  14. C
  15. C LANGAGE     : ESOPE
  16. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  17. C               mél : gounand@semt2.smts.cea.fr
  18. C***********************************************************************
  19. C APPELES          : REGMAI, INIRPM, RPELEM
  20. C APPELE PAR       : PRMCP2
  21. C***********************************************************************
  22. C ENTREES            : MLPRI, MMLDUA, MMATEL, ICMPRI, ICMDUA, LNBME,
  23. C                      MPOPRI, KICPRI, KMCPRI, KICDUA, KMCDUA
  24. C ENTREES/SORTIES    : -
  25. C SORTIES            : MPODUA
  26. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  27. C***********************************************************************
  28. C VERSION    : v1, 18/04/2000, version initiale
  29. C HISTORIQUE : v1, 18/04/2000, création
  30. C HISTORIQUE :
  31. C HISTORIQUE :
  32. C***********************************************************************
  33. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  34. C en cas de modification de ce sous-programme afin de faciliter
  35. C la maintenance !
  36. C***********************************************************************
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. -INC SMELEME
  40.       POINTEUR MMLPRI.MELEME
  41.       POINTEUR MMLDUA.MELEME
  42.       POINTEUR ML2PRI.MELEME
  43.       POINTEUR ML2DUA.MELEME
  44.       POINTEUR SMLPRI.MELEME
  45.       POINTEUR SMLDUA.MELEME
  47.       POINTEUR MMATEL.IMATRI
  48.       POINTEUR VMATEL.IZAFM
  49. -INC SMLENTI
  50.       POINTEUR RPMAT.MLENTI
  51.       POINTEUR ICMPRI.MLENTI
  52.       POINTEUR ICMDUA.MLENTI
  53.       POINTEUR LNBME.MLENTI
  54.       POINTEUR KICPRI.MLENTI
  55.       POINTEUR KICDUA.MLENTI
  56.       POINTEUR KMCPRI.MLENTI
  57.       POINTEUR KMCDUA.MLENTI
  58. -INC SMCHPOI
  59.       POINTEUR MPOPRI.MPOVAL
  60.       POINTEUR MPODUA.MPOVAL
  61. *
  62.       INTEGER IMPR,IRET
  63. *
  64.       INTEGER ICCPRI,ICCDUA,ILMAT,NUELG,NUELOC,ITPOPR,ITPODU
  65.       INTEGER IELEM ,IMATL ,IPMAT,JDMAT, ISOUM,ISOUMA,OLDISM
  66.       INTEGER NELPRI,NMATL ,NPMAT,NDMAT,NBSOUM,NBSOUP,NBSOUD
  67. *
  68. * Executable statements
  69. *
  70.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prmcp5.eso'
  71. * On régularise les maillage pour plus se faire chier si LISOUS(/1).EQ.0
  72. * In REGMAI : SEGINI ML2DUA
  73.       CALL REGMAI(MMLDUA,ML2DUA)
  74. * In REGMAI : SEGINI ML2PRI
  75.       CALL REGMAI(MMLPRI,ML2PRI)
  76. *
  77. * Activons les chapeaux (Matrices et supports)
  78. *
  79.       SEGACT ML2DUA
  80.       NBSOUD=ML2DUA.LISOUS(/1)
  81.       SEGACT ML2PRI
  82.       NBSOUP=ML2PRI.LISOUS(/1)
  83.       SEGACT MMATEL
  84.       NBSOUM=NBSOUP
  85.       IF (NBSOUD.NE.NBSOUP) THEN
  86.          WRITE(IOIMP,*) 'Maillage primal, dual :'
  87.          WRITE(IOIMP,*) 'partitionnment différent...'
  88.          WRITE(IOIMP,*) 'NBSOUD=',NBSOUD
  89.          WRITE(IOIMP,*) 'NBSOUP=',NBSOUP
  90.          GOTO 9999
  91.       ENDIF
  92. *
  93. * Tableau de repérage dans la matrice
  94. *
  95. * In INIRPM : SEGINI RPMAT
  96.       CALL INIRPM(MMATEL,RPMAT,IMPR,IRET)
  97.       IF (IRET.NE.0) GOTO 9999
  98. *
  99. * Activons les tableaux de repérage
  100. *
  101. * Matrices
  102. *  Inconnues
  103.       SEGACT ICMPRI
  104.       SEGACT ICMDUA
  105. *  Matrices élémentaires à parcourir
  106.       SEGACT LNBME
  107. * Chpoints
  108.       SEGACT MPOPRI
  109.       SEGACT MPODUA*MOD
  110. *  Inconnues
  111.       SEGACT KICPRI
  112.       SEGACT KICDUA
  113. *  Maillages
  114.       SEGACT KMCPRI
  115.       SEGACT KMCDUA
  116. *
  117. * Parcourons les matrices élémentaires par sous-domaine et
  118. * remplissons les valeurs de MPODUA.
  119. *
  120.       NMATL=LNBME.LECT(/1)
  121.       DO 1 IMATL=1,NMATL
  122. * Numéros d'inconnues dans les chpo. primaux et duaux
  123. * pour la LNBME.LECT(IMATL)ième matrice
  124.          ICCPRI=KICPRI.LECT(ICMPRI.LECT(LNBME.LECT(IMATL)))
  125.          ICCDUA=KICDUA.LECT(ICMDUA.LECT(LNBME.LECT(IMATL)))
  126.          NUELG=0
  127.          OLDISM=1
  128.          VMATEL=MMATEL.LIZAFM(OLDISM,LNBME.LECT(IMATL))
  129.          SEGACT VMATEL
  130.          DO 12 ISOUM=1,NBSOUM
  131.             SMLDUA=ML2DUA.LISOUS(ISOUM)
  132.             SEGACT SMLDUA
  133.             SMLPRI=ML2PRI.LISOUS(ISOUM)
  134.             SEGACT SMLPRI
  135.             NELPRI=SMLPRI.NUM(/2)
  136.             DO 122 IELEM=1,NELPRI
  137.                NUELG=NUELG+1
  138.                CALL RPELEM(NUELG,RPMAT,ISOUMA,NUELOC,IMPR,IRET)
  139.                IF (IRET.NE.0) GOTO 9999
  140.                ISOUMA=MAX(ISOUMA,1)
  141.                IF (ISOUMA.NE.OLDISM) THEN
  142.                   SEGDES VMATEL
  143.                   VMATEL=MMATEL.LIZAFM(ISOUMA,LNBME.LECT(IMATL))
  144.                   SEGACT VMATEL
  145.                   OLDISM=ISOUMA
  146.                ENDIF
  147.                ILMAT=NUELOC
  148.                NPMAT=VMATEL.AM(/2)
  149.                NDMAT=VMATEL.AM(/3)
  150.                DO 1222 JDMAT=1,NDMAT
  151.                   ITPODU=KMCDUA.LECT(SMLDUA.NUM(JDMAT,IELEM))
  152.                   IF (ITPODU.EQ.0) THEN
  153.                      WRITE(IOIMP,*) 'Point dual ????'
  154.                      GOTO 9999
  155.                   ENDIF
  156.                   DO 12222 IPMAT=1,NPMAT
  157.                      ITPOPR=KMCPRI.LECT(SMLPRI.NUM(IPMAT,IELEM))
  158. *                     IF (ITPOPR.EQ.0) THEN
  159. *                        WRITE(IOIMP,*) 'Un point du chpo. primal ',
  160. *     $                       'n''est pas dans le spg primal de la  ',
  161. *     $                       'matrice..'
  162. *                        GOTO 9999
  163. *                     ENDIF
  164.                      IF (ITPOPR.NE.0) THEN
  165.                         MPODUA.VPOCHA(ITPODU,ICCDUA)=
  166.      $                       MPODUA.VPOCHA(ITPODU,ICCDUA)+
  167.      $                       (VMATEL.AM(ILMAT,IPMAT,JDMAT)
  168.      $                       *MPOPRI.VPOCHA(ITPOPR,ICCPRI))
  169.                      ENDIF
  170. 12222             CONTINUE
  171.  1222          CONTINUE
  172.  122        CONTINUE
  173.             SEGDES SMLPRI
  174.             SEGDES SMLDUA
  175.   12      CONTINUE
  176.           SEGDES VMATEL
  177.  1    CONTINUE
  178. *
  179. * Désactivons les tableaux de repérage
  180. *
  181.       SEGDES KMCDUA
  182.       SEGDES KMCPRI
  183.       SEGDES KICDUA
  184.       SEGDES KICPRI
  185.       SEGDES LNBME
  186.       SEGDES ICMDUA
  187.       SEGDES ICMPRI
  188.       SEGDES RPMAT
  189.       SEGDES MMATEL
  190.       SEGDES ML2PRI
  191.       SEGDES ML2DUA
  192.       SEGSUP ML2PRI
  193.       SEGSUP ML2DUA
  194. *
  195. * Normal termination
  196. *
  197.       IRET=0
  198.       RETURN
  199. *
  200. * Format handling
  201. *
  202. *
  203. * Error handling
  204. *
  205.  9999 CONTINUE
  206.       IRET=1
  207.       WRITE(IOIMP,*) 'An error was detected in subroutine prmcp5'
  208.       RETURN
  209. *
  210. * End of subroutine PRMCP5
  211. *
  212.       END
  213.  
  214.  

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