pkg/fizhi/slprs.F

0381d7dde7 Andr*0001 #include "FIZHI_OPTIONS.h"
76a78cf632 Andr*0002       subroutine slprs (PHIS,PLE,THZ,lwmask,im,jm,lm,SLP)
337c673391 Jean*0003 C**********************************************************************
                0004 C  INPUT
                0005 C    PHIS .... SURFACE GEOPOTENTIAL (M2/S2)
                0006 C    THZ ..... POTENTIAL TEMPERATURE (K) ON  Model LEVELS
                0007 C    grid .... Dynamics Grid Structure
0381d7dde7 Andr*0008 C    lwmask .. Land:(0.0) Water:(1.0) Mask
337c673391 Jean*0009 C
                0010 C  OUTPUT
                0011 C    SLP ..... SEA LEVEL PRESSURE (MB)
0381d7dde7 Andr*0012 C
                0013 C NOTE: Level counting here for thz and ple is top down (thz(1) is top)
337c673391 Jean*0014 C***********************************************************************
0381d7dde7 Andr*0015
                0016       implicit none
                0017
                0018       integer im,jm,lm
76a78cf632 Andr*0019       _RL  SLP   (im*jm)
0381d7dde7 Andr*0020       _RL  PHIS  (im*jm),  THZ  (im*jm,lm)
                0021       _RL  lwmask(im*jm)
                0022       _RL  ple(im*jm,lm+1)
                0023
76a78cf632 Andr*0024       _RL TWO, BETA
0381d7dde7 Andr*0025       PARAMETER(TWO  = 2.0)
                0026       PARAMETER(BETA = 0.0065)
                0027
76a78cf632 Andr*0028       _RL  getcon,g,r,ak
0381d7dde7 Andr*0029       integer i,L
                0030       _RL  tm (im*jm)
                0031       integer Ltop (im*jm)
337c673391 Jean*0032
                0033       G  = GETCON('GRAVITY')
                0034       R  = GETCON('RGAS')
                0035       AK = GETCON('KAPPA')
                0036 C***********************************************************************
                0037 C*                COMPUTE MEAN THETA IN PBL (100 MB)                   *
                0038 C***********************************************************************
0381d7dde7 Andr*0039
                0040       do i=1,im*jm
                0041       tm(i) = 0.0
                0042       Ltop(i) = lm
                0043       enddo
                0044
                0045       do L = lm,1,-1
                0046        do i=1,im*jm
                0047         if ( ple(i,L+1).ge.(ple(i,lm+1)-100.) ) then
                0048          Ltop(i) = L
                0049          tm(i) = tm(i) + thz(i,L)*(ple(i,L+1)-ple(i,L))
                0050         endif
                0051        enddo
                0052       enddo
                0053
                0054       do i=1,im*jm
                0055       tm(i) = tm(i)/(ple(i,lm+1)-ple(i,Ltop(i)))
                0056       enddo
                0057
337c673391 Jean*0058 C***********************************************************************
                0059 C*                   COMPUTE SEA LEVEL PRESSURE                        *
                0060 C***********************************************************************
                0061
                0062       do i=1,im*jm
8e402e4ff2 Andr*0063       if( lwmask(i).ne.0.0 ) then
76a78cf632 Andr*0064       TM(I) = TM(I) * (PLE(I,LM+1)/1000.)**AK + BETA*PHIS(I)/(TWO*G)
0381d7dde7 Andr*0065       else
76a78cf632 Andr*0066       TM(I) = THZ(I,LM)*(PLE(I,LM+1)/1000.)**AK + BETA*PHIS(I)/(TWO*G)
0381d7dde7 Andr*0067       endif
                0068
337c673391 Jean*0069       SLP(I) = PHIS(I) / ( R*TM(I) )
                0070       SLP(I) = PLE(I,LM+1) * EXP( SLP(I) )
0381d7dde7 Andr*0071       enddo
337c673391 Jean*0072
                0073       RETURN
                0074       END