Télécharger arpini.eso

Retour à la liste

Numérotation des lignes :

  1. C ARPINI SOURCE BP208322 15/10/21 21:15:07 8690
  2. SUBROUTINE ARPINI (NVAL,NK,SYM,CHOLE,INVER,
  3. & PIRE,SIGMA,CHOIX,IPMAUP,MAXITE)
  4.  
  5. ***********************************************************************
  6. *
  7. * A R P I N I
  8. *
  9. * FONCTION:
  10. * ---------
  11. *
  12. * SPECIFICATION DES PARAMETRES D'ENTREE + CREATION DES VARIABLES DE
  13. * TRAVAIL D'ARPACK EN FONCTION DU TYPE DE PROBLEME ETUDIE
  14. *
  15. *
  16. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  17. * -----------
  18. *
  19. * NVAL ENTIER (E) NOMBRE DE MODES PROPRES CALCULES
  20. *
  21. * NK ENTIER (E) DIMENSION DU PROBLEME
  22. *
  23. * SYM LOGIQUE (E) PROBLEME SYMETRIQUE OU NON
  24. *
  25. * CHOLE LOGIQUE (E) CHOLESKY NON ALTERNATIVE POSSIBLE
  26. *
  27. * INVER LOGIQUE (E) .TRUE. -> PRODUIT SCALAIRE X'KX
  28. * .FALSE. -> PRODUIT SCALAIRE X'MX
  29. *
  30. * SIGMA COMPLEX DP (E) VALEUR PROPRE DE SHIFT
  31. *
  32. * CHOIX CHAINE*2 (E) VALEURS PROPRES VOULUES
  33. * LM - VP DE MODULE MAX
  34. * SM - VP DE MODULE MIN
  35. * LR - VP DE PARTIE R MAX
  36. * SR - VP DE PARTIE R MIN
  37. * LI - VP DE PARTIE I MAX
  38. * SI - VP DE PARTIE I MIN
  39. * LA - VP MAX
  40. * SA - VP MAX
  41. * BE - VP DE CHAQUE COTE
  42. *
  43. * IPMAUP ENTIER (E/S) POINTEUR OBJETS ARPACK
  44. *
  45. * MAXITE ENTIER (E) NOMBRE MAXIMAL D'ITERATIONS AUTORISE
  46. *
  47. *
  48. * SOUS-PROGRAMMES APPELES:
  49. * ------------------------
  50. *
  51. * NEANT
  52. *
  53. * AUTEUR, DATE DE CREATION:
  54. * -------------------------
  55. *
  56. * PASCAL BOUDA 29 JUIN 2015
  57. *
  58. * LANGAGE:
  59. * --------
  60.  
  61. *
  62. * FORTRAN 77 & 90
  63. *
  64. ***********************************************************************
  65.  
  66. -INC CCOPTIO
  67. -INC TARWORK
  68.  
  69. INTEGER NVAL
  70. INTEGER NK
  71. LOGICAL SYM
  72. LOGICAL CHOLE
  73. LOGICAL INVER
  74. LOGICAL PIRE
  75. COMPLEX*16 SIGMA
  76. CHARACTER*2 CHOIX
  77. INTEGER IPMAUP
  78. INTEGER MAXITE
  79.  
  80.  
  81. COMPLEX*16 ZERO
  82.  
  83. ZERO =CMPLX(0.D0,0.D0)
  84. ndim=NK
  85.  
  86. *Attention: ncv ne doit pas dépasser le nombre d'inconnues vraies
  87. ncv=min(2*NVAL+8,NK)
  88.  
  89. lnev=NVAL+1
  90.  
  91. *taille de l'espace de travail qui differe du type de probleme
  92. IF (SYM) THEN
  93. lworkl=ncv**2+8*ncv
  94. lipntr=11
  95. ELSE
  96. lworkl=3*ncv**2+6*ncv
  97. lipntr=14
  98. ENDIF
  99.  
  100. SEGINI MAUP
  101.  
  102. ido=0
  103. info=1
  104. which=CHOIX
  105.  
  106. iparam(1)=1
  107. iparam(3)=MAXITE
  108. iparam(4)=1
  109. iparam(7)=3
  110.  
  111. * Si Chole ou inver le problème n'est pas genéralise (matrice identite
  112. *dans le second membre) + differentiation du probleme avec shift ou non
  113. IF (.NOT. INVER) THEN
  114.  
  115. IF (SIGMA .EQ. ZERO) THEN
  116. IF (PIRE) THEN
  117. bmat='I'
  118. ELSE
  119. bmat='G'
  120. ENDIF
  121. ELSE
  122. IF (CHOLE) THEN
  123. bmat='I'
  124. ELSE
  125. bmat='G'
  126. ENDIF
  127. ENDIF
  128.  
  129. * -petit message informatif
  130. IF (IIMPI.GE.1) THEN
  131.  
  132. IF (bmat .EQ. 'G') then
  133.  
  134. WRITE(IOIMP,*)'----------- Shift-and-Invert mode -----------'
  135. WRITE(IOIMP,*)'Resolution de : K*x = lambda*M*x'
  136. IF (INVER) THEN
  137. WRITE(IOIMP,*)'Avec modes K-orthgonaux (K semi-def pos)'
  138. ELSE
  139. WRITE(IOIMP,*)'Avec modes M-orthgonaux (M semi-def pos)'
  140. ENDIF
  141. WRITE(IOIMP,*)'OP = (inv[K - sigma*M])*M and B = M'
  142.  
  143. ELSE
  144.  
  145. WRITE(IOIMP,*)'----------- Shift-and-Invert mode -----------'
  146. WRITE(IOIMP,*)'Resolution de : K*x = lambda*M*x'
  147. WRITE(IOIMP,*)'OP = inv[K]*M and B = I'
  148.  
  149. ENDIF
  150.  
  151. ENDIF
  152.  
  153. ELSE
  154.  
  155. c * -petit message informatif
  156. c IF (IIMPI.GE.1) THEN
  157. c WRITE(IOIMP,*)'--------------- Buckling mode ---------------'
  158. c WRITE(IOIMP,*)'Resolution de : K*x = lambda*KG*x'
  159. c WRITE(IOIMP,*)'K symetrique semi-defini positif, KGsymetrique'
  160. c WRITE(IOIMP,*)'OP = (inv[K - sigma*KG])*K and B = K'
  161. c ENDIF
  162. c iparam(7)=4
  163. bmat='G'
  164.  
  165. ENDIF
  166.  
  167. eigvec=.TRUE.
  168. nev=NVAL
  169. howmny='A'
  170. ldv=NK
  171.  
  172. IPMAUP=MAUP
  173. SEGDES MAUP
  174.  
  175.  
  176. END
  177.  

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