Télécharger arpost.eso

Retour à la liste

Numérotation des lignes :

  1. C ARPOST SOURCE BP208322 19/04/29 21:15:05 10213
  2. SUBROUTINE ARPOST (IPRTRA,LAGDUA,SIGMA,QUAD,SYM,INVER,
  3. & IPMAUP,IPSOLU,EPSI)
  4.  
  5. ***********************************************************************
  6. *
  7. * A R P O S T
  8. *
  9. * FONCTION:
  10. * ---------
  11. *
  12. * POSTTRAITEMENT DE LA FACTORISATION D'ARNOLDI: CALCUL DES MODES
  13. * PROPRES + FORMATION DE L'OBJET SOLUTION
  14. *
  15. *
  16. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  17. * -----------
  18. *
  19. * IPRTRA ENTIER (E) POINTEUR DES OPERATEURS DE TRAVAIL
  20. *
  21. * LAGDUA ENTIER (E) NB DE M. DE LAGRANGE DUALISES
  22. *
  23. * SIGMA COMPLEX DP (E) VALEUR PROPRE DE SHIFT
  24. *
  25. * QUAD LOGIQUE (E) PROBLEME QUADRATIQUE OU NON
  26. *
  27. * SYM LOGIQUE (E) PROBLEME SYMETRIQUE OU NON
  28. *
  29. * INVER LOGIQUE (E) .TRUE. -> PRODUIT SCALAIRE X'KX
  30. * .FALSE. -> PRODUIT SCALAIRE X'MX
  31. *
  32. * IPMAUP ENTIER (E/S) POINTEUR OBJETS ARPACK
  33. *
  34. * EPSI REEL DP (E) ZERO DE TOLERANCE
  35. *
  36. *
  37. * SOUS-PROGRAMMES APPELES:
  38. * ------------------------
  39. *
  40. * DSEUPD,DNEUPD,ARSLUR,DIAGN1,CRSOLU,ARSLUC,CCSOLU
  41. *
  42. * AUTEUR, DATE DE CREATION:
  43. * -------------------------
  44. *
  45. * PASCAL BOUDA 29 JUIN 2015
  46. *
  47. * LANGAGE:
  48. * --------
  49. *
  50. * FORTRAN 77 & 90
  51. *
  52. ***********************************************************************
  53.  
  54. IMPLICIT INTEGER(I-N)
  55. IMPLICIT REAL*8 (A-H,O-Z)
  56.  
  57. -INC CCOPTIO
  58. -INC SMLCHPO
  59. -INC SMSOLUT
  60. -INC SMCHPOI
  61. -INC SMLREEL
  62. -INC TARWORK
  63.  
  64.  
  65. INTEGER IPRTRA
  66. INTEGER LAGDUA
  67. COMPLEX*16 SIGMA
  68. LOGICAL QUAD
  69. LOGICAL SYM
  70. LOGICAL INVER
  71. INTEGER IPMAUP
  72. INTEGER IPSOLU
  73. REAL*8 EPSI,W2
  74.  
  75.  
  76. INTEGER IPRIGI,IPMASS
  77. INTEGER TEST
  78. INTEGER N
  79. INTEGER CORR
  80. LOGICAL OUT
  81. INTEGER SCAL
  82. INTEGER IPLVAR
  83. INTEGER IPLVER
  84. INTEGER IPLVAI
  85. INTEGER IPLVEI
  86.  
  87.  
  88. OUT=.FALSE.
  89. IPLVAR=0
  90. IPLVER=0
  91. IPLVAI=0
  92. IPLVEI=0
  93.  
  94. MAUP=IPMAUP
  95. SEGACT MAUP*MOD
  96.  
  97. *recuperation des dimensions
  98. ndim=resid(/1)
  99. ncv=v(/2)
  100. lworkl=workl(/1)
  101. SCAL=iparam(7)
  102. N=nev
  103.  
  104. * shift
  105. W2=REAL(SIGMA)
  106.  
  107.  
  108. ************************************************************************
  109. *Si le probleme est symetrique, on appelle la routine spécifique aux
  110. *problemes symetriques, sinon on appelle celle pour les problemes
  111. *non symetriques
  112. *
  113. *En sortie
  114. * - v contient les vecteurs propres (cas symetrique ou non)
  115. * - dr contient les valeurs propres reelles
  116. * - di (optionnel) contient les valeurs propres imaginaires
  117. * Pour les autres variables, voir chapeaux de dseupd et dneupd
  118. ************************************************************************
  119.  
  120. IF (SYM) THEN
  121.  
  122. CALL DSEUPD (eigvec, howmny,select, dr, v, ldv,W2,
  123. & bmat, ndim, which, nev, EPSI, resid, ncv, v,
  124. & ldv, iparam, ipntr, workd, workl, lworkl, info)
  125.  
  126. ELSE
  127.  
  128. CALL DNEUPD (eigvec, howmny, select, dr, di ,v, ldv,
  129. & W2,AIMAG(SIGMA), workev,bmat,ndim,which,nev,
  130. & 0.1D0*EPSI,resid,ncv,v,ldv,iparam,ipntr,workd,workl,lworkl,info)
  131.  
  132. ENDIF
  133.  
  134. MAUP=IPMAUP
  135. SEGDES MAUP
  136.  
  137.  
  138. **********************************************
  139. *Formation des listes de reels et de mlchpo's*
  140. **********************************************
  141.  
  142. IF (SYM) THEN
  143.  
  144. CALL ARSLUR (IPRTRA,SIGMA,IPMAUP,QUAD,EPSI,INVER,
  145. & IPLVAR,IPLVER)
  146.  
  147. ELSE
  148.  
  149. CALL ARSLUC (IPRTRA,SIGMA,IPMAUP,QUAD,EPSI,INVER,
  150. & IPLVAR,IPLVER,IPLVAI,IPLVEI)
  151.  
  152. ENDIF
  153. IF (IERR.NE.0) RETURN
  154.  
  155. *********************************
  156. *Remplissage de l'objet solution*
  157. *********************************
  158. MRITRA=IPRTRA
  159. SEGACT MRITRA
  160.  
  161. IPRIGI=RIGI(1)
  162. IPMASS=RIGI(2)
  163. IPKW2M=RIGI(4)
  164.  
  165. IF (SYM) THEN
  166.  
  167. * travail pour la bonne numerotation des modes dans CRSOLU
  168. CALL CRSOLU (0.D0,IPLVAR,IPLVER,N,IPKW2M,IPMASS,IPSOLU,0)
  169.  
  170. ELSE
  171.  
  172. * cas non-symetrique : on en connait pas a priori le nombre de
  173. * modes a gauche du shift (quel sens dans le plan complexe ?)
  174. * --> on met 0 comme dernier argument
  175. CALL CCSOLU (0.D0,IPLVAR,IPLVAI,IPLVER,IPLVEI,
  176. & IPRIGI,IPMASS,IPSOLU,0)
  177.  
  178. ENDIF
  179.  
  180. SEGDES MRITRA
  181.  
  182. *************************************************
  183. **Dedualisation des multiplicateurs de Lagrange**
  184. *************************************************
  185.  
  186. MSOLUT=IPSOLU
  187. SEGACT MSOLUT*MOD
  188. DO i=1,MSOLIT(/1)
  189. *On ne dedualise que dans le cas des chpoints (ssi MSOLIT(i)=2)
  190. IF (MSOLIT(i) .EQ. 2) THEN
  191.  
  192. MSOLEN=MSOLIS(i)
  193. SEGACT MSOLEN*MOD
  194. *Boucle sur les chpoints
  195. DO j=1,ISOLEN(/1)
  196. MCHPOI=ISOLEN(j)
  197. SEGACT MCHPOI*MOD
  198. *On dedualise les multiplicateurs
  199. IF (LAGDUA .NE. 0) THEN
  200. CALL DBBCF (MCHPOI,LAGDUA)
  201. ENDIF
  202. ISOLEN(j)=MCHPOI
  203. SEGDES MCHPOI
  204. ENDDO
  205. SEGDES MSOLEN
  206.  
  207. ENDIF
  208.  
  209. ENDDO
  210. SEGDES MSOLUT
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217. END
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  
  224.  
  225.  

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