Télécharger graco0.eso

Retour à la liste

Numérotation des lignes :

graco0
  1. C GRACO0 SOURCE PV 22/01/31 21:15:02 8699
  2. SUBROUTINE GRACO0(KRIGI,IDAMEM,NOID,NOEN)
  3. C
  4. C **** SUBROUTINE QUI EXECUTE L OPERATION RESOU PAR GRADIENT CONJUGUE
  5. C **** APPELEE PAR GRACO
  6. C
  7. IMPLICIT INTEGER(I-N)
  8. REAL*8 XKT
  9. INTEGER OOOVAL
  10. SEGMENT IDEMEM(0)
  11. -INC SMRIGID
  12. -INC SMVECTD
  13.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. -INC SMMATRI
  17. C
  18. MRIGID=KRIGI
  19. SEGACT MRIGID
  20. ICHOLX=ICHOLE
  21. SEGDES MRIGID
  22. IF(ICHOLX.NE.0) THEN
  23. MMATRI=ICHOLX
  24. SEGACT MMATRI
  25. MILIGN=IILIGN
  26. MILIG1=IASLIG
  27. SEGACT MILIGN,MILIG1
  28. DO 110 I=1,ILIGN(/1)
  29. LIGN=ILIGN(I)
  30. SEGACT LIGN
  31. LIGN=MILIG1.ILIGN(I)
  32. SEGACT LIGN
  33. 110 CONTINUE
  34. ELSE
  35. CALL GRACO1(KRIGI)
  36. IF(IERR.NE.0) GO TO 5000
  37. MRIGID=KRIGI
  38. SEGACT MRIGID
  39. ICHOLX=ICHOLE
  40. SEGDES MRIGID
  41. C
  42. C **** SUBROUTINE CHV2 : TRANSFORME LE CHPOIN ISECO EN VECTEUR
  43. C
  44. ENDIF
  45. IDEMEM=IDAMEM
  46. SEGACT IDEMEM*MOD
  47. NNTOT=IDEMEM(/1)
  48. MMATRI=ICHOLX
  49. SEGACT MMATRI
  50. MILIGN=IILIGN
  51. SEGACT,MILIGN
  52. INK=IPNO(/1)
  53. SEGDES MILIGN,MMATRI
  54. CALL INTPDO(LENB)
  55. NNPA= MAX(1,((OOOVAL(1,1)-NGMAXY)/(2*LENB))/INK+1)
  56. C
  57. C ON TRAVAILLE AVEC AUTANT DE VECTEUR SIMULTANEE QU'IL EN RENTRE DANS
  58. C LA MOITIE DE LA MEMOIRE CENTRALE
  59. C
  60. NN=NNPA
  61. DO 201 KGEN = 1,NNTOT,NNPA
  62. IF(KGEN+NNPA-1.GT.NNTOT) NN= NNTOT-KGEN+1
  63. KGEN1=KGEN-1
  64. DO 2 K=1,NN
  65. ISECO=IDEMEM(K+KGEN1)
  66. CALL CHV2(ICHOLX,ISECO,MVECTX,NOID)
  67. IF(IERR.NE.0) GO TO 5000
  68. IDEMEM(K+KGEN1)=MVECTX
  69. 2 CONTINUE
  70. IF(NN.NE.1) THEN
  71. INC = INK * NN
  72. SEGINI MVECTD
  73. DO 3 LL=1,NN
  74. LD=INK*(LL-1)
  75. MVECT1=IDEMEM(LL+KGEN1)
  76. SEGACT MVECT1
  77. DO L=1,INK
  78. VECTBB(L+LD)=MVECT1.VECTBB(L)
  79. ENDDO
  80. SEGSUP MVECT1
  81. 3 CONTINUE
  82. MVECTX=MVECTD
  83. SEGDES MVECTD
  84. ENDIF
  85. C
  86. C **** SUBROUTINE GRACO6 :
  87. C
  88. IF(IIMPI.EQ.1) THEN
  89. WRITE(IOIMP,499)
  90. 499 FORMAT(' TEMPS SUIVANT AVANT APPEL GRACO6')
  91. CALL GIBTEM(XKT)
  92. INTERR(1)=XKT
  93. CALL ERREUR(-259)
  94. ENDIF
  95. CALL GRACO6(ICHOLX,MVECTX,NOEN,MSOL,lenb)
  96. IF(IIMPI.EQ.1) THEN
  97. WRITE(IOIMP,498)
  98. 498 FORMAT(' TEMPS SUIVANT APRES APPEL GRACO6')
  99. CALL GIBTEM(XKT)
  100. INTERR(1)=XKT
  101. CALL ERREUR(-259)
  102. ENDIF
  103. if(ierr.ne.0) return
  104. C
  105. C desactivation de LLIGN
  106. C
  107. SEGACT MMATRI
  108. MILIGN = IASLIG
  109. SEGACT MILIGN
  110. DO 763 N=1,ILIGN(/1)
  111. LLIGN=ILIGN(N)
  112. SEGDES LLIGN
  113. 763 CONTINUE
  114. SEGDES MILIGN
  115. MILIGN = IILIGN
  116. SEGACT MILIGN
  117. DO 764 N=1,ILIGN(/1)
  118. LLIGN=ILIGN(N)
  119. SEGDES LLIGN
  120. 764 CONTINUE
  121. MDIAG = IASDIA
  122. SEGDES MILIGN,MDIAG,MMATRI
  123. IF(IERR.NE.0) GO TO 5000
  124. C
  125. C **** SUBROUTINE VCH1 : REMET LE VECTEUR SOUS FORME D UN CHPOINT
  126. C **** LE CHPOINT EST DE TYPE PREMIER MEMBRE
  127. C
  128. MVECTA=MSOL
  129. DO 5 K=1,NN
  130. IF(NN.EQ.1) GO TO 10
  131. IF(K.EQ.1) THEN
  132. INC=INK
  133. MVECT1=MSOL
  134. SEGACT MVECT1
  135. SEGINI MVECTD
  136. ENDIF
  137. SEGACT MVECTD
  138. LD=(K-1)*INK
  139. DO 6 L=1,INK
  140. VECTBB(L)=MVECT1.VECTBB(L+LD)
  141. 6 CONTINUE
  142. MVECTA=MVECTD
  143. SEGDES MVECTD
  144. IF(K.EQ.NN) SEGSUP MVECT1
  145. 10 CONTINUE
  146. CALL VCH1(ICHOLX,MVECTA,ISOLU,KRIGI)
  147. IF(IERR.NE.0) RETURN
  148. C
  149. IDEMEM(K+KGEN1)=ISOLU
  150. 5 CONTINUE
  151. MVECTD=MVECTA
  152. SEGSUP MVECTD
  153. 201 CONTINUE
  154. IDAMEM = IDEMEM
  155. SEGDES IDEMEM
  156. C
  157. 5000 CONTINUE
  158. RETURN
  159. END
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  

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