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

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