      PROGRAM ZXWAVE                                                                                                                
C     PROGRAM ZXWAVE (MEAN,       AMPS,       PHASES,       INPUT,              E2                                                  
C    1                                                      OUTPUT,     )       E2                                                  
C    2          TAPE1=MEAN, TAPE2=AMPS, TAPE3=PHASES, TAPE5=INPUT,                                                                  
C    3                                                TAPE6=OUTPUT)                                                                 
C     -------------------------------------------------------------             E2                                                  
C                                                                               E2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       E2                                                  
C     FEB 15/94 - F.MAJAESS (REVISE FOR TRUNCATIONS > 99)                                                                           
C     JUL 13/92 - E. CHAN  (DIMENSION SELECTED VARIABLES AS REAL*8)                                                                 
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     MAY 14/83 - R.LAPRISE.                                                                                                        
C     OCT   /78 - S. LAMBERT                                                                                                        
C                                                                               E2                                                  
CZXWAVE  - MAKES CROSS-SECTION OF SPECTRAL AMPLITUDE AND PHASE          1  2 C  E1                                                  
C                                                                               E3                                                  
CAUTHOR  - S.LAMBERT                                                            E3                                                  
C                                                                               E3                                                  
CPURPOSE - COMPUTES CROSS-SECTIONS OF THE AMPLITUDES AND PHASES FOR A           E3                                                  
C          ZONAL WAVENUMBER DECOMPOSITION OF FIELD X.                           E3                                                  
C          NOTE - CROSS-SECTIONS ARE PRODUCED FOR WAVENUMBERS UP TO A           E3                                                  
C                 GIVEN MAX. INPUT IS SPHERICAL HARMONIC COEFFICIENTS           E3                                                  
C                 FOR NLEV PRESSURE LEVELS.                                     E3                                                  
C                 MAXIMUM DIMENSIONS:  $M$ WAVES $BJ$ LATS  $L$ LEVS.           E3                                                  
C                                                                               E3                                                  
CINPUT FILE...                                                                  E3                                                  
C                                                                               E3                                                  
C      MEAN   = GLOBAL SPECTRAL FIELDS                                          E3                                                  
C                                                                               E3                                                  
COUTPUT FILES...                                                                E3                                                  
C                                                                               E3                                                  
C      AMPS   = AMPLITUDE CROSS-SECTIONS                                        E3                                                  
C      PHASES = PHASE     CROSS-SECTIONS                                        E3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               E5                                                  
C      NLAT = NUMBER OF LATITUDES IN THE CROSS-SECTION                          E5                                                  
C      MAXW = MAXIMUM ZONAL WAVENUMBER.                                         E5                                                  
C                                                                               E5                                                  
CEXAMPLE OF INPUT CARD...                                                       E5                                                  
C                                                                               E5                                                  
C*  ZXWAVE   52    6                                                            E5                                                  
C----------------------------------------------------------------------------                                                       
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMPLEX F                                                                                                                     
      COMMON/BLANCK/F(2210)                                                                                                         
      COMMON/LCM/EPSI,ALP                                                                                                           
C                                                                                                                                   
      LOGICAL OK                                                                                                                    
      DIMENSION LEV(100)                                                                                                            
      REAL*8    S(96),W(96),SIA(96),RAD(96),WOCS(96)                                                                                
      REAL*8    EPSI(2276),ALP(2276)                                                                                                
      DIMENSION AMP(96),PHASE(96),LSR(2,66)                                                                                         
      COMMON/ICOM/IBUF(8),IDAT(4420)                                                                                                
      DATA MAXX/4420/, MAXL/100/                                                                                                    
C-----------------------------------------------------------------------                                                            
C                                                                                                                                   
      NFF=5                                                                                                                         
      CALL JCLPNT(NFF,1,2,3,5,6)                                                                                                    
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      REWIND 3                                                                                                                      
      CALL FILEV(LEV,NLEV,IBUF,1)                                                                                                   
      IF(NLEV.LT.1 .OR. NLEV.GT.MAXL) CALL         XIT('ZXWAVE',-1)                                                                 
C                                                                                                                                   
C     * READ A CARD CONTAINING ZONAL WAVENUMBER                                                                                     
C                                                                                                                                   
      READ(5,5000,END=902) NLAT,MAXW                                            E4                                                  
      MAX1=MAXW+1                                                                                                                   
      ILATH=NLAT/2                                                                                                                  
      CALL GAUSSG(ILATH,S,W,SIA,RAD,WOCS)                                                                                           
      CALL  TRIGL(ILATH,S,W,SIA,RAD,WOCS)                                                                                           
      LRLMT=IBUF(7)                                                                                                                 
      IF(LRLMT.LT.100) CALL FXLRLMT (LRLMT,IBUF(5),IBUF(6),0)                                                                       
      CALL DIMGT(LSR,LA,LR,LM,KTR,LRLMT)                                                                                            
      CALL EPSCAL(EPSI,LSR,LM)                                                                                                      
      IF(MAX1.GT.LM) MAX1=LM                                                                                                        
      DO 1500 M=1,MAX1                                                                                                              
      REWIND 1                                                                                                                      
      IF=LSR(1,M)-1                                                                                                                 
      LF=LSR(1,M+1)-2                                                                                                               
      NN=LF-IF                                                                                                                      
      IP=LSR(2,M)-1                                                                                                                 
      DO 1000 L=1,NLEV                                                                                                              
      CALL GETFLD2(1,F,NC4TO8("SPEC"),-1,-1,-1,IBUF,MAXX,OK)                                                                        
      IF(M.EQ.1) CALL PRTLAB (IBUF)                                                                                                 
      DO 1020 I=1,NLAT                                                                                                              
      CALL ALPST2(ALP,LSR,LM,S(I),EPSI)                                                                                             
      FR=0.E0                                                                                                                       
      FI=0.E0                                                                                                                       
      DO 1110 K=1,NN                                                                                                                
      FR=FR+REAL(F(K+IF))*ALP(K+IP)                                                                                                 
1110  FI=FI+ IMAG(F(K+IF))*ALP(K+IP)                                                                                                
      AMP(I)=2.E0*SQRT(FR*FR+FI*FI)                                                                                                 
      IF(M.EQ.1) AMP(I)=0.5E0*AMP(I)*SIGN(1.E0,FR)                                                                                  
      IF((FI.EQ.0.E0).AND.(FR.EQ.0.E0))THEN                                                                                         
        PHASE(I)=0.E0                                                                                                               
        GO TO 1020                                                                                                                  
      ENDIF                                                                                                                         
      PHASE(I)=57.29E0*ATAN2(-FI,FR)                                                                                                
      IF(PHASE(I).LT.0.E0) PHASE(I)=PHASE(I)+360.E0                                                                                 
      IF(M.EQ.1) PHASE(I)=0.E0                                                                                                      
1020  CONTINUE                                                                                                                      
      CALL SETLAB(IBUF,NC4TO8("ZONL"),M-1,NC4TO8(" AMP"),LEV(L),                                                                    
     +                                               NLAT,1,0,1)                                                                    
      DO 1030 K=1,ILATH                                                                                                             
1030  F(K)=CMPLX(AMP(2*K-1),AMP(2*K))                                                                                               
      CALL PUTFLD2(2,F,IBUF,MAXX)                                                                                                   
      IF(M.EQ.MAX1) CALL PRTLAB (IBUF)                                                                                              
      DO 1040 K=1,ILATH                                                                                                             
1040  F(K)=CMPLX(PHASE(2*K-1),PHASE(2*K))                                                                                           
      IBUF(3)=NC4TO8("PHSE")                                                                                                        
      CALL PUTFLD2(3,F,IBUF,MAXX)                                                                                                   
      IF(M.EQ.MAX1) CALL PRTLAB (IBUF)                                                                                              
1000  CONTINUE                                                                                                                      
1500  CONTINUE                                                                                                                      
      CALL                                         XIT('ZXWAVE',0)                                                                  
C                                                                                                                                   
C     * E.O.F. ON INPUT.                                                                                                            
C                                                                                                                                   
  902 CALL                                         XIT('ZXWAVE',-2)                                                                 
C-----------------------------------------------------------------------                                                            
 5000 FORMAT(10X,2I5)                                                           E4                                                  
      END                                                                                                                           
