Télécharger cgres.eso

Retour à la liste

Numérotation des lignes :

  1. C CGRES SOURCE CHAT 05/01/12 21:53:35 5004
  2. SUBROUTINE CGRES(KSTO,
  3. 1 NL,ILG,
  4. 2 IMAT,IA,JA,KA,
  5. 3 IZB,IZP,ICOLD,
  6. 4 NPT,NPITE,NEFF,ICONV,EPI,IPOU,VPOU,
  7. 5 NIMPR,IPAT)
  8. C
  9. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  10. C C
  11. C RESOLUTION ITERATIVE D'UN SYSTEME C
  12. C SYMETRIQUE CREUX PAR LA METHODE DU C
  13. C GRADIENT CONJUGUE SANS PRECONDITIONNEMENT C
  14. C C
  15. C***** INFOS SUR LA METHODE (LIGNE 0) C
  16. C C
  17. C DEUX MODES DE STOCKAGE SONT PROPOSES C
  18. C MORSE OU COMPRESSE. C
  19. C C
  20. C MORSE (KSTO=0) C
  21. C COMPRESSE (KSTO=1) C
  22. C C
  23. C POUR LE CAS SANS PRECONDITIONNEMENT ON RESOUD C
  24. C C
  25. C A*xi = b C
  26. C C
  27. C***** INFOS SUR LES DIMENSIONS (LIGNE 1) C
  28. C C
  29. C NL (L'ORDRE DU SYSTEME) C
  30. C C
  31. C ILG (LONGUEUR LA POUR LE MORSE) C
  32. C (NOMBRE MAXI DE VALEURS PAR LIGNE DE LA C
  33. C MATRICE POUR LE COMPRESSE) C
  34. C C
  35. C***** INFOS SUR LA MATRICE (LIGNE 2) C
  36. C C
  37. C IMAT (LA MATRICE DANS UN LISTREEL) C
  38. C C
  39. C IA (TABLEAU DE POINTEURS DU STOCKAGE MORSE) C
  40. C C
  41. C IL DOIT ETRE DIMENSIONNE A NL+1 AU MINIMUM C
  42. C C
  43. C JA (TABLEAU DE CONNECTIVITES DE LA MATRICE) C
  44. C C
  45. C IL EST STOCKE EN MORSE ET DE LONGUEUR LA C
  46. C C
  47. C KA (TABLEAU DE CONNECTIVITES EN MODE COMPRESSE) C
  48. C C
  49. C IL EST DE LA FORME KA(NL,NNZ) AVEC NNZ C
  50. C LE NOMBRE MAXI DE TERMES NON NULS POUR UNE C
  51. C LIGNE DE LA MATRICE C
  52. C C
  53. C NB : EN MORSE, KA N'EST PAS UTILISE C
  54. C EN COMPRESSE, IA ET JA NE SONT PAS UTILISES C
  55. C C
  56. C IA,JA ET KA SONT DES LISTENTI. C
  57. C C
  58. C***** INFOS SUR LE SECOND MEMBRE, LA SOLUTION INITIALE C
  59. C***** ET LA SOLUTION FINALE. (LIGNE 3) C
  60. C C
  61. C IZB SECOND MEMBRE EN ENTREE C
  62. C PAS MODIFIE. C
  63. C C
  64. C IZP ESTIMATION DE LA SOLUTION EN ENTREE C
  65. C LA SOLUTION EN SORTIE, IL FAUT LA C
  66. C CONSERVER POUR LA RESOLUTION SUIVANTE C
  67. C C
  68. C IZB ET IZP SONT DES LISTREEL DIMENSIONNES A NL C
  69. C C
  70. C ICOLD =1 (DEMARRAGE FROID) C
  71. C ICOLD!=1 (DEMARRAGE CHAUD A PARTIR DE LA C
  72. C SOLUTION INITIALE FOURNIE DANS IZP) C
  73. C C
  74. C***** INFOS SUR LA CONVERGENCE (LIGNE 4) C
  75. C C
  76. C NPT NOMBRE MAXI D'ITERATIONS EN ENTREE C
  77. C SI IL EST < 10, IL EST MIS A 10 C
  78. C NPITE FREQUENCE DES TESTS C
  79. C NEFF NOMBRE REEL EN SORTIE C
  80. C ICONV 0 NON CONVERGE, 1 CONVERGE C
  81. C EPI PRECISION DEMANDEE C
  82. C IPOU=1 LA PRECISION VA ETRE POUSSE D'UN FACTEUR C
  83. C VPOU. CECI PEUT S'AVERER UTILE LORS D'UN C
  84. C CALCUL ITERATIF OU ON VEUT DES LE DEBUT C
  85. C UNE SOLUTION PRECISE POUR EVITER DE PARTIR C
  86. C SUR UNE MAUVAISE PISTE. VPOU A UNE VALEUR C
  87. C PAR DEFAUT DE 100. C
  88. C C
  89. C***** INFOS SUR LE CONTROLE DES IMPRESSIONS (LIGNE 5) C
  90. C C
  91. C NIMPR =1 (INFOS SUR LA CONVERGENCE) C
  92. C NIMPR!=1 (SILENCIEUX SAUF EN CAS DE DIVERGENCE) C
  93. C C
  94. C IPAT = (FACULTATIF, PAR EXEMPLE UN PAS DE TEMPS)C
  95. C C
  96. C RSETD(B,A) B <- A C
  97. C ADIVEC(A,B,C,alpha) C <- A + alpha*B C
  98. C PIMDV(A,B,C) C <- A*B C
  99. C C
  100. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  101. C
  102. IMPLICIT INTEGER(I-N)
  103. IMPLICIT REAL*8 (A-H,O-Z)
  104. -INC SMLENTI
  105. POINTEUR IA.MLENTI
  106. POINTEUR JA.MLENTI
  107. POINTEUR KA.MLENTI
  108. -INC SMLREEL
  109. POINTEUR IMAT.MLREEL
  110. POINTEUR IZB.MLREEL
  111. POINTEUR IZBB.MLREEL
  112. POINTEUR IZP.MLREEL
  113. POINTEUR IZPS.MLREEL
  114. POINTEUR IZZPR.MLREEL
  115. POINTEUR IZPMV.MLREEL
  116. POINTEUR IZTMP.MLREEL
  117. POINTEUR IZDIR.MLREEL
  118.  
  119. DATA VPOU0/100./
  120.  
  121. IF(KSTO.EQ.0) LA=ILG
  122. IF(KSTO.EQ.1) NNZ=ILG
  123. IF(IPOU.EQ.1) THEN
  124. VPOUE=VPOU0
  125. IF(VPOU.NE.VPOU0) VPOUE=VPOU
  126. ENDIF
  127.  
  128. CALL OOOMRU(1)
  129.  
  130. C On sauve le second membre en le dupliquant dans IZBB
  131. C qui lui sera ecrase.
  132. SEGACT IZB
  133. JG=IZB.PROG(/1)
  134. SEGINI IZBB
  135. CALL RSETD(IZBB.PROG,IZB.PROG,JG)
  136. SEGDES IZB
  137.  
  138. SEGACT IZP
  139.  
  140. JG=NL
  141. SEGINI IZPS
  142. SEGINI IZZPR
  143. SEGINI IZPMV
  144. SEGINI IZTMP
  145. SEGINI IZDIR
  146.  
  147. SEGACT IMAT
  148. IF(KSTO.EQ.0) SEGACT IA
  149. IF(KSTO.EQ.0) SEGACT JA
  150. IF(KSTO.EQ.1) SEGACT KA
  151.  
  152. IF(NPT.LT.10) NPT=10
  153. IF(NPT.GT.NL) NPT=NL
  154.  
  155. IF(ICOLD.EQ.1) CALL INITD (IZP.PROG,NL,0.D0)
  156. CALL RSETD(IZPS.PROG,IZP.PROG,NL)
  157. CALL RSETD(IZTMP.PROG,IZP.PROG,NL)
  158. IF(KSTO.EQ.0) THEN
  159. C CALL PMVM(A,IA,JA,X,Y,NL,LA)
  160. CALL PMVM(IMAT.PROG,IA.LECT,JA.LECT,
  161. 1 IZTMP.PROG,IZPMV.PROG,NL,LA)
  162. ELSE
  163. C CALL PMVC(A,KA,X,Y,NL,NNZ)
  164. CALL PMVC(IMAT.PROG,KA.LECT,
  165. 1 IZTMP.PROG,IZPMV.PROG,NL,NNZ)
  166. ENDIF
  167. CALL ADIVEC (IZBB.PROG,IZPMV.PROG,IZBB.PROG,-1.d0,NL)
  168. ANORB=SQRT(PISCAL(IZBB.PROG,IZBB.PROG,NL))
  169. CALL RSETD(IZZPR.PROG,IZBB.PROG,NL)
  170. CALL RSETD(IZDIR.PROG,IZZPR.PROG,NL)
  171. SCAR1=PISCAL(IZBB.PROG,IZDIR.PROG,NL)
  172. C
  173. C===========DEBUT DE LA BOUCLE ITERATIVE=====600========
  174. C
  175. NEFF=0
  176. NCOMP=0
  177. ICONV=0
  178. DO 600 I=1,NPT
  179. NEFF=NEFF+1
  180. NCOMP=NCOMP+1
  181. CALL RSETD(IZTMP.PROG,IZDIR.PROG,NL)
  182. IF(KSTO.EQ.0) THEN
  183. C CALL PMVM(A,IA,JA,X,Y,NL,LA)
  184. CALL PMVM(IMAT.PROG,IA.LECT,JA.LECT,
  185. 1 IZTMP.PROG,IZPMV.PROG,NL,LA)
  186. ELSE
  187. C CALL PMVC(A,KA,X,Y,NL,NNZ)
  188. CALL PMVC(IMAT.PROG,KA.LECT,
  189. 1 IZTMP.PROG,IZPMV.PROG,NL,NNZ)
  190. ENDIF
  191. SCADIR=PISCAL(IZDIR.PROG,IZPMV.PROG,NL)
  192. ALPHA=SCAR1/SCADIR
  193. CALL ADIVEC(IZP.PROG,IZDIR.PROG,IZP.PROG,ALPHA,NL)
  194. ALP=-1.D0*ALPHA
  195. CALL ADIVEC (IZBB.PROG,IZPMV.PROG,IZBB.PROG,ALP,NL)
  196. CALL RSETD(IZZPR.PROG,IZBB.PROG,NL)
  197. SCAR2=PISCAL(IZBB.PROG,IZZPR.PROG,NL)
  198. BETA=SCAR2/SCAR1
  199. CALL ADIVEC (IZZPR.PROG,IZDIR.PROG,IZDIR.PROG,BETA,NL)
  200. IF (NCOMP.EQ.NPITE.OR.I.EQ.NPT) THEN
  201. IF (I.EQ.NPT) INDIC=1
  202. C On pousse la precision si necessaire
  203. ZEPS=EPI
  204. IF(IPOU.EQ.1) ZEPS=EPI/VPOUE
  205. CALL COTEST (IZP.PROG,IZPS.PROG,
  206. 1 ZEPS,DELTA,DELTAP,
  207. 2 INDIC,ICONV,NL)
  208. SEPA=DELTA
  209. RSEPA=DELTA/DELTAP
  210. CALL RSETD(IZPS.PROG,IZP.PROG,NL)
  211. NCOMP=0
  212. ENDIF
  213. IF (ICONV.EQ.1) GOTO 601
  214. SCAR1=SCAR2
  215. 600 CONTINUE
  216. 601 CONTINUE
  217. CALL MTABL(IZBB.PROG,RES,IMA,NL)
  218. RRES=RES/ANORB
  219. IF (ICONV.NE.1) THEN
  220. WRITE(6,1111)IPAT,NPT,RSEPA,DELTAP,RES,IZBB.PROG(IMA)
  221. ELSE
  222. IF(NIMPR.EQ.1) WRITE(6,2222)IPAT,EPI,
  223. 1 RES,SEPA,I,
  224. 2 RRES,RSEPA,IMA
  225. ENDIF
  226.  
  227. SEGDES IZP
  228.  
  229. SEGSUP IZBB
  230. SEGSUP IZPS
  231. SEGSUP IZZPR
  232. SEGSUP IZDIR
  233. SEGSUP IZTMP
  234. SEGSUP IZPMV
  235.  
  236. SEGDES IMAT*(NOMOD,MRU)
  237. IF(KSTO.EQ.0) SEGDES IA*(NOMOD,MRU)
  238. IF(KSTO.EQ.0) SEGDES JA*(NOMOD,MRU)
  239. IF(KSTO.EQ.1) SEGDES KA*(NOMOD,MRU)
  240.  
  241. CALL OOOMRU(0)
  242.  
  243. C
  244. 1111 FORMAT(1X,'* CGRES* ',I6,' NON CONV EN ',I5,
  245. 1' ITERA, RSEPA = ',D8.2,1X,'DELTAP = ',D8.2,1X,
  246. 2' RES = ',D8.2,' P = ',D8.2)
  247. 2222 FORMAT(1X,'* CGRES* ',I6,' *PREC ',D8.2,
  248. 1 ' * RESIDU-SEPARA @ NITE ',D8.2,1X,D8.2,1X,I5,
  249. 2 ' * RRES-RSEP ',D8.2,1X,D8.2,
  250. 3 ' * ELEMENT ',I7)
  251. C
  252. C FIN RESOLUTION
  253. C
  254. RETURN
  255. END
  256.  
  257.  
  258.  

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