Télécharger kres8.eso

Retour à la liste

Numérotation des lignes :

  1. C KRES8 SOURCE GOUNAND 19/07/03 21:15:07 10248
  2. SUBROUTINE KRES8(MRIGID,KSMBR,INORMU,
  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. *inutile EXTERNAL GAXPY,GCOPY,GDOT,GNRM2
  62.  
  63. IVALI=0
  64. XVALI=0.D0
  65. LOGII=.FALSE.
  66. IRETI=0
  67. XVALR=0.D0
  68. *inutile 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,oothrd)
  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,oothrd)
  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. C old INORMU=1 : Normalisation des mutiplicateurs de Lagrange
  108. * INORMU est transmis à la subroutine
  109. * Le problème est que si MRIGID est deja assemblée, INORMU n'est pas
  110. * pris en compte... mais où le stocker ??
  111. CALL KRES9(MRIGID,INORMU)
  112. IF (IERR.NE.0) RETURN
  113. IF (LTIME) THEN
  114. call timespv(ittime,oothrd)
  115. ITI2=(ITTIME(1)+ITTIME(2))/10
  116. ENDIF
  117. C
  118. C - Conversion au format Morse de la matrice
  119. C
  120. CALL KRES10(MRIGID,KMORS,KIZA)
  121. IF (IERR.NE.0) RETURN
  122. IF (LTIME) THEN
  123. call timespv(ittime,oothrd)
  124. ITI3=(ITTIME(1)+ITTIME(2))/10
  125. ENDIF
  126. C
  127. C On donne des infos sur la matrice
  128. C
  129. * SEGACT MRIGID
  130. * ICHOLX=ICHOLE
  131. ** INFDDL.ESO est dans ~/triou/p1nc
  132. ** CALL INFDDL(ICHOLX)
  133. C WRITE(IOIMP,*) 'IMPR=',IMPR
  134. CALL INFMAT(KMORS,KIZA,IMPR,IRET)
  135. C IF (IRET.NE.0) GOTO 9999
  136. C WRITE(IOIMP,*) 'Apres KRES10'
  137. C WRITE(IOIMP,*) 'KMORS=',KMORS
  138. C WRITE(IOIMP,*) 'KIZA=',KIZA
  139.  
  140. C
  141. C - Conversion du second membre en MVECTD
  142. C et initialisation du résultat
  143. C
  144. SEGACT MRIGID
  145. ICHOLX=ICHOLE
  146. ISECO=KSMBR
  147. C On ne vérifie pas que le second membre doit être dans le dual
  148. NOID=1
  149. CALL CHVNS(ICHOLX,ISECO,ISMBR,NOID)
  150. IF (IERR.NE.0) RETURN
  151. IF (LTIME) THEN
  152. call timespv(ittime,oothrd)
  153. ITI4=(ITTIME(1)+ITTIME(2))/10
  154. ENDIF
  155.  
  156. C SEGACT ISMBR
  157. C WRITE(IOIMP,*) 'Second membre sous forme vecteur'
  158. C INC=ISMBR.VECTBB(/1)
  159. C WRITE(IOIMP,*) ' ISMBR, INC=',INC
  160. C WRITE(IOIMP,2022) (ISMBR.VECTBB(II),II=1,ISMBR.VECTBB(/1))
  161. C
  162. C Gestion normalisation Lagrange (repris de MONDES)
  163. C
  164. * IF (INORMU.EQ.1) THEN
  165. SEGACT ISMBR*MOD
  166. MMATRI=ICHOLE
  167. SEGACT MMATRI
  168. IF(IDNORD.GT.0) THEN
  169. MDNO1=IDNORD
  170. ELSE
  171. MDNO1=IDNORM
  172. ENDIF
  173. SEGACT MDNO1
  174. INC=MDNO1.DNOR(/1)
  175. DO 45 I=1,INC
  176. ISMBR.VECTBB(I)=ISMBR.VECTBB(I)*MDNO1.DNOR(I)
  177. 45 CONTINUE
  178. SEGDES MDNO1
  179. SEGDES MMATRI
  180. SEGDES ISMBR
  181. * ENDIF
  182. C
  183. C - Construction du préconditionneur (repris sur kres5)
  184. C - Appel des solveurs itératifs
  185. C
  186. C Si solveur multigrille, il faut un segment permettant de distinguer
  187. C les inconnues
  188. IF (KTYPI.EQ.7.OR.KTYPI.EQ.8) THEN
  189. MMATRI=ICHOLE
  190. SEGACT MMATRI
  191. MINCPO=IINCPO
  192. SEGACT MINCPO
  193. NCOMP=INCPO(/1)
  194. NNOE=INCPO(/2)
  195. SEGACT ISMBR
  196. INC=ISMBR.VECTBB(/1)
  197. SEGDES ISMBR
  198. JG=INC
  199. SEGINI KTYP
  200. DO ICOMP=1,NCOMP
  201. DO INOE=1,NNOE
  202. IG=INCPO(ICOMP,INOE)
  203. IF (IG.GT.0) KTYP.LECT(IG)=ICOMP
  204. ENDDO
  205. ENDDO
  206. SEGDES KTYP
  207. SEGDES MINCPO
  208. SEGDES MMATRI
  209. ELSE
  210. KTYP=0
  211. ENDIF
  212. C
  213. C Warning KMORS, KIZA et KTYP sont détruits dans KRES11 et KRES12
  214. C si inodet=0
  215. INODET=1
  216. C CALL ECMORS(KMORS,KIZA,4)
  217. C SEGACT ISMBR
  218. C WRITE(IOIMP,*) 'Second membre sous forme vecteur'
  219. C INC=ISMBR.VECTBB(/1)
  220. C WRITE(IOIMP,*) ' ISMBR, INC=',INC
  221. C WRITE(IOIMP,2022) (ISMBR.VECTBB(II),II=1,ISMBR.VECTBB(/1))
  222. C Solveur Direct
  223. IF (KTYPI.EQ.1) THEN
  224. SEGINI,INCX=ISMBR
  225. CALL KRES12(KMORS,KIZA,INCX,
  226. C CALL KRES12(KMORS,KIZA,ISMBR,
  227. $ KTIME,LTIME,
  228. $ INCX,LRES,LNMV,ICVG,IMPR,INODET)
  229. ELSE
  230. C Solveur Itératif
  231. CALL KRES11(KMORS,KIZA,KTYP,ISMBR,
  232. $ KTYPI,ITER,RESID,ICALRS,IRSTRT,LBCG,BRTOL,IDDOT,IMVEC,
  233. $ KPREC,RXMILU,RXILUP,XLFIL,XDTOL,XSPIV,
  234. $ KTIME,LTIME,
  235. $ INCX,LRES,LNMV,ICVG,IMPR,INODET)
  236. C WRITE(IOIMP,*) 'Apres KRES11'
  237. ENDIF
  238. IF(IERR.NE.0) RETURN
  239. C SEGACT INCX
  240. C WRITE(IOIMP,*) 'Inconnue sous forme vecteur'
  241. C INC=INCX.VECTBB(/1)
  242. C WRITE(IOIMP,*) ' INCX, INC=',INC
  243. C WRITE(IOIMP,2022) (INCX.VECTBB(II),II=1,INCX.VECTBB(/1))
  244. C IF(IERR.NE.0) RETURN
  245. C r(0)=b
  246. C SEGINI,IR=ISMBR
  247. C SEGACT INCX
  248. C SEGACT KMORS
  249. C SEGACT KIZA
  250. CC r(0)=b-Ax
  251. C CALL GMOMV(IMVEC,'N',-1.D0,KMORS,KIZA,INCX,1.D0,IR)
  252. C RNRM2 = GNRM2(IR)
  253. C WRITE(IOIMP,*) '||R||=',RNRM2
  254. C
  255. C Gestion normalisation Lagrange (repris de MONDES)
  256. C + égalité multiplicateurs
  257. * IF (INORMU.EQ.1) THEN
  258. SEGACT INCX*MOD
  259. MMATRI=ICHOLE
  260. SEGACT MMATRI
  261. MDNOR=IDNORM
  262. SEGACT MDNOR
  263. INC=DNOR(/1)
  264. DO 35 I=1,INC
  265. INCX.VECTBB(I)=INCX.VECTBB(I)*DNOR(I)
  266. 35 CONTINUE
  267. SEGDES MDNOR
  268. MILIGN=IILIGN
  269. SEGACT,MILIGN
  270. DO 36 I = 1, INC
  271. if (ITTR(I).ne.0) then
  272. * write (6,*) ' dans mondes ',i,ittr(i)
  273. if (incx.vectbb(i).eq.0.d0
  274. $ .or.incx.vectbb(ittr(i)).eq.0.d0) then
  275. * write (6,*) ' mondes vectbbs ',vectbb(i+k),vectbb(ittr(i)+k)
  276. incx.vectbb(i)=0.d0
  277. incx.vectbb(ittr(i))=0.d0
  278. goto 36
  279. endif
  280. incx.vectbb(i)=(incx.vectbb(i)+incx.vectbb(ittr(i)))/2
  281. incx.vectbb(ittr(i))=incx.vectbb(i)
  282. endif
  283. 36 CONTINUE
  284. SEGDES MILIGN
  285. SEGDES MMATRI
  286. SEGDES INCX
  287. * ENDIF
  288. C
  289. C
  290. C SEGACT INCX
  291. C WRITE(IOIMP,*) 'Inconnue sous forme vecteur'
  292. C INC=INCX.VECTBB(/1)
  293. C WRITE(IOIMP,*) ' INCX, INC=',INC
  294. C WRITE(IOIMP,2022) (INCX.VECTBB(II),II=1,INCX.VECTBB(/1))
  295. C IF(IERR.NE.0) RETURN
  296.  
  297. IF (LTIME) THEN
  298. call timespv(ittime,oothrd)
  299. ITI5=(ITTIME(1)+ITTIME(2))/10
  300. ENDIF
  301. C
  302. C - Conversion du résultat en CHPOINT
  303. C
  304. CALL VCH1(ICHOLX,INCX,MCHSOL,MRIGID)
  305. C WRITE(IOIMP,*) 'Apres VCH1'
  306. IF(IERR.NE.0) RETURN
  307. IF (LTIME) THEN
  308. call timespv(ittime,oothrd)
  309. ITI6=(ITTIME(1)+ITTIME(2))/10
  310. CHARI='ASS+RENU'
  311. CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI,
  312. $ 'ENTIER ',ITI2-ITI1,XVALR,CHARR,LOGIR,IRETR)
  313. CHARI='CONVMORS'
  314. CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI,
  315. $ 'ENTIER ',ITI3-ITI2,XVALR,CHARR,LOGIR,IRETR)
  316. C CHARI='CONVSMB '
  317. C CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI,
  318. C $ 'ENTIER ',ITI4-ITI3,XVALR,CHARR,LOGIR,IRETR)
  319. IF (KTYPI.EQ.1) THEN
  320. CHARI='FAC+RESO'
  321. ELSE
  322. CHARI='PRE+RESO'
  323. ENDIF
  324. CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI,
  325. $ 'ENTIER ',ITI5-ITI4,XVALR,CHARR,LOGIR,IRETR)
  326. C CHARI='CONVINC'
  327. C CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI,
  328. C $ 'ENTIER ',ITI6-ITI5,XVALR,CHARR,LOGIR,IRETR)
  329. CHARI='TOTAL '
  330. CALL ECCTAB(KTIME,'MOT ',IVALI,XVALI,CHARI,LOGII,IRETI,
  331. $ 'ENTIER ',ITI6-ITI1,XVALR,CHARR,LOGIR,IRETR)
  332. SEGDES KTIME
  333. ENDIF
  334. C Le solveur direct surcharge le second membre
  335. IF (ISMBR.NE.INCX) SEGSUP ISMBR
  336. SEGSUP INCX
  337. SEGDES MRIGID
  338. C
  339. C Normal termination
  340. C
  341. RETURN
  342. C
  343. C Format handling
  344. C
  345. 2022 FORMAT(10(1X,1PG12.5))
  346. C
  347. C End of subroutine KRES8
  348. C
  349. END
  350.  
  351.  
  352.  
  353.  
  354.  
  355.  
  356.  
  357.  
  358.  
  359.  
  360.  
  361.  

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