Télécharger graco0.eso

Retour à la liste

Numérotation des lignes :

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

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