      PROGRAM GSMSLP                                                                                                                
C     PROGRAM GSMSLP (GSTEMP,       GLNSP,       GPHIS,       GPMSL,            J2                                                  
C    1                                           INPUT,       OUTPUT,   )       J2                                                  
C    2          TAPE1=GSTEMP, TAPE2=GLNSP, TAPE3=GPHIS, TAPE4=GPMSL,                                                                
C    3                                     TAPE5=INPUT, TAPE6=OUTPUT)                                                               
C     ---------------------------------------------------------------           J2                                                  
C                                                                               J2                                                  
C     MAR 04/10 - S.KHARIN,F.MAJAESS (CHANGE "RGAS" FROM 287. TO 287.04,        J2                                                  
C                                     AND    "GRAV" FROM 9.8  TO 9.80616)       J2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)                                                           
C     JAN 12/93 - E. CHAN  (DECODE LEVELS IN 8-WORD LABEL)                                                                          
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     MAY 12/83 - R.LAPRISE.                                                                                                        
C     MAY 06/81 - R.LAPRISE.                                                                                                        
C                                                                               J2                                                  
CGSMSLP  - COMPUTES MEAN-SEA-LEVEL PRESSURE FROM SIGMA T, LNSP, PHIS    3  1 C  J1                                                  
C                                                                               J3                                                  
CAUTHOR  - R.LAPRISE                                                            J3                                                  
C                                                                               J3                                                  
CPURPOSE - FROM A SERIES OF SIGMA LEVEL TEMPERATURES (=GSTEMP) AND              J3                                                  
C          LN(PS) (=GLNSP), COMPUTE  A  SERIES  OF  MEAN-SEA-LEVEL              J3                                                  
C          PRESSURES (=GPMSL), USING THE MOUNTAIN FIELD PHIS (=GPHIS).          J3                                                  
C                                                                               J3                                                  
CINPUT FILES...                                                                 J3                                                  
C                                                                               J3                                                  
C      GSTEMP = SIGMA LEVEL GRID SETS OF TEMPERATURE (DEG K).                   J3                                                  
C      GSLNSP = CORRESPONDING GRIDS OF LN(SF.PRES.)                             J3                                                  
C      GPHIS  = GRID OF SURFACE GEOPOTENTIAL.                                   J3                                                  
C                                                                               J3                                                  
COUTPUT FILE...                                                                 J3                                                  
C                                                                               J3                                                  
C      GPMSL  = MEAN-SEA-LEVEL PRESSURE GRIDS.                                  J3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               J5                                                  
C      GAM    = LOW LEVEL LAPSE RATE                                            J5                                                  
C      NLVLUP = LEVEL NUMBER OF THE TEMPERATURE FIELD USED                      J5                                                  
C                                                                               J5                                                  
CEXAMPLE OF INPUT CARD...                                                       J5                                                  
C                                                                               J5                                                  
C* GSMSLP      .0065    1                                                       J5                                                  
C-------------------------------------------------------------------------                                                          
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      LOGICAL OK                                                                                                                    
      INTEGER LEV(100)                                                                                                              
C                                                                                                                                   
      COMMON/ICOM/ IBUF(8),IDAT(18528)                                                                                              
C                                                                                                                                   
      COMMON/BLANCK/ T(18528),RLNSP(18528),PHIS(18528)                                                                              
C                                                                                                                                   
      REAL PMSL(18528)                                                                                                              
      EQUIVALENCE (PMSL,T)                                                                                                          
C                                                                                                                                   
      DATA MAXX/18528/, MAXL/100/                                                                                                   
      DATA RGAS/287.04/, GRAV/9.80616/                                                                                              
C     DATA GAM/0.0065/                                                                                                              
C-----------------------------------------------------------------------                                                            
      NFF=6                                                                                                                         
      CALL JCLPNT(NFF,1,2,3,4,5,6)                                                                                                  
      REWIND 1                                                                                                                      
      REWIND 2                                                                                                                      
      REWIND 3                                                                                                                      
      RGOCP=2.E0/7.E0                                                                                                               
      READ(5,5010,END=901)GAM,NLVLUP                                            J4                                                  
      WRITE(6,6010)GAM,NLVLUP                                                                                                       
C                                                                                                                                   
C     * USE THE TEMP AT THE SECOND LEVEL ABOVE THE SURFACE TO EXTRAPOL.                                                             
C                                                                                                                                   
      CALL FILEV(LEV,NLEV,IBUF,1)                                                                                                   
      IF((NLEV.LT.1).OR.(NLEV.GT.MAXL)) CALL       XIT('GSMSLP',-1)                                                                 
      NLEV=NLEV-NLVLUP                                                                                                              
      IF(NLEV.LE.0) CALL                           XIT('GSMSLP',-99)                                                                
      REWIND 1                                                                                                                      
      LOWEST=LEV(NLEV)                                                                                                              
      CALL LVDCODE(SIGLOW,LOWEST,1)                                                                                                 
      SIGLOW=SIGLOW/1000.E0                                                                                                         
      NPTS=IBUF(5)*IBUF(6)                                                                                                          
C                                                                                                                                   
C     * GET THE MOUNTAIN FIELD.                                                                                                     
C                                                                                                                                   
      CALL GETFLD2(3,PHIS,NC4TO8("GRID"),-1,NC4TO8("PHIS"),-1,                                                                      
     +                                           IBUF,MAXX,OK)                                                                      
      IF(.NOT.OK) CALL                             XIT('GSMSLP',-2)                                                                 
      IF(IBUF(5)*IBUF(6).NE.NPTS) CALL             XIT('GSMSLP',-3)                                                                 
C                                                                                                                                   
C     * GET LOWEST LEVEL OF TEMPERATURE.                                                                                            
C                                                                                                                                   
      NRECS=0                                                                                                                       
  100 CALL GETFLD2(1,T,NC4TO8("GRID"),-1,NC4TO8("TEMP"),LOWEST,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030)NRECS                                                                                                          
        CALL                                       XIT('GSMSLP',0)                                                                  
      ENDIF                                                                                                                         
      IF(NRECS.EQ.0)WRITE(6,6025)IBUF                                                                                               
      NT=IBUF(2)                                                                                                                    
C                                                                                                                                   
C     * GET LN(PS) FOR CORRESPONDING TIMESTEP.                                                                                      
C                                                                                                                                   
      CALL GETFLD2(2,RLNSP,NC4TO8("GRID"),NT,NC4TO8("LNSP"),-1,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
      IF(.NOT.OK) CALL                             XIT('GSMSLP',-4)                                                                 
      IF(IBUF(5)*IBUF(6).NE.NPTS) CALL             XIT('GSMSLP',-5)                                                                 
      IF(NRECS.EQ.0) WRITE(6,6025)IBUF                                                                                              
C                                                                                                                                   
C     * COMPUTE M.S.L. PRESSURE.                                                                                                    
C     * ASSUME A UNIFORM LAPSE RATE OF (DT/DZ)=-GAM, FROM SIGLOW TO                                                                 
C     * THE SURFACE, AND THEN FROM THE SURFACE TO SEA LEVEL.                                                                        
C     * APPROXIMATE HEIGHT OF SIGLOW ABOVE GROUND = 8E3*(1-SIGLOW).                                                                 
C                                                                                                                                   
      DO 200 I=1,NPTS                                                                                                               
      TS      = T(I) + GAM*8.E3*(1.E0-SIGLOW)                                                                                       
      TBAR    =TS + 0.5E0*GAM*PHIS(I)/GRAV                                                                                          
  200 PMSL(I) =      EXP(RLNSP(I)+PHIS(I)/(RGAS*TBAR))                                                                              
C                                                                                                                                   
C     * SAVE M.S.L. PRESSURE.                                                                                                       
C                                                                                                                                   
      IBUF(3)=NC4TO8("PMSL")                                                                                                        
      IBUF(4)=1                                                                                                                     
      CALL PUTFLD2(4,PMSL,IBUF,MAXX)                                                                                                
      IF(NRECS.EQ.0) WRITE(6,6025)IBUF                                                                                              
      NRECS=NRECS+1                                                                                                                 
      GO TO 100                                                                                                                     
C                                                                                                                                   
C     * E.O.F. ON INPUT.                                                                                                            
C                                                                                                                                   
  901 CALL                                         XIT('GSMSLP',-6)                                                                 
C-----------------------------------------------------------------------                                                            
 5010 FORMAT(10X,F10.0,I5)                                                      J4                                                  
 6010 FORMAT(' GAM=',E10.3,' TEMP. LEVEL USED IS ILEV -',I2,' + 1/2')                                                               
 6025 FORMAT(' ',A4,I10,2X,A4,I10,4I6)                                                                                              
 6030 FORMAT('0',I5,' FIELDS SAVED')                                                                                                
      END                                                                                                                           
