      PROGRAM ZXGAM                                                                                                                 
C     PROGRAM ZXGAM (ZXIN,       ZXOUT,       INPUT,       OUTPUT,      )       F2                                                  
C    1         TAPE1=ZXIN, TAPE2=ZXOUT, TAPE5=INPUT, TAPE6=OUTPUT)                                                                  
C     ------------------------------------------------------------              F2                                                  
C                                                                               F2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       F2                                                  
C     JAN 15/93 - E. CHAN  (DECODE LEVELS IN 8-WORD LABEL)                                                                          
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     NOV 06/80 - J.D.HENDERSON                                                                                                     
C                                                                               F2                                                  
CZXGAM   - CROSS-SECTION GAMMA CALCULATION  GAM=K/(-P*DT/DP+KT)         1  1   GF1                                                  
C                                                                               F3                                                  
CAUTHOR  - J.D.HENDERSON                                                        F3                                                  
C                                                                               F3                                                  
CPURPOSE - READS ONE CROSS-SECTION OF TEMPERATURE FROM FILE ZXIN,               F3                                                  
C          CALCULATES GAMMA FOR EACH LEVEL USING:                               F3                                                  
C                 GAMMA = K/(-P*DT/DP + K*T)                                    F3                                                  
C          WHERE,                                                               F3                                                  
C                 K=RGAS/CP,  T=MERIDIONAL MEAN TEMPERATURE                     F3                                                  
C          AND PUTS THE RESULT ON FILE ZXOUT.                                   F3                                                  
C          NOTE - MAX LATITUDES IS $BJ$, MAX LEVELS IS $L$.                     F3                                                  
C                                                                               F3                                                  
CINPUT FILE...                                                                  F3                                                  
C                                                                               F3                                                  
C      ZXIN  = ONE TEMPERATURE CROSS-SECTION                                    F3                                                  
C                                                                               F3                                                  
COUTPUT FILE...                                                                 F3                                                  
C                                                                               F3                                                  
C      ZXOUT = GAMMA CROSS-SECTION                                              F3                                                  
C-----------------------------------------------------------------------------                                                      
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMMON/XS/ T(181,100),GM(181,100)                                                                                             
C                                                                                                                                   
      LOGICAL OK                                                                                                                    
      INTEGER LEV(100)                                                                                                              
      REAL PR(100)                                                                                                                  
      REAL TML(100),DTDP(100),GAM(100)                                                                                              
      REAL F(181)                                                                                                                   
      REAL*8 SL(181),CL(181),WL(181),WOSSL(181),RAD(181)                                                                            
C                                                                                                                                   
      COMMON/ICOM/IBUF(8),IDAT(181)                                                                                                 
      DATA MAXX/181/, MAXL/100/, MAXJ/181/                                                                                          
C---------------------------------------------------------------------                                                              
      NFF=3                                                                                                                         
      CALL JCLPNT(NFF,1,2,6)                                                                                                        
      PIH=3.14159265E0/2.E0                                                                                                         
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
C                                                                                                                                   
C     * READ THE CROSS-SECTION. STOP IF THE FILE IS EMPTY.                                                                          
C     * LEV WILL CONTAIN THE PRESSURE LEVEL VALUES IN MILLIBARS.                                                                    
C                                                                                                                                   
      CALL GETZX2(1, T,MAXJ,LEV,NLEV,IBUF,MAXX,OK)                                                                                  
      IF(.NOT.OK) CALL                             XIT('ZXGAM',-1)                                                                  
      WRITE(6,6025) IBUF                                                                                                            
      IF((NLEV.LT.1).OR.(NLEV.GT.MAXL)) CALL       XIT('ZXGAM',-2)                                                                  
      NLAT=IBUF(5)                                                                                                                  
C                                                                                                                                   
C     * SET PR TO THE PRESSURE IN N/M**2.                                                                                           
C                                                                                                                                   
      CALL LVDCODE(PR,LEV,NLEV)                                                                                                     
      DO 120 L=1,NLEV                                                                                                               
  120 PR(L)=PR(L)*100.E0                                                                                                            
C                                                                                                                                   
C     * GAUSSG COMPUTES THE VALUE OF THE GAUSSIAN LATITUDES AND THEIR                                                               
C     * SINES AND COSINES. TRIGL MAKES THEM GLOBAL (S TO N).                                                                        
C                                                                                                                                   
      ILATH=NLAT/2                                                                                                                  
      CALL GAUSSG(ILATH,SL,WL,CL,RAD,WOSSL)                                                                                         
      CALL  TRIGL(ILATH,SL,WL,CL,RAD,WOSSL)                                                                                         
C                                                                                                                                   
C     * INTEGRATE IN LATITUDE TO COMPUTE THE MEAN AT EACH LEVEL.                                                                    
C                                                                                                                                   
      DO 280 L=1,NLEV                                                                                                               
      DO 240 J=1,NLAT                                                                                                               
  240 F(J)= T(J,L)* CL(J)                                                                                                           
      VAL=F(1)*(RAD(1)-(-PIH))                                                                                                      
      DO 250 J=2,NLAT                                                                                                               
  250 VAL=VAL+0.5E0*(F(J)+F(J-1))*(RAD(J)-RAD(J-1))                                                                                 
      VAL=VAL+F(NLAT)*(PIH-RAD(NLAT))                                                                                               
      FMEAN=VAL*0.5E0                                                                                                               
      TML(L)=FMEAN                                                                                                                  
  280 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * COMPUTE DT/DP AND THEN GAMMA FOR EACH LEVEL.                                                                                
C                                                                                                                                   
      ROCP=2.E0/7.E0                                                                                                                
      NLEVM=NLEV-1                                                                                                                  
      DTDP(1)=(TML(2)-TML(1))/(PR(2)-PR(1))                                                                                         
      DO 320 L=2,NLEVM                                                                                                              
  320 DTDP(L)=(TML(L+1)-TML(L-1))/(PR(L+1)-PR(L-1))                                                                                 
      DTDP(NLEV)=(TML(NLEV)-TML(NLEVM))/(PR(NLEV)-PR(NLEVM))                                                                        
C                                                                                                                                   
C     * COMPUTE GAMMA .                                                                                                             
C                                                                                                                                   
      DO 360 L=1,NLEV                                                                                                               
  360 GAM(L)=    ROCP/(-PR(L)*DTDP(L)+ROCP*TML(L))                                                                                  
C                                                                                                                                   
C     * PUT GAMMA INTO ALL POINTS OF THE CROSS-SECTION.                                                                             
C                                                                                                                                   
      DO 380 L=1,NLEV                                                                                                               
      DO 380 J=1,NLAT                                                                                                               
  380 GM(J,L)=GAM(L)                                                                                                                
C                                                                                                                                   
C     * PUT THE RESULT ON FILE ZXOUT.                                                                                               
C                                                                                                                                   
      DO 440 L=1,NLEV                                                                                                               
      IBUF(3)=NC4TO8("GAMA")                                                                                                        
      IBUF(4)=LEV(L)                                                                                                                
      CALL PUTFLD2(2,GM(1,L),IBUF,MAXX)                                                                                             
      WRITE(6,6025) IBUF                                                                                                            
  440 CONTINUE                                                                                                                      
C                                                                                                                                   
      CALL                                         XIT('ZXGAM',0)                                                                   
C---------------------------------------------------------------------                                                              
 6025 FORMAT(' ',A4,I10,1X,A4,I10,4I6)                                                                                              
      END                                                                                                                           
