      PROGRAM PHIHAT                                                                                                                
C     PROGRAM PHIHAT (GSPHI,      GSPHIS,      GSTEMP,      OUTPUT,     )       J2                                                  
C    1          TAPE1=GSPHI,TAPE2=GSPHIS,TAPE3=GSTEMP,TAPE6=OUTPUT)                                                                 
C     -------------------------------------------------------------             J2                                                  
C                                                                               J2                                                  
C     MAR 04/10 - S.KHARIN,F.MAJAESS (CHANGE "RGAS" FROM 287. TO 287.04)        J2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)                                                           
C     AUG 18/94 - J. KOSHYK                                                                                                         
C                                                                               J2                                                  
CPHIHAT  - CALCULATES T ON ETA (SIGMA/HYBRID) LEVELS FROM "PHI HAT"             J1                                                  
C          ON ETA LEVELS (FOR USE WITH GCMII).                          2  1    J1                                                  
C                                                                               J3                                                  
CAUTHOR  - J. KOSHYK                                                            J3                                                  
C                                                                               J3                                                  
CPURPOSE - CALCULATES T ON ETA (SIGMA/HYBRID) LEVELS FROM "PHI HAT"             J3                                                  
C          ON ETA LEVELS.                                                       J3                                                  
C                                                                               J3                                                  
CINPUT FILES...                                                                 J3                                                  
C                                                                               J3                                                  
C      GSPHI  = SETS OF "PHI" ON ETA LEVELS, DEFINED AS                         J3                                                  
C               "PHI"=PHIS + INT(R*T*D LN ETA)  IN PAKGCMH.                     J3                                                  
C      GSPHIS = MOUNTAINS (SURFACE GEOPOTENTIAL).                               J3                                                  
C                                                                               J3                                                  
COUTPUT FILES...                                                                J3                                                  
C                                                                               J3                                                  
C      GSTEMP = ETA LEVEL TEMPERATURES.                                         J3                                                  
C---------------------------------------------------------------------                                                              
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      LOGICAL OK                                                                                                                    
                                                                                                                                    
      INTEGER LG(101), LH(100)                                                                                                      
                                                                                                                                    
      REAL    SG(101), SH(100)                                                                                                      
                                                                                                                                    
      COMMON/ICOM/IBUF(8),IDAT(18528)                                                                                               
      COMMON/JCOM/JBUF(8),JDAT(18528)                                                                                               
      COMMON/ A  / PHI(1871328)                                                                                                     
      COMMON/ B  /   T(1871328)                                                                                                     
                                                                                                                                    
      DATA RGAS / 287.04/                                                                                                           
      DATA MAXX /18528/, MAXL /1871328/, MAXLEV /100/                                                                               
C---------------------------------------------------------------------                                                              
      NFIL=4                                                                                                                        
      CALL JCLPNT(NFIL,1,2,3,6)                                                                                                     
      DO 110 N=1,3                                                                                                                  
  110 REWIND N                                                                                                                      
                                                                                                                                    
C     * GET ETA VALUES FROM PHI FILE.                                                                                               
                                                                                                                                    
      CALL FILEV (LG,NSL,IBUF,1)                                                                                                    
      IF(NSL.LT.1 .OR. NSL.GT.MAXLEV) CALL         XIT('PHIHAT ',-1)                                                                
      CALL LVDCODE(SG,LG,NSL)                                                                                                       
      DO 120 L=1,NSL                                                                                                                
         SG(L) = SG(L)*0.001E0                                                                                                      
  120 CONTINUE                                                                                                                      
      SG(NSL+1) = 1.E0                                                                                                              
      CALL WRITLEV(SG,NSL,' ETA')                                                                                                   
                                                                                                                                    
C     * CONVERT FULL TO HALF ETA LEVELS CONSISTENTLY WITH PAKGCMH.                                                                  
                                                                                                                                    
      DO 130 L=1,NSL                                                                                                                
         SH   (L)=SQRT(SG(L)*SG(L+1))                                                                                               
         LH   (L)=INT(SH(L)*1000.E0+0.5E0)                                                                                          
  130 CONTINUE                                                                                                                      
                                                                                                                                    
C     * READ MOUNTAINS AND KEEP IN JCOM.                                                                                            
                                                                                                                                    
      CALL RECGET (2,NC4TO8("GRID"),-1,NC4TO8("PHIS"),1,JBUF,MAXX,OK)                                                               
      IF(.NOT.OK) CALL                             XIT('PHIHAT ',-2)                                                                
      WRITE(6,6025) JBUF                                                                                                            
      CALL CMPLBL (0,IBUF, 0,JBUF, OK)                                                                                              
      IF(.NOT.OK) THEN                                                                                                              
         WRITE(6,6025) IBUF,JBUF                                                                                                    
         CALL                                      XIT('PHIHAT ',-3)                                                                
      ENDIF                                                                                                                         
                                                                                                                                    
C     * STOP IF THERE IS NOT ENOUGH SPACE.                                                                                          
                                                                                                                                    
      NWDS = JBUF(5)*JBUF(6)                                                                                                        
      ISP  = NSL*NWDS+1                                                                                                             
      IF((NSL+1)*NWDS.GT.MAXL) CALL                XIT('PHIHAT ',-4)                                                                
C---------------------------------------------------------------------                                                              
C     * GET NEXT SET OF GEOPOTENTIALS INTO ARRAY PHI.                                                                               
                                                                                                                                    
      NSETS=0                                                                                                                       
  150 CALL GETSET2 (1,PHI,LG,ISL,IBUF,MAXX,OK)                                                                                      
      IF(NSETS.EQ.0) WRITE(6,6025) IBUF                                                                                             
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) NSETS                                                                                                         
        CALL                                       XIT('PHIHAT ',0)                                                                 
      ENDIF                                                                                                                         
      IF(IBUF(3).NE.NC4TO8(" PHI")) CALL           XIT('PHIHAT ',-5)                                                                
      IF(ISL.NE.NSL) CALL                          XIT('PHIHAT ',-6)                                                                
      CALL CMPLBL(0,IBUF,0,JBUF,OK)                                                                                                 
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6025) IBUF,JBUF                                                                                                     
        CALL                                       XIT('PHIHAT ',-7)                                                                
      ENDIF                                                                                                                         
                                                                                                                                    
C     * TRANSFER MOUNTAINS FROM JBUF TO LEVEL NSL+1 OF PHI.                                                                         
                                                                                                                                    
      IPHIS=NSL*NWDS+1                                                                                                              
      CALL RECUP2 (PHI(IPHIS),JBUF)                                                                                                 
                                                                                                                                    
C     * COMPUTE T ON HALF LEVELS FROM "PHI" ON FULL LEVELS IN A WAY THAT                                                            
C     * RECOVERS THE CORRECT TEMPERATURES ON ETA COORDINATES.                                                                       
                                                                                                                                    
      CALL STFGZ  (T, PHI,NWDS,NSL+1,SG,RGAS)                                                                                       
                                                                                                                                    
C     * WRITE-OUT ETA LEVELS TEMP.                                                                                                  
                                                                                                                                    
      IBUF(3)=NC4TO8("TEMP")                                                                                                        
      CALL PUTSET2 (3,  T,LH,NSL,IBUF,MAXX)                                                                                         
      IF(NSETS.EQ.0) WRITE(6,6025) IBUF                                                                                             
      NSETS=NSETS+1                                                                                                                 
      GO TO 150                                                                                                                     
                                                                                                                                    
C---------------------------------------------------------------------                                                              
 6025 FORMAT(' ',A4,I10,2X,A4,I10,4I6)                                                                                              
 6030 FORMAT('0',I5,' SETS CONVERTED')                                                                                              
      END                                                                                                                           
