Télécharger arpsol.eso

Retour à la liste

Numérotation des lignes :

  1. C ARPSOL SOURCE CB215821 17/07/20 21:15:02 9511
  2. SUBROUTINE ARPSOL (SIGMA,CHOIX,QUAD,NVAL,IPRIGI,IPMASS,LAGDUA,NK,
  3. & NM,INVER,PIRE,SYM,CHOLE,IPSOLU,EPSI)
  4.  
  5. ***********************************************************************
  6. *
  7. * A R P S O L
  8. *
  9. * FONCTION:
  10. * ---------
  11. *
  12. * SOLVEUR DU PROBLEME LINAIRE AUX VALEURS PROPRES AVEC LA METHODE
  13. * 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 (K)
  43. *
  44. * NM ENTIER (E) DIMENSION DU PROBLEME (M)
  45. *
  46. * INVER LOGIQUE (E) .TRUE. -> PRODUIT SCALAIRE X'KX
  47. * .FALSE. -> PRODUIT SCALAIRE X'MX
  48. *
  49. * PIRE LOGIQUE (E) PRODUIT SCALAIRE EUCLIDIEN
  50. *
  51. * SYM LOGIQUE (E) PROBLEME SYMETRIQUE OU NON
  52. *
  53. * CHOLE LOGIQUE (E) CHOLESKY NON ALTERNATIVE POSSIBLE
  54. *
  55. * IPSOLU ENTIER (S) POINTEUR SUR LA SOLUTION CREE
  56. *
  57. * EPSI REEL DP (E) ZERO DE TOLERANCE
  58. *
  59. *
  60. * SOUS-PROGRAMMES APPELES:
  61. * ------------------------
  62. *
  63. * ARPINI,ARPALE,ARPOPE,ARPITL,ARPOST
  64. *
  65. * AUTEUR, DATE DE CREATION:
  66. * -------------------------
  67. *
  68. * PASCAL BOUDA 29 JUIN 2015
  69. *
  70. * LANGAGE:
  71. * --------
  72. *
  73. * FORTRAN 77 & 90
  74. *
  75. ***********************************************************************
  76.  
  77. IMPLICIT INTEGER(I-N)
  78. IMPLICIT REAL*8 (A-H,O-Z)
  79.  
  80. -INC CCOPTIO
  81. -INC TARWORK
  82.  
  83. COMPLEX*16 SIGMA
  84. CHARACTER*2 CHOIX
  85. LOGICAL QUAD
  86. INTEGER NVAL
  87. INTEGER IPRIGI
  88. INTEGER IPMASS
  89. INTEGER LAGDUA
  90. INTEGER NK
  91. INTEGER NM
  92. LOGICAL INVER
  93. LOGICAL PIRE
  94. LOGICAL SYM
  95. LOGICAL CHOLE
  96. INTEGER IPSOLU
  97. REAL*8 EPSI
  98.  
  99. INTEGER ITER
  100. INTEGER IPRTRA
  101. INTEGER IPBUFF
  102. LOGICAL OUT
  103.  
  104.  
  105. *Nombre maximal d'iteration autorise
  106. MAXITE=MIN(100*MAX(NK,NM),10000)
  107.  
  108.  
  109. *Initialisation de tous les paramètres ARPACK
  110. CALL ARPINI (NVAL,NK,SYM,CHOLE,INVER,PIRE,
  111. & SIGMA,CHOIX,IPMAUP,MAXITE)
  112.  
  113. *Construction des operateurs de travail
  114. CALL ARPOPE (IPRIGI,IPMASS,0,QUAD,SIGMA,IPRTRA)
  115.  
  116. *Inititalisation du vecteur residu d'arpack
  117. CALL ARPALE (IPRTRA,IPMAUP,QUAD)
  118. IF (IERR.NE.0) GOTO 999
  119.  
  120. *Boucle pour la factorisation d'Arnoldi
  121. DO ITER=1,MAXITE
  122. IF (IIMPI.GE.10) WRITE(IOIMP,*) '*** ITERATION N°:',ITER,'***'
  123. *Iteration
  124. CALL ARPITL (IPRTRA,IPMAUP,SIGMA,INVER,SYM,EPSI,OUT)
  125. IF (IERR.NE.0) GOTO 999
  126. *Sortie si convergence
  127.  
  128. IF (OUT) THEN
  129. GOTO 999
  130. END IF
  131.  
  132. ENDDO
  133.  
  134. 999 CONTINUE
  135.  
  136. IF (IIMPI.GE.1)
  137. & WRITE(IOIMP,*) '*** SORTIE APRES :',ITER,' ITERATIONS ***'
  138.  
  139. *Destruction des operateurs de travail (matrices principales exclues)
  140.  
  141. MRITRA=IPRTRA
  142. SEGACT MRITRA*MOD
  143. DO i=3,RIGI(/1)
  144. IF (RIGI(i) .NE. 0) THEN
  145. IPBUFF=RIGI(i)
  146. CALL DTRIGI(IPBUFF)
  147. RIGI(i)=0
  148. ENDIF
  149. ENDDO
  150. SEGDES MRITRA
  151. IF (IERR.NE.0) RETURN
  152.  
  153. *Posttraitement des resultats: creation de l'objet solution
  154. CALL ARPOST (IPRTRA,LAGDUA,SIGMA,QUAD,SYM,INVER,
  155. & IPMAUP,IPSOLU,EPSI)
  156. IF (IERR.NE.0) RETURN
  157.  
  158. *Suppression du segment de travail ARPACK
  159. MAUP=IPMAUP
  160. SEGSUP MAUP
  161.  
  162. END
  163.  
  164.  

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