Télécharger la plaquette Cast3M


fr en

Télécharger mkiz2.eso

Retour à la liste

Numérotation des lignes : 

mkiz2

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

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