C ARPSOQ SOURCE BP208322 20/02/06 21:15:12 10512 SUBROUTINE ARPSOQ (SIGMA,CHOIX,QUAD,NVAL,IPRIGI,IPMASS,IPAMOR, & LAGDUA,NK,NM,INVER,SYM,CHOLE,IPSOLU,EPSI) *********************************************************************** * * A R P S O Q * * FONCTION: * --------- * * SOLVEUR DU PROBLEME QUADRATIQUE AUX VALEURS PROPRES AVEC LA * METHODE IRAM (METHODE D'ARNOLDI AVEC REDEMARRAGE IMPLICITE) * * * PARAMETRES: (E)=ENTREE (S)=SORTIE * ----------- * * SIGMA COMPLEX DP (E) VALEUR PROPRE DE SHIFT * * 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 * * QUAD LOGIQUE (E) PROBLEME QUADRATIQUE OU NON * * NVAL ENTIER (E) NOMBRE DE MODES PROPRES A CALCULER * * IPRIGI ENTIER (E) POINTEUR D'UNE RIGIDITE * * IPMASS ENTIER (E) POINTEUR D'UNE MASSE * * LAGDUA ENTIER (E) NB DE M. DE LAGRANGE DUALISES * * NK ENTIER (E) DIMENSION DU PROBLEME (K) * * NM ENTIER (E) DIMENSION DU PROBLEME (M) * * CHOLE LOGIQUE (E) CHOLESKY NON ALTERNATIVE POSSIBLE * * IPSOLU ENTIER (S) POINTEUR SUR LA SOLUTION CREE * * EPSI REEL DP (E) ZERO DE TOLERANCE * * * SOUS-PROGRAMMES APPELES: * ------------------------ * * ARPINI,ARPALE,ARPOPE,ARPITQ,ARPOST * * AUTEUR, DATE DE CREATION: * ------------------------- * * PASCAL BOUDA 17 JUILLET 2015 * * LANGAGE: * -------- * * FORTRAN 77 & 90 * *********************************************************************** -INC PPARAM -INC CCOPTIO -INC TARWORK COMPLEX*16 SIGMA CHARACTER*2 CHOIX LOGICAL QUAD INTEGER NVAL INTEGER IPRIGI INTEGER IPMASS INTEGER IPAMOR INTEGER LAGDUA INTEGER NK INTEGER NM LOGICAL CHOLE INTEGER IPSOLU REAL*8 EPSI INTEGER IPBUFF INTEGER ITER INTEGER IPRTRA LOGICAL OUT LOGICAL SYM LOGICAL INVER *Nombre maximal d'iteration autorise MAXITE=MIN(100*MAX(NK,NM),10000) *Initialisation de tous les paramètres ARPACK CALL ARPINI (NVAL,2*NK,.FALSE.,CHOLE,.FALSE.,.FALSE., & SIGMA,CHOIX,IPMAUP,MAXITE) *Construction des operateurs de travail CALL ARPOPE (IPRIGI,IPMASS,IPAMOR,QUAD,SIGMA,IPRTRA) *Inititalisation du vecteur residu d'arpack CALL ARPALE (IPRTRA,IPMAUP,QUAD) IF (IERR.NE.0) GOTO 999 *Boucle pour la factorisation d'Arnoldi DO ITER=1,MAXITE IF (IIMPI.GE.10) WRITE(IOIMP,*) '***ITERATION :',ITER,' ***' *Iteration CALL ARPITQ (IPRTRA,IPMAUP,SIGMA,INVER,EPSI,OUT) IF (IERR.NE.0) GOTO 999 *Sortie si convergence IF (OUT) GOTO 999 ENDDO 999 CONTINUE IF (IIMPI.GE.1) & WRITE(IOIMP,*) '*** SORTIE APRES :',ITER,' ITERATIONS ***' *Destruction des operateurs de travail (matrices principales exclues) MRITRA=IPRTRA SEGACT MRITRA*MOD DO i=4,RIGI(/1) IF (RIGI(i) .NE. 0) THEN IPBUFF=RIGI(i) CALL DTRIGI(IPBUFF) RIGI(i)=0 ENDIF ENDDO SEGDES MRITRA IF (IERR.NE.0) RETURN *Posttraitement des resultats: creation de l'objet solution CALL ARPOST (IPRTRA,LAGDUA,SIGMA,QUAD,SYM,INVER, & IPMAUP,IPSOLU,EPSI) IF (IERR.NE.0) RETURN *Suppression du segment de travail ARPACK MAUP=IPMAUP c SEGSUP MAUP END