Télécharger resock.eso

Retour à la liste

Numérotation des lignes :

  1. C RESOCK SOURCE PV 16/11/17 22:01:23 9180
  2. SUBROUTINE RESOCK(IZB,IZL,IZR)
  3. C************************************************************************
  4. C
  5. C 1/ KTYPI = 1 OU 5
  6. C
  7. C RESOLUTION (MONTEE DESCENTE) D'UNE MATRICE SYMETRIQUE LIGNE A LIGNE
  8. C PRECEDEMMENT TRIANGULEE PAR TRIAWS
  9. C
  10. C POINTEUR : EN ENTREE IZL CONTIENT LA MATRICE TRIANGULEE
  11. C IZB CONTIENT LE SECOND MEMBRE
  12. C EN SORTIE IZB CONTIENT LA SOLUTION
  13. C
  14. C VERSION OPTIMISEE EN GESTION MEMOIRE POUR LES TRES GROSSES
  15. C MATRICES. ON UTILISE L'ALGORITHME MRU (AVEC LA MODIFICATION
  16. C DANS OOOMWD) POUR LES BLOCS DE LA MATRICE. CECI EVITE DE TRANSFERER
  17. C SUR DISQUE LE RESTE DU CONTENU DE LA MEMOIRE, I.E. LES TABLEAUX
  18. C VITESSE, TEMPERATURE, ETC... QUI AURAIENT A ETRE RAPPELES DES
  19. C LA RESOLUTION TERMINEE.
  20. C
  21. C************************************************************************
  22. IMPLICIT INTEGER(I-N)
  23. IMPLICIT REAL*8 (A-H,O-Z)
  24. REAL*8 AUX,BJ
  25. C-INC SMMATRAKANC
  26. C*************************************************************************
  27. C
  28. C REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES puis assemblees
  29. C
  30.  
  31. * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange
  32. * (points CENTRE ) pour chaque operateur de contrainte
  33. * KGEOC SPG pour la totalite des points CENTRE.
  34. * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse)
  35. * KLEMC Connectivites de l'ensemble des contraintes
  36. * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones
  37.  
  38. SEGMENT MATRAK
  39. INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP)
  40. INTEGER LIZAFM(NBSOUS)
  41. INTEGER IKAM0 (NBSOUS)
  42. INTEGER IMEM (NBELC)
  43. INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC
  44. ENDSEGMENT
  45.  
  46. SEGMENT IZAFM
  47. REAL*8 AM(NNELP,NP,IESP),RPGI(NELAX)
  48. ENDSEGMENT
  49.  
  50. POINTEUR IPMJ.IZAFM,IPMK.IZAFM
  51.  
  52. C*******************************************************************
  53. -INC SMCHPOI
  54. SEGMENT/IZA/(A(1)*D)
  55. SEGMENT/IZD/(D(1)*D)
  56.  
  57. KTYPI = 1
  58. MPOVAL=IZB
  59. SEGACT MPOVAL,IZL*MOD
  60. IDMAT=KZA1
  61. SEGACT IDMAT
  62. NBLK=IDESCR(/1)
  63. C
  64. C---------------------METHODE DIRECTE-----------------------*
  65. C
  66. NL=VPOCHA(/1)
  67. N1=B(/1)
  68.  
  69. C--- LE SECOND MEMBRE EST R{ORDONN{ DANS LA NUM{ROTATION OPTIMIS{E
  70.  
  71. DO 30 I=1,NL
  72. B(I)=VPOCHA(NUNA(I),1)
  73. 30 CONTINUE
  74.  
  75. C WRITE(6,*)' RESOCK BB: NL=',NL
  76. C WRITE(6,1002)(VPOCHA(I,1),I=1,NL)
  77. C WRITE(6,*)' NUNA'
  78. C WRITE(6,1001)(NUNA(I),I=1,NL)
  79. C1001 FORMAT(20(1X,I5))
  80.  
  81. SEGDES MPOVAL
  82. N1=KZA(/1)
  83. IF(KTYPI.EQ.5)GOTO 50
  84. IF(N1.NE.NL)CALL ARRET(0)
  85. C
  86. C DESCENTE
  87. C
  88.  
  89. CALL OOOMRU(1)
  90. DO 100 IBLK=1,NBLK
  91. IJD=NLDBLK(IBLK)
  92. IJF=NLDBLK(IBLK+1)-1
  93. IDBLK=IDESCR(IBLK)
  94. SEGACT IDBLK
  95. IZA=IMAT
  96. SEGACT IZA
  97. DO 1 I=IJD,IJF
  98. AUX=0.D0
  99. C LA=LONGUEUR DE LA LIGNE I
  100. LA=IDEBLK(I-IJD+2)-IDEBLK(I-IJD+1)
  101. C DÉCALAGE DANS LE TABLEAU POUR ACCÉDER À LA LIGNE I
  102. C - NUMÉRO DE LA LIGNE I DANS LE BLOC =I-IJD+1
  103. IDECI=IDEBLK(I-IJD+1)-1
  104. IF(LA.EQ.0)GO TO 3
  105. JMIN=I-LA
  106. AUX=SDOT(LA,A(IDECI+1),1,B(JMIN),1)
  107. 3 CONTINUE
  108. B(I)=B(I)-AUX
  109. 1 CONTINUE
  110. SEGDES IZA*(NOMOD,MRU)
  111. SEGDES IDBLK*(NOMOD,MRU)
  112. 100 CONTINUE
  113. C
  114. IZD=IDIAG
  115. SEGACT IZD
  116. C write(6,*)' DIAGONALE'
  117. C NDI=D(/1)
  118. C write(6,1002)(D(I),I=1,NDI)
  119. C write(6,*)' B= '
  120. C NBI=B(/1)
  121. C write(6,1002)(B(I),I=1,NBI)
  122.  
  123. CALL DIVISE(NL,B,B,D)
  124. SEGDES IZD*(NOMOD,MRU)
  125. C
  126. C REMONTEE
  127. C
  128. DO 200 KBLK=1,NBLK
  129. IBLK=NBLK-KBLK+1
  130. IJD=NLDBLK(IBLK)
  131. IJF=NLDBLK(IBLK+1)-1
  132. IDBLK=IDESCR(IBLK)
  133. SEGACT IDBLK
  134. IZA=IMAT
  135. SEGACT IZA
  136. DO 9 K=IJD,IJF
  137. I=IJF-K+IJD
  138. C LA=LONGUEUR DE LA LIGNE I
  139. LA=IDEBLK(I-IJD+2)-IDEBLK(I-IJD+1)
  140. C DÉCALAGE DANS LE TABLEAU POUR ACCÉDER À LA LIGNE I
  141. C - NUMÉRO DE LA LIGNE I DANS LE BLOC =I-IJD+1
  142. IDECI=IDEBLK(I-IJD+1)-1
  143. IF(LA.EQ.0)GO TO 9
  144. JMIN=I-LA
  145. J2=I-1
  146. BJ=-B(I)
  147. CALL SAXPY(LA,BJ,A(IDECI+1),1,B(JMIN),1)
  148. 9 CONTINUE
  149. SEGDES IZA*(NOMOD,MRU)
  150. SEGDES IDBLK*(NOMOD,MRU)
  151. 200 CONTINUE
  152. CALL OOOMRU(0)
  153.  
  154. C--- LE R{SULTAT EST R{ORDONN{ DANS LA NUM{ROTATION NATURELLE
  155.  
  156. MPOVAL=IZR
  157. SEGACT MPOVAL*MOD
  158. DO 31 I=1,NL
  159. VPOCHA(I,1)=B(NUAN(I))
  160. 31 CONTINUE
  161.  
  162. C WRITE(6,*)' RESOCK BB:EN SORTIE NL=',NL
  163. C WRITE(6,1002)(VPOCHA(I,1),I=1,NL)
  164. C WRITE(6,1002)(B(I) ,I=1,NL)
  165. C WRITE(6,*)' NUAN'
  166. C WRITE(6,1001)(NUAN(I),I=1,NL)
  167.  
  168. SEGDES MPOVAL,IZL
  169. SEGDES IDMAT
  170. RETURN
  171. C
  172. C KTYPI=5 LES SEGMENTS ONT ETE ACTIVES
  173. C
  174. 50 CONTINUE
  175. IF(N1.NE.NL)CALL ARRET(0)
  176. C
  177. C DESCENTE
  178. C
  179. DO 51 I=2,NL
  180. IZA=KZA(I)
  181. AUX=0.D0
  182. LA=A(/1)
  183. IF(LA.EQ.0)GO TO 53
  184. JMIN=I-LA
  185. AUX=SDOT(LA,A(1),1,B(JMIN),1)
  186. 53 CONTINUE
  187. B(I)=B(I)-AUX
  188. 51 CONTINUE
  189. C
  190. IZD=KZA(1)
  191. CALL DIVISE(NL,B,B,D)
  192. C
  193. C REMONTEE
  194. C
  195. DO 59 K=2,NL
  196. J=NL-K+2
  197. IZA=KZA(J)
  198. LA=A(/1)
  199. IF(LA.EQ.0)GO TO 59
  200. JMIN=J-LA
  201. J2=J-1
  202. BJ=-B(J)
  203. CALL SAXPY(LA,BJ,A,1,B(JMIN),1)
  204. 59 CONTINUE
  205. C
  206. C------- FIN RESOLUTION DIRECTE -------*
  207. C
  208. RETURN
  209. 1002 FORMAT(10(1X,1PE11.4))
  210. END
  211.  
  212.  
  •  
  •  
  •  
  •  
  • © Cast3M 2003 - Tous droits réservés.
    Mentions légales