Télécharger la plaquette Cast3M


fr en

Télécharger mkizt2.eso

Retour à la liste

Numérotation des lignes : 

mkizt2

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

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