Sources Esope | Cast3M

arpost
C ARPOST    SOURCE    PB245956  21/09/13    21:15:00     11101          
      SUBROUTINE ARPOST (IPRTRA,LAGDUA,SIGMA,QUAD,SYM,INVER,
     &                                  IPMAUP,IPSOLU,EPSI)
 
*********************************************************************** 
*       
*                          A R P O S T                                 
*       
* FONCTION:                                                             
* ---------                                                             
* 
*     POSTTRAITEMENT DE LA FACTORISATION D'ARNOLDI: CALCUL DES MODES 
*     PROPRES + FORMATION DE L'OBJET SOLUTION
*    
*
* PARAMETRES:  (E)=ENTREE   (S)=SORTIE             
* -----------                                                           
*     
*     IPRTRA   ENTIER     (E)   POINTEUR DES OPERATEURS DE TRAVAIL  
*
*     LAGDUA   ENTIER    (E)    NB DE M. DE LAGRANGE DUALISES
* 
*     SIGMA   COMPLEX DP (E)    VALEUR PROPRE DE SHIFT
*
*     QUAD    LOGIQUE    (E)    PROBLEME QUADRATIQUE OU NON
*          
*     SYM     LOGIQUE    (E)    PROBLEME SYMETRIQUE OU NON
*     
*     INVER   LOGIQUE    (E)   .TRUE. -> PRODUIT SCALAIRE X'KX
*                              .FALSE. -> PRODUIT SCALAIRE X'MX
*
*     IPMAUP  ENTIER     (E/S)  POINTEUR OBJETS ARPACK
*
*     EPSI    REEL DP    (E)    ZERO DE TOLERANCE
*
*      
* SOUS-PROGRAMMES APPELES:    
* ------------------------                                             
* 
*     DSEUPD,DNEUPD,ARSLUR,DIAGN1,CRSOLU,ARSLUC,CCSOLU
*
* AUTEUR, DATE DE CREATION:       
* -------------------------   
*
*     PASCAL BOUDA     29 JUIN 2015                        
*  
* LANGAGE:                     
* --------                                                             
*  
*     FORTRAN 77 & 90
*       
*********************************************************************** 
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z) 
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMLCHPO
-INC SMSOLUT
-INC SMCHPOI
-INC SMLREEL
-INC TARWORK
 
 
      INTEGER IPRTRA
      INTEGER LAGDUA
      COMPLEX*16 SIGMA
      LOGICAL QUAD
      LOGICAL SYM
      LOGICAL INVER
      INTEGER IPMAUP    
      INTEGER IPSOLU
      REAL*8 EPSI,W2
 
 
      INTEGER IPRIGI,IPMASS
      INTEGER TEST
      INTEGER N
      INTEGER CORR
      LOGICAL OUT
      INTEGER SCAL
      INTEGER IPLVAR
      INTEGER IPLVER
      INTEGER IPLVAI
      INTEGER IPLVEI
 
 
      OUT=.FALSE.
      IPLVAR=0
      IPLVER=0
      IPLVAI=0
      IPLVEI=0
 
      MAUP=IPMAUP
      SEGACT MAUP*MOD   
 
*recuperation des dimensions      
      ndim=resid(/1)
      ncv=v(/2)
      lworkl=workl(/1)
      SCAL=iparam(7)
      N=nev
 
*     shift
      W2=REAL(SIGMA)
 
 
************************************************************************
*Si le probleme est symetrique, on appelle la routine spécifique aux 
*problemes symetriques, sinon on appelle celle pour les problemes 
*non symetriques
*
*En sortie
*       - v contient les vecteurs propres (cas symetrique ou non)
*       - dr contient les valeurs propres reelles
*       - di (optionnel) contient les valeurs propres imaginaires
* Pour les autres variables, voir chapeaux de dseupd et dneupd
************************************************************************
 
      IF (SYM) THEN  
 
          CALL DSEUPD (eigvec, howmny,select, dr, v, ldv,W2, 
     &       bmat, ndim, which, nev, EPSI, resid, ncv, v,
     &          ldv, iparam, ipntr, workd, workl, lworkl, info)
 
      ELSE    
 
          CALL DNEUPD (eigvec, howmny, select, dr, di ,v, ldv, 
     &         W2,AIMAG(SIGMA), workev,bmat,ndim,which,nev, 
     &  0.1D0*EPSI,resid,ncv,v,ldv,iparam,ipntr,workd,workl,lworkl,info)
 
      ENDIF
 
      MAUP=IPMAUP
c       SEGDES MAUP  
 
 
**********************************************      
*Formation des listes de reels et de mlchpo's*
**********************************************
 
      IF (SYM) THEN
 
          CALL ARSLUR (IPRTRA,SIGMA,IPMAUP,QUAD,EPSI,INVER,
     &                                                IPLVAR,IPLVER)
 
      ELSE     
 
          CALL ARSLUC (IPRTRA,SIGMA,IPMAUP,QUAD,EPSI,INVER,
     &                                  IPLVAR,IPLVER,IPLVAI,IPLVEI)
 
      ENDIF
      IF (IERR.NE.0) RETURN
 
********************************* 
*Remplissage de l'objet solution*
*********************************
      MRITRA=IPRTRA
      SEGACT MRITRA
 
      IPRIGI=RIGI(1)
      IPMASS=RIGI(2)
*      IPKW2M=RIGI(4)
 
      IF (SYM) THEN      
 
*         travail pour la bonne numerotation des modes dans CRSOLU          
          CALL CRSOLU (0.D0,IPLVAR,IPLVER,N,IPRIGI,IPMASS,IPSOLU)
 
      ELSE
 
*         cas non-symetrique : on en connait pas a priori le nombre de 
*         modes a gauche du shift (quel sens dans le plan complexe ?)
*         --> on met 0 comme dernier argument
          CALL CCSOLU (0.D0,IPLVAR,IPLVAI,IPLVER,IPLVEI, 
     &                                   IPRIGI,IPMASS,IPSOLU,0) 
 
      ENDIF
 
      SEGDES MRITRA
 
* pb nov20 : inuile car posttraitement desormais fait en aval
* pour toutes les options de vibrat.eso  
**************************************************
***Dedualisation des multiplicateurs de Lagrange**
**************************************************
*     
*      MSOLUT=IPSOLU
*      SEGACT MSOLUT*MOD
*      DO i=1,MSOLIT(/1)
**On ne dedualise que dans le cas des chpoints (ssi MSOLIT(i)=2)   
*         IF (MSOLIT(i) .EQ. 2) THEN
*         
*          MSOLEN=MSOLIS(i)
*          SEGACT MSOLEN*MOD
**Boucle sur les chpoints          
*          DO j=1,ISOLEN(/1)
*           MCHPOI=ISOLEN(j)
*           SEGACT MCHPOI*MOD
**On dedualise les multiplicateurs
*           IF (LAGDUA .NE. 0) THEN
*            CALL DBBCF (MCHPOI,LAGDUA)
*           ENDIF           
*           ISOLEN(j)=MCHPOI
*           SEGDES MCHPOI
*          ENDDO          
*          SEGDES MSOLEN
*          
*         ENDIF
*         
*      ENDDO
*      SEGDES MSOLUT
 
 
 
 
 
 
      END