Télécharger la plaquette Cast3M


fr en

Télécharger mkiza.eso

Retour à la liste

Numérotation des lignes : 

mkiza

  1. C MKIZA     SOURCE    PV        20/09/26    21:18:53     10724          
  2.       SUBROUTINE MKIZA(MELDUA,MELPRI,IMATEL,
  3.      $     KRINCD,KRINCP,KMINCT,KRSPGT,
  4.      $     PMTOT,
  5.      $     IZATOT,
  6.      $     IMPR,IRET)
  7.       IMPLICIT INTEGER(I-N)
  8.       IMPLICIT REAL*8 (A-H,O-Z)
  9. C***********************************************************************
  10. C NOM         : MKIZA
  11. C DESCRIPTION : Matrice élémentaire + Profil Morse de la matrice
  12. C               assemblée => ajout de la contribution de la matrice
  13. C               élémentaire aux valeurs de la matrice Morse assemblée.
  14. C
  15. C               Le profil Morse est supposé avoir ses colonnes
  16. C               ordonnées.
  17. C
  18. C LANGAGE     : ESOPE
  19. C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  20. C               mél : gounand@semt2.smts.cea.fr
  21. C***********************************************************************
  22. C APPELES          : REGMAI, IFIDIC, INIRPM
  23. C APPELE PAR       : PRASEM
  24. C***********************************************************************
  25. C ENTREES            : MELDUA, MELPRI, IMATEL, KRINCD, KRINCP, KMINCT,
  26. C                      KRSPGT, PMTOT
  27. C ENTREES/SORTIES    : IZATOT
  28. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  29. C***********************************************************************
  30. C VERSION    : v2, 13/12/99
  31. C HISTORIQUE : v1, 08/10/99, création
  32. C HISTORIQUE : v2, remaniement (on assemble les profils Morse, puis
  33. C                  la matrice totale)
  34. C HISTORIQUE : 05/01/00 : On ne suppose plus les maillages duaux et
  35. C      primaux partitionnés de la même façon que les matrices
  36. C      élémentaires.
  37. C HISTORIQUE :
  38. C***********************************************************************
  39. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  40. C en cas de modification de ce sous-programme afin de faciliter
  41. C la maintenance !
  42. C***********************************************************************
  43. *
  44. *
  45. * On peut optimiser les boucles en sortant les NPOS
  46. * On a supposé la chose logique (pas pour tout le monde)
  47. * que le NBSOUS est le même pour MELDUA, MELPRI, IMATEL
  48. *
  49. * Ce serait bien de sortir les REGMAI pour mettre dans prasem
  50. * et supprimmer du source tous les if (NBSOUS.EQ.0)
  51. *
  52. * Le stockage des matrices élémentaires est fait à l'envers
  53. * (NBEL est le premier indice), par contre, les boucles sont
  54. * dans l'ordre logique => perte de performances
  55. *
  56.  
  57. -INC PPARAM
  58. -INC CCOPTIO
  59. -INC SMELEME
  60.       POINTEUR MELDUA.MELEME
  61.       POINTEUR ML2DUA.MELEME
  62.       POINTEUR SMLDUA.MELEME
  63.       POINTEUR MELPRI.MELEME
  64.       POINTEUR ML2PRI.MELEME
  65.       POINTEUR SMLPRI.MELEME
  67.       POINTEUR IMATEL.IMATRI
  68.       POINTEUR VMATEL.IZAFM
  69.       POINTEUR KMINCT.MINC
  70.       POINTEUR PMTOT.PMORS
  71.       POINTEUR IZATOT.IZA
  72. -INC SMLENTI
  73.       POINTEUR KRINCD.MLENTI
  74.       POINTEUR KRINCP.MLENTI
  75.       POINTEUR KRSPGT.MLENTI
  76.       POINTEUR RPMAT.MLENTI
  77. *
  78.       INTEGER IMPR,IRET
  79. *
  80.       LOGICAL LPARTD,LPARTP
  81.       INTEGER IDX,IDXDEB
  82.       INTEGER ISOUM,NBSOUM,NBSOUD,NBSOUP
  83.       INTEGER ITDDLD,ITDDLP,ITIDUA,ITIPRI,ITPODU,ITPOPR
  84.       INTEGER NBCMPD,NBCMPP
  85.       INTEGER NELPRI
  86.       INTEGER ILMAT,JDMAT,IPMAT,IMATL
  87.       INTEGER NDMAT,NPMAT,NBMATL
  88.       INTEGER LONLIG
  89.       INTEGER IELEM
  90.       INTEGER NUELG,OLDISM,ISOUMA,NUELOC
  91. *
  92. * Executable statements
  93. *
  94.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mkiza'
  95. * On régularise les maillage pour plus se faire chier si LISOUS(/1).EQ.0
  96. * In REGMAI : IF (.NOT.LPARTD) SEGINI ML2DUA
  97.       CALL REGMAI(MELDUA,ML2DUA,LPARTD,IMPR,IRET)
  98.       IF (IRET.NE.0) GOTO 9999
  99. * In REGMAI : IF (.NOT.LPARTP) SEGINI ML2PRI
  100.       CALL REGMAI(MELPRI,ML2PRI,LPARTP,IMPR,IRET)
  101.       IF (IRET.NE.0) GOTO 9999
  102. *
  103. * Activons les chapeaux (Matrices et supports)
  104. *
  105.       SEGACT ML2DUA
  106.       NBSOUD=ML2DUA.LISOUS(/1)
  107.       SEGACT ML2PRI
  108.       NBSOUP=ML2PRI.LISOUS(/1)
  109.       SEGACT IMATEL
  110.       NBSOUM=NBSOUP
  111.       NBMATL=IMATEL.LIZAFM(/2)
  112.       IF (NBSOUD.NE.NBSOUP) THEN
  113.          WRITE(IOIMP,*) 'Maillage primal, dual :'
  114.          WRITE(IOIMP,*) 'partitionnment différent...'
  115.          WRITE(IOIMP,*) 'NBSOUD=',NBSOUD
  116.          WRITE(IOIMP,*) 'NBSOUP=',NBSOUP
  117.          GOTO 9999
  118.       ENDIF
  119. *
  120. * Tableau de repérage dans la matrice
  121. *
  122. * In INIRPM : SEGINI RPMAT
  123.       CALL INIRPM(IMATEL,RPMAT,IMPR,IRET)
  124.       IF (IRET.NE.0) GOTO 9999
  125. *
  126. * Activons les tableaux de repérage
  127. *
  128.       SEGACT KRINCD
  129.       NBCMPD=KRINCD.LECT(/1)
  130.       SEGACT KRINCP
  131.       NBCMPP=KRINCP.LECT(/1)
  132.       IF (NBCMPD.NE.NBMATL.OR.NBCMPP.NE.NBMATL) THEN
  133.          WRITE(IOIMP,*) 'KRINCD, KRINCP et IMATEL :'
  134.          WRITE(IOIMP,*) 'nb. comp. différents...'
  135.          GOTO 9999
  136.       ENDIF
  137.       SEGACT KMINCT
  138.       SEGACT KRSPGT
  139.       SEGACT PMTOT
  140.       SEGACT IZATOT*MOD
  141. *
  142. * Parcourons les matrices élémentaires par sous-domaine et
  143. * remplissons les valeurs de la matrice Morse.
  144. *
  145.       DO 1 IMATL=1,NBMATL
  146.          ITIDUA=KRINCD.LECT(IMATL)
  147.          ITIPRI=KRINCP.LECT(IMATL)
  148.          NUELG=0
  149.          OLDISM=1
  150.          VMATEL=IMATEL.LIZAFM(OLDISM,IMATL)
  151.          SEGACT VMATEL
  152.          DO 12 ISOUM=1,NBSOUM
  153.             SMLDUA=ML2DUA.LISOUS(ISOUM)
  154.             SEGACT SMLDUA
  155.             SMLPRI=ML2PRI.LISOUS(ISOUM)
  156.             SEGACT SMLPRI
  157.             NELPRI=SMLPRI.NUM(/2)
  158.             DO 122 IELEM=1,NELPRI
  159.                NUELG=NUELG+1
  160.                CALL RPELEM(NUELG,RPMAT,ISOUMA,NUELOC,IMPR,IRET)
  161.                IF (IRET.NE.0) GOTO 9999
  162.                ISOUMA=MAX(ISOUMA,1)
  163.                IF (ISOUMA.NE.OLDISM) THEN
  164.                   SEGDES VMATEL
  165.                   VMATEL=IMATEL.LIZAFM(ISOUMA,IMATL)
  166.                   SEGACT VMATEL
  167.                   OLDISM=ISOUMA
  168.                ENDIF
  169.                ILMAT=NUELOC
  170.                NPMAT=VMATEL.AM(/2)
  171.                NDMAT=VMATEL.AM(/3)
  172.                DO 1222 JDMAT=1,NDMAT
  173.                   ITPODU=KRSPGT.LECT(SMLDUA.NUM(JDMAT,IELEM))
  174.                   IF (ITPODU.EQ.0) THEN
  175.                      WRITE(IOIMP,*) 'Point dual ????'
  176.                      GOTO 9999
  177.                   ENDIF
  178. C     Test du MPOS... déjà fait dans mkpmor...
  179.                   ITDDLD=KMINCT.NPOS(ITPODU)
  180.      $                 + KMINCT.MPOS(ITPODU,ITIDUA)-1
  181.                   IDXDEB=PMTOT.IA(ITDDLD)
  182.                   LONLIG=PMTOT.IA(ITDDLD+1)-IDXDEB
  183.                   IF (LONLIG.EQ.0) THEN
  184.                      WRITE(IOIMP,*) 'Ligne inex. ddl dua =',ITDDLD
  185.                      GOTO 9999
  186.                   ENDIF
  187. C     IPMAT parce que IDMAT est le nom d'un segment par défaut...
  188.                   DO 12222 IPMAT=1,NPMAT
  189.                      ITPOPR=KRSPGT.LECT(SMLPRI.NUM(IPMAT,IELEM))
  190.                      IF (ITPOPR.EQ.0) THEN
  191.                         WRITE(IOIMP,*) 'Point primal ????'
  192.                         GOTO 9999
  193.                      ENDIF
  194.                      ITDDLP=KMINCT.NPOS(ITPOPR)
  195.      $                 + KMINCT.MPOS(ITPOPR,ITIPRI)-1
  196.                      CALL IFIDIC(LONLIG,PMTOT.JA(IDXDEB),ITDDLP,
  197.      $                    IDX,
  198.      $                    IMPR,IRET)
  199.                      IF (IRET.NE.0) GOTO 9999
  200.                      IZATOT.A(IDXDEB+IDX-1)=IZATOT.A(IDXDEB+IDX-1)
  201.      $                    + VMATEL.AM(ILMAT,IPMAT,JDMAT)
  202. 12222             CONTINUE
  203.  1222          CONTINUE
  204.  122        CONTINUE
  205.             SEGDES SMLPRI
  206.             SEGDES SMLDUA
  207.   12      CONTINUE
  208.           SEGDES VMATEL
  209.  1    CONTINUE
  210.       SEGDES IZATOT
  211.       SEGDES PMTOT
  212.       SEGDES KRSPGT
  213.       SEGDES KMINCT
  214.       SEGDES KRINCP
  215.       SEGDES KRINCD
  216.       SEGSUP RPMAT
  217.       SEGDES IMATEL
  218.       SEGDES ML2PRI
  219.       SEGDES ML2DUA
  220.       IF (.NOT.LPARTP) SEGSUP ML2PRI
  221.       IF (.NOT.LPARTD) SEGSUP ML2DUA
  222. *
  223. * Normal termination
  224. *
  225.       IRET=0
  226.       RETURN
  227. *
  228. * Format handling
  229. *
  230. *
  231. * Error handling
  232. *
  233.  9999 CONTINUE
  234.       IRET=1
  235.       WRITE(IOIMP,*) 'An error was detected in subroutine mkiza'
  236.       RETURN
  237. *
  238. * End of subroutine MKIZA
  239. *
  240.       END
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  

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