Télécharger la plaquette Cast3M


fr en

Télécharger mkizat.eso

Retour à la liste

Numérotation des lignes : 

mkizat

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

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