      PROGRAM ZXMAKE                                                                                                                
C     PROGRAM ZXMAKE (FC,       ZX,       INPUT,       OUTPUT,          )       E2                                                  
C    1          TAPE1=FC, TAPE2=ZX, TAPE5=INPUT, TAPE6=OUTPUT)                                                                      
C     --------------------------------------------------------                  E2                                                  
C                                                                               E2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       E2                                                  
C     NOV 06/95 - F.MAJAESS (REVISE DEFAULT PACKING DENSITY VALUE)                                                                  
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     MAY 14/83 - R.LAPRISE.                                                                                                        
C     JAN   /81 - S. LAMBERT                                                                                                        
C                                                                               E2                                                  
CZXMAKE  - CONVERTS WAVE-LAT FOURIER COEFF TO CROSS-SECTION             1  1   GE1                                                  
C                                                                               E3                                                  
CAUTHOR  - S.LAMBERT                                                            E3                                                  
C                                                                               E3                                                  
CPURPOSE - CONVERTS A MULTI-LEVEL WAVENUMBER-LATITUDE ARRAY OF FOURIER          E3                                                  
C          COEFFICIENTS INTO CROSS-SECTIONS.  ONE CROSS-SECTION IS              E3                                                  
C          PRODUCED FOR EACH WAVENUMBER CONTAINED IN THE INPUT FILE.            E3                                                  
C                                                                               E3                                                  
CINPUT FILE...                                                                  E3                                                  
C                                                                               E3                                                  
C      FC = ONE MULTI-LEVEL WAVENUMBER-LATITUDE ARRAY OF FOURIER                E3                                                  
C           COEFFICIENTS.                                                       E3                                                  
C                                                                               E3                                                  
COUTPUT FILE...                                                                 E3                                                  
C                                                                               E3                                                  
C      ZX = ONE CROSS SECTION FOR EACH WAVENUMBER IN FC.                        E3                                                  
C------------------------------------------------------------------------------                                                     
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMPLEX F                                                                                                                     
      LOGICAL OK                                                                                                                    
      COMMON/LCM/F(633600),G(193)                                                                                                   
      DIMENSION LEV(100)                                                                                                            
      COMMON/BUFCOM/IBUF(8),IDAT(12672)                                                                                             
      DATA MAXX,MAX2,MAXL/12672,193,100/                                                                                            
C-----------------------------------------------------------------------                                                            
      NFF=3                                                                                                                         
      CALL JCLPNT(NFF,1,2,6)                                                                                                        
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      CALL FILEV(LEV,NLEV,IBUF,1)                                                                                                   
      IF((NLEV.LT.1).OR.(NLEV.GT.MAXL)) CALL       XIT('ZXMAKE',-1)                                                                 
      REWIND 1                                                                                                                      
      LM=IBUF(5)                                                                                                                    
      NLAT=IBUF(6)                                                                                                                  
      NWDS=LM*NLAT                                                                                                                  
      NZXS=0                                                                                                                        
50    DO 100 L=1,NLEV                                                                                                               
      N=(L-1)*NWDS+1                                                                                                                
      CALL GETFLD2(1,F(N),NC4TO8("FOUR"),-1,-1,-1,IBUF,MAXX,OK)                                                                     
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6020) NZXS                                                                                                          
        CALL                                       XIT('ZXMAKE',0)                                                                  
      ENDIF                                                                                                                         
      IF(NZXS.EQ.0) THEN                                                                                                            
       NPACK=MIN(2,IBUF(8))                                                                                                         
      ENDIF                                                                                                                         
100   CONTINUE                                                                                                                      
      DO 150 M=1,LM                                                                                                                 
      DO 200 L=1,NLEV                                                                                                               
      DO 250 K=1,NLAT                                                                                                               
      J=(L-1)*NWDS+(K-1)*LM+M                                                                                                       
      G(K)=2.E0*SQRT(REAL(F(J))*REAL(F(J))+ IMAG(F(J))* IMAG(F(J)))                                                                 
250   IF(M.EQ.1.OR.IBUF(3).EQ.NC4TO8("FCOV").OR.                                                                                    
     +             IBUF(3).EQ.NC4TO8("TRIP")    ) G(K)=REAL(F(J))                                                                   
      CALL SETLAB(IBUF,NC4TO8("ZONL"),M-1,IBUF(3),LEV(L),NLAT,1,0,NPACK)                                                            
      CALL PUTFLD2(2,G,IBUF,MAX2)                                                                                                   
200   CONTINUE                                                                                                                      
      NZXS=NZXS+1                                                                                                                   
150   CONTINUE                                                                                                                      
      GO TO 50                                                                                                                      
C-----------------------------------------------------------------------                                                            
6020  FORMAT('0',I5,'  CROSS-SECTION(S) MADE')                                                                                      
      END                                                                                                                           
