Télécharger kres8.eso

Retour à la liste

Numérotation des lignes :

  1. C KRES8 SOURCE PV 16/11/17 22:00:25 9180
  2. SUBROUTINE KRES8(MRIGID,KSMBR,
  3. $ KTYPI,ITER,RESID,ICALRS,IRSTRT,LBCG,BRTOL,IDDOT,IMVEC,
  4. $ KPREC,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV,
  5. $ KTIME,LTIME,
  6. $ MCHSOL,LRES,LNMV,ICVG,IMPR)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. IMPLICIT INTEGER (I-N)
  9. C***********************************************************************
  10. C NOM : KRES8
  11. C DESCRIPTION : - Assemblage par RESOU
  12. C - Conversion au format Morse de la matrice
  13. C - Conversion du second membre en MVECTD
  14. C - Construction du préconditionneur
  15. C - Appel des solveurs itératifs
  16. C - Conversion du résultat en CHPOINT
  17. C
  18. C
  19. C LANGAGE : ESOPE
  20. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  21. C mél : gounand@semt2.smts.cea.fr
  22. C***********************************************************************
  23. C VERSION : v1, 04/08/2011, version initiale
  24. C HISTORIQUE : v1, 04/08/2011, création
  25. C HISTORIQUE :
  26. C HISTORIQUE :
  27. C***********************************************************************
  28. -INC CCOPTIO
  29. -INC SMCHPOI
  30. POINTEUR MCHSOL.MCHPOI
  31. -INC SMRIGID
  32. -INC SMVECTD
  33. POINTEUR ISMBR.MVECTD
  34. POINTEUR INCX.MVECTD
  35. POINTEUR IR.MVECTD
  36. -INC SMMATRI
  37. SEGMENT PMORS
  38. INTEGER IA (NTT+1)
  39. INTEGER JA (NJA)
  40. ENDSEGMENT
  41. POINTEUR PMS1.PMORS,PMS2.PMORS
  42. POINTEUR KMORS.PMORS
  43. C Segment de stokage
  44. SEGMENT IZA
  45. REAL*8 A(NBVA)
  46. ENDSEGMENT
  47. POINTEUR IZA1.IZA,IZA2.IZA,IZAU.IZA,IZAL.IZA,ISA.IZA
  48. POINTEUR KIZA.IZA
  49.  
  50. -INC SMLENTI
  51. POINTEUR KTYP.MLENTI
  52. -INC SMTABLE
  53. POINTEUR KTIME.MTABLE
  54. DIMENSION ITTIME(4)
  55. CHARACTER*8 CHARI
  56. CHARACTER*1 CCOMP
  57. LOGICAL LTIME,LOGII
  58. REAL*8 GNRM2
  59. C ..
  60. C .. External subroutines and functions..
  61. EXTERNAL GAXPY,GCOPY,GDOT,GNRM2
  62.  
  63. IVALI=0
  64. XVALI=0.D0
  65. LOGII=.FALSE.
  66. IRETI=0
  67. XVALR=0.D0
  68. IOBRE=0
  69. IRETR=0
  70. C
  71. C Executable statements
  72. C
  73. IF (LTIME) THEN
  74. CALL CRTABL(KTIME)
  75. CALL TIMESPV(ITTIME)
  76. ITI1=(ITTIME(1)+ITTIME(2))/10
  77. ELSE
  78. KTIME=0
  79. ENDIF
  80. C
  81. C CAS PARTICULIER : Si la matrice est vide (toutes les inconnues
  82. C éliminées, par exemple)
  83. C
  84. SEGACT MRIGID
  85. IF (IRIGEL(/2).EQ.0) THEN
  86. NSOUPO=0
  87. NAT=0
  88. SEGINI MCHSOL
  89. SEGDES MCHSOL
  90. ICVG=0
  91. LNMV=0
  92. LRES=0
  93. IF (LTIME) THEN
  94. CALL TIMESPV(ITTIME)
  95. ITI2=(ITTIME(1)+ITTIME(2))/10
  96. CHARI='MATVIDE'
  97. CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI,
  98. $ 'ENTIER ',ITI2-ITI1,XVALR,CHARR,LOGIR,IRETR)
  99. SEGDES KTIME
  100. ENDIF
  101. SEGDES MRIGID
  102. RETURN
  103. ENDIF
  104. C
  105. C - Assemblage par RESOU
  106. C
  107. CALL KRES9(MRIGID,1)
  108. IF (IERR.NE.0) RETURN
  109. IF (LTIME) THEN
  110. CALL TIMESPV(ITTIME)
  111. ITI2=(ITTIME(1)+ITTIME(2))/10
  112. ENDIF
  113. C
  114. C - Conversion au format Morse de la matrice
  115. C
  116. CALL KRES10(MRIGID,KMORS,KIZA)
  117. IF (IERR.NE.0) RETURN
  118. IF (LTIME) THEN
  119. CALL TIMESPV(ITTIME)
  120. ITI3=(ITTIME(1)+ITTIME(2))/10
  121. ENDIF
  122. C
  123. C On donne des infos sur la matrice
  124. C
  125. C WRITE(IOIMP,*) 'IMPR=',IMPR
  126. CALL INFMAT(KMORS,KIZA,IMPR,IRET)
  127. C IF (IRET.NE.0) GOTO 9999
  128. C WRITE(IOIMP,*) 'Apres KRES10'
  129. C WRITE(IOIMP,*) 'KMORS=',KMORS
  130. C WRITE(IOIMP,*) 'KIZA=',KIZA
  131.  
  132. C
  133. C - Conversion du second membre en MVECTD
  134. C et initialisation du résultat
  135. C
  136. SEGACT MRIGID
  137. ICHOLX=ICHOLE
  138. ISECO=KSMBR
  139. C On ne vérifie pas que le second membre doit être dans le dual
  140. NOID=1
  141. CALL CHVNS(ICHOLX,ISECO,ISMBR,NOID)
  142. IF (IERR.NE.0) RETURN
  143. IF (LTIME) THEN
  144. CALL TIMESPV(ITTIME)
  145. ITI4=(ITTIME(1)+ITTIME(2))/10
  146. ENDIF
  147. C SEGACT ISMBR
  148. C WRITE(IOIMP,*) 'Second membre sous forme vecteur'
  149. C INC=ISMBR.VECTBB(/1)
  150. C WRITE(IOIMP,*) ' ISMBR, INC=',INC
  151. C WRITE(IOIMP,2022) (ISMBR.VECTBB(II),II=1,ISMBR.VECTBB(/1))
  152. C
  153. C - Construction du préconditionneur (repris sur kres5)
  154. C - Appel des solveurs itératifs
  155. C
  156. C Si solveur multigrille, il faut un segment permettant de distinguer
  157. C les inconnues
  158. IF (KTYPI.EQ.7.OR.KTYPI.EQ.8) THEN
  159. MMATRI=ICHOLE
  160. SEGACT MMATRI
  161. MINCPO=IINCPO
  162. SEGACT MINCPO
  163. NCOMP=INCPO(/1)
  164. NNOE=INCPO(/2)
  165. SEGACT ISMBR
  166. INC=ISMBR.VECTBB(/1)
  167. SEGDES ISMBR
  168. JG=INC
  169. SEGINI KTYP
  170. DO ICOMP=1,NCOMP
  171. DO INOE=1,NNOE
  172. IG=INCPO(ICOMP,INOE)
  173. IF (IG.GT.0) KTYP.LECT(IG)=ICOMP
  174. ENDDO
  175. ENDDO
  176. SEGDES KTYP
  177. SEGDES MINCPO
  178. SEGDES MMATRI
  179. ELSE
  180. KTYP=0
  181. ENDIF
  182. C
  183. C Warning KMORS, KIZA et KTYP sont détruits dans KRES11 et KRES12
  184. C si inodet=0
  185. INODET=1
  186. C CALL ECMORS(KMORS,KIZA,3)
  187. C SEGACT ISMBR
  188. C WRITE(IOIMP,*) 'Second membre sous forme vecteur'
  189. C INC=ISMBR.VECTBB(/1)
  190. C WRITE(IOIMP,*) ' ISMBR, INC=',INC
  191. C WRITE(IOIMP,2022) (ISMBR.VECTBB(II),II=1,ISMBR.VECTBB(/1))
  192. C Solveur Direct
  193. IF (KTYPI.EQ.1) THEN
  194. SEGINI,INCX=ISMBR
  195. CALL KRES12(KMORS,KIZA,INCX,
  196. C CALL KRES12(KMORS,KIZA,ISMBR,
  197. $ KTIME,LTIME,
  198. $ INCX,LRES,LNMV,ICVG,IMPR,INODET)
  199. ELSE
  200. C Solveur Itératif
  201. CALL KRES11(KMORS,KIZA,KTYP,ISMBR,
  202. $ KTYPI,ITER,RESID,ICALRS,IRSTRT,LBCG,BRTOL,IDDOT,IMVEC,
  203. $ KPREC,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV,
  204. $ KTIME,LTIME,
  205. $ INCX,LRES,LNMV,ICVG,IMPR,INODET)
  206. C WRITE(IOIMP,*) 'Apres KRES11'
  207. ENDIF
  208. IF(IERR.NE.0) RETURN
  209. C SEGACT INCX
  210. C WRITE(IOIMP,*) 'Inconnue sous forme vecteur'
  211. C INC=INCX.VECTBB(/1)
  212. C WRITE(IOIMP,*) ' INCX, INC=',INC
  213. C WRITE(IOIMP,2022) (INCX.VECTBB(II),II=1,INCX.VECTBB(/1))
  214. C IF(IERR.NE.0) RETURN
  215. C r(0)=b
  216. C SEGINI,IR=ISMBR
  217. C SEGACT INCX
  218. C SEGACT KMORS
  219. C SEGACT KIZA
  220. CC r(0)=b-Ax
  221. C CALL GMOMV('N',-1.D0,KMORS,KIZA,INCX,1.D0,IR)
  222. C RNRM2 = GNRM2(IR)
  223. C WRITE(IOIMP,*) '||R||=',RNRM2
  224.  
  225. IF (LTIME) THEN
  226. CALL TIMESPV(ITTIME)
  227. ITI5=(ITTIME(1)+ITTIME(2))/10
  228. ENDIF
  229. C
  230. C - Conversion du résultat en CHPOINT
  231. C
  232. CALL VCH1(ICHOLX,INCX,MCHSOL,MRIGID)
  233. C WRITE(IOIMP,*) 'Apres VCH1'
  234. IF(IERR.NE.0) RETURN
  235. IF (LTIME) THEN
  236. CALL TIMESPV(ITTIME)
  237. ITI6=(ITTIME(1)+ITTIME(2))/10
  238. CHARI='ASS+RENU'
  239. CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI,
  240. $ 'ENTIER ',ITI2-ITI1,XVALR,CHARR,LOGIR,IRETR)
  241. CHARI='CONVMORS'
  242. CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI,
  243. $ 'ENTIER ',ITI3-ITI2,XVALR,CHARR,LOGIR,IRETR)
  244. C CHARI='CONVSMB '
  245. C CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI,
  246. C $ 'ENTIER ',ITI4-ITI3,XVALR,CHARR,LOGIR,IRETR)
  247. IF (KTYPI.EQ.1) THEN
  248. CHARI='FAC+RESO'
  249. ELSE
  250. CHARI='PRE+RESO'
  251. ENDIF
  252. CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI,
  253. $ 'ENTIER ',ITI5-ITI4,XVALR,CHARR,LOGIR,IRETR)
  254. C CHARI='CONVINC'
  255. C CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI,
  256. C $ 'ENTIER ',ITI6-ITI5,XVALR,CHARR,LOGIR,IRETR)
  257. CHARI='TOTAL '
  258. CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI,
  259. $ 'ENTIER ',ITI6-ITI1,XVALR,CHARR,LOGIR,IRETR)
  260. SEGDES KTIME
  261. ENDIF
  262. C Le solveur direct surcharge le second membre
  263. IF (ISMBR.NE.INCX) SEGSUP ISMBR
  264. SEGSUP INCX
  265. SEGDES MRIGID
  266. C
  267. C Normal termination
  268. C
  269. RETURN
  270. C
  271. C Format handling
  272. C
  273. C 2022 FORMAT(10(1X,1PG12.5))
  274. C
  275. C End of subroutine KRES8
  276. C
  277. END
  278.  
  279.  
  280.  
  281.  
  282.  
  283.  
  284.  
  285.  
  286.  
  287.  

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