Télécharger resock.eso

Retour à la liste

Numérotation des lignes :

resock
  1. C RESOCK SOURCE FANDEUR 22/05/02 21:15:30 11359
  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. REAL*8 DDOT
  58. EXTERNAL DDOT
  59. EXTERNAL DAXPY
  60.  
  61. KTYPI = 1
  62. MPOVAL=IZB
  63. SEGACT MPOVAL,IZL*MOD
  64. IDMAT=KZA1
  65. SEGACT IDMAT
  66. NBLK=IDESCR(/1)
  67. C
  68. C---------------------METHODE DIRECTE-----------------------*
  69. C
  70. NL=VPOCHA(/1)
  71. N1=B(/1)
  72.  
  73. C--- LE SECOND MEMBRE EST R{ORDONN{ DANS LA NUM{ROTATION OPTIMIS{E
  74.  
  75. DO I=1,NL
  76. B(I)=VPOCHA(NUNA(I),1)
  77. ENDDO
  78.  
  79. C WRITE(6,*)' RESOCK BB: NL=',NL
  80. C WRITE(6,1002)(VPOCHA(I,1),I=1,NL)
  81. C WRITE(6,*)' NUNA'
  82. C WRITE(6,1001)(NUNA(I),I=1,NL)
  83. C1001 FORMAT(20(1X,I5))
  84.  
  85. SEGDES MPOVAL
  86. N1=KZA(/1)
  87. IF(KTYPI.EQ.5)GOTO 50
  88. IF(N1.NE.NL)CALL ARRET(0)
  89. C
  90. C DESCENTE
  91. C
  92. CALL OOOMRU(1)
  93. DO 100 IBLK=1,NBLK
  94. IJD=NLDBLK(IBLK)
  95. IJF=NLDBLK(IBLK+1)-1
  96. IDBLK=IDESCR(IBLK)
  97. SEGACT IDBLK
  98. IZA=IMAT
  99. SEGACT IZA
  100. DO 1 I=IJD,IJF
  101. AUX=0.D0
  102. C LA=LONGUEUR DE LA LIGNE I
  103. LA=IDEBLK(I-IJD+2)-IDEBLK(I-IJD+1)
  104. C DÉCALAGE DANS LE TABLEAU POUR ACCÉDER À LA LIGNE I
  105. C - NUMÉRO DE LA LIGNE I DANS LE BLOC =I-IJD+1
  106. IDECI=IDEBLK(I-IJD+1)-1
  107. IF(LA.EQ.0)GO TO 3
  108. JMIN=I-LA
  109. AUX=DDOT(LA,A(IDECI+1),1,B(JMIN),1)
  110. 3 CONTINUE
  111. B(I)=B(I)-AUX
  112. 1 CONTINUE
  113. SEGDES IZA*(NOMOD,MRU)
  114. SEGDES IDBLK*(NOMOD,MRU)
  115. 100 CONTINUE
  116. C
  117. IZD=IDIAG
  118. SEGACT IZD
  119. C write(6,*)' DIAGONALE'
  120. C NDI=D(/1)
  121. C write(6,1002)(D(I),I=1,NDI)
  122. C write(6,*)' B= '
  123. C NBI=B(/1)
  124. C write(6,1002)(B(I),I=1,NBI)
  125.  
  126. CALL DIVISE(NL,B,B,D)
  127. SEGDES IZD*(NOMOD,MRU)
  128. C
  129. C REMONTEE
  130. C
  131. DO 200 KBLK=1,NBLK
  132. IBLK=NBLK-KBLK+1
  133. IJD=NLDBLK(IBLK)
  134. IJF=NLDBLK(IBLK+1)-1
  135. IDBLK=IDESCR(IBLK)
  136. SEGACT IDBLK
  137. IZA=IMAT
  138. SEGACT IZA
  139. DO 9 K=IJD,IJF
  140. I=IJF-K+IJD
  141. C LA=LONGUEUR DE LA LIGNE I
  142. LA=IDEBLK(I-IJD+2)-IDEBLK(I-IJD+1)
  143. C DÉCALAGE DANS LE TABLEAU POUR ACCÉDER À LA LIGNE I
  144. C - NUMÉRO DE LA LIGNE I DANS LE BLOC =I-IJD+1
  145. IDECI=IDEBLK(I-IJD+1)-1
  146. IF(LA.EQ.0)GO TO 9
  147. JMIN=I-LA
  148. J2=I-1
  149. BJ=-B(I)
  150. CALL DAXPY(LA,BJ,A(IDECI+1),1,B(JMIN),1)
  151. 9 CONTINUE
  152. SEGDES IZA*(NOMOD,MRU)
  153. SEGDES IDBLK*(NOMOD,MRU)
  154. 200 CONTINUE
  155. CALL OOOMRU(0)
  156.  
  157. C--- LE R{SULTAT EST R{ORDONN{ DANS LA NUM{ROTATION NATURELLE
  158.  
  159. MPOVAL=IZR
  160. SEGACT MPOVAL*MOD
  161. DO 31 I=1,NL
  162. VPOCHA(I,1)=B(NUAN(I))
  163. 31 CONTINUE
  164.  
  165. C WRITE(6,*)' RESOCK BB:EN SORTIE NL=',NL
  166. C WRITE(6,1002)(VPOCHA(I,1),I=1,NL)
  167. C WRITE(6,1002)(B(I) ,I=1,NL)
  168. C WRITE(6,*)' NUAN'
  169. C WRITE(6,1001)(NUAN(I),I=1,NL)
  170.  
  171. SEGDES MPOVAL,IZL
  172. SEGDES IDMAT
  173. RETURN
  174. C
  175. C KTYPI=5 LES SEGMENTS ONT ETE ACTIVES
  176. C
  177. 50 CONTINUE
  178. IF(N1.NE.NL)CALL ARRET(0)
  179. C
  180. C DESCENTE
  181. C
  182. DO 51 I=2,NL
  183. IZA=KZA(I)
  184. AUX=0.D0
  185. LA=A(/1)
  186. IF(LA.EQ.0)GO TO 53
  187. JMIN=I-LA
  188. AUX=DDOT(LA,A(1),1,B(JMIN),1)
  189. 53 CONTINUE
  190. B(I)=B(I)-AUX
  191. 51 CONTINUE
  192. C
  193. IZD=KZA(1)
  194. CALL DIVISE(NL,B,B,D)
  195. C
  196. C REMONTEE
  197. C
  198. DO 59 K=2,NL
  199. J=NL-K+2
  200. IZA=KZA(J)
  201. LA=A(/1)
  202. IF(LA.EQ.0)GO TO 59
  203. JMIN=J-LA
  204. J2=J-1
  205. BJ=-B(J)
  206. CALL DAXPY(LA,BJ,A,1,B(JMIN),1)
  207. 59 CONTINUE
  208. C
  209. C------- FIN RESOLUTION DIRECTE -------*
  210. C
  211. RETURN
  212. 1002 FORMAT(10(1X,1PE11.4))
  213. END
  214.  
  215.  
  216.  

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