1 : C INTVA3 SOURCE BP208322 09/03/24 21:15:00 6341 2 : SUBROUTINE INTVA3 (IPRIGI,IPMASS,INF0,IPMODE,IALEAT,LIMAGE) 3 : ************************************************************************ 4 : * 5 : * I N T V A 3 6 : * ----------- 7 : * 8 : * FONCTION: 9 : * --------- 10 : * 11 : * RECHERCHE D'UN MODE PROPRE. 12 : * 13 : * MODE D'APPEL: 14 : * ------------- 15 : * 15 : * CALL INTVA3 (IPRIGI,IPMASS,INF0,IPMODE) 16 : * 17 : * PARAMETRES: (E)=ENTREE (S)=SORTIE 18 : * ----------- 19 : * 20 : * IPRIGI ENTIER (E) POINTEUR DE L'OBJET 'RIGIDITE' CONTENANT 21 : * LA MATRICE DE RIGIDITE. 22 : * IPMASS ENTIER (E) POINTEUR DE L'OBJET 'RIGIDITE' CONTENANT 23 : * LA MATRICE MASSE. 24 : * INF0 ENTIER (E) NOMBRE DE TERMES DIAGONAUX NEGATIFS DE LA 25 : * 'RIGIDITE' "K" DECOMPOSEE EN L.D.LT . 26 : * CE NOMBRE N'EST PAS NUL A CAUSE DE LA FACON 27 : * DONT SONT INTRODUITS LES BLOCAGES DES 28 : * D.D.L. (MULTIPLICATEURS DE LAGRANGE "LX"). 29 : * IPMODE ENTIER (S) POINTEUR DE L'OBJET 'SOLUTION' CONTENANT 30 : * LE MODE PROPRE TROUVE. 31 : * +W2A REEL DP (E) 1ERE BORNE DE L'INTERVALLE ENCADRANT LA 32 : * PULSATION PROPRE AU CARRE. 33 : * +W2B REEL DP (E) 2EME BORNE DE L'INTERVALLE ENCADRANT LA 34 : * PULSATION PROPRE AU CARRE. 35 : * 36 : * + = PARAMETRE PASSE DANS LE COMMUN "CINTVA". 37 : * 38 : * LEXIQUE: (ORDRE ALPHABETIQUE) 39 : * -------- 40 : * 41 : * CONVRG LOGIQUE VOIR LE SOUS-PROGRAMME "ITINV". 42 : * FREQPP REEL DP FREQUENCE PROPRE CALCULEE. 43 : * IPKW2M ENTIER POINTEUR DE LA 'RIGIDITE' "DECALEE" K - W2.M 44 : * IPVECP ENTIER POINTEUR DU 'CHPOINT' QUI CONTIENT DES NOMBRES 45 : * ALEATOIRES, PUIS UN VECTEUR PROPRE. 46 : * ITERMX ENTIER VOIR LE SOUS-PROGRAMME "ITINV". 47 : * JREPET ENTIER NOMBRE DE FOIS QUE L'ON EFFECTUE UNE SEQUENCE 48 : * D'ITERATIONS INVERSES, AU MAXIMUM. 49 : * NUMACC ENTIER VOIR LE SOUS-PROGRAMME "ITINV". 50 : * OMEGA2 REEL DP PULSATION PROPRE TROUVEE AU CARRE. 51 : * PRECI1 REEL SP VOIR LE SOUS-PROGRAMME "ITINV". 52 : * PRECI2 REEL SP VOIR LE SOUS-PROGRAMME "ITINV". 53 : * PROPRE REEL DP VOIR LE SOUS-PROGRAMME "ITINV". 54 : * W2 REEL DP PULSATION AU CARRE A APPROCHER. 55 : * 56 : * MODE DE FONCTIONNEMENT: 57 : * ----------------------- 58 : * 59 : * LE CALCUL D'UN VECTEUR PROPRE SE FAIT PAR LA METHODE DES 60 : * ITERATIONS INVERSES (DITE AUSSI DE LA PUISSANCE INVERSE), AVEC 61 : * DECALAGE INITIAL ("SHIFTING") ET AJUSTEMENT DU DECALAGE TOUTES 62 : * LES "ITERMX" ITERATIONS. 63 : * DANS LE CAS DE MODES MULTIPLES, IL EST INUTILE DE FAIRE TOUTES 64 : * LES ITERATIONS PUISQU'ON CONNAIT LA FREQUENCE ET QU'ON RISQUE 65 : * D'ITERER SUR DES COMBINAISONS LINEAIRES DES MODES MULTIPLES. 66 : * 67 : * 68 : * SOUS-PROGRAMMES APPELES: 69 : * ------------------------ 70 : * 71 : * ALEAT1, CREMOD, DECALE, DIAGN1, DTRIGI, ECCHPO, ECMODE, ITINV, 72 : * W2FREQ. 73 : * 74 : * AUTEUR, DATE DE CREATION: 75 : * ------------------------- 76 : * 77 : * PASCAL MANIGOT 24 DECEMBRE 1984 78 : * 79 : * LANGAGE: 80 : * -------- 81 : * 82 : * FORTRAN77 83 : * 84 : ************************************************************************ 85 : * 86 : IMPLICIT INTEGER(I-N) 87 : IMPLICIT REAL*8 (A-H,O-Z) 88 : -INC CCREEL 89 : -INC CCOPTIO 90 : * 91 : * REGROUPEMENT DES INFORMATIONS SUR LA SUITE DE PULSATIONS AU CARRE: 92 : COMMON/CINTVA/IMULTP,IPW2,W2A,W2I,W2B,NBW2,IPNUM,NUMW2A,NUMW2I, 93 : & NUMW2B ,IUN 94 : * 95 : LOGICAL CONVRG,LIMAGE 96 : * 97 : PARAMETER (LPROPR = 5) 98 : * 99 : REAL*8 PROPRE(LPROPR),DEUXPI 100 : * 101 : PARAMETER (JREPET = 4) 102 : PARAMETER (ITERMX = 30) 103 : PARAMETER (PRECI1 = 1.D-5) 104 : PARAMETER (PRECI2 = 1.D-5) 105 : PARAMETER (DEUXPI = (2.D0*XPI)) 106 : PARAMETER (NUMACC = 5) 107 : * 108 : * 109 : W2AA = W2A 110 : W2BB = W2B 111 : * 112 : IF(IMULTP.EQ.1) THEN 113 : JREPE1=1 114 : ITRMX1=10 115 : ELSE 116 : JREPE1=JREPET 117 : ITRMX1=ITERMX 118 : ENDIF 119 : * 120 : * 121 : DO 100 IB100=1,JREPE1 122 : ***************************************************** 123 : IF(IIMPI.EQ.30) WRITE(IOIMP,1000) IB100,JREPE1,ITRMX1,IMULTP 124 : 1000 FORMAT(/10X,'SBR INTVA3 IB100,JREPE1,ITRMX1,IMULTP', 125 : C 4(I5,1X)) 126 : ***************************************************** 127 : * 128 : * -- CREATION DE (K-W2M) -- 129 : * 130 : W2 = (W2AA + W2BB) / 2.D0 131 : IF (IIMPI .EQ. 30) THEN 132 : FREQ = SQRT(W2) / DEUXPI 133 : WRITE (IOIMP,2010) W2,FREQ 134 : 2010 FORMAT (//,' DECALAGE DE LA MATRICE DE RIGIDITE ', 135 : & 'CORRESPONDANT A LA PULSATION AU CARRE ',1PE12.5, 136 : & ' (FREQUENCE: ',1PE12.5,').'///) 137 : END IF 137 : CALL DECALE (IPRIGI,IPMASS,W2, IPKW2M) 138 : IF (IERR .NE. 0) RETURN 139 : * 140 : * -- INITIALISATION DES ITERATIONS: CREATION D'UN 'CHPOINT' 141 : * ALEATOIRE -- 142 : * 143 : IF (IB100 .EQ. 1) THEN 143 : IF (IALEAT.EQ.0) CALL ALEAT1 (IPKW2M,IALEAT) 143 : CALL COPIE2(IALEAT,IPVECP) 144 : * 145 : * CALCUL DE M*X 146 : * 146 : CALL MUCPRI(IPVECP,IPMASS,IPM1) 147 : IF (IERR .NE. 0) RETURN 148 : * 149 : END IF 150 : * 151 : * DUPLIQUER IPMX QUI EST DETRUIT DANS ITINV 152 : * 152 : CALL ECRCHA('GEOM') 152 : CALL ECROBJ('CHPOINT ',IPM1) 152 : CALL COPIER 153 : IF(IERR.NE.0) RETURN 154 : ICODE=1 154 : CALL LIROBJ('CHPOINT ',IPMX,ICODE,IRETOU) 155 : IF(IERR.NE.0) RETURN 156 : 157 : * 158 : * -- RESOLUTION PAR ITERATIONS INVERSES -- 159 : * 159 : CALL ITINV (IPKW2M,IPMASS,IPVECP,PROPRE,CONVRG,ITRMX1,NUMACC 160 : & ,PRECI1,PRECI2,IPMX) 161 : IF (IERR .NE. 0) RETURN 162 : IF (CONVRG) THEN 163 : * --> SORTIE DE BOUCLE N.100 164 : GOTO 102 165 : ELSE IF (IB100 .LT. JREPE1) THEN 166 : ** MESSAGE POUR ANNONCER QUE L'ON DEPASSE "ITRMX1" ITERATIONS 167 : ** ?????????????????????????????????????????????????????????? 167 : CALL DIAGN1 (IPKW2M, NUMW2) 168 : IF (IERR .NE. 0) RETURN 169 : * AJUSTEMENT DU DECALAGE: 170 : IF (NUMW2 .EQ. NUMW2A) THEN 171 : W2AA = W2 172 : ELSE 173 : * RQ: NUMW2 VAUT NUMW2B 174 : W2BB = W2 175 : END IF 175 : CALL DTRIGI (IPKW2M) 176 : END IF 177 : * 178 : 100 CONTINUE 179 : * END DO 180 : 102 CONTINUE 180 : * CALL DTCHPO(IPM1) 181 : * 182 : IF (.NOT.CONVRG) THEN 183 : INTERR(1) = ITRMX1 * JREPE1 184 : NUMERR = 151 184 : CALL ERREUR (NUMERR) 185 : END IF 186 : * 187 : * -- FREQUENCE PROPRE -- 188 : * 188 : CALL W2FREQ (PROPRE(1),W2, OMEGA2,FREQPP,LIMAGE) 189 : IF (IERR .NE. 0) RETURN 190 : PROPRE(1) = FREQPP 191 : * 192 : IF (IIMPI .EQ. 747) THEN 193 : WRITE (IOIMP,*) 'FREQUENCE PROPRE CALCULEE = ',FREQPP 194 : WRITE (IOIMP,*) '-------------------------' 195 : WRITE (IOIMP,*) 'CHPOINT PROPRE:' 195 : CALL ECCHPO (IPVECP,0) 196 : END IF 197 : * 198 : * RQ: LE MODE PROPRE CORRESPOND AU COUPLE (FREQPP,IPVECP), 199 : * "IPVECP" ETANT UN POINTEUR SUR UN SEGMENT DE 'CHPOINT'. 200 : * 201 : * -- CREATION DE L'OBJET REPRESENTANT LE MODE -- 202 : * 203 : FREQ = SQRT(ABS(W2)) / DEUXPI 204 : IF(LIMAGE) THEN 205 : FREQ = SIGN (FREQ,W2) 206 : ENDIF 207 : NUMOD2 = 0 207 : c CALL CREMOD (PROPRE,IPVECP,IPKW2M,INF0,FREQ,NUMOD2,IPMODE) 207 : CALL CREMOD (PROPRE,IPVECP,IPKW2M,INF0,NUMOD2,IPMODE) 208 : IF (IERR .NE. 0) RETURN 209 : * 210 : * IMPRESSION DU MODE( ON N'IMPRIME PAS LE CHPOINT) 211 : IF (IIMPI.EQ.2) THEN 212 : WRITE (IOIMP,2000) 213 : 2000 FORMAT ('1MODE PROPRE CALCULE:'/' --------------------'//) 213 : CALL ECMODE (IPMODE) 214 : ENDIF 215 : * 216 : * -- SUPPRESSION DES OBJETS DE TRAVAIL -- 217 : * 217 : CALL DTRIGI (IPKW2M) 218 : * 219 : END 220 : 221 : 222 : 223 : 224 : 225 : 226 :
© Cast3M 2003 - All rights reserved.
Disclaimer