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    GOUNAND   24/11/06    21:15:12     12073          
  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.       INTEGER IDX,IDXDEB
  81.       INTEGER ISOUM,NBSOUM,NBSOUD,NBSOUP
  82.       INTEGER ITDDLD,ITDDLP,ITIDUA,ITIPRI,ITPODU,ITPOPR
  83.       INTEGER NBCMPD,NBCMPP
  84.       INTEGER NELPRI
  85.       INTEGER ILMAT,JDMAT,IPMAT,IMATL
  86.       INTEGER NDMAT,NPMAT,NBMATL
  87.       INTEGER LONLIG
  88.       INTEGER IELEM
  89.       INTEGER NUELG,OLDISM,ISOUMA,NUELOC
  90. *
  91. * Executable statements
  92. *
  93.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mkiza'
  94. * On régularise les maillage pour plus se faire chier si LISOUS(/1).EQ.0
  95. * In REGMAI : SEGINI ML2DUA
  96.       CALL REGMAI(MELDUA,ML2DUA)
  97. * In REGMAI : SEGINI ML2PRI
  98.       CALL REGMAI(MELPRI,ML2PRI)
  99. *
  100. * Activons les chapeaux (Matrices et supports)
  101. *
  102.       SEGACT ML2DUA
  103.       NBSOUD=ML2DUA.LISOUS(/1)
  104.       SEGACT ML2PRI
  105.       NBSOUP=ML2PRI.LISOUS(/1)
  106.       SEGACT IMATEL
  107.       NBSOUM=NBSOUP
  108.       NBMATL=IMATEL.LIZAFM(/2)
  109.       IF (NBSOUD.NE.NBSOUP) THEN
  110.          WRITE(IOIMP,*) 'Maillage primal, dual :'
  111.          WRITE(IOIMP,*) 'partitionnment différent...'
  112.          WRITE(IOIMP,*) 'NBSOUD=',NBSOUD
  113.          WRITE(IOIMP,*) 'NBSOUP=',NBSOUP
  114.          GOTO 9999
  115.       ENDIF
  116. *
  117. * Tableau de repérage dans la matrice
  118. *
  119. * In INIRPM : SEGINI RPMAT
  120.       CALL INIRPM(IMATEL,RPMAT,IMPR,IRET)
  121.       IF (IRET.NE.0) GOTO 9999
  122. *
  123. * Activons les tableaux de repérage
  124. *
  125.       SEGACT KRINCD
  126.       NBCMPD=KRINCD.LECT(/1)
  127.       SEGACT KRINCP
  128.       NBCMPP=KRINCP.LECT(/1)
  129.       IF (NBCMPD.NE.NBMATL.OR.NBCMPP.NE.NBMATL) THEN
  130.          WRITE(IOIMP,*) 'KRINCD, KRINCP et IMATEL :'
  131.          WRITE(IOIMP,*) 'nb. comp. différents...'
  132.          GOTO 9999
  133.       ENDIF
  134.       SEGACT KMINCT
  135.       SEGACT KRSPGT
  136.       SEGACT PMTOT
  137.       SEGACT IZATOT*MOD
  138. *
  139. * Parcourons les matrices élémentaires par sous-domaine et
  140. * remplissons les valeurs de la matrice Morse.
  141. *
  142.       DO 1 IMATL=1,NBMATL
  143.          ITIDUA=KRINCD.LECT(IMATL)
  144.          ITIPRI=KRINCP.LECT(IMATL)
  145.          NUELG=0
  146.          OLDISM=1
  147.          VMATEL=IMATEL.LIZAFM(OLDISM,IMATL)
  148.          SEGACT VMATEL
  149.          DO 12 ISOUM=1,NBSOUM
  150.             SMLDUA=ML2DUA.LISOUS(ISOUM)
  151.             SEGACT SMLDUA
  152.             SMLPRI=ML2PRI.LISOUS(ISOUM)
  153.             SEGACT SMLPRI
  154.             NELPRI=SMLPRI.NUM(/2)
  155.             DO 122 IELEM=1,NELPRI
  156.                NUELG=NUELG+1
  157.                CALL RPELEM(NUELG,RPMAT,ISOUMA,NUELOC,IMPR,IRET)
  158.                IF (IRET.NE.0) GOTO 9999
  159.                ISOUMA=MAX(ISOUMA,1)
  160.                IF (ISOUMA.NE.OLDISM) THEN
  161.                   SEGDES VMATEL
  162.                   VMATEL=IMATEL.LIZAFM(ISOUMA,IMATL)
  163.                   SEGACT VMATEL
  164.                   OLDISM=ISOUMA
  165.                ENDIF
  166.                ILMAT=NUELOC
  167.                NPMAT=VMATEL.AM(/2)
  168.                NDMAT=VMATEL.AM(/3)
  169.                DO 1222 JDMAT=1,NDMAT
  170.                   ITPODU=KRSPGT.LECT(SMLDUA.NUM(JDMAT,IELEM))
  171.                   IF (ITPODU.EQ.0) THEN
  172.                      WRITE(IOIMP,*) 'Point dual ????'
  173.                      GOTO 9999
  174.                   ENDIF
  175. C     Test du MPOS... déjà fait dans mkpmor...
  176.                   ITDDLD=KMINCT.NPOS(ITPODU)
  177.      $                 + KMINCT.MPOS(ITPODU,ITIDUA)-1
  178.                   IDXDEB=PMTOT.IA(ITDDLD)
  179.                   LONLIG=PMTOT.IA(ITDDLD+1)-IDXDEB
  180.                   IF (LONLIG.EQ.0) THEN
  181.                      WRITE(IOIMP,*) 'Ligne inex. ddl dua =',ITDDLD
  182.                      GOTO 9999
  183.                   ENDIF
  184. C     IPMAT parce que IDMAT est le nom d'un segment par défaut...
  185.                   DO 12222 IPMAT=1,NPMAT
  186.                      ITPOPR=KRSPGT.LECT(SMLPRI.NUM(IPMAT,IELEM))
  187.                      IF (ITPOPR.EQ.0) THEN
  188.                         WRITE(IOIMP,*) 'Point primal ????'
  189.                         GOTO 9999
  190.                      ENDIF
  191.                      ITDDLP=KMINCT.NPOS(ITPOPR)
  192.      $                 + KMINCT.MPOS(ITPOPR,ITIPRI)-1
  193.                      CALL IFIDIC(LONLIG,PMTOT.JA(IDXDEB),ITDDLP,
  194.      $                    IDX,
  195.      $                    IMPR,IRET)
  196.                      IF (IRET.NE.0) GOTO 9999
  197.                      IZATOT.A(IDXDEB+IDX-1)=IZATOT.A(IDXDEB+IDX-1)
  198.      $                    + VMATEL.AM(ILMAT,IPMAT,JDMAT)
  199. 12222             CONTINUE
  200.  1222          CONTINUE
  201.  122        CONTINUE
  202.             SEGDES SMLPRI
  203.             SEGDES SMLDUA
  204.   12      CONTINUE
  205.           SEGDES VMATEL
  206.  1    CONTINUE
  207.       SEGDES IZATOT
  208.       SEGDES PMTOT
  209.       SEGDES KRSPGT
  210.       SEGDES KMINCT
  211.       SEGDES KRINCP
  212.       SEGDES KRINCD
  213.       SEGSUP RPMAT
  214.       SEGDES IMATEL
  215.       SEGDES ML2PRI
  216.       SEGDES ML2DUA
  217.       SEGSUP ML2PRI
  218.       SEGSUP ML2DUA
  219. *
  220. * Normal termination
  221. *
  222.       IRET=0
  223.       RETURN
  224. *
  225. * Format handling
  226. *
  227. *
  228. * Error handling
  229. *
  230.  9999 CONTINUE
  231.       IRET=1
  232.       WRITE(IOIMP,*) 'An error was detected in subroutine mkiza'
  233.       RETURN
  234. *
  235. * End of subroutine MKIZA
  236. *
  237.       END
  238.  
  239.  

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