C INTVA2 SOURCE CHAT 05/01/13 00:41:46 5004 SUBROUTINE INTVA2 (IPRIGI,IPMASS,NBFREQ,INF0,IPSOLU,LIMAGE,LMULT) ************************************************************************ * * I N T V A 2 * ----------- * * FONCTION: * --------- * * ISOLATION DES PULSATIONS PROPRES CONTENUES DANS UN INTERVALLE * DONNE ET CALCUL DES MODES PROPRES CORRESPONDANTS. * * MODE D'APPEL: * ------------- * * CALL INTVA2 (IPRIGI,IPMASS,NBFREQ,INF0,IPSOLU) * * PARAMETRES: (E)=ENTREE (S)=SORTIE * ----------- * * IPRIGI ENTIER (E) POINTEUR SUR UNE 'RIGIDITE'. * IPMASS ENTIER (E) POINTEUR SUR UNE 'RIGIDITE'. * NBFREQ ENTIER (E) NOMBRE MAXIMAL DE MODES PROPRES DEMANDES. * IPSOLU ENTIER (S) POINTEUR SUR LA 'SOLUTION' CONTENANT LES * MODES PROPRES. * * VOIR AUSSI LE PARAGRAPHE "COMMUN CINTVA". * * COMMUN "CINTVA": * ---------------- * * IMULTP ENTIER MIS A 1 SI INTERVALLE A DETECTE UN MODE * MULTIPLE (=0 SINON) (8 AVRIL 86) * IPW2 ENTIER POINTEUR SUR LE 'LISTREEL' REPRESENTANT LA * PARTITION DE L'INTERVALLE DE PULSATIONS AU * CARRE. * W2A REEL DP AVANT DERNIERE VALEUR DANS LE 'LISTREEL' DE * POINTEUR "IPW2". * W2B REEL DP DERNIERE VALEUR DANS LE 'LISTREEL' DE POINTEUR * "IPW2". * W2I REEL DP MILIEU DU SOUS-INTERVALLE (W2A,W2B). * NBW2 ENTIER NOMBRE DE SOUS-INTERVALLES PLUS 1 DE LA * PARTITION. * IPNUM ENTIER POINTEUR SUR LE 'LISTENTI' CONTENANT LA * COLLECTION DES NOMBRES DE PULSATIONS PROPRES AU * CARRE INFERIEURES AUX PULSATIONS AU CARRE * COLLECTEES DANS LE 'LISTREEL' DE POINTEUR * "IPW2". * NUM... ENTIER NOMBRE DE PULSATIONS PROPRES AU CARRE * INFERIEURES A ... ("..." REPRESENTANT "W2A", * "W2B" OU "W2I") A UNE CONSTANTE PRES ,DEPENDANT * DE LA 'RIGIDITE' DE POINTEUR "IPRIGI". * IUN ENTIER = +1 SI LA SUITE DE PULSATIONS DEFINISSANT LA * PARTITION DE L'INTERVALLE EST EN ORDRE * DECROISSANT, * = -1 SINON. * * A L'ENTREE DANS "INTVA2", LES VALEURS SUIVANTES DU COMMUN "CINTVA" * ONT ETE INITIALISEES OU FIXEES PAR LE PROGRAMME APPELANT: * INITIALISEES: W2A, W2B, NBW2, NUMW2A, NUMW2B. * FIXEES: IPW2, IPNUM, IUN. * * SOUS-PROGRAMMES APPELES: * ------------------------ * * DESOLU, FUSOLU, INTVA3, INTVA4, INTVA5, INTVA6, VRFINT. * * AUTEUR, DATE DE CREATION: * ------------------------- * * PASCAL MANIGOT 2 JANVIER 1985 * * LANGAGE: * -------- * * FORTRAN77 * LES ' GOTO 105 ' ONT ETE AJOUTES EN RAISON D'UNE ERREUR DE * COMPILATEUR LE 8 AVRIL 86 * ************************************************************************ * IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC CCREEL -INC PPARAM -INC CCOPTIO -INC SMSOLUT * * REGROUPEMENT DES INFORMATIONS SUR LA SUITE DE PULSATIONS AU CARRE: COMMON/CINTVA/IMULTP,IPW2,W2A,W2I,W2B,NBW2,IPNUM,NUMW2A,NUMW2I, & NUMW2B ,IUN * LOGICAL NONVID,LIMAGE,LMULT * PARAMETER (SMALL = 1.D-2 , SMALS2 = SMALL/2.D0) PARAMETER (DEUXPI = (2.D0*XPI)) * NONVID = .TRUE. IFREQ = 0 IMULTP=0 IALEAT=0 INSYM=0 IBID1=0 IBID2=0 * * /FAIRE TANT QUE .../ 105 CONTINUE IF (NONVID .AND. (IFREQ .LT. NBFREQ) ) THEN * IF (IIMPI.EQ.2) CALL VRFINT(LIMAGE) * IF (NUMW2A .EQ. NUMW2B) THEN * * ON RACCOURCIT L'INTERVALLE EN SUPPRIMANT LA PARTIE (W2A,W2B) CALL INTVA6 (NONVID) IF (IERR .NE. 0) RETURN GOTO 105 * ELSE IF (NUMW2A .EQ. (NUMW2B + IUN) & .OR. ABS( (W2A-W2B) / (W2A+W2B) ) .LT. SMALS2) THEN * IF (NUMW2A .NE. (NUMW2B + IUN) ) THEN IF (.NOT.LMULT) THEN IF (IIMPI.EQ.2) WRITE (IOIMP,2000) SMALL,W2A,W2B 2000 FORMAT (//,' ***** ATTENTION: MODES PROPRES DE MEME ' & ,'PULSATION OU DE PULSATIONS AU CARRE VOISINES '/ & ,' ***** A MOINS DE ',1PE8.1,' (ECART RELATIF)' & ,' DANS L''INTERVALLE (',1PE12.5,',',1PE12.5,').'/ & ,' ***** ON NE RECHERCHE QU''UN SEUL MODE DANS CET' & ,' INTERVALLE.'///) IMULTP=1 ENDIF END IF * * RECHERCHE DE MODE PROPRE: ********************************************************************** * * -- RECHERCHE DES MODES PROPRES MULTIPLES MISE EN PLACE * LE 29/08/94 . -- * ********************************************************************** NBMOD = NUMW2A - NUMW2B IF ( (NBMOD .EQ. 1) .OR. ( .NOT. LMULT ) ) THEN ****** * -- AVANT L'AJOUT DES MODES MULTIPLES -- *** CALL INTVA3 (IPRIGI,IPMASS,INF0,IPMODE,IALEAT,LIMAGE) ELSE ****** * -- APRES L'AJOUT DES MODES MULTIPLES -- *** W2 = ( W2A + W2B ) / 2.D0 FREQ = SQRT( ABS(W2) ) / DEUXPI FREQ = SIGN( FREQ, W2 ) CALL PROCH3(FREQ,NBMOD,IPRIGI,IPMASS,INF0,IPMODE,LIMAGE $ , INSYM,IBID1,IBID2) ENDIF ****** * -- FIN DE LA MODIFICATION -- *** IMULTP=0 IF (IERR .NE. 0) RETURN IFREQ = IFREQ + 1 * * AJOUT DU MODE A L'ENSEMBLE DES MODES: IF (IFREQ .EQ. 1) THEN IPSOLU = IPMODE ELSE CALL FUSOLU (IPSOLU,IPMODE, IPSOL1) IF (IERR .NE. 0) RETURN CALL DESOLU (IPMODE) CALL DESOLU (IPSOLU) IPSOLU = IPSOL1 END IF * * ON RACCOURCIT L'INTERVALLE EN SUPPRIMANT LA PARTIE (W2A,W2B) CALL INTVA6 (NONVID) IF (IERR .NE. 0) RETURN GOTO 105 * ELSE IF ( (IUN*(NUMW2A -NUMW2B) ) .GT. 0) THEN * W2I = (W2A + W2B) / 2.D0 CALL NBVALP (IPRIGI,IPMASS,W2I, NUMW2I) IF (IERR .NE. 0) RETURN * IF (NUMW2I .EQ. NUMW2B) THEN * ON RACCOURCIT L'INTERVALLE EN REMPLACANT "W2B" PAR "W2I": CALL INTVA5 IF (IERR .NE. 0) RETURN ELSE * ON INSERE "W2I" AVANT "W2B" DANS LA PARTITION: CALL INTVA4 IF (IERR .NE. 0) RETURN END IF * ELSE * NUMERR = 185 CALL ERREUR (NUMERR) RETURN * END IF * GOTO 105 END IF * /FIN FAIRE/ * IF(IALEAT.NE.0) CALL DTCHPO(IALEAT) IF(IFREQ.EQ.0) THEN NIPO=0 SEGINI MSOLUT ITYSOL='MODE ' SEGDES MSOLUT IPSOLU=MSOLUT ENDIF END