Sources Esope | Cast3M

vrfint
C VRFINT    SOURCE    CHAT      05/01/13    04:09:59     5004
      SUBROUTINE VRFINT(LIMAGE)
************************************************************************
*
*                             V R F I N T
*                             -----------
*
* FONCTION:
* ---------
*
*     VERIFIER QUE LE PARTITIONNEMENT DE L'INTERVALLE DE PULSATIONS
*     SE FAIT BIEN.
*     (CONTEXTE: CALCUL DE FREQUENCES PROPRES DANS UN INTERVALLE DONNE)
*
* MODE D'APPEL:
* -------------
*
*     CALL VRFINT
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE
* -----------
*
*     IPW2    ENTIER    (E)  POINTEUR SUR LE 'LISTREEL' REPRESENTANT LA
*                            PARTITION DE L'INTERVALLE.
*     IPNUM   ENTIER    (E)  POINTEUR SUR LE 'LISTENTI' CONTENANT LES
*                            "NOMBRES DE TERMES DIAGONAUX NEGATIFS"
*                            ASSOCIES AU PULSATIONS AU CARRE FORMANT LA
*                            PARTITION DE L'INTERVALLE.
*     NBW2    ENTIER    (E)  NOMBRE DE PULSATIONS AU CARRE FORMANT LA
*                            PARTITION DE L'INTERVALLE.
*     IUN     ENTIER    (E)  = +1  SI LES PULSATIONS SONT RANGEES EN
*                            ORDRE DECROISSANT,
*                            = -1  SINON.
*
*     CES PARAMETRES SONT PASSES DANS LE COMMUN "CINTVA".
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     27 DECEMBRE 1984
*
* LANGAGE:
* --------
*
*     ESOPE + FORTRAN77
*
************************************************************************
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-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(UNS2PI = .159154943D0)
*
      LOGICAL LIMAGE
*
      MLREEL = IPW2
      SEGACT,MLREEL
      MLENTI = IPNUM
      SEGACT,MLENTI
*
         WRITE (IOIMP,2000)
      IF (IUN .EQ. 1) THEN
      DO 1 I=NBW2,1,-1
      FREQQQ=SQRT(ABS(PROG(I)))*UNS2PI
      IF(LIMAGE) THEN
         FREQQQ=SIGN(FREQQQ,PROG(I))
      ENDIF
      WRITE(IOIMP,2010)FREQQQ,PROG(I),LECT(I)
    1 CONTINUE
      ELSE
*        "IUN" EST SUPPOSE VALOIR -1 .
      DO 2 I=1,NBW2
      FREQQQ=SQRT(ABS(PROG(I)))*UNS2PI
      IF(LIMAGE) THEN
         FREQQQ=SIGN(FREQQQ,PROG(I))
      ENDIF
      WRITE(IOIMP,2010)FREQQQ,PROG(I),LECT(I)
    2 CONTINUE
      END IF
 
      WRITE (IOIMP,'(//)')
*
      SEGDES,MLREEL
      SEGDES,MLENTI
*
 2000 FORMAT (//,1X,'  FREQUENCE   PULSATION**2 NOMBRE FREQUENCES ',
     &'INFERIEURES',/)
 2010 FORMAT (1X,2(3X,1PE12.5),5X,I12)
*
      END