Télécharger la plaquette Cast3M


fr en

Télécharger prase2.eso

Retour à la liste

Numérotation des lignes : 

prase2

  1. C PRASE2    SOURCE    PV        22/04/22    21:15:12     11344          
  2.       SUBROUTINE PRASE2(MATELE,MATASS,
  3.      $     IMPR,IRET)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5.       IMPLICIT INTEGER (I-N)
  6. C***********************************************************************
  7. C NOM         : PRASE2
  8. C PROJET      : Noyau linéaire NLIN
  9. C DESCRIPTION : Version raccourcie de prasem lorsqu'on connaît la
  10. C               structure de la matrice assemblée (tableau de repérage
  11. C               des ddl, renumérotation, profil Morse).  On effectue
  12. C               l'assemblage d'un ensemble de matrices élémentaires pour
  13. C               faire une matrice Morse.
  14. C               Ceci est la version raccourcie de prasem.
  15. C               on a une autre matrice identique sauf pour les
  16. C               valeurs des matrices élémentaires.
  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          : MKIZ2, MKIZT2
  23. C APPELES (UTIL)   : RSETXI, CREPER
  24. C APPELE PAR       : KRES2
  25. C***********************************************************************
  26. C ENTREES            : MATASS
  27. C ENTREES/SORTIES    : MATELE
  28. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  29. C***********************************************************************
  30. C VERSION    : v1, 16/12/99, nouvelle version initiale
  31. C HISTORIQUE : v1, 16/12/99, création
  32. C HISTORIQUE : 09/04/04 rajout de idmatd
  33. C HISTORIQUE :
  34. C***********************************************************************
  35. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  36. C en cas de modification de ce sous-programme afin de faciliter
  37. C la maintenance !
  38. C***********************************************************************
  39. * MATASS est une matrice de préconditionnement déjà assemblée
  40. * permettant de sauter des étapes de l'assemblage
  41.  
  42. -INC PPARAM
  43. -INC CCOPTIO
  44. -INC SMCOORD
  45. -INC SMELEME
  46.       POINTEUR KJSPGT.MELEME
  47.       POINTEUR MELPRI.MELEME
  48.       POINTEUR MELDUA.MELEME
  49. -INC SMLENTI
  50.       INTEGER JG
  51.       POINTEUR KRSPGT.MLENTI
  52.       POINTEUR KRINCP.MLENTI
  53.       POINTEUR KRINCD.MLENTI
  54.       POINTEUR IWORK.MLENTI
  55. -INC SMLMOTS
  56.       INTEGER JGN,JGM
  57.       POINTEUR LITOT.MLMOTS
  59.       POINTEUR MATELE.MATRIK
  60.       POINTEUR MATASS.MATRIK
  61.       POINTEUR IMATEL.IMATRI
  62.       POINTEUR KMINCT.MINC
  63. *      POINTEUR IDMTOT.IDMAT
  64.       POINTEUR IDMATP.IDMAT
  65.       POINTEUR IDMATD.IDMAT
  66.       POINTEUR PMTOT.PMORS
  67.       POINTEUR PMTOT2.PMORS
  68.       INTEGER NBVA
  69.       POINTEUR IZATOT.IZA
  70. *
  71.       INTEGER LNMOTS
  72.       PARAMETER (LNMOTS=8)
  73. *
  74.       INTEGER IMPR,IRET
  75. *
  76.       INTEGER NMATE,NTTDDL,NNZTOT,NTOGPO,NTOTIN,NTOTPO
  77.       INTEGER IMATE,                     ITOTIN
  78.       INTEGER LNM,NME
  79.       REAL*8 RDUMMY(1)
  80. *
  81. * Executable statements
  82. *
  83.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prase2'
  84.       SEGACT MATASS
  85.       SEGACT MATELE*MOD
  86.       NMATE=MATASS.IRIGEL(/2)
  87. * Copie de IRIGEL(1,I) et IRIGEL(2,I)
  88.       DO 1 IMATE=1,NMATE
  89.          MELPRI=MATASS.IRIGEL(1,IMATE)
  90.          MELDUA=MATASS.IRIGEL(2,IMATE)
  91.          MATELE.IRIGEL(1,IMATE)=MELPRI
  92.          MATELE.IRIGEL(2,IMATE)=MELDUA
  93.  1    CONTINUE
  94.       MATELE.KSYM=MATASS.KSYM
  95. *
  96. * Construire l'ensemble des points sur lesquels sont localisées des
  97. * inconnues (KSPGT).
  98. *
  99.       KJSPGT=MATASS.KISPGT
  100.       MATELE.KISPGT=KJSPGT
  101.       MATELE.KISPGP=KJSPGT
  102.       MATELE.KISPGD=KJSPGT
  103. *
  104. * Construire le repérage des inconnues KMINCT
  105. *
  106.       KMINCT=MATASS.KMINC
  107.       MATELE.KMINC=KMINCT
  108.       MATELE.KMINCP=KMINCT
  109.       MATELE.KMINCD=KMINCT
  110. *
  111. * Il faut reconstruire un profil Morse pour MATELE
  112. *
  113.       NTTDDL=MATASS.KNTTT
  114.       MATELE.KNTTT=NTTDDL
  115.       MATELE.KNTTP=NTTDDL
  116.       MATELE.KNTTD=NTTDDL
  117.       IDMATP=MATASS.KIDMAT(1)
  118.       IDMATD=MATASS.KIDMAT(2)
  119.       MATELE.KIDMAT(1)=IDMATP
  120.       MATELE.KIDMAT(2)=IDMATD
  121.       PMTOT2=MATASS.KIDMAT(4)
  122.       SEGINI,PMTOT=PMTOT2
  123.       MATELE.KIDMAT(4)=PMTOT
  124.       NNZTOT=PMTOT.JA(/1)
  125.       SEGDES PMTOT
  126. *
  127. * L'ensemble des inconnues
  128. *
  129.       SEGACT KMINCT
  130.       NTOTIN=KMINCT.LISINC(/2)
  131.       JGN=LNMOTS
  132.       JGM=NTOTIN
  133.       SEGINI LITOT
  134.       DO 3 ITOTIN=1,NTOTIN
  135.          LITOT.MOTS(ITOTIN)(1:8)=KMINCT.LISINC(ITOTIN)(1:LNMOTS)
  136.  3    CONTINUE
  137.       SEGDES LITOT
  138.       SEGDES KMINCT
  139. *
  140. * Le repérage dans KSPGT
  141. *
  142.       SEGACT KJSPGT
  143.       NTOTPO=KJSPGT.NUM(/2)
  144.       NTOGPO=nbpts
  145.       JG=NTOGPO
  146.       SEGINI KRSPGT
  147. *     SEGACT KRSPGT
  148.       CALL RSETXI(KRSPGT.LECT,KJSPGT.NUM,NTOTPO)
  149.       SEGDES KRSPGT
  150.       SEGDES KJSPGT
  151. *
  152. * Ordonnancement du profil Morse total
  153. *
  154.       SEGACT PMTOT*MOD
  155.       NTTDDL=PMTOT.IA(/1)-1
  156.       NNZTOT=PMTOT.JA(/1)
  157.       JG=MAX(NTTDDL+1,2*NNZTOT)
  158.       SEGINI IWORK
  159.       CALL CSORT(PMTOT.IA(/1)-1,RDUMMY,PMTOT.JA,PMTOT.IA,
  160.      $     IWORK.LECT,.FALSE.)
  161.       SEGSUP IWORK
  162.       SEGDES PMTOT
  163. *
  164. * Assemblage des matrices élémentaires
  165. *
  166.       SEGACT LITOT
  167.       NBVA=NNZTOT
  168.       SEGINI IZATOT
  169.       SEGDES IZATOT
  170.       DO 77 IMATE=1,NMATE
  171.          MELPRI=MATELE.IRIGEL(1,IMATE)
  172.          MELDUA=MATELE.IRIGEL(2,IMATE)
  173.          IMATEL=MATELE.IRIGEL(4,IMATE)
  174.          SEGACT IMATEL
  175. *     repérage dans la primale
  176.          LNM=IMATEL.LISPRI(/1)
  177.          NME=IMATEL.LISPRI(/2)
  178.          JG=NME
  179.          SEGINI KRINCP
  180.          CALL CREPER(LNM,NME,NTOTIN,
  181.      $        IMATEL.LISPRI,LITOT.MOTS,
  182.      $        KRINCP.LECT,
  183.      $        IMPR,IRET)
  184.          IF (IRET.NE.0) GOTO 9999
  185. *     repérage dans la duale
  186.          LNM=IMATEL.LISDUA(/1)
  187.          NME=IMATEL.LISDUA(/2)
  188.          JG=NME
  189.          SEGINI KRINCD
  190.          CALL CREPER(LNM,NME,NTOTIN,
  191.      $        IMATEL.LISDUA,LITOT.MOTS,
  192.      $        KRINCD.LECT,
  193.      $        IMPR,IRET)
  194.          IF (IRET.NE.0) GOTO 9999
  195.          CALL MKIZ2(MELDUA,MELPRI,IMATEL,
  196.      $     KRINCD,KRINCP,KMINCT,KRSPGT,
  197.      $     PMTOT,IDMATP,IDMATD,
  198.      $     IZATOT,
  199.      $     IMPR,IRET)
  200.          IF (IRET.NE.0) GOTO 9999
  201. *
  202. * Cas particulier : celui des matrices CCt
  203. *
  204.          ITYMAT=MATELE.IRIGEL(7,IMATE)
  205.          IF (ITYMAT.EQ.4.OR.ITYMAT.EQ.-4) THEN
  206.             CALL MKIZT2(MELDUA,MELPRI,IMATEL,
  207.      $           KRINCD,KRINCP,KMINCT,KRSPGT,
  208.      $           PMTOT,IDMATP,IDMATD,
  209.      $           IZATOT,
  210.      $           IMPR,IRET)
  211.             IF (IRET.NE.0) GOTO 9999
  212.          ENDIF
  213.          SEGSUP KRINCD
  214.          SEGSUP KRINCP
  215.          SEGDES IMATEL
  216.  77   CONTINUE
  217.       SEGSUP LITOT
  218.       SEGSUP KRSPGT
  219.       MATELE.KIDMAT(5)=IZATOT
  220.       SEGDES MATELE
  221.       SEGDES MATASS
  222. *
  223. * Normal termination
  224. *
  225.       IRET=0
  226.       RETURN
  227. *
  228. * Format handling
  229. *
  230. *
  231. * Error handling
  232. *
  233.  9999 CONTINUE
  234.       IRET=1
  235.       WRITE(IOIMP,*) 'An error was detected in subroutine prase2'
  236.       RETURN
  237. *
  238. * End of subroutine PRASE2
  239. *
  240.       END
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  

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