home *** CD-ROM | disk | FTP | other *** search
/ ftptest.leeds.ac.uk / 2015.02.ftptest.leeds.ac.uk.tar / ftptest.leeds.ac.uk / pub / leeds / obsqc1.f < prev   
Text File  |  1997-05-30  |  26KB  |  395 lines
  1. C OBSQC2.FORT ***** VERSION: 12/87 **************************                   
  2. c  modified 8/17/89 by C. Ebinger for use on Vax
  3. c  modified 11-7-90 by C. Ebinger to work on Sun
  4. C  CALCULATES OBSERVED ADMITTANCE "Q" AND COHERENCE "C"                         
  5. C  USING THE EQUATIONS OF BOWIN AND MCKENZIE (1976).                            
  6. C  THE ERRORS FOR THE ADMITTANCE "DQ" AND COHERENCE "DC"                        
  7. C  ARE CALCULATED FROM BENDAT AND PIERSOL (1980).                               
  8. C  NOTE- "C" CORRESPONDS TO GAMMA SQUARED IN THE NOTATION                       
  9. C  USED IN THE ABOVE PUBLICATIONS.                                              
  10. C                                                                               
  11. C  CROSS AND POWER SPECTRA "CS","TPS" AND "GPS" ARE                             
  12. C  AVERAGED OVER ANNULI WITH LOG SPACING IN THE WAVENUMBER                      
  13. C  PLANE.  THE ANNULI ARE BOUNDED BY THE VALUES OF "K2D"                        
  14. C  IN THE "ANNBD" ARRAY. "NA" IS THE NUMBER OF AMPLITUDES IN                    
  15. C  EACH ANNULUS.                                                                
  16. C                                                                               
  17. C  NOTE- "N1" IN THIS PROGRAM CORRESPONDS TO "NN2" IN THE                       
  18. C  PROGRAM FFT.FORT.                                                            
  19. C                                                                               
  20. C  THIS PROGRAM ALSO HAS THE OPTION OF COMPUTING 1/Q**-1 TO CHECK               
  21. C  THE CONSISTENCY OF TOP LOADING IN THE MANNER OF FORSYTH (1985).              
  22. C                                                                               
  23. C  INPUT FILES: KTOPO*.DAT (DEVICE 1)                                          
  24. C               KGRAV*.DAT (DEVICE 2)    FROM FFT3a.FOR                  
  25. C                                                                               
  26. C  OUTPUT FILE: OBSCOH.DAT (DEVICE 3)                                          
  27. C                                                                               
  28. C  IF ORIGINAL DATA WAS MIRRORED IN FFT.FOR IT MIGHT                           
  29. C  BE A GOOD IDEA TO MAKE THE FIRST ANNULUS BOUNDARY                            
  30. C  CORRESPOND TO THE LENGTH OF THE ORIGINAL (UNMIRRORED)                        
  31. C  DATA.                                                                        
  32. C  
  33. C  modified 16-5-91 by C. Ebinger to output correlation coefficient
  34. c  for surface and subsurface loads.  Input ibload and itload as 
  35. C  ktopo and kgrav files. Standard errors dc computed using erfc.
  36. C
  37. C  THE WAVENUMBER RANGE FOR PLOTTING IS 0.001 1/KM - 0.2 1/KM.                  
  38. C******************** MAIN PROGRAM ***********************                      
  39.       IMPLICIT REAL (K)                                                         
  40.       COMMON/DATA/N1,N2,DL(2),GAMP(800,800),TAMP(800,800),IPLOT,IWHT            
  41.       COMMON/WAVE/K2D(800,800),ANNBD(31),PI                                     
  42.       COMMON/SPEC/TPS(30),GPS(30),CS(30),NC ,SPG(30)         
  43.       COMMON/AVRG/C(30),DC(30),KC(30),CWGHT(30),NA(30),Q(30),DQ(30)             
  44.       common/corr/top(30),bot1(30),bot2(30),top1(30),top2(30),
  45.      #   dcor(30),cor(30),ncor(30)
  46. C
  47.       PI=3.14159265358                                                          
  48.       WRITE(6,*) ' '                                                            
  49.       WRITE(6,*) 'CALCULATION OF OBSERVED ADMITTANCE AND COHERENCE'             
  50.       WRITE(6,*) 'FROM TOPOGRAPHY AND GRAVITY SPECTRAL AMPLITUDES -'            
  51.       WRITE(6,*) 'TWO LAYER MODEL'                                              
  52.       WRITE(6,*) ' '                                                            
  53. c      WRITE(6,*) 'DO YOU WISH TO CALCULATE THE ADMITTANCE AND'                 
  54. c      WRITE(6,*) 'COHERENCE (0) OR TEST FOR THE CONSISTENCY OF'                
  55. c      WRITE(6,*) 'TOP LOADING BY CALCULATING THE ADMITTANCE TWO'              
  56. c      WRITE(6,*) 'INDEPENDENT WAYS (1)?'                                     
  57. c      READ(5,*) IWHT                                            
  58.       IWHT = 0               
  59.       CALL INPUT                                                                
  60.       CALL TWODK                                                                
  61.  20   WRITE(6,*) 'ENTER NUMBER OF WAVEBANDS OVER WHICH TO'                      
  62.       WRITE(6,*) 'AVERAGE THE COHERENCE (30 MAX): '                             
  63.       READ(5,*) NC                                                              
  64.       IF(NC.GT.30) NC=30                                                        
  65.       CALL ANNBDS                                                               
  66.  30   CALL INIT (III)                                                           
  67.       CALL AVSPEC                                                               
  68.       CALL correl
  69.       CALL DELANN (III)                                                         
  70.       GOTO (30,40),III                                                          
  71.  40   CALL COHERE                                                               
  72.       CALL OUTPUT                                                               
  73.       CALL REPT (III)                                                           
  74.       GOTO (20,999),III                                                         
  75.  999  END                                                                       
  76. C                                                                               
  77. C ----------------------------------------------------------------------------------
  78.       SUBROUTINE INPUT                                                          
  79.       COMMON/DATA/N1,N2,DL(2),GAMP(800,800),TAMP(800,800),IPLOT,IWHT            
  80. c
  81.       character*12 filetin, filegin,fileout,fspect
  82.       print *, 'enter input ktopo filename(output from fft)'
  83.       read *, filetin
  84.       print *, 'enter input kgrav filename(output from fft)'
  85.       read *, filegin
  86.       open (unit=2, file=filegin, status='old')
  87.       open(unit=1, file=filetin, status='old')
  88.       READ(1,100) IDENTT,ILON0T,ILAT0T,SDELTT,THETAT                            
  89.       READ(1,110) N2,N1,DL(2),DL(1)                                             
  90.       DO 10 I=1,N1                                                              
  91.  10   READ (1,120) (TAMP(I,J),J=1,N2)
  92. c 10   write (*,120) (TAMP(I,J),J=1,N2)
  93.       READ(2,100) IDENTG,ILON0G,ILAT0G,SDELTG,THETAG                            
  94.       READ(2,110) NN2,NN1,D2,D1                                                 
  95.       IF((NN2.NE.N2).OR.(NN1.NE.N1).OR.(D2.NE.DL(2)).OR.(D1.NE.DL(1))           
  96.      +.OR.(ILAT0T.NE.ILAT0G).OR.(ILON0T.NE.ILON0G)                              
  97.      +.OR.(SDELTT.NE.SDELTG)) THEN                 
  98.       WRITE(6,*) 'TOPO AND GRAVITY FILES DO NOT CORRESPOND. '                   
  99.       STOP                                                                      
  100.       END IF                                                                    
  101.       DO 20 I=1,N1                                                              
  102.  20   READ (2,120) (GAMP(I,J),J=1,N2)                                           
  103.       WRITE(6,50)                                                               
  104.       WRITE(6,51)                                                               
  105.  50   FORMAT(' IDENT, IDENTG, ILON0, ILAT0, SPACING (KM), AZIMUTH,',            
  106.      #' (+CCW N)')                                                              
  107.  51   FORMAT(' NPTS EW, NPTS NS, LENGTH EW (KM), LENGTH NS (KM)')               
  108.       WRITE(6,*) '      '                                                       
  109.       WRITE(6,*) IDENTT,IDENTG,ILON0G,ILAT0G,SDELTG,THETAG                    
  110.       WRITE(6,*) NN2,NN1,D2,D1                                                
  111.       WRITE(6,*) '      '                                                       
  112.       WRITE(6,*) 'INPUT COMPLETE. '                                             
  113.       WRITE(6,*) 'TOPOGRAPHY AND GRAVITY FILES CORRESPOND.'                     
  114.       WRITE(6,*) '      '                                                       
  115.       WRITE(6,*) 'ENTER 1 TO SAVE OBSERVED COHERENCE FOR PLOTTING'              
  116.       WRITE(6,*) '      2 TO SAVE OBSERVED ADMITTANCE FOR PLOTTING'             
  117.       WRITE(6,*) '      3 IF NO DATA IS TO BE SAVED'                            
  118.       READ(5,*) IPLOT                                                           
  119.        IF (IPLOT.EQ.1.OR.IPLOT.EQ.2) THEN
  120.        PRINT *, ' ENTER OUTPUT FILENAME'
  121.        READ(5,*) FILEOUT
  122.        OPEN ( UNIT=3, FILE=FILEOUT, STATUS= 'NEW')
  123.        ENDIF
  124.        print *,'fichier spectre?'
  125.        read(5,*) fspect
  126.        open(unit =10,file =fspect,status ='new')
  127. C-----------------------                                                        
  128.  100   FORMAT(3I5,2G12.6)                                                      
  129.  105   FORMAT(4I5,2G12.6)                                                      
  130.  110   FORMAT(2I5,2G12.6)                                                      
  131.  115   FORMAT(4G12.6)                                                          
  132.  120   FORMAT(6G12.6)                                                          
  133.       RETURN                                                                    
  134.       END                                                                       
  135. C                                                                               
  136. C -----------------------------------------------------------------------------------
  137.       SUBROUTINE INIT (III)                                                     
  138.       IMPLICIT REAL (K)    
  139.       real spg                                                     
  140.       COMMON/SPEC/TPS(30),GPS(30),CS(30),NC,SPG(30)       
  141.       COMMON/AVRG/C(30),DC(30),KC(30),CWGHT(30),NA(30),Q(30),DQ(30)             
  142.       common/corr/top(30),bot1(30),bot2(30),top1(30),top2(30),dcor(30),
  143.      #    cor(30),ncor(30)
  144.       DO 10 I=1,NC                                                              
  145.       CS(I)=0.0                                                                 
  146.       Q(I)=0.0                                                                  
  147.       TPS(I)=0.0                                                                
  148.       GPS(I)=0.0                                                                
  149.       NA(I)=0.0                                                                 
  150.       KC(I)=0.0                                                                 
  151.       ncor(i)=0.0
  152.       top(i)=0.0
  153.       top1(i)=0.0
  154.       top2(i)=0.0
  155.       bot1(i)=0.0
  156.       bot2(i)=0.0
  157.       cor(i)=0.0
  158.       dcor(i)=0.0
  159.  10   CWGHT(I)=0.0                                                              
  160.       III=2                                                                     
  161.       RETURN                                                                    
  162.       END                                                                       
  163. C
  164. C ---------------------------------------------------------------------------- 
  165.       SUBROUTINE TWODK                                                          
  166.       IMPLICIT REAL (K)                                                         
  167.       COMMON/DATA/N1,N2,DL(2),GAMP(800,800),TAMP(800,800),IPLOT,IWHT            
  168.       COMMON/WAVE/K2D(800,800),ANNBD(31),PI                                     
  169.       K2D(1,1)=0.0                                                              
  170.       DO 10 I=2,N1/2+1                                                          
  171.  10   K2D(I,1)=2*PI*(I-1)/DL(1)                                                 
  172.       DO 20 J=2,N2/2+1                                                          
  173.  20   K2D(1,J)=2*PI*(J-1)/DL(2)                                                 
  174.       DO 30 I=2,N1/2+1                                                          
  175.       DO 30 J=2,N2/2+1                                                          
  176.  30   K2D(I,J)=SQRT(K2D(1,J)**2+K2D(I,1)**2)                                    
  177.       RETURN                                                                    
  178.       END                                                                       
  179. C 
  180. C ------------------------------------------------------------------------------ 
  181.       SUBROUTINE ANNBDS                                                         
  182.       IMPLICIT REAL (K) 
  183.       real spg                                                        
  184.       COMMON/DATA/N1,N2,DL(2),GAMP(800,800),TAMP(800,800),IPLOT,IWHT            
  185.       COMMON/WAVE/K2D(800,800),ANNBD(31),PI                                     
  186.       COMMON/SPEC/TPS(30),GPS(30),CS(30),NC,SPG(30)    
  187.       X1=LOG10(AMIN1(K2D(1,2),K2D(2,1)))                                        
  188.       X2=LOG10(K2D(N1/2+1,N2/2+1))                                              
  189.       Y=(X2-X1)/NC                                                              
  190.       DO 10 I=1,NC+1                                                            
  191.  10   ANNBD(I)=10.0**(X1+Y*(I-1))                                               
  192.       RETURN                                                                    
  193.       END                                                                       
  194. C                                                                               
  195. C --------------------------------------------------------------------------------
  196.       SUBROUTINE AVSPEC                                                         
  197.       IMPLICIT REAL (K)  
  198.       real spg                                                       
  199.       COMMON/DATA/N1,N2,DL(2),GAMP(800,800),TAMP(800,800),IPLOT,IWHT            
  200.       COMMON/WAVE/K2D(800,800),ANNBD(31),PI                                     
  201.       COMMON/SPEC/TPS(30),GPS(30),CS(30),NC,SPG(30) 
  202.       COMMON/AVRG/C(30),DC(30),KC(30),CWGHT(30),NA(30),Q(30),DQ(30)             
  203.       DO 10 I=1,N1/2+1                                                          
  204.       DO 10 J=1,N2/2+1                                                          
  205.       DO 10 L=1,NC                                                              
  206.       IF((K2D(I,J).GE.ANNBD(L)).AND.(K2D(I,J).LE.ANNBD(L+1))) THEN              
  207.       CS(L)=CS(L)+(GAMP(I,J)*TAMP(I,J))                                         
  208.       TPS(L)=TPS(L)+(TAMP(I,J)*TAMP(I,J))                                       
  209.       GPS(L)=GPS(L)+(GAMP(I,J)*GAMP(I,J))                                       
  210.  
  211.       NA(L)=NA(L)+1                                                             
  212.       KC(L)=KC(L)+(K2D(I,J)*TAMP(I,J)*TAMP(I,J)*GAMP(I,J)*GAMP(I,J))            
  213.       CWGHT(L)=CWGHT(L)+(TAMP(I,J)*TAMP(I,J)*GAMP(I,J)*GAMP(I,J))               
  214.       END IF                                                                    
  215.  10   CONTINUE                                                                  
  216.       RETURN                                                                    
  217.       END                                                                       
  218. C
  219. C ---------------------------------------------------------------------------
  220.       subroutine correl
  221. C...  correlation coefficient plus standard errors (erfc)
  222. C
  223.       IMPLICIT REAL (K)  
  224.       COMMON/DATA/N1,N2,DL(2),GAMP(800,800),TAMP(800,800),IPLOT,IWHT            
  225.       COMMON/WAVE/K2D(800,800),ANNBD(31),PI                                     
  226.       COMMON/SPEC/TPS(30),GPS(30),CS(30),NC,SPG(30)
  227.       COMMON/AVRG/C(30),DC(30),KC(30),CWGHT(30),NA(30),Q(30),DQ(30)
  228.  
  229.       common/corr/top(30),bot1(30),bot2(30),top1(30),top2(30),
  230.      #    dcor(30),cor(30),ncor(30)
  231. C
  232.       DO 10 I=1,N1/2+1                                                          
  233.       DO 10 J=1,N2/2+1                                                          
  234.       DO 10 L=1,NC                                                              
  235.       IF((K2D(I,J).GE.ANNBD(L)).AND.(K2D(I,J).LE.ANNBD(L+1))) THEN  
  236.       top1(L)=top1(L)+(TAMP(I,J))                                       
  237.       top2(L)=top2(L)+(GAMP(I,J))                                       
  238.       NCOR(L)=NCOR(L)+1 
  239.       endif
  240.  10   continue
  241.       do 20 l=1, NC
  242.       top1(l)= top1(l)/NCOR(l)
  243.       top2(l)= top2(l)/NCOR(l)
  244.  20   continue
  245.       DO 30 I=1,N1/2+1                                                          
  246.       DO 30 J=1,N2/2+1 
  247.       do 30 L=1,NC
  248.       IF((K2D(I,J).GE.ANNBD(L)).AND.(K2D(I,J).LE.ANNBD(L+1))) THEN 
  249.       top(l)=top(l)+((TAMP(i,j)-top1(l))*(GAMP(i,j)-top2(l)))
  250.       bot1(l)=bot1(l)+(TAMP(i,j)-top1(l))**2
  251.       bot2(l)=bot2(l)+(GAMP(i,j)-top2(l))**2
  252.       endif
  253.  30   continue
  254.       return 
  255.       end
  256. C                                                                               
  257. C ------------------------------------------------------------------------------ 
  258.       SUBROUTINE DELANN (III)                                                   
  259.       IMPLICIT REAL (K)                                                       
  260.       real spg
  261.       COMMON/DATA/N1,N2,DL(2),GAMP(800,800),TAMP(800,800),IPLOT,IWHT            
  262.       COMMON/WAVE/K2D(800,800),ANNBD(31),PI                                     
  263.       COMMON/SPEC/TPS(30),GPS(30),CS(30),NC,SPG(30)
  264.       COMMON/AVRG/C(30),DC(30),KC(30),CWGHT(30),NA(30),Q(30),DQ(30)
  265.       NNC=NC                                                                    
  266.       I=0                                                                       
  267.  10   I=I+1                                                                     
  268.  20   IF(I.GT.NNC) GOTO 40                                                      
  269.       IF(NA(I).LT.2) THEN                                                       
  270.       III=1                                                                     
  271.       NNC=NNC-1                                                                 
  272.       DO 30 II=I,NNC                                                            
  273.       NA(II)=NA(II+1)                                                           
  274.  30   ANNBD(II)=ANNBD(II+1)                                                     
  275.       ANNBD(NNC+1)=ANNBD(NNC+2)                                                 
  276.       ELSE                                                                      
  277.       GOTO 10                                                                   
  278.       END IF                                                                    
  279.       GOTO 20                                                                   
  280.  40   NC=NNC                                                                    
  281.       RETURN                                                                    
  282.       END                                                                       
  283. C 
  284. C ------------------------------------------------------------------------------ 
  285.       SUBROUTINE COHERE                                                       
  286.       IMPLICIT REAL (K)                     
  287.       real spg
  288.       COMMON/DATA/N1,N2,DL(2),GAMP(800,800),TAMP(800,800),IPLOT,IWHT            
  289.       COMMON/WAVE/K2D(800,800),ANNBD(31),PI                                     
  290.       COMMON/SPEC/TPS(30),GPS(30),CS(30),NC ,SPG(30)        
  291.       COMMON/AVRG/C(30),DC(30),KC(30),CWGHT(30),NA(30),Q(30),DQ(30)             
  292.       common/corr/top(30),bot1(30),bot2(30),top1(30),top2(30),
  293.      #    dcor(30),cor(30),ncor(30)
  294.       DO 10 I=1,NC                                                              
  295.       KC(I)=KC(I)/CWGHT(I)                                                      
  296.       CS(I)=CS(I)/(2*NA(I))                                                     
  297.       TPS(I)=TPS(I)/(2*NA(I))                                                   
  298.       GPS(I)=GPS(I)/(2*NA(I))
  299.       SPG(I) = log(GPS(I))
  300.       CB=(CS(I)*CS(I))/(TPS(I)*GPS(I))                                          
  301.       IF (IWHT.EQ.0) THEN                                                       
  302. C...  OBSERVED COHERENCE                                                        
  303.       C(I)=(NA(I)*CB-1.0)/(NA(I)-1) 
  304.       DC(I)=ABS(CB*(SQRT(2.0/NA(I))*(1.0-CB)/SQRT(CB)))                         
  305.       cor(i) = top(i)/(SQRT(bot1(i)*bot2(i)))
  306.       dcor(i) = abs(cor(i)*sqrt(2.*NA(i))/SQRT(2.0))
  307. c      print *, cor(i)
  308.       T = 1./(1. + 0.5*(dcor(i)))
  309.       dcor(i) = T*exp(-dcor(i)*dcor(i)-1.26551223+T*(1.00002368+
  310.      #  T*(0.37409196+T*(0.09678418+T*(0.27886807+T*(-1.13520398+T*
  311.      #  (1.48851587+T*(-0.82215223+T*0.17087277))))))))
  312.       IF(C(I).LT.0.0) DC(I)=ABS(C(I))+0.02                                      
  313.       DC(I)=AMAX1(DC(I),0.03)                                                   
  314.       ELSEIF (IWHT.EQ.1) THEN                                                   
  315. C...  OBSERVED ADMITTANCE FROM 1/Q**-1                                          
  316.       C(I)=1.0/(CS(I)/GPS(I))                                                   
  317.       DC(I)=ABS(C(I)*(SQRT((1.0/CB-1.0)/(2.0*NA(I)))))                          
  318.       ENDIF                                                                     
  319. C...  STANDARD OBSERVED ADMITTANCE                                              
  320.       Q(I)=CS(I)/TPS(I)                                                         
  321.       DQ(I)=ABS(Q(I)*(SQRT((1.0/CB-1.0)/(2.0*NA(I)))))                          
  322.  10   CONTINUE                                                                  
  323.       RETURN        
  324.       END                                                                       
  325. C  
  326. C ------------------------------------------------------------------------------ 
  327.       SUBROUTINE OUTPUT       
  328.       IMPLICIT REAL (K)   
  329.       real SPG
  330.       COMMON/DATA/N1,N2,DL(2),GAMP(800,800),TAMP(800,800),IPLOT,IWHT            
  331.       COMMON/WAVE/K2D(800,800),ANNBD(31),PI                                     
  332.       COMMON/SPEC/TPS(30),GPS(30),CS(30),NC,SPG(30)
  333.       COMMON/AVRG/C(30),DC(30),KC(30),CWGHT(30),NA(30),Q(30),DQ(30)     
  334.       common/corr/top(30),bot1(30),bot2(30),top1(30),top2(30),
  335.      #    dcor(30),cor(30),ncor(30)
  336.       WRITE(6,20)                                                               
  337.       IF (IWHT.EQ.0) THEN                                                       
  338.       WRITE(6,*) 'OBSERVED COHERENCE AND ADMITTANCE '                           
  339.       WRITE(6,15)                                                               
  340.       WRITE(6,*) 'K(1/KM)    WVL(KM)   OBS.COH  ',                   
  341.      +'                        STD.ERR.C    OBS.ADM    STD.ERR.A   NPTS' 
  342.       write(3,*) ' WVL(km)     COPLUS       COMOIN  '
  343.       ELSEIF (IWHT.EQ.1) THEN                                                   
  344.       WRITE(6,*) 'TEST CONSISTENCY OF TOP LOADING MODEL FROM ADMITTANCE'        
  345.       WRITE(6,15)                                                               
  346.       WRITE(6,*) 'K(1/KM)    WVL(KM)   1/Q**-1',                                
  347.      +'    STD ERR A    STD ADM    STD ERR A   NPTS'                            
  348.       ENDIF                                                                     
  349.       DO 10 I=1,NC                                                              
  350.       WVL=2*PI/KC(I) 
  351. C...  Pour calculer comoins(cmo) et coplus(cpl)  
  352.       cmo = c(i) - dc(i)
  353.       cpl = c(i) + dc(i)                                                          
  354.        WRITE(6,23) KC(I),WVL,C(I),DC(I),Q(I),DQ(I),NA(I) 
  355. C...  TO SAVE OBSERVED COHERENCES                                               
  356.       IF (IPLOT.EQ.1) THEN
  357. C      WRITE(3,24) KC(I),WVL, C(I),CPL,CMO
  358.       WRITE(3,26) WVL,CPL,CMO
  359. c      write(10,27) kc(i),wvl,spg(i)
  360. C      WRITE(3,25) KC(I),C(I),DC(I),Q(I),cor(i),dcor(i)      
  361. C...  TO SAVE OBSERVED ADMITTANCES                                              
  362.       ELSEIF (IPLOT.EQ.2) THEN                                                  
  363.       WRITE(3,25) KC(I),Q(I),DQ(I),C(I)                                         
  364.       ENDIF
  365.       write(10,27) kc(i),wvl,spg(i)
  366.  10   CONTINUE                                                                  
  367.       WRITE(6,20)                                                               
  368.       WRITE(6,15)                                                               
  369.       IF (IPLOT.EQ.1.OR.IPLOT.EQ.2) THEN                                        
  370.       STOP                                                                      
  371.       ENDIF                                                                     
  372.  15   FORMAT('     ')                                                           
  373.  20    FORMAT('--------------------------------------------------',             
  374.      +'------------------------')                                              
  375.  23    FORMAT(1X,G9.3,2X,G9.3,1X,G9.3,2X,G9.3,3X,G9.3,3X,G9.3,1X,I5)
  376.  24    FORMAT(1X,G9.3,2X,G9.3,1X,G9.3,2X,G9.3,3X,G9.3)            
  377.  25    FORMAT(G12.6,1X,G12.6,1X,G12.6,1X,G12.6,G12.6,G12.6)
  378.  26    FORMAT(1X,G11.5,2X,G11.5,3X,G11.5)            
  379.  27    FORMAT(2(G11.5,2X),G11.5)
  380.       RETURN 
  381.       END                                                                       
  382. C 
  383. C ------------------------------------------------------------------------------ 
  384.       SUBROUTINE REPT (III) 
  385.       WRITE(6,*) 'ENTER 1 TO CHANGE NUMBER OF ANNULI FOR AVERAGING'
  386.       WRITE(6,*) '      2 TO QUIT' 
  387.       READ(5,*)  III 
  388.       RETURN
  389.       END
  390.  
  391.                                                                                                                                          
  392.                                                                      
  393.  
  394.  
  395.