Télécharger arpost.eso

Retour à la liste

Numérotation des lignes :

  1. C ARPOST SOURCE JC220346 16/04/25 21:15:01 8915
  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
  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.  
  105. ************************************************************************
  106. *Si le probleme est symetrique, on appelle la routine spécifique aux
  107. *problemes symetriques, sinon on appelle celle pour les problemes
  108. *non symetriques
  109. *
  110. *En sortie
  111. * - v contient les vecteurs propres (cas symetrique ou non)
  112. * - dr contient les valeurs propres reelles
  113. * - di (optionnel) contient les valeurs propres imaginaires
  114. * Pour les autres variables, voir chapeaux de dseupd et dneupd
  115. ************************************************************************
  116.  
  117. IF (SYM) THEN
  118.  
  119. CALL DSEUPD (eigvec, howmny,select, dr, v, ldv,REAL(SIGMA),
  120. & bmat, ndim, which, nev, EPSI, resid, ncv, v,
  121. & ldv, iparam, ipntr, workd, workl, lworkl, info)
  122.  
  123. ELSE
  124.  
  125. CALL DNEUPD (eigvec, howmny, select, dr, di ,v, ldv,
  126. & REAL(SIGMA),AIMAG(SIGMA), workev,bmat,ndim,which,nev,
  127. & 0.1D0*EPSI,resid,ncv,v,ldv,iparam,ipntr,workd,workl,lworkl,info)
  128.  
  129. ENDIF
  130.  
  131. MAUP=IPMAUP
  132. SEGDES MAUP
  133.  
  134.  
  135. **********************************************
  136. *Formation des listes de reels et de mlchpo's*
  137. **********************************************
  138.  
  139. IF (SYM) THEN
  140.  
  141. CALL ARSLUR (IPRTRA,SIGMA,IPMAUP,QUAD,EPSI,INVER,
  142. & IPLVAR,IPLVER)
  143.  
  144. ELSE
  145.  
  146. CALL ARSLUC (IPRTRA,SIGMA,IPMAUP,QUAD,EPSI,INVER,
  147. & IPLVAR,IPLVER,IPLVAI,IPLVEI)
  148.  
  149. ENDIF
  150. IF (IERR.NE.0) RETURN
  151.  
  152. *********************************
  153. *Remplissage de l'objet solution*
  154. *********************************
  155. MRITRA=IPRTRA
  156. SEGACT MRITRA
  157.  
  158. IPRIGI=RIGI(1)
  159. IPMASS=RIGI(2)
  160.  
  161.  
  162. IF (SYM) THEN
  163.  
  164. CALL CRSOLU (0.D0,IPLVAR,IPLVER,N,IPRIGI,IPMASS,IPSOLU,0)
  165.  
  166. ELSE
  167.  
  168. *Facteur de correction pour le numero du mode
  169. CALL DIAGN1 (IPRIGI,CORR)
  170. CALL CCSOLU (0.D0,IPLVAR,IPLVAI,IPLVER,IPLVEI,
  171. & IPRIGI,IPMASS,IPSOLU,CORR)
  172.  
  173. ENDIF
  174.  
  175. SEGDES MRITRA
  176.  
  177. *************************************************
  178. **Dedualisation des multiplicateurs de Lagrange**
  179. *************************************************
  180.  
  181. MSOLUT=IPSOLU
  182. SEGACT MSOLUT*MOD
  183. DO i=1,MSOLIT(/1)
  184. *On ne dedualise que dans le cas des chpoints (ssi MSOLIT(i)=2)
  185. IF (MSOLIT(i) .EQ. 2) THEN
  186.  
  187. MSOLEN=MSOLIS(i)
  188. SEGACT MSOLEN*MOD
  189. *Boucle sur les chpoints
  190. DO j=1,ISOLEN(/1)
  191. MCHPOI=ISOLEN(j)
  192. SEGACT MCHPOI*MOD
  193. *On dedualise les multiplicateurs
  194. IF (LAGDUA .NE. 0) THEN
  195. CALL DBBCF (MCHPOI,LAGDUA)
  196. ENDIF
  197. ISOLEN(j)=MCHPOI
  198. SEGDES MCHPOI
  199. ENDDO
  200. SEGDES MSOLEN
  201.  
  202. ENDIF
  203.  
  204. ENDDO
  205. SEGDES MSOLUT
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212. END
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  

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