Télécharger ldmt.eso

Retour à la liste

Numérotation des lignes :

ldmt
  1. C LDMT SOURCE PV 20/09/26 21:18:30 10724
  2. SUBROUTINE LDMT(KRIGI,IDAMEM,NOID,NOEN,PREC,ISOUCI)
  3. C
  4. C **** SUBROUTINE QUI EXECUTE L OPERATION RESOU
  5. C SUR DES MATRICES SANS SYMETRIES
  6. C **** APPELEE PAR RESOU OU PAR SUPRI
  7. C
  8. C Elle est équivalente à RESOU1 dans le cas de l'inversion des
  9. C matrices symétriques
  10. C
  11. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  12. C
  13. C Auteur : Michel BULIK
  14. C
  15. C Date : Printemps '95
  16. C
  17. C Langage : ESOPE + FORTRAN77
  18. C
  19. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  20. IMPLICIT INTEGER(I-N)
  21. REAL*8 XKT,PREC
  22. INTEGER OOOVAL
  23. SEGMENT IDEMEM(0)
  24. -INC SMRIGID
  25. -INC SMVECTD
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC SMMATRI
  29. C
  30. MRIGID=KRIGI
  31. SEGACT MRIGID
  32. ICHOLX=ICHOLE
  33. SEGDES MRIGID
  34. IF(ICHOLX.NE.0) then
  35. MMATRI=ICHOLX
  36. SEGACT MMATRI
  37. IF (PRCHLV.lt.PREC*1.001.and.PRCHLV.gt.PREC*0.999) GO TO 1
  38. write (6,*) ' attention changement de precision '
  39. MILIGN=IILIGN
  40. segact milign
  41. DO 20 I=1,ILIGN(/1)
  42. LIGN=ILIGN(I)
  43. SEGSUP LIGN
  44. SEGSUP LIGN
  45. 20 CONTINUE
  46. MDIAG=IDIAG
  47. SEGSUP MDIAG
  48. MDNOR=IDNORM
  49. SEGSUP MDNOR
  50. SEGSUP MMATRI
  51. ICHOLX=0
  52. ENDIF
  53. CALL LDMT1(KRIGI,PREC)
  54. IF(IERR.NE.0) GO TO 5000
  55. MRIGID=KRIGI
  56. SEGACT MRIGID
  57. ICHOLX=ICHOLE
  58. SEGDES MRIGID
  59. C
  60. C **** SUBROUTINE CHV2 : TRANSFORME LE CHPOIN ISECO EN VECTEUR
  61. C
  62. 1 CONTINUE
  63. IDEMEM=IDAMEM
  64. SEGACT IDEMEM*MOD
  65. NNTOT=IDEMEM(/1)
  66. MMATRI=ICHOLX
  67. SEGACT MMATRI
  68. MILIGN=IILIGN
  69. SEGACT,MILIGN
  70. INK=IPNO(/1)
  71. SEGDES MILIGN,MMATRI
  72. CALL INTPDO(LENB)
  73. NNPA= MAX(1,((OOOVAL(1,1)-NGMAXY)/(2*LENB))/INK+1)
  74. C
  75. C ON TRAVAILLE AVEC AUTANT DE VECTEUR SIMULTANEE QU'IL EN RENTRE DANS
  76. C LA MOITIE DE LA MEMOIRE CENTRALE
  77. C
  78. NN=NNPA
  79. DO 201 KGEN = 1,NNTOT,NNPA
  80. IF(KGEN+NNPA-1.GT.NNTOT) NN= NNTOT-KGEN+1
  81. KGEN1=KGEN-1
  82. DO 2 K=1,NN
  83. ISECO=IDEMEM(K+KGEN1)
  84. CALL CHVNS(ICHOLX,ISECO,MVECTX,NOID)
  85. IF(IERR.NE.0) GO TO 5000
  86. IDEMEM(K+KGEN1)=MVECTX
  87. 2 CONTINUE
  88. IF(NN.NE.1) THEN
  89. INC = INK * NN
  90. SEGINI MVECTD
  91. DO 3 LL=1,NN
  92. LD=INK*(LL-1)
  93. MVECT1=IDEMEM(LL+KGEN1)
  94. SEGACT MVECT1
  95. DO L=1,INK
  96. VECTBB(L+LD)=MVECT1.VECTBB(L)
  97. ENDDO
  98. SEGSUP MVECT1
  99. 3 CONTINUE
  100. MVECTX=MVECTD
  101. SEGDES MVECTD
  102. ENDIF
  103. C
  104. C **** SUBROUTINE MONDES :
  105. C
  106. IF(IIMPI.EQ.1) THEN
  107. WRITE(IOIMP,499)
  108. 499 FORMAT(' TEMPS SUIVANT AVANT APPEL MONDES')
  109. CALL GIBTEM(XKT)
  110. INTERR(1)=XKT
  111. CALL ERREUR(-259)
  112. ENDIF
  113. CALL MONDES(ICHOLX,MVECTX,NOEN,ISOUCI)
  114. IF(IIMPI.EQ.1) THEN
  115. WRITE(IOIMP,498)
  116. 498 FORMAT(' TEMPS SUIVANT APRES APPEL MONDES')
  117. CALL GIBTEM(XKT)
  118. INTERR(1)=XKT
  119. CALL ERREUR(-259)
  120. ENDIF
  121. IF(IERR.NE.0) GO TO 5000
  122. C
  123. C **** SUBROUTINE VCH1 : REMET LE VECTEUR SOUS FORME D UN CHPOINT
  124. C **** LE CHPOINT EST DE TYPE PREMIER MEMBRE
  125. C
  126. MVECTA=MVECTX
  127. DO 5 K=1,NN
  128. IF(NN.EQ.1) GO TO 10
  129. IF(K.EQ.1) THEN
  130. INC=INK
  131. MVECT1=MVECTX
  132. SEGACT MVECT1
  133. SEGINI MVECTD
  134. ENDIF
  135. SEGACT MVECTD*mod
  136. LD=(K-1)*INK
  137. DO 6 L=1,INK
  138. VECTBB(L)=MVECT1.VECTBB(L+LD)
  139. 6 CONTINUE
  140. MVECTA=MVECTD
  141. SEGDES MVECTD
  142. IF(K.EQ.NN) SEGSUP MVECT1
  143. 10 CONTINUE
  144. CALL VCH1(ICHOLX,MVECTA,ISOLU,KRIGI)
  145. IF(IERR.NE.0) RETURN
  146. C
  147. IDEMEM(K+KGEN1)=ISOLU
  148. 5 CONTINUE
  149. MVECTD=MVECTA
  150. SEGSUP MVECTD
  151. 201 CONTINUE
  152. IDAMEM = IDEMEM
  153. C
  154. 5000 CONTINUE
  155. RETURN
  156. END
  157.  
  158.  
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  

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