1 : C SESPC5 SOURCE BP208322 09/03/20 21:15:24 6331 2 : * 3 : ************************************************************************ 4 : * SESPC5 5 : ************************************************************************ 6 : * FONCTION: 7 : * ON TEST LA CONVERGENCE DES ELEMENTS PROPRES Complexes: 8 : * 1./ TEST entre 2 itérés de LA VALEUR PROPRE complexe. 9 : * 2./ TEST SUR Le Residu = [A - lambda B]*X. 10 : * 11 : * AUTEUR, DATE DE CREATION: 12 : * Benoit Prabel (Novembre 2008) 13 : * 14 : ************************************************************ 15 : 16 : SUBROUTINE SESPC5 ( ILVA1R,ILVA1I, ILVA2R,ILVA2I, IPLCH2, 17 : 1 IPA,IPB, BOOL1,BOOL2, NBMOD ) 18 : 19 : IMPLICIT INTEGER(I-N) 20 : IMPLICIT REAL*8 (A-H,O-Z) 21 : 22 : -INC CCOPTIO 23 : -INC SMLREEL 24 : -INC SMLCHPO 25 : 26 : ****** 27 : * -- CONSTANTES -- 28 : *** 29 : PARAMETER ( PRECI1 = 1.0D-6 ) 30 : PARAMETER ( PRECI2 = 1.0D-6 ) 31 : 32 : ****** 33 : * -- ARGUMENTS -- 34 : *** 35 : POINTEUR ILVA1R.MLREEL,ILVA1I.MLREEL,ILVA2R.MLREEL,ILVA2I.MLREEL 36 : POINTEUR IPLCH1.MLCHPO, IPLCH2.MLCHPO 37 : INTEGER NBMOD, IPA,IPB, IPAX,IPBX 38 : LOGICAL BSWAP,BOOL1,BOOL2 39 : 40 : ****** 41 : * -- VARIABLES LOCALES -- 42 : *** 43 : INTEGER IB100 44 : REAL*8 XTMP, ALPHA1, ALPHA2, RESMAX,RESMAR,RESMAI 45 : CHARACTER*4 MOTCLE 46 : 47 : 48 : *---- ON TRIE ----------------------------------------------------- 49 : * le tri ne concerne que la liste 2 + le chpoint associé, 50 : * car on suppose la liste 1 deja ordonnée 51 : segact,ILVA2R,ILVA2I 52 : ILDIM = ILVA2R.PROG(/1) 53 : 54 : * algo type tri a bulle: pas tres efficace mais simple (cf ORDVEC.eso) 55 : 10 CONTINUE 56 : BSWAP = .FALSE. 57 : 58 : * on boucle sur toutes les valeurs de la liste 59 : DO 100 IB100=1,(ILDIM-1) 60 : 61 : * on recupere la valeur test (la ib100 ième) 62 : XR1 = ILVA2R.PROG(IB100) 63 : XI1 = ILVA2I.PROG(IB100) 64 : XM1 = ((XR1**2) + (XI1**2))**0.5 65 : XR2 = ILVA2R.PROG(IB100 + 1) 66 : XI2 = ILVA2I.PROG(IB100 + 1) 67 : XM2 = ((XR2**2) + (XI2**2))**0.5 68 : 69 : * si le module de 2 val propre est trop proche, alors on trie selon la partie réelle 70 : if( (abs (XM1 - XM2)) .lt. (1.0D-5 * XM2)) then 71 : XM1 = XR1 72 : XM2 = XR2 73 : endif 74 : 75 : * cas ou la valeur est mal placée 76 : if(XM1 .gt. XM2) then 77 : segdes,ILVA2R,ILVA2I 77 : CALL SWAP( IB100, ILVA2R, IPLCH2 ) 78 : segact,ILVA2I*mod 79 : XTMP = ILVA2I.PROG( IB100 ) 80 : ILVA2I.PROG( IB100 ) = ILVA2I.PROG( IB100 + 1 ) 81 : ILVA2I.PROG( IB100 + 1 ) = XTMP 82 : IF ( IERR .NE. 0 ) RETURN 83 : BSWAP = .TRUE. 84 : segact,ILVA2R 85 : endif 86 : 87 : 100 CONTINUE 88 : 89 : IF(BSWAP) GOTO 10 90 : 91 : 92 : 93 : *---- TESTS DE CONVERGENCE sur les NBMOD 1ers modes ---------------- 93 : CALL MOTS1 (IPLMOT,MOTCLE) 94 : BOOL1 = .true. 95 : BOOL2 = .true. 96 : JVEC = 0 97 : segact,ILVA1R,ILVA1I 98 : segact,IPLCH2 99 : 100 : DO 200 IB200 =1,NBMOD 101 : 102 : JVEC = JVEC + 1 103 : 104 : *------ CONVERGENCE DE LA VALEUR PROPRE ---------------------------- 105 : 106 : XR1 = ILVA1R.PROG(JVEC) 107 : XI1 = ILVA1I.PROG(JVEC) 108 : XR2 = ILVA2R.PROG(JVEC) 109 : XI2 = ILVA2I.PROG(JVEC) 110 : 111 : * pour l'instant on ne juge pas necessaire de tester la vitesse de cvgce de lambda 112 : * du moins pas de cette maniere qui utilise 2 itérés parfois très lointains.... 113 : goto 201 114 : 115 : * write(*,*) 'test de la val p',JVEC,':',XR1,XI1,' ?=? ',XR2,XI2, 116 : * 1 ' ecart=',(XR2-XR1),(XI2-XI1) 117 : XREFR = max(PRECI1,(abs(XR2))) 118 : XREFI = max(PRECI1,(abs(XI2))) 119 : IF( ( (abs(XR2 - XR1)) .GT. (PRECI1*XREFR) ) 120 : 1 .OR. ( (abs(XI2 - XI1)) .GT. (PRECI1*XREFI) ) ) THEN 121 : BOOL1 = .FALSE. 122 : GOTO 900 123 : ENDIF 124 : 125 : 201 CONTINUE 126 : *------ CONVERGENCE DU VECTEUR PROPRE (Residu nul) ------------------ 127 : 128 : * Cas d'un mode Réel 129 : IF(XI2 .eq. 0.D0) THEN 130 : * write(*,*) 'on va tester le vecteur reel num',JVEC 131 : IPCHP2 = IPLCH2.ICHPOI( JVEC ) 131 : CALL MUCPRI ( IPCHP2, IPA, IPAX ) 131 : CALL MUCPRI ( IPCHP2, IPB, IPBX ) 131 : CALL COMBI2 ( IPAX, 1.D0, IPBX, (-1.D0*XR2), IRES ) 131 : CALL DTCHPO (IPAX) 131 : CALL DTCHPO (IPBX) 131 : CALL MAXIM1 (IRES,IPLMOT,MOTCLE,0,RESMAX) 131 : CALL DTCHPO (IRES) 132 : RESMAX = abs (RESMAX) 133 : * write(*,*) 'mode reel JVEC,RESMAX=',JVEC,RESMAX 134 : 135 : 136 : * Cas d'un mode Complexe 137 : ELSE 138 : * write(*,*) 'on va tester le vecteur complexe num',JVEC 139 : ICHP2R = IPLCH2.ICHPOI( JVEC ) 140 : ICHP2I = IPLCH2.ICHPOI( JVEC + 1 ) 140 : CALL COMBI2 (ICHP2R,(-1.D0*XR2),ICHP2I,XI2,ICHP3R) 140 : CALL COMBI2 (ICHP2R,(-1.D0*XI2),ICHP2I,(-1.D0*XR2),ICHP3I) 140 : CALL MUCPRI ( ICHP2R, IPA, IPAXR ) 140 : CALL MUCPRI ( ICHP3R, IPB, IPBXR ) 140 : CALL DTCHPO (ICHP3R) 140 : CALL MUCPRI ( ICHP2I, IPA, IPAXI ) 140 : CALL MUCPRI ( ICHP3I, IPB, IPBXI ) 140 : CALL DTCHPO (ICHP3I) 140 : CALL COMBI2 ( IPAXR, 1.D0, IPBXR, 1.D0, IRESR ) 140 : CALL DTCHPO (IPAXR) 140 : CALL DTCHPO (IPBXR) 140 : CALL COMBI2 ( IPAXI, 1.D0, IPBXI, 1.D0, IRESI ) 140 : CALL DTCHPO (IPAXI) 140 : CALL DTCHPO (IPBXI) 140 : CALL MAXIM1 (IRESR,IPLMOT,MOTCLE,0,RESMAR) 140 : CALL DTCHPO (IRESR) 140 : CALL MAXIM1 (IRESI,IPLMOT,MOTCLE,0,RESMAI) 140 : CALL DTCHPO (IRESI) 141 : RESMAX = (abs(RESMAR)) + (abs(RESMAI)) 142 : * write(*,*) 'mode complexe JVEC,RESMAX=',JVEC,RESMAX 143 : JVEC = JVEC + 1 144 : ENDIF 145 : 146 : IF( IERR .NE. 0 ) RETURN 147 : 148 : * Test de convergence sur le residu 149 : IF(RESMAX .ge. PRECI2) then 150 : BOOL2 = .FALSE. 151 : GOTO 900 152 : ENDIF 153 : 154 : if(JVEC .ge. NBMOD) goto 900 155 : 156 : 157 : 200 CONTINUE 158 : 159 : 900 CONTINUE 160 : SEGDES ,ILVA1R,ILVA1I, ILVA2R,ILVA2I, IPLCH2 161 : * on modifie le nbmod proposé si le dernier mode est complexe 162 : * et que l'on a besoin du nbmod+1^ieme vecteur 163 : if(JVEC .gt. NBMOD) NBMOD=JVEC 164 : 165 : RETURN 166 : END 167 : 168 : 169 :
© Cast3M 2003 - All rights reserved.
Disclaimer