C ARPACK SOURCE PB245956 20/12/21 21:15:00 10747 C SUBROUTINE ARPACK (IPRIG1,IPRIG2,IPRIG3,IPSOLU,FSHIFT,NVAL,CHOIX, C & INSYM,LAGDUA) ************************************************************************ * * A R P A C K * ----------- * * SOUS-PROGRAMME ASSOCIE A L'OPTION "IRAM" DE L'OPERATEUR * "VIBRATION". * * FONCTION: * --------- * * DETERMINER UNE SERIE DE MODES PROPRES AVEC LA LIBRAIRIE ARPACK * * * PARAMETRES: (E)=ENTREE (S)=SORTIE * ----------- * * * IPRIG1 ENTIER (E) POINTEUR D'UN MRIGID * * IPRIG2 ENTIER (E) POINTEUR D'UN MRIGID * * IPRIG3 ENTIER (E) POINTEUR D'UN MRIGID * * IPSOLU ENTIER (S) POINTEUR OBJET SOLUTION * * FSHIFT COMPLEXE DP (E) FREQUENCE DE SHIFT * * NVAL ENTIER (E) NOMBRE DE MODES A CALCULER * * CHOIX CHAINE*2 (E) VALEURS PROPRES VOULUES * LM - VP DE MODULE MAX * SM - VP DE MODULE MIN * LR - VP DE PARTIE R MAX * SR - VP DE PARTIE R MIN * LI - VP DE PARTIE I MAX * SI - VP DE PARTIE I MIN * LA - VP MAX * SA - VP MIN * BE - VP DE CHAQUE COTE * * INSYM ENTIER (S) PROBLEME SYMETRIQUE OU NON * * LAGDUA ENTIER (E) NB DE M DE LAGRANGE DUALISES * * SOUS-PROGRAMMES APPELES: * ------------------------ * * WHICH1,QZTRIR,NBINC,ACHECK,ARPSHI,ARPSOL,ARPSOQ * * AUTEUR, DATE DE CREATION: * ------------------------- * * PASCAL BOUDA 29 JUIN 2015 * PASCAL BOUDA AOUT 2020 : sortie du pretraitement * (analyse des matrices) + posttraitement (objet solution) * * LANGAGE: * -------- * * FORTRAN 77 & 90 * *********************************************************************** SUBROUTINE ARPACK (IPSOLU,IPMASS,IPRIGI,IPAMOR,FSHIFT,NVAL,CHOIX, & INSYM,LAGDUA) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMRIGID INTEGER IPRIG1 INTEGER IPRIG2 INTEGER IPRIG3 INTEGER LAGDUA INTEGER IPSOLU COMPLEX*16 FSHIFT INTEGER NVAL CHARACTER*2 CHOIX INTEGER INSYM INTEGER IPRIGI INTEGER IPMASS INTEGER IPAMOR INTEGER NK,NM,NA LOGICAL FLAG LOGICAL INVER LOGICAL PIRE LOGICAL CHOLE REAL*8 EPSI COMPLEX*16 SIGMA,ZERO LOGICAL SYM LOGICAL QUAD ZERO=CMPLX(0.D0,0.D0) ********************************** ** TOLERANCE SUR LES EIGENPAIRS ** ********************************** EPSI=1.D-08 c EPSI=1.D-10 ********************************** *Identification du degre du probleme: lineaire, quadratique IF (IPAMOR .EQ. 0) THEN QUAD=.FALSE. IF (IIMPI .GT. 2) THEN WRITE(IOIMP,*) 'LE PROBLEME EST LINEAIRE' ENDIF ELSE QUAD=.TRUE. IF (IIMPI .GT. 2) THEN WRITE(IOIMP,*) 'LE PROBLEME EST QUADRATIQUE' ENDIF ENDIF *pb nov20: le travail est desormais fait en amont (cf vibrat.eso) **Determination de la matrice de masse, de rigidite et eventuellement **d'amortissement * IF (.NOT. QUAD) THEN * CALL WHICH1 (IPRIG1,IPRIG2,IPRIGI,IPMASS) * IF (IERR .NE. 0) RETURN * ELSE * IPRIGI=IPRIG1 * IPMASS=IPRIG2 * IPAMOR=IPRIG3 * CALL QZTRIR (IPMASS,IPRIGI,IPAMOR) * IF (IERR .NE. 0) RETURN * ENDIF *Calcul du nombre d'inconnues + triangularisation si necessaire CALL NBINC (IPRIGI,NK) IF (IERR.NE.0) RETURN CALL NBINC (IPMASS,NM) IF (IERR.NE.0) RETURN IF (QUAD) THEN CALL NBINC (IPAMOR,NA) IF (IERR.NE.0) RETURN ENDIF IF(IIMPI.GE.1) THEN WRITE(IOIMP,*) 'NOMBRE DE VALEURS PROPRES DEMANDEES=',NVAL WRITE(IOIMP,*) 'SHIFT EN FREQUENCE=', REAL(FSHIFT) ENDIF *Verification de la solvabilite du probleme CALL ACHECK(IPRIGI,IPMASS,QUAD,SYM,FSHIFT,NK,FLAG, & INVER,PIRE,CHOLE,EPSI) IF (IERR.NE.0) RETURN *Valeur du insym depend du type de probleme resolu IF (SYM) THEN INSYM=0 IF (IIMPI.GE.1) WRITE(IOIMP,*) 'LE PROBLEME EST SYMETRIQUE' ELSE INSYM=1 IF (IIMPI.GE.1) WRITE(IOIMP,*)'LE PROBLEME N EST PAS SYMETRIQUE' ENDIF * Conversion du shift "frequence" en shift "valeur propre"; CALL ARPSHI (FSHIFT,SIGMA,QUAD,1) IF (IERR.NE.0) RETURN * 27/07/2015 : La resolution avec shift complexe n'est pas implementee * Mise a zero de la partie imaginaire du shift SIGMA=CMPLX(REAL(SIGMA),0.D0) IF (FLAG) THEN IF (.NOT. QUAD) THEN c RESOLUTION DU PB AUX VALEURS PROPRES LINEAIRE CALL ARPSOL (SIGMA,CHOIX,QUAD,NVAL,IPRIGI,IPMASS,LAGDUA,NK,NM, & INVER,PIRE,SYM,CHOLE,IPSOLU,EPSI) ELSE c RESOLUTION DU PB AUX VALEURS PROPRES QUADRATIQUE CALL ARPSOQ (SIGMA,CHOIX,QUAD,NVAL,IPRIGI,IPMASS,IPAMOR, & LAGDUA,NK,NM,INVER,SYM,CHOLE,IPSOLU,EPSI) ENDIF IF (IERR.NE.0) RETURN ENDIF END