Télécharger prase2.eso

Retour à la liste

Numérotation des lignes :

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

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