Sources Esope | Cast3M

intva1
C INTVA1    SOURCE    CHAT      05/01/13    00:41:42     5004
      SUBROUTINE INTVA1 (FREINF,FRESUP,IPRIGI,IPMASS,MOPTIO,NBFREQ
     &     ,IPSOLU,LIMAGE,LMULT)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
************************************************************************
*
*                             I N T V A 1
*                             -----------
*
* FONCTION:
* ---------
*
*     EFFECTUER LE TRAVAIL ATTRIBUE AU SOUS-PROGRAMME "INTVAL".
*
* MODE D'APPEL:
* -------------
*
*     CALL INTVA1 (FREINF,FRESUP,IPRIGI,IPMASS,MOPTIO,NBFREQ,IPSOLU)
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE
* -----------
*
*     FREINF  REEL DP   (E)  1ERE BORNE DE L'INTERVALLE DE FREQUENCES.
*                       (S)  BORNE INFERIEURE DE L'INTERVALLE DE
*                            FREQUENCES.
*     FRESUP  REEL DP   (E)  2EME BORNE DE L'INTERVALLE DE FREQUENCES.
*                       (S)  BORNE SUPERIEURE DE L'INTERVALLE DE
*                            FREQUENCES.
*     IPRIGI  ENTIER    (E)  POINTEUR SUR UNE 'RIGIDITE'.
*     IPMASS  ENTIER    (E)  POINTEUR SUR UNE 'RIGIDITE'.
*     MOPTIO  ENTIER    (E)  MOT-CLE INDIQUANT PAR "BASS" OU "HAUT" SI
*                            LA RECHERCHE DE FREQUENCES DOIT SE FAIRE
*                            EN COMMENCANT PAR LES PLUS BASSES OU LES
*                            PLUS HAUTES FREQUENCES PROPRES.
*     NBFREQ  ENTIER    (E)  NOMBRE MAXIMUM DE FREQUENCES PROPRES
*                            DEMANDEES.
*     IPSOLU  ENTIER    (S)  POINTEUR SUR L'OBJET 'SOLUTION' REGROUPANT
*                            LES MODES PROPRES CALCULES.
*
* LEXIQUE: (ORDRE ALPHABETIQUE)
* --------
*
*     IPW2    ENTIER    VOIR LE SOUS-PROGRAMME "INTVA2".
*     IPNUM   ENTIER    VOIR LE SOUS-PROGRAMME "INTVA2".
*     NUMW2A  ENTIER    VOIR LE SOUS-PROGRAMME "INTVA2".
*     NUMW2B  ENTIER    VOIR LE SOUS-PROGRAMME "INTVA2".
*     W2A     REEL DP   VOIR LE SOUS-PROGRAMME "INTVA2".
*     W2B     REEL DP   VOIR LE SOUS-PROGRAMME "INTVA2".
*
* SOUS-PROGRAMMES APPELES:
* ------------------------
*
*     DIAGN1, ERREUR, INTVA2, NBVALP.
*
* MODE DE FONCTIONNEMENT:
* -----------------------
*
*     1) INITIALISATION D'UNE PARTITION DE L'INTERVALLE DE FREQUENCES
*     EN SOUS-INTERVALLES: ON CREE 1 SEUL SOUS-INTERVALLE (W2A,W2B) EGAL
*     A L'INTERVALLE ENTIER.
*     2) APPEL AU SOUS-PROGRAMME "INTVA2".
*
* REMARQUES:
* ----------
*
*     AVEC L'OPTION "BASSE", LES PULSATIONS SONT RANGEES EN ORDRE
*     DECROISSANT,
*     AVEC L'OPTION "HAUTE", LES PULSATIONS SONT RANGEES EN ORDRE
*     CROISSANT,
*     POUR UNE PROGRAMMATION PLUS SIMPLE ET UN DEROULEMENT PLUS RAPIDE
*     DE LA PROCEDURE.
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     24 DECEMBRE 1984
*
* LANGAGE:
* --------
*
*     ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS.
*
************************************************************************
*
-INC CCREEL
 
-INC PPARAM
-INC CCOPTIO
-INC SMLENTI
-INC SMLREEL
*
*     REGROUPEMENT DES INFORMATIONS SUR LA SUITE DE PULSATIONS AU CARRE:
      COMMON/CINTVA/IMULTP,IPW2,W2A,W2I,W2B,NBW2,IPNUM,NUMW2A,NUMW2I,
     &     NUMW2B  ,IUN
*
*
      PARAMETER (DEUXPI = (2.D0*XPI))
*
      CHARACTER*4 MOPTIO
      LOGICAL LIMAGE,LMULT
*
*     -- VERIFICATION DES DONNEES --
*
*     SI LES BORNES DE L'INTERVALLE SONT DONNEES DANS LE DESORDRE:
      IF (FREINF .GT. FRESUP) THEN
         X = FREINF
         FREINF = FRESUP
         FRESUP = X
      END IF
*
*     SI L'OPTION DONNEE NE FIGURE PAS PARMI CELLES RECONNUES:
      IF (MOPTIO .NE. 'BASS'.AND. MOPTIO .NE.'HAUT') THEN
         MOTERR(1:4) = MOPTIO
         NUMERR = 7
         CALL ERREUR (NUMERR)
         RETURN
      END IF
*
*     -- CREATION DE LA SUITE DE PULSATIONS AU CARRE --
*
      IF (MOPTIO .EQ. 'BASS') THEN
         W2A = (FRESUP * DEUXPI) ** 2
         W2B = (FREINF * DEUXPI) ** 2
         IF(LIMAGE) THEN
            W2A = SIGN(W2A,FRESUP)
            W2B = SIGN(W2B,FREINF)
         ENDIF
         IUN = 1
      ELSE
         W2A = (FREINF * DEUXPI) ** 2
         W2B = (FRESUP * DEUXPI) ** 2
         IF(LIMAGE) THEN
            W2A = SIGN(W2A,FREINF)
            W2B = SIGN(W2B,FRESUP)
         ENDIF
         IUN = -1
      END IF
*
      JG=2
      SEGINI,MLREEL
      IPW2 = MLREEL
      PROG(1) = W2A
      PROG(2) = W2B
      SEGDES,MLREEL
      NBW2 = 2
*
      CALL NBVALP (IPRIGI,IPMASS,W2A,  NUMW2A)
      IF (IERR .NE. 0) RETURN
      CALL NBVALP (IPRIGI,IPMASS,W2B,  NUMW2B)
      IF (IERR .NE. 0) RETURN
*
      JG=2
      SEGINI,MLENTI
      IPNUM = MLENTI
      LECT(1) = NUMW2A
      LECT(2) = NUMW2B
      SEGDES,MLENTI
*
*     -- ISOLATION ET CALCUL DES PULSATIONS PROPRES --
*
***************************************************************
**    CALL DIAGN1 (IPRIGI,INF0)
**    IF (IERR .NE. 0) RETURN
***************************************************************
      INF0=0
      CALL INTVA2 (IPRIGI,IPMASS,NBFREQ,INF0,IPSOLU,LIMAGE,LMULT)
      IF (IERR .NE. 0) RETURN
*
      MLREEL = IPW2
      SEGSUP,MLREEL
      MLENTI = IPNUM
      SEGSUP,MLENTI
*
      END