1 : C INTVA1 SOURCE CHAT 05/01/13 00:41:42 5004 2 : SUBROUTINE INTVA1 (FREINF,FRESUP,IPRIGI,IPMASS,MOPTIO,NBFREQ 3 : & ,IPSOLU,LIMAGE,LMULT) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : ************************************************************************ 7 : * 8 : * I N T V A 1 9 : * ----------- 10 : * 11 : * FONCTION: 12 : * --------- 13 : * 14 : * EFFECTUER LE TRAVAIL ATTRIBUE AU SOUS-PROGRAMME "INTVAL". 15 : * 16 : * MODE D'APPEL: 17 : * ------------- 18 : * 18 : * CALL INTVA1 (FREINF,FRESUP,IPRIGI,IPMASS,MOPTIO,NBFREQ,IPSOLU) 19 : * 20 : * PARAMETRES: (E)=ENTREE (S)=SORTIE 21 : * ----------- 22 : * 23 : * FREINF REEL DP (E) 1ERE BORNE DE L'INTERVALLE DE FREQUENCES. 24 : * (S) BORNE INFERIEURE DE L'INTERVALLE DE 25 : * FREQUENCES. 26 : * FRESUP REEL DP (E) 2EME BORNE DE L'INTERVALLE DE FREQUENCES. 27 : * (S) BORNE SUPERIEURE DE L'INTERVALLE DE 28 : * FREQUENCES. 29 : * IPRIGI ENTIER (E) POINTEUR SUR UNE 'RIGIDITE'. 30 : * IPMASS ENTIER (E) POINTEUR SUR UNE 'RIGIDITE'. 31 : * MOPTIO ENTIER (E) MOT-CLE INDIQUANT PAR "BASS" OU "HAUT" SI 32 : * LA RECHERCHE DE FREQUENCES DOIT SE FAIRE 33 : * EN COMMENCANT PAR LES PLUS BASSES OU LES 34 : * PLUS HAUTES FREQUENCES PROPRES. 35 : * NBFREQ ENTIER (E) NOMBRE MAXIMUM DE FREQUENCES PROPRES 36 : * DEMANDEES. 37 : * IPSOLU ENTIER (S) POINTEUR SUR L'OBJET 'SOLUTION' REGROUPANT 38 : * LES MODES PROPRES CALCULES. 39 : * 40 : * LEXIQUE: (ORDRE ALPHABETIQUE) 41 : * -------- 42 : * 43 : * IPW2 ENTIER VOIR LE SOUS-PROGRAMME "INTVA2". 44 : * IPNUM ENTIER VOIR LE SOUS-PROGRAMME "INTVA2". 45 : * NUMW2A ENTIER VOIR LE SOUS-PROGRAMME "INTVA2". 46 : * NUMW2B ENTIER VOIR LE SOUS-PROGRAMME "INTVA2". 47 : * W2A REEL DP VOIR LE SOUS-PROGRAMME "INTVA2". 48 : * W2B REEL DP VOIR LE SOUS-PROGRAMME "INTVA2". 49 : * 50 : * SOUS-PROGRAMMES APPELES: 51 : * ------------------------ 52 : * 53 : * DIAGN1, ERREUR, INTVA2, NBVALP. 54 : * 55 : * MODE DE FONCTIONNEMENT: 56 : * ----------------------- 57 : * 58 : * 1) INITIALISATION D'UNE PARTITION DE L'INTERVALLE DE FREQUENCES 59 : * EN SOUS-INTERVALLES: ON CREE 1 SEUL SOUS-INTERVALLE (W2A,W2B) EGAL 60 : * A L'INTERVALLE ENTIER. 61 : * 2) APPEL AU SOUS-PROGRAMME "INTVA2". 62 : * 63 : * REMARQUES: 64 : * ---------- 65 : * 66 : * AVEC L'OPTION "BASSE", LES PULSATIONS SONT RANGEES EN ORDRE 67 : * DECROISSANT, 68 : * AVEC L'OPTION "HAUTE", LES PULSATIONS SONT RANGEES EN ORDRE 69 : * CROISSANT, 70 : * POUR UNE PROGRAMMATION PLUS SIMPLE ET UN DEROULEMENT PLUS RAPIDE 71 : * DE LA PROCEDURE. 72 : * 73 : * AUTEUR, DATE DE CREATION: 74 : * ------------------------- 75 : * 76 : * PASCAL MANIGOT 24 DECEMBRE 1984 77 : * 78 : * LANGAGE: 79 : * -------- 80 : * 81 : * ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS. 82 : * 83 : ************************************************************************ 84 : * 85 : -INC CCREEL 86 : -INC CCOPTIO 87 : -INC SMLENTI 88 : -INC SMLREEL 89 : * 90 : * REGROUPEMENT DES INFORMATIONS SUR LA SUITE DE PULSATIONS AU CARRE: 91 : COMMON/CINTVA/IMULTP,IPW2,W2A,W2I,W2B,NBW2,IPNUM,NUMW2A,NUMW2I, 92 : & NUMW2B ,IUN 93 : * 94 : * 95 : PARAMETER (DEUXPI = (2.D0*XPI)) 96 : * 97 : CHARACTER*4 MOPTIO 98 : LOGICAL LIMAGE,LMULT 99 : * 100 : * -- VERIFICATION DES DONNEES -- 101 : * 102 : * SI LES BORNES DE L'INTERVALLE SONT DONNEES DANS LE DESORDRE: 103 : IF (FREINF .GT. FRESUP) THEN 104 : X = FREINF 105 : FREINF = FRESUP 106 : FRESUP = X 107 : END IF 108 : * 109 : * SI L'OPTION DONNEE NE FIGURE PAS PARMI CELLES RECONNUES: 110 : IF (MOPTIO .NE. 'BASS'.AND. MOPTIO .NE.'HAUT') THEN 111 : MOTERR(1:4) = MOPTIO 112 : NUMERR = 7 112 : CALL ERREUR (NUMERR) 113 : RETURN 114 : END IF 115 : * 116 : * -- CREATION DE LA SUITE DE PULSATIONS AU CARRE -- 117 : * 118 : IF (MOPTIO .EQ. 'BASS') THEN 119 : W2A = (FRESUP * DEUXPI) ** 2 120 : W2B = (FREINF * DEUXPI) ** 2 121 : IF(LIMAGE) THEN 122 : W2A = SIGN(W2A,FRESUP) 123 : W2B = SIGN(W2B,FREINF) 124 : ENDIF 125 : IUN = 1 126 : ELSE 127 : W2A = (FREINF * DEUXPI) ** 2 128 : W2B = (FRESUP * DEUXPI) ** 2 129 : IF(LIMAGE) THEN 130 : W2A = SIGN(W2A,FREINF) 131 : W2B = SIGN(W2B,FRESUP) 132 : ENDIF 133 : IUN = -1 134 : END IF 135 : * 136 : JG=2 137 : SEGINI,MLREEL 138 : IPW2 = MLREEL 139 : PROG(1) = W2A 140 : PROG(2) = W2B 141 : SEGDES,MLREEL 142 : NBW2 = 2 143 : * 143 : CALL NBVALP (IPRIGI,IPMASS,W2A, NUMW2A) 144 : IF (IERR .NE. 0) RETURN 144 : CALL NBVALP (IPRIGI,IPMASS,W2B, NUMW2B) 145 : IF (IERR .NE. 0) RETURN 146 : * 147 : JG=2 148 : SEGINI,MLENTI 149 : IPNUM = MLENTI 150 : LECT(1) = NUMW2A 151 : LECT(2) = NUMW2B 152 : SEGDES,MLENTI 153 : * 154 : * -- ISOLATION ET CALCUL DES PULSATIONS PROPRES -- 155 : * 156 : *************************************************************** 156 : ** CALL DIAGN1 (IPRIGI,INF0) 157 : ** IF (IERR .NE. 0) RETURN 158 : *************************************************************** 159 : INF0=0 159 : CALL INTVA2 (IPRIGI,IPMASS,NBFREQ,INF0,IPSOLU,LIMAGE,LMULT) 160 : IF (IERR .NE. 0) RETURN 161 : * 162 : MLREEL = IPW2 163 : SEGSUP,MLREEL 164 : MLENTI = IPNUM 165 : SEGSUP,MLENTI 166 : * 167 : END 168 : 169 : 170 : 171 : 172 :
© Cast3M 2003 - All rights reserved.
Disclaimer