Télécharger prase2.eso

Retour à la liste

Numérotation des lignes :

  1. C PRASE2 SOURCE PV 20/03/30 21:22:21 10567
  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
  58. POINTEUR MATELE.MATRIK
  59. POINTEUR MATASS.MATRIK
  60. POINTEUR IMATEL.IMATRI
  61. POINTEUR KMINCT.MINC
  62. * POINTEUR IDMTOT.IDMAT
  63. POINTEUR IDMATP.IDMAT
  64. POINTEUR IDMATD.IDMAT
  65. POINTEUR PMTOT.PMORS
  66. POINTEUR PMTOT2.PMORS
  67. INTEGER NBVA
  68. POINTEUR IZATOT.IZA
  69. *
  70. INTEGER LNMOTS
  71. PARAMETER (LNMOTS=8)
  72. *
  73. INTEGER IMPR,IRET
  74. *
  75. INTEGER NMATE,NTTDDL,NNZTOT,NTOGPO,NTOTIN,NTOTPO
  76. INTEGER IMATE, ITOTIN
  77. INTEGER LNM,NME
  78. *
  79. * Executable statements
  80. *
  81. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prase2'
  82. SEGACT MATASS
  83. SEGACT MATELE*MOD
  84. NMATE=MATASS.IRIGEL(/2)
  85. * Copie de IRIGEL(1,I) et IRIGEL(2,I)
  86. DO 1 IMATE=1,NMATE
  87. MELPRI=MATASS.IRIGEL(1,IMATE)
  88. MELDUA=MATASS.IRIGEL(2,IMATE)
  89. MATELE.IRIGEL(1,IMATE)=MELPRI
  90. MATELE.IRIGEL(2,IMATE)=MELDUA
  91. 1 CONTINUE
  92. MATELE.KSYM=MATASS.KSYM
  93. *
  94. * Construire l'ensemble des points sur lesquels sont localisées des
  95. * inconnues (KSPGT).
  96. *
  97. KJSPGT=MATASS.KISPGT
  98. MATELE.KISPGT=KJSPGT
  99. MATELE.KISPGP=KJSPGT
  100. MATELE.KISPGD=KJSPGT
  101. *
  102. * Construire le repérage des inconnues KMINCT
  103. *
  104. KMINCT=MATASS.KMINC
  105. MATELE.KMINC=KMINCT
  106. MATELE.KMINCP=KMINCT
  107. MATELE.KMINCD=KMINCT
  108. *
  109. * Il faut reconstruire un profil Morse pour MATELE
  110. *
  111. NTTDDL=MATASS.KNTTT
  112. MATELE.KNTTT=NTTDDL
  113. MATELE.KNTTP=NTTDDL
  114. MATELE.KNTTD=NTTDDL
  115. IDMATP=MATASS.KIDMAT(1)
  116. IDMATD=MATASS.KIDMAT(2)
  117. MATELE.KIDMAT(1)=IDMATP
  118. MATELE.KIDMAT(2)=IDMATD
  119. PMTOT2=MATASS.KIDMAT(4)
  120. SEGINI,PMTOT=PMTOT2
  121. MATELE.KIDMAT(4)=PMTOT
  122. NNZTOT=PMTOT.JA(/1)
  123. SEGDES PMTOT
  124. *
  125. * L'ensemble des inconnues
  126. *
  127. SEGACT KMINCT
  128. NTOTIN=KMINCT.LISINC(/2)
  129. JGN=LNMOTS
  130. JGM=NTOTIN
  131. SEGINI LITOT
  132. DO 3 ITOTIN=1,NTOTIN
  133. LITOT.MOTS(ITOTIN)(1:8)=KMINCT.LISINC(ITOTIN)(1:LNMOTS)
  134. 3 CONTINUE
  135. SEGDES LITOT
  136. SEGDES KMINCT
  137. *
  138. * Le repérage dans KSPGT
  139. *
  140. SEGACT KJSPGT
  141. NTOTPO=KJSPGT.NUM(/2)
  142. NTOGPO=nbpts
  143. JG=NTOGPO
  144. SEGINI KRSPGT
  145. * SEGACT KRSPGT
  146. CALL RSETXI(KRSPGT.LECT,KJSPGT.NUM,NTOTPO)
  147. SEGDES KRSPGT
  148. SEGDES KJSPGT
  149. *
  150. * Ordonnancement du profil Morse total
  151. *
  152. SEGACT PMTOT*MOD
  153. NTTDDL=PMTOT.IA(/1)-1
  154. NNZTOT=PMTOT.JA(/1)
  155. JG=MAX(NTTDDL+1,2*NNZTOT)
  156. SEGINI IWORK
  157. CALL CSORT(PMTOT.IA(/1)-1,RDUMMY,PMTOT.JA,PMTOT.IA,
  158. $ IWORK.LECT,.FALSE.)
  159. SEGSUP IWORK
  160. SEGDES PMTOT
  161. *
  162. * Assemblage des matrices élémentaires
  163. *
  164. SEGACT LITOT
  165. NBVA=NNZTOT
  166. SEGINI IZATOT
  167. SEGDES IZATOT
  168. DO 77 IMATE=1,NMATE
  169. MELPRI=MATELE.IRIGEL(1,IMATE)
  170. MELDUA=MATELE.IRIGEL(2,IMATE)
  171. IMATEL=MATELE.IRIGEL(4,IMATE)
  172. SEGACT IMATEL
  173. * repérage dans la primale
  174. LNM=IMATEL.LISPRI(/1)
  175. NME=IMATEL.LISPRI(/2)
  176. JG=NME
  177. SEGINI KRINCP
  178. CALL CREPER(LNM,NME,NTOTIN,
  179. $ IMATEL.LISPRI,LITOT.MOTS,
  180. $ KRINCP.LECT,
  181. $ IMPR,IRET)
  182. IF (IRET.NE.0) GOTO 9999
  183. * repérage dans la duale
  184. LNM=IMATEL.LISDUA(/1)
  185. NME=IMATEL.LISDUA(/2)
  186. JG=NME
  187. SEGINI KRINCD
  188. CALL CREPER(LNM,NME,NTOTIN,
  189. $ IMATEL.LISDUA,LITOT.MOTS,
  190. $ KRINCD.LECT,
  191. $ IMPR,IRET)
  192. IF (IRET.NE.0) GOTO 9999
  193. CALL MKIZ2(MELDUA,MELPRI,IMATEL,
  194. $ KRINCD,KRINCP,KMINCT,KRSPGT,
  195. $ PMTOT,IDMATP,IDMATD,
  196. $ IZATOT,
  197. $ IMPR,IRET)
  198. IF (IRET.NE.0) GOTO 9999
  199. *
  200. * Cas particulier : celui des matrices CCt
  201. *
  202. ITYMAT=MATELE.IRIGEL(7,IMATE)
  203. IF (ITYMAT.EQ.4.OR.ITYMAT.EQ.-4) THEN
  204. CALL MKIZT2(MELDUA,MELPRI,IMATEL,
  205. $ KRINCD,KRINCP,KMINCT,KRSPGT,
  206. $ PMTOT,IDMATP,IDMATD,
  207. $ IZATOT,
  208. $ IMPR,IRET)
  209. IF (IRET.NE.0) GOTO 9999
  210. ENDIF
  211. SEGSUP KRINCD
  212. SEGSUP KRINCP
  213. SEGDES IMATEL
  214. 77 CONTINUE
  215. SEGSUP LITOT
  216. SEGSUP KRSPGT
  217. MATELE.KIDMAT(5)=IZATOT
  218. SEGDES MATELE
  219. SEGDES MATASS
  220. *
  221. * Normal termination
  222. *
  223. IRET=0
  224. RETURN
  225. *
  226. * Format handling
  227. *
  228. *
  229. * Error handling
  230. *
  231. 9999 CONTINUE
  232. IRET=1
  233. WRITE(IOIMP,*) 'An error was detected in subroutine prase2'
  234. RETURN
  235. *
  236. * End of subroutine PRASE2
  237. *
  238. END
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  

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