Télécharger arpost.eso

Retour à la liste

Numérotation des lignes :

arpost
  1. C ARPOST SOURCE PB245956 20/12/21 21:15:03 10747
  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.  
  58. -INC PPARAM
  59. -INC CCOPTIO
  60. -INC SMLCHPO
  61. -INC SMSOLUT
  62. -INC SMCHPOI
  63. -INC SMLREEL
  64. -INC TARWORK
  65.  
  66.  
  67. INTEGER IPRTRA
  68. INTEGER LAGDUA
  69. COMPLEX*16 SIGMA
  70. LOGICAL QUAD
  71. LOGICAL SYM
  72. LOGICAL INVER
  73. INTEGER IPMAUP
  74. INTEGER IPSOLU
  75. REAL*8 EPSI,W2
  76.  
  77.  
  78. INTEGER IPRIGI,IPMASS
  79. INTEGER TEST
  80. INTEGER N
  81. INTEGER CORR
  82. LOGICAL OUT
  83. INTEGER SCAL
  84. INTEGER IPLVAR
  85. INTEGER IPLVER
  86. INTEGER IPLVAI
  87. INTEGER IPLVEI
  88.  
  89.  
  90. OUT=.FALSE.
  91. IPLVAR=0
  92. IPLVER=0
  93. IPLVAI=0
  94. IPLVEI=0
  95.  
  96. MAUP=IPMAUP
  97. SEGACT MAUP*MOD
  98.  
  99. *recuperation des dimensions
  100. ndim=resid(/1)
  101. ncv=v(/2)
  102. lworkl=workl(/1)
  103. SCAL=iparam(7)
  104. N=nev
  105.  
  106. * shift
  107. W2=REAL(SIGMA)
  108.  
  109.  
  110. ************************************************************************
  111. *Si le probleme est symetrique, on appelle la routine spécifique aux
  112. *problemes symetriques, sinon on appelle celle pour les problemes
  113. *non symetriques
  114. *
  115. *En sortie
  116. * - v contient les vecteurs propres (cas symetrique ou non)
  117. * - dr contient les valeurs propres reelles
  118. * - di (optionnel) contient les valeurs propres imaginaires
  119. * Pour les autres variables, voir chapeaux de dseupd et dneupd
  120. ************************************************************************
  121.  
  122. IF (SYM) THEN
  123.  
  124. CALL DSEUPD (eigvec, howmny,select, dr, v, ldv,W2,
  125. & bmat, ndim, which, nev, EPSI, resid, ncv, v,
  126. & ldv, iparam, ipntr, workd, workl, lworkl, info)
  127.  
  128. ELSE
  129.  
  130. CALL DNEUPD (eigvec, howmny, select, dr, di ,v, ldv,
  131. & W2,AIMAG(SIGMA), workev,bmat,ndim,which,nev,
  132. & 0.1D0*EPSI,resid,ncv,v,ldv,iparam,ipntr,workd,workl,lworkl,info)
  133.  
  134. ENDIF
  135.  
  136. MAUP=IPMAUP
  137. c SEGDES MAUP
  138.  
  139.  
  140. **********************************************
  141. *Formation des listes de reels et de mlchpo's*
  142. **********************************************
  143.  
  144. IF (SYM) THEN
  145.  
  146. CALL ARSLUR (IPRTRA,SIGMA,IPMAUP,QUAD,EPSI,INVER,
  147. & IPLVAR,IPLVER)
  148.  
  149. ELSE
  150.  
  151. CALL ARSLUC (IPRTRA,SIGMA,IPMAUP,QUAD,EPSI,INVER,
  152. & IPLVAR,IPLVER,IPLVAI,IPLVEI)
  153.  
  154. ENDIF
  155. IF (IERR.NE.0) RETURN
  156.  
  157. *********************************
  158. *Remplissage de l'objet solution*
  159. *********************************
  160. MRITRA=IPRTRA
  161. SEGACT MRITRA
  162.  
  163. IPRIGI=RIGI(1)
  164. IPMASS=RIGI(2)
  165. IPKW2M=RIGI(4)
  166.  
  167. IF (SYM) THEN
  168.  
  169. * travail pour la bonne numerotation des modes dans CRSOLU
  170. CALL CRSOLU (0.D0,IPLVAR,IPLVER,N,IPKW2M,IPMASS,IPSOLU)
  171.  
  172. ELSE
  173.  
  174. * cas non-symetrique : on en connait pas a priori le nombre de
  175. * modes a gauche du shift (quel sens dans le plan complexe ?)
  176. * --> on met 0 comme dernier argument
  177. CALL CCSOLU (0.D0,IPLVAR,IPLVAI,IPLVER,IPLVEI,
  178. & IPRIGI,IPMASS,IPSOLU,0)
  179.  
  180. ENDIF
  181.  
  182. SEGDES MRITRA
  183.  
  184. * pb nov20 : inuile car posttraitement desormais fait en aval
  185. * pour toutes les options de vibrat.eso
  186. **************************************************
  187. ***Dedualisation des multiplicateurs de Lagrange**
  188. **************************************************
  189. *
  190. * MSOLUT=IPSOLU
  191. * SEGACT MSOLUT*MOD
  192. * DO i=1,MSOLIT(/1)
  193. **On ne dedualise que dans le cas des chpoints (ssi MSOLIT(i)=2)
  194. * IF (MSOLIT(i) .EQ. 2) THEN
  195. *
  196. * MSOLEN=MSOLIS(i)
  197. * SEGACT MSOLEN*MOD
  198. **Boucle sur les chpoints
  199. * DO j=1,ISOLEN(/1)
  200. * MCHPOI=ISOLEN(j)
  201. * SEGACT MCHPOI*MOD
  202. **On dedualise les multiplicateurs
  203. * IF (LAGDUA .NE. 0) THEN
  204. * CALL DBBCF (MCHPOI,LAGDUA)
  205. * ENDIF
  206. * ISOLEN(j)=MCHPOI
  207. * SEGDES MCHPOI
  208. * ENDDO
  209. * SEGDES MSOLEN
  210. *
  211. * ENDIF
  212. *
  213. * ENDDO
  214. * SEGDES MSOLUT
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221. END
  222.  
  223.  
  224.  
  225.  
  226.  
  227.  
  228.  
  229.  
  230.  
  231.  
  232.  

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