Sources Esope | Cast3M

arslur
C ARSLUR    SOURCE    CB215821  20/11/25    13:18:27     10792          
      SUBROUTINE ARSLUR (IPRTRA,SIGMA,IPMAUP,QUAD,EPSI,INVER,
     &                                                  IPLVAR,IPLVER)
 
************************************************************************
*
*                                A R S L U R
*
*
*
* FONCTION:
* ---------
*
*     CONSTRUCTION D'UN LISTREEL SOLUTION DES FREQUENCES ET D'UN MLCHPO
*     SOLUTION DES MODES CALCULES A PARTIR DES VARIABLES DE SORTIE
*     ARPACK
*
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE
* -----------
*
*     IPRTRA  ENTIER     (E)    POINTEUR DES OPERATEURS DE TRAVAIL
*
*     SIGMA   COMPLEX DP (E)    VALEUR PROPRE DU PB [K-sigma*M] X = 0
*
*     INVER   LOGIQUE    (E)   .TRUE. -> PRODUIT SCALAIRE X'KX
*                              .FALSE. -> PRODUIT SCALAIRE X'MX
*
*     IPMAUP  ENTIER     (E)    POINTEUR DES VARIABLES ARPACK
*
*     QUAD    LOGIQUE    (E)    PROBLEME QUADRATIQUE OU NON
*
*     IPLVAR  ENTIER     (S) POINTEUR DE L'OBJET 'LISTREEL' CONTENANT
*                            LA SUITE DES FREQUENCES PROPRES RELLES
*
*     IPLVER  ENTIER     (S) POINTEUR DE L'OBJET 'LISTCHPO' CONTENANT
*                            LA SUITE DES MODES PROPRES REELS
*
* SOUS-PROGRAMMES APPELES:
* ------------------------
*
*     MOTS1,MAXIM1,VCH1,ARPSHI,NORMA1,ARPVER
*
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL BOUDA      11 JUILLET 2015
*
************************************************************************
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
-INC SMRIGID
-INC SMVECTD
-INC SMLCHPO
-INC SMLREEL
-INC TARWORK
 
 
 
      INTEGER IPRTRA
      COMPLEX*16 SIGMA
      LOGICAL INVER
      INTEGER IPMAUP
      LOGICAL QUAD
      INTEGER IPLVAR
      INTEGER IPLVER
 
      INTEGER IPCHO
      INTEGER IPVEC
      INTEGER IPMODE
      INTEGER IPLMOT
      CHARACTER*(LOCOMP) MOTCLE
      INTEGER IPMONO
      INTEGER TYPRO
      REAL*8 MAXVAL
      INTEGER N
      COMPLEX*16 VPROPR,FPROPR
 
      REAL*8 XMX
 
      VPROPR=CMPLX(0.D0,0.D0)
      FPROPR=CMPLX(0.D0,0.D0)
 
      MRITRA=IPRTRA
      SEGACT MRITRA
 
      IPRIGI=RIGI(1)
 
      MRIGID=IPRIGI
      SEGACT MRIGID
      IPCHO=ICHOLE
      SEGDES MRIGID
 
      MAUP=IPMAUP
      SEGACT MAUP
*Dimension du probleme
      N=v(/1)
 
*Initialisation de la taille du mlchpo et du listreeel
      JG=nev
      SEGINI MLREEL
      N1=nev
      SEGINI MLCHPO
 
 
*Boucle sur le nombre de modes propres calcules
      DO i=1,nev
 
* On recupere la valeur propre (reelle),
* on la transforme en "frequence" et on la stocke
        VPROPR=CMPLX(dr(i),REAL(0.D0))
        IF (IIMPI .GT. 2) WRITE(IOIMP,*) 'Valeur propre',VPROPR
 
        CALL ARPSHI (FPROPR,VPROPR,QUAD,3)
        PROG(i)=REAL(FPROPR)
 
        INC=N
        SEGINI MVECTD
*Recuperation du vecteur propre reel
        DO j=1,N
          VECTBB(j)=v(j,i)
        ENDDO
 
        IPVEC=MVECTD
        SEGDES MVECTD
*Transformation en chpoint
        CALL VCH1 (IPCHO,IPVEC,IPMODE,IPRIGI)
        SEGSUP MVECTD
 
 
*Calcul de la norme et du residu
        TYPRO=iparam(7)
        CALL ARPVER (IPRTRA,TYPRO,i,.FALSE.,.TRUE.,
     &                                   EPSI,INVER,IPMODE,0,VPROPR)
 
 
*La normalisation est impossible si le chpoint est nul
 
        CALL MOTS1 (IPLMOT,MOTCLE)
        CALL MAXIM1 (IPMODE,IPLMOT,MOTCLE,0,MAXVAL)
 
        IF (MAXVAL .LE. XPETIT) THEN
          IPMONO=IPMODE
        ELSE
          CALL NORMA1 (IPMODE,IPLMOT,MOTCLE,IPMONO)
        ENDIF
 
        ICHPOI(i)=IPMONO
 
      ENDDO
 
      IPLVAR=MLREEL
      SEGDES MLREEL
      IPLVER=MLCHPO
      SEGDES MLCHPO
c       SEGDES MAUP
      SEGDES MRITRA
 
      END