*IF DEF,C92_1A PMSL1A.2
C ******************************COPYRIGHT****************************** GTS2F400.7273
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.7274
C GTS2F400.7275
C Use, duplication or disclosure of this code is subject to the GTS2F400.7276
C restrictions as set forth in the contract. GTS2F400.7277
C GTS2F400.7278
C Meteorological Office GTS2F400.7279
C London Road GTS2F400.7280
C BRACKNELL GTS2F400.7281
C Berkshire UK GTS2F400.7282
C RG12 2SZ GTS2F400.7283
C GTS2F400.7284
C If no contract has been raised with this copy of the code, the use, GTS2F400.7285
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.7286
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.7287
C Modelling at the above address. GTS2F400.7288
C ******************************COPYRIGHT****************************** GTS2F400.7289
C GTS2F400.7290
CLL SUBROUTINE PMSL-------------------------------------------------- PMSL1A.3
CLL PMSL1A.4
CLL Purpose: Calculates mean sea level pressure PMSL1A.5
CLL PMSL1A.6
CLL AD, DR <- programmer of some or all of previous code or changes PMSL1A.7
CLL PMSL1A.8
CLL Model Modification history from model version 3.0: PMSL1A.9
CLL version Date PMSL1A.10
CLL PMSL1A.11
CLL 4.2 23/07/96 Revised for CRAY T3E. Option to use fast vector GSS5F402.8
CLL like function for raising to a power introduced GSS5F402.9
CLL under DEF T3E. GSS5F402.10
CLL New arguments START and END introduced to GSS5F402.11
CLL facilitate the removal of duplicate calculations GSS5F402.12
CLL when using domain decomposition. GSS5F402.13
CLL Author A. Dickinson Reviewer: F. Rawlins GSS5F402.14
!LL 4.5 20/4/98 Implement the START,END described above. GSM1F405.556
!LL S.D.Mullerworth GSM1F405.557
CLL GSS5F402.15
CLL 4.5 09/01/98 CRAY T3E optimisation: replace rtor_v by powr_v GDR8F405.11
CLL Deborah Salmond GDR8F405.12
CLL Programming standard : PMSL1A.12
CLL PMSL1A.13
CLL Logical components covered : D441 PMSL1A.14
CLL PMSL1A.15
CLL Project task : PMSL1A.16
CLL PMSL1A.17
CLL Documentation: The interpolation formulae are described in PMSL1A.18
CLL unified model on-line documentation paper S1. PMSL1A.19
CLL PMSL1A.20
CLL ----------------------------------------------------------------- PMSL1A.21
C PMSL1A.22
C*L Arguments:------------------------------------------------------- PMSL1A.23
SUBROUTINE PMSL 1PMSL1A.24
& (P_MSL,PL,PSTAR,P_EXNER_HALF,THETA,Q,PHI_STAR GSM1F405.558
& ,POINTS,P_LEVELS,Q_LEVELS,L,AKH,BKH GSM1F405.559
& ,START,END) GSM1F405.560
PMSL1A.27
IMPLICIT NONE PMSL1A.28
PMSL1A.29
INTEGER PMSL1A.30
* POINTS !IN Number of points per level GSS5F402.18
*,P_LEVELS !IN Number of model levels PMSL1A.32
*,Q_LEVELS !IN Number of wet levels PMSL1A.33
*,L !IN Reference level for below surface T extrapolation. PMSL1A.34
* ! = No of B.L. levels plus one PMSL1A.35
*,START !IN First point to be processed GSS5F402.19
*,END !IN Last point to be processed GSS5F402.20
PMSL1A.36
REAL PMSL1A.37
* P_MSL(POINTS) !OUT Mean sea level pressure PMSL1A.38
*,PHI_STAR(POINTS) !IN Geopotential height of topography PMSL1A.39
*,PL(POINTS) !IN Reference pressure at level L PMSL1A.40
*,PSTAR(POINTS) !IN Surface pressure PMSL1A.41
*,P_EXNER_HALF(POINTS,P_LEVELS+1) !IN Exner pressure at model PMSL1A.42
* ! half levels PMSL1A.43
*,THETA(POINTS,P_LEVELS) !IN Potential temperature at full levels PMSL1A.44
*,Q(POINTS,Q_LEVELS) !IN Specific humidity at full levels PMSL1A.45
*,AKH(P_LEVELS+1) !IN Hybrid Coords. A and B values PMSL1A.46
*,BKH(P_LEVELS+1) !IN at half levels. PMSL1A.47
PMSL1A.48
C Workspace usage:----------------------------------------------------- PMSL1A.49
REAL TEMP(POINTS),POWER GDR8F405.13
C --------------------------------------------------------------------- PMSL1A.51
C External subroutines called:----------------------------------------- PMSL1A.52
C GSS5F402.22
C*--------------------------------------------------------------------- PMSL1A.54
C Define local variables:---------------------------------------------- PMSL1A.55
INTEGER I,K PMSL1A.56
REAL PTOP ! Pressure at top of layer PMSL1A.57
REAL PBOT ! Pressure at bottom of layer PMSL1A.58
REAL P_EXNER_FULL ! Exner Pressure at full model level PMSL1A.59
REAL TS ! Surface Temperature PMSL1A.60
REAL ALOGHF,EXPHF PMSL1A.61
C---------------------------------------------------------------------- PMSL1A.62
C Constants from comdecks:--------------------------------------------- PMSL1A.63
*CALL C_EPSLON 
PMSL1A.64
*CALL C_G PMSL1A.65
*CALL C_R_CP PMSL1A.66
*CALL C_LAPSE PMSL1A.67
C---------------------------------------------------------------------- PMSL1A.68
PMSL1A.69
CL 1. Define local constants PMSL1A.70
PMSL1A.71
REAL LAPSE_R_OVER_G,G_OVER_LAPSE_R,ONE_OVER_G PMSL1A.72
PARAMETER(LAPSE_R_OVER_G=LAPSE*R/G) PMSL1A.73
PARAMETER(G_OVER_LAPSE_R=1./LAPSE_R_OVER_G) PMSL1A.74
PARAMETER(ONE_OVER_G=1./G) PMSL1A.75
PMSL1A.76
*CALL P_EXNERC PMSL1A.77
PMSL1A.78
CL 2. Calculate mean sea level pressure: equations (3.8) & (3.11) PMSL1A.79
PMSL1A.80
*IF DEF,VECTLIB PXVECTLB.120
POWER=LAPSE_R_OVER_G GDR8F405.14
DO I=START,END GSS5F402.27
TEMP(I)=PSTAR(I)/PL(I) GSS5F402.29
ENDDO GSS5F402.30
CALL POWR_V(END-START+1,TEMP(START),POWER,TEMP(START)) GDR8F405.15
*ENDIF GSS5F402.32
GSS5F402.33
DO I=START,END GSS5F402.34
*IF -DEF,VECTLIB PXVECTLB.121
TEMP(I)=(PSTAR(I)/PL(I))**LAPSE_R_OVER_G GSS5F402.36
*ENDIF GSS5F402.37
PMSL1A.82
C Estimate surface temperature: equation (3.8) PMSL1A.83
PTOP = AKH(L+1) + BKH(L+1)*PSTAR(I) PMSL1A.84
PBOT = AKH(L) + BKH(L) *PSTAR(I) PMSL1A.85
P_EXNER_FULL = P_EXNER_C PMSL1A.86
+(P_EXNER_HALF(I,L+1),P_EXNER_HALF(I,L),PTOP,PBOT,KAPPA) PMSL1A.87
TS=THETA(I,L)*P_EXNER_FULL*TEMP(I) GSS5F402.38
TS=TS*(1.0+C_VIRTUAL*Q(I,1)) PMSL1A.94
TEMP(I)=(TS+LAPSE*ONE_OVER_G*PHI_STAR(I))/TS GSS5F402.39
ENDDO GSS5F402.40
PMSL1A.95
C Calculate PMSL using equation (3.11) PMSL1A.96
GSS5F402.41
*IF DEF,VECTLIB PXVECTLB.122
POWER=G_OVER_LAPSE_R GDR8F405.16
CALL POWR_V(END-START+1,TEMP(START),POWER,TEMP(START)) GDR8F405.17
*ENDIF PMSL1A.102
PMSL1A.103
DO I=START,END GSS5F402.47
*IF -DEF,VECTLIB PXVECTLB.123
TEMP(I)=TEMP(I)**G_OVER_LAPSE_R GSS5F402.49
*ENDIF GSS5F402.50
GSS5F402.51
P_MSL(I)=PSTAR(I) * TEMP(I) GSS5F402.52
GSS5F402.53
ENDDO GSS5F402.54
PMSL1A.105
RETURN PMSL1A.106
END PMSL1A.107
PMSL1A.108
*ENDIF PMSL1A.109