Télécharger arpsoq.eso

Retour à la liste

Numérotation des lignes :

  1. C ARPSOQ SOURCE PV 16/04/08 21:15:02 8898
  2. SUBROUTINE ARPSOQ (SIGMA,CHOIX,QUAD,NVAL,IPRIGI,IPMASS,IPAMOR,
  3. & LAGDUA,NK,INVER,SYM,CHOLE,IPSOLU,EPSI)
  4.  
  5. ***********************************************************************
  6. *
  7. * A R P S O Q
  8. *
  9. * FONCTION:
  10. * ---------
  11. *
  12. * SOLVEUR DU PROBLEME QUADRATIQUE AUX VALEURS PROPRES AVEC LA
  13. * METHODE IRAM (METHODE D'ARNOLDI AVEC REDEMARRAGE IMPLICITE)
  14. *
  15. *
  16. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  17. * -----------
  18. *
  19. * SIGMA COMPLEX DP (E) VALEUR PROPRE DE SHIFT
  20. *
  21. * CHOIX CHAINE*2 (E) VALEURS PROPRES VOULUES
  22. * LM - VP DE MODULE MAX
  23. * SM - VP DE MODULE MIN
  24. * LR - VP DE PARTIE R MAX
  25. * SR - VP DE PARTIE R MIN
  26. * LI - VP DE PARTIE I MAX
  27. * SI - VP DE PARTIE I MIN
  28. * LA - VP MAX
  29. * SA - VP MIN
  30. * BE - VP DE CHAQUE COTE
  31. *
  32. * QUAD LOGIQUE (E) PROBLEME QUADRATIQUE OU NON
  33. *
  34. * NVAL ENTIER (E) NOMBRE DE MODES PROPRES A CALCULER
  35. *
  36. * IPRIGI ENTIER (E) POINTEUR D'UNE RIGIDITE
  37. *
  38. * IPMASS ENTIER (E) POINTEUR D'UNE MASSE
  39. *
  40. * LAGDUA ENTIER (E) NB DE M. DE LAGRANGE DUALISES
  41. *
  42. * NK ENTIER (E) DIMENSION DU PROBLEME
  43. *
  44. * CHOLE LOGIQUE (E) CHOLESKY NON ALTERNATIVE POSSIBLE
  45. *
  46. * IPSOLU ENTIER (S) POINTEUR SUR LA SOLUTION CREE
  47. *
  48. * EPSI REEL DP (E) ZERO DE TOLERANCE
  49. *
  50. *
  51. * SOUS-PROGRAMMES APPELES:
  52. * ------------------------
  53. *
  54. * ARPINI,ARPALE,ARPOPE,ARPITQ,ARPOST
  55. *
  56. * AUTEUR, DATE DE CREATION:
  57. * -------------------------
  58. *
  59. * PASCAL BOUDA 17 JUILLET 2015
  60. *
  61. * LANGAGE:
  62. * --------
  63. *
  64. * FORTRAN 77 & 90
  65. *
  66. ***********************************************************************
  67.  
  68. -INC CCOPTIO
  69. -INC TARWORK
  70.  
  71.  
  72. COMPLEX*16 SIGMA
  73. CHARACTER*2 CHOIX
  74. LOGICAL QUAD
  75. INTEGER NVAL
  76. INTEGER IPRIGI
  77. INTEGER IPMASS
  78. INTEGER IPAMOR
  79. INTEGER LAGDUA
  80. INTEGER NK
  81. INTEGER NM
  82. LOGICAL CHOLE
  83. INTEGER IPSOLU
  84. REAL*8 EPSI
  85.  
  86. INTEGER IPBUFF
  87. INTEGER ITER
  88. INTEGER IPRTRA
  89. LOGICAL OUT
  90. LOGICAL SYM
  91. LOGICAL INVER
  92.  
  93.  
  94. *Nombre maximal d'iteration autorise
  95. MAXITE=MIN(100*MAX(NK,NM),10000)
  96.  
  97. *Initialisation de tous les paramètres ARPACK
  98. CALL ARPINI (NVAL,2*NK,.FALSE.,CHOLE,.FALSE.,.FALSE.,
  99. & SIGMA,CHOIX,IPMAUP,MAXITE)
  100.  
  101. *Construction des operateurs de travail
  102. CALL ARPOPE (IPRIGI,IPMASS,IPAMOR,QUAD,SIGMA,IPRTRA)
  103.  
  104. *Inititalisation du vecteur residu d'arpack
  105. CALL ARPALE (IPRTRA,IPMAUP,QUAD)
  106. IF (IERR.NE.0) GOTO 999
  107.  
  108. *Boucle pour la factorisation d'Arnoldi
  109. DO ITER=1,MAXITE
  110. IF (IIMPI.GE.10) WRITE(IOIMP,*) '***ITERATION :',ITER,' ***'
  111. *Iteration
  112. CALL ARPITQ (IPRTRA,IPMAUP,SIGMA,INVER,EPSI,OUT)
  113. IF (IERR.NE.0) GOTO 999
  114. *Sortie si convergence
  115. IF (OUT) GOTO 999
  116.  
  117. ENDDO
  118.  
  119. 999 CONTINUE
  120.  
  121. IF (IIMPI.GE.1)
  122. & WRITE(IOIMP,*) '*** SORTIE APRES :',ITER,' ITERATIONS ***'
  123.  
  124. *Destruction des operateurs de travail (matrices principales exclues)
  125. MRITRA=IPRTRA
  126. SEGACT MRITRA*MOD
  127.  
  128. DO i=4,RIGI(/1)
  129. IF (RIGI(i) .NE. 0) THEN
  130. IPBUFF=RIGI(i)
  131. CALL DTRIGI(IPBUFF)
  132. RIGI(i)=0
  133. ENDIF
  134. ENDDO
  135.  
  136. SEGDES MRITRA
  137.  
  138. IF (IERR.NE.0) RETURN
  139.  
  140. *Posttraitement des resultats: creation de l'objet solution
  141. CALL ARPOST (IPRTRA,LAGDUA,SIGMA,QUAD,SYM,INVER,
  142. & IPMAUP,IPSOLU,EPSI)
  143. IF (IERR.NE.0) RETURN
  144.  
  145.  
  146. *Suppression du segment de travail ARPACK
  147. MAUP=IPMAUP
  148. SEGSUP MAUP
  149.  
  150. END
  151.  
  152.  
  153.  

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