Télécharger la plaquette Cast3M


fr en

Télécharger arpini.eso

Retour à la liste

Numérotation des lignes : 

arpini

  1. C ARPINI    SOURCE    BP208322  20/02/06    21:15:06     10512          
  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.  
  67. -INC PPARAM
  68. -INC CCOPTIO
  69. -INC TARWORK
  70.  
  71.       INTEGER NVAL
  72.       INTEGER NK
  73.       LOGICAL SYM
  74.       LOGICAL CHOLE
  75.       LOGICAL INVER
  76.       LOGICAL PIRE
  77.       COMPLEX*16 SIGMA
  78.       CHARACTER*2 CHOIX
  79.       INTEGER IPMAUP
  80.       INTEGER MAXITE
  81.  
  82.  
  83.       COMPLEX*16 ZERO
  84.  
  85.       ZERO =CMPLX(0.D0,0.D0)
  86.       ndim=NK
  87.  
  88. *Attention: ncv ne doit pas dépasser le nombre d'inconnues vraies
  89.       ncv=min(2*NVAL+8,NK)
  90.  
  91.       lnev=NVAL+1
  92.  
  93. *taille de l'espace de travail qui differe du type de probleme
  94.       IF (SYM) THEN
  95.         lworkl=ncv**2+8*ncv
  96.         lipntr=11
  97.       ELSE
  98.         lworkl=3*ncv**2+6*ncv
  99.         lipntr=14
  100.       ENDIF
  101.  
  102.       SEGINI MAUP
  103.  
  104.       ido=0
  105.       info=1
  106.       which=CHOIX
  107.  
  108.       iparam(1)=1
  109.       iparam(3)=MAXITE
  110.       iparam(4)=1
  111.       iparam(7)=3
  112.  
  113. * Si Chole ou inver le problème n'est pas genéralise (matrice identite
  114. *dans le second membre) + differentiation du probleme avec shift ou non
  115.       IF (.NOT. INVER) THEN
  116.  
  117.         IF (SIGMA .EQ. ZERO) THEN
  118.           IF (PIRE) THEN
  119.             bmat='I'
  120.           ELSE
  121.             bmat='G'
  122.           ENDIF
  123.         ELSE
  124.           IF (CHOLE) THEN
  125.             bmat='I'
  126.           ELSE
  127.             bmat='G'
  128.           ENDIF
  129.         ENDIF
  130.  
  131. *      -petit message informatif
  132.         IF (IIMPI.GE.1) THEN
  133.  
  134.           IF (bmat .EQ. 'G') then
  135.  
  136.           WRITE(IOIMP,*)'----------- Shift-and-Invert mode -----------'
  137.           WRITE(IOIMP,*)'Resolution de :  K*x = lambda*M*x'
  138.           IF (INVER) THEN
  139.           WRITE(IOIMP,*)'Avec modes K-orthgonaux (K semi-def pos)'
  140.           ELSE
  141.           WRITE(IOIMP,*)'Avec modes M-orthgonaux (M semi-def pos)'
  142.           ENDIF
  143.           WRITE(IOIMP,*)'OP = (inv[K - sigma*M])*M  and  B = M'
  144.  
  145.           ELSE
  146.  
  147.           WRITE(IOIMP,*)'----------- Shift-and-Invert mode -----------'
  148.           WRITE(IOIMP,*)'Resolution de :  K*x = lambda*M*x'
  149.           WRITE(IOIMP,*)'OP = inv[K]*M  and  B = I'
  150.  
  151.           ENDIF
  152.  
  153.         ENDIF
  154.  
  155.       ELSE
  156.  
  157. c *      -petit message informatif
  158. c         IF (IIMPI.GE.1) THEN
  159. c         WRITE(IOIMP,*)'--------------- Buckling mode ---------------'
  160. c         WRITE(IOIMP,*)'Resolution de :  K*x = lambda*KG*x'
  161. c         WRITE(IOIMP,*)'K symetrique semi-defini positif, KGsymetrique'
  162. c         WRITE(IOIMP,*)'OP = (inv[K - sigma*KG])*K  and  B = K'
  163. c         ENDIF
  164. c         iparam(7)=4
  165.         bmat='G'
  166.  
  167.       ENDIF
  168.  
  169.       eigvec=.TRUE.
  170.       nev=NVAL
  171.       howmny='A'
  172.       ldv=NK
  173.  
  174.       IPMAUP=MAUP
  175. c       SEGDES MAUP
  176.  
  177.  
  178.       END
  179.  
  180.  

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