Esope source files

   1 : C VRFINT    SOURCE    CHAT      05/01/13    04:09:59     5004           
   2 :       SUBROUTINE VRFINT(LIMAGE)
   3 : ************************************************************************        
   4 : *                                                                               
   5 : *                             V R F I N T                                       
   6 : *                             -----------                                       
   7 : *                                                                               
   8 : * FONCTION:                                                                     
   9 : * ---------                                                                     
  10 : *                                                                               
  11 : *     VERIFIER QUE LE PARTITIONNEMENT DE L'INTERVALLE DE PULSATIONS             
  12 : *     SE FAIT BIEN.                                                             
  13 : *     (CONTEXTE: CALCUL DE FREQUENCES PROPRES DANS UN INTERVALLE DONNE)         
  14 : *                                                                               
  15 : * MODE D'APPEL:                                                                 
  16 : * -------------                                                                 
  17 : *                                                                               
  17 : *     CALL VRFINT                                                               
  18 : *                                                                               
  19 : * PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
  20 : * -----------                                                                   
  21 : *                                                                               
  22 : *     IPW2    ENTIER    (E)  POINTEUR SUR LE 'LISTREEL' REPRESENTANT LA         
  23 : *                            PARTITION DE L'INTERVALLE.                         
  24 : *     IPNUM   ENTIER    (E)  POINTEUR SUR LE 'LISTENTI' CONTENANT LES           
  25 : *                            "NOMBRES DE TERMES DIAGONAUX NEGATIFS"             
  26 : *                            ASSOCIES AU PULSATIONS AU CARRE FORMANT LA         
  27 : *                            PARTITION DE L'INTERVALLE.                         
  28 : *     NBW2    ENTIER    (E)  NOMBRE DE PULSATIONS AU CARRE FORMANT LA           
  29 : *                            PARTITION DE L'INTERVALLE.                         
  30 : *     IUN     ENTIER    (E)  = +1  SI LES PULSATIONS SONT RANGEES EN            
  31 : *                            ORDRE DECROISSANT,                                 
  32 : *                            = -1  SINON.                                       
  33 : *                                                                               
  34 : *     CES PARAMETRES SONT PASSES DANS LE COMMUN "CINTVA".                       
  35 : *                                                                               
  36 : * AUTEUR, DATE DE CREATION:                                                     
  37 : * -------------------------                                                     
  38 : *                                                                               
  39 : *     PASCAL MANIGOT     27 DECEMBRE 1984                                       
  40 : *                                                                               
  41 : * LANGAGE:                                                                      
  42 : * --------                                                                      
  43 : *                                                                               
  44 : *     ESOPE + FORTRAN77                                                         
  45 : *                                                                               
  46 : ************************************************************************        
  47 : *                                                                               
  48 :       IMPLICIT INTEGER(I-N)
  49 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
  50 : -INC CCOPTIO                                                                    
  51 : -INC SMLENTI                                                                    
  52 : -INC SMLREEL                                                                    
  53 : *                                                                               
  54 : *     REGROUPEMENT DES INFORMATIONS SUR LA SUITE DE PULSATIONS AU CARRE:        
  55 :       COMMON/CINTVA/IMULTP,IPW2,W2A,W2I,W2B,NBW2,IPNUM,NUMW2A,NUMW2I,           
  56 :      &      NUMW2B  ,IUN                                                        
  57 :       PARAMETER(UNS2PI = .159154943D0)                                          
  58 : *                                                                               
  59 :       LOGICAL LIMAGE
  60 : *
  61 :       MLREEL = IPW2                                                             
  62 :       SEGACT,MLREEL                                                             
  63 :       MLENTI = IPNUM                                                            
  64 :       SEGACT,MLENTI                                                             
  65 : *                                                                               
  66 :          WRITE (IOIMP,2000)                                                     
  67 :       IF (IUN .EQ. 1) THEN                                                      
  68 :       DO 1 I=NBW2,1,-1                                                          
  69 :       FREQQQ=SQRT(ABS(PROG(I)))*UNS2PI                                          
  70 :       IF(LIMAGE) THEN
  71 :          FREQQQ=SIGN(FREQQQ,PROG(I))
  72 :       ENDIF
  73 :       WRITE(IOIMP,2010)FREQQQ,PROG(I),LECT(I)                                   
  74 :     1 CONTINUE                                                                  
  75 :       ELSE                                                                      
  76 : *        "IUN" EST SUPPOSE VALOIR -1 .                                          
  77 :       DO 2 I=1,NBW2                                                             
  78 :       FREQQQ=SQRT(ABS(PROG(I)))*UNS2PI                                          
  79 :       IF(LIMAGE) THEN
  80 :          FREQQQ=SIGN(FREQQQ,PROG(I))
  81 :       ENDIF
  82 :       WRITE(IOIMP,2010)FREQQQ,PROG(I),LECT(I)                                   
  83 :     2 CONTINUE                                                                  
  84 :       END IF                                                                    
  85 :                                                                                 
  86 :       WRITE (IOIMP,'(//)')                                                      
  87 : *                                                                               
  88 :       SEGDES,MLREEL                                                       
  89 :       SEGDES,MLENTI                                                       
  90 : *                                                                               
  91 :  2000 FORMAT (//,1X,'  FREQUENCE   PULSATION**2 NOMBRE FREQUENCES ',            
  92 :      &'INFERIEURES',/)                                                          
  93 :  2010 FORMAT (1X,2(3X,1PE12.5),5X,I12)                                          
  94 : *                                                                               
  95 :       END                                                                       
  96 :