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    CB215821  20/11/25    13:37:09     10792          
  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.       LOGICAL LPARTP,LPARTD
  68. *
  69. * Executable statements
  70. *
  71.       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans prmcp5.eso'
  72. * On régularise les maillage pour plus se faire chier si LISOUS(/1).EQ.0
  73. * In REGMAI : IF (.NOT.LPARTD) SEGINI ML2DUA
  74.       CALL REGMAI(MMLDUA,ML2DUA,LPARTD,IMPR,IRET)
  75.       IF (IRET.NE.0) GOTO 9999
  76. * In REGMAI : IF (.NOT.LPARTP) SEGINI ML2PRI
  77.       CALL REGMAI(MMLPRI,ML2PRI,LPARTP,IMPR,IRET)
  78.       IF (IRET.NE.0) GOTO 9999
  79. *
  80. * Activons les chapeaux (Matrices et supports)
  81. *
  82.       SEGACT ML2DUA
  83.       NBSOUD=ML2DUA.LISOUS(/1)
  84.       SEGACT ML2PRI
  85.       NBSOUP=ML2PRI.LISOUS(/1)
  86.       SEGACT MMATEL
  87.       NBSOUM=NBSOUP
  88.       IF (NBSOUD.NE.NBSOUP) THEN
  89.          WRITE(IOIMP,*) 'Maillage primal, dual :'
  90.          WRITE(IOIMP,*) 'partitionnment différent...'
  91.          WRITE(IOIMP,*) 'NBSOUD=',NBSOUD
  92.          WRITE(IOIMP,*) 'NBSOUP=',NBSOUP
  93.          GOTO 9999
  94.       ENDIF
  95. *
  96. * Tableau de repérage dans la matrice
  97. *
  98. * In INIRPM : SEGINI RPMAT
  99.       CALL INIRPM(MMATEL,RPMAT,IMPR,IRET)
  100.       IF (IRET.NE.0) GOTO 9999
  101. *
  102. * Activons les tableaux de repérage
  103. *
  104. * Matrices
  105. *  Inconnues
  106.       SEGACT ICMPRI
  107.       SEGACT ICMDUA
  108. *  Matrices élémentaires à parcourir
  109.       SEGACT LNBME
  110. * Chpoints
  111.       SEGACT MPOPRI
  112.       SEGACT MPODUA*MOD
  113. *  Inconnues
  114.       SEGACT KICPRI
  115.       SEGACT KICDUA
  116. *  Maillages
  117.       SEGACT KMCPRI
  118.       SEGACT KMCDUA
  119. *
  120. * Parcourons les matrices élémentaires par sous-domaine et
  121. * remplissons les valeurs de MPODUA.
  122. *
  123.       NMATL=LNBME.LECT(/1)
  124.       DO 1 IMATL=1,NMATL
  125. * Numéros d'inconnues dans les chpo. primaux et duaux
  126. * pour la LNBME.LECT(IMATL)ième matrice
  127.          ICCPRI=KICPRI.LECT(ICMPRI.LECT(LNBME.LECT(IMATL)))
  128.          ICCDUA=KICDUA.LECT(ICMDUA.LECT(LNBME.LECT(IMATL)))
  129.          NUELG=0
  130.          OLDISM=1
  131.          VMATEL=MMATEL.LIZAFM(OLDISM,LNBME.LECT(IMATL))
  132.          SEGACT VMATEL
  133.          DO 12 ISOUM=1,NBSOUM
  134.             SMLDUA=ML2DUA.LISOUS(ISOUM)
  135.             SEGACT SMLDUA
  136.             SMLPRI=ML2PRI.LISOUS(ISOUM)
  137.             SEGACT SMLPRI
  138.             NELPRI=SMLPRI.NUM(/2)
  139.             DO 122 IELEM=1,NELPRI
  140.                NUELG=NUELG+1
  141.                CALL RPELEM(NUELG,RPMAT,ISOUMA,NUELOC,IMPR,IRET)
  142.                IF (IRET.NE.0) GOTO 9999
  143.                ISOUMA=MAX(ISOUMA,1)
  144.                IF (ISOUMA.NE.OLDISM) THEN
  145.                   SEGDES VMATEL
  146.                   VMATEL=MMATEL.LIZAFM(ISOUMA,LNBME.LECT(IMATL))
  147.                   SEGACT VMATEL
  148.                   OLDISM=ISOUMA
  149.                ENDIF
  150.                ILMAT=NUELOC
  151.                NPMAT=VMATEL.AM(/2)
  152.                NDMAT=VMATEL.AM(/3)
  153.                DO 1222 JDMAT=1,NDMAT
  154.                   ITPODU=KMCDUA.LECT(SMLDUA.NUM(JDMAT,IELEM))
  155.                   IF (ITPODU.EQ.0) THEN
  156.                      WRITE(IOIMP,*) 'Point dual ????'
  157.                      GOTO 9999
  158.                   ENDIF
  159.                   DO 12222 IPMAT=1,NPMAT
  160.                      ITPOPR=KMCPRI.LECT(SMLPRI.NUM(IPMAT,IELEM))
  161. *                     IF (ITPOPR.EQ.0) THEN
  162. *                        WRITE(IOIMP,*) 'Un point du chpo. primal ',
  163. *     $                       'n''est pas dans le spg primal de la  ',
  164. *     $                       'matrice..'
  165. *                        GOTO 9999
  166. *                     ENDIF
  167.                      IF (ITPOPR.NE.0) THEN
  168.                         MPODUA.VPOCHA(ITPODU,ICCDUA)=
  169.      $                       MPODUA.VPOCHA(ITPODU,ICCDUA)+
  170.      $                       (VMATEL.AM(ILMAT,IPMAT,JDMAT)
  171.      $                       *MPOPRI.VPOCHA(ITPOPR,ICCPRI))
  172.                      ENDIF
  173. 12222             CONTINUE
  174.  1222          CONTINUE
  175.  122        CONTINUE
  176.             SEGDES SMLPRI
  177.             SEGDES SMLDUA
  178.   12      CONTINUE
  179.           SEGDES VMATEL
  180.  1    CONTINUE
  181. *
  182. * Désactivons les tableaux de repérage
  183. *
  184.       SEGDES KMCDUA
  185.       SEGDES KMCPRI
  186.       SEGDES KICDUA
  187.       SEGDES KICPRI
  188.       SEGDES LNBME
  189.       SEGDES ICMDUA
  190.       SEGDES ICMPRI
  191.       SEGDES RPMAT
  192.       SEGDES MMATEL
  193.       SEGDES ML2PRI
  194.       SEGDES ML2DUA
  195.       IF (.NOT.LPARTP) SEGSUP ML2PRI
  196.       IF (.NOT.LPARTD) SEGSUP ML2DUA
  197. *
  198. * Normal termination
  199. *
  200.       IRET=0
  201.       RETURN
  202. *
  203. * Format handling
  204. *
  205. *
  206. * Error handling
  207. *
  208.  9999 CONTINUE
  209.       IRET=1
  210.       WRITE(IOIMP,*) 'An error was detected in subroutine prmcp5'
  211.       RETURN
  212. *
  213. * End of subroutine PRMCP5
  214. *
  215.       END
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  
  224.  
  225.  
  226.  

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