GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/pppmer.F90 Lines: 24 24 100.0 %
Date: 2023-06-30 12:56:34 Branches: 18 18 100.0 %

Line Branch Exec Source
1
420192
SUBROUTINE PPPMER(KPROMA,KSTART,KPROF,PRPRESS,POROG,PTSTAR,PT0,PMSLPPP)
2
3
!**** *PPPMER* - POST-PROCESS MSL PRESSURE.
4
5
!     PURPOSE.
6
!     --------
7
!           COMPUTES MSL PRESSURE.
8
9
!**   INTERFACE.
10
!     ----------
11
12
!        *CALL* *PPPMER(KPROMA,KSTART,KPROF,PRPRESS,POROG,PTSTAR,PT0,
13
!    S                  PMSLPPP)
14
15
!        EXPLICIT ARGUMENTS
16
!        --------------------
17
18
19
!        KPROMA                    - HORIZONTAL DIMENSION.             (INPUT)
20
!        KSTART                    - START OF WORK.                    (INPUT)
21
!        KPROF                     - DEPTH OF WORK.                    (INPUT)
22
!        PRPRESS(KPROMA)           - SURFACE PRESSURE                  (INPUT)
23
!        POROG(KPROMA)             - MODEL OROGRAPHY.                  (INPUT)
24
!        PTSTAR(KPROMA)            - SURFACE TEMPERATURE               (INPUT)
25
!        PT0(KPROMA)               - STANDARD SURFACE TEMPERATURE      (INPUT)
26
!        PMSLPPP(KPROMA)           - POST-PROCESSED MSL PRESSURE       (OUTPUT)
27
!        IMPLICIT ARGUMENTS :  CONSTANTS FROM YOMCST,YOMGEM,YOMSTA.
28
!        --------------------
29
30
!     METHOD.
31
!     -------
32
!        SEE DOCUMENTATION
33
34
!     EXTERNALS.  NONE
35
!     ----------
36
37
!     REFERENCE.
38
!     ----------
39
!        ECMWF Research Department documentation of the IFS
40
41
!     AUTHOR.
42
!     -------
43
!        MATS HAMRUD AND PHILIPPE COURTIER  *ECMWF*
44
45
!     MODIFICATIONS.
46
!     --------------
47
!        ORIGINAL : 89-01-26
48
49
!     E. A-son, J-F Geleyn 920409 Mod. T*, T0 and alpha below surface.
50
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
51
52
!     ------------------------------------------------------------------
53
54
! USE PARKIND1
55
!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/module/parkind1.F90.php#parkind1>  ,ONLY : JPIM     ,JPRB
56
! USE YOMHOOK
57
!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/module/yomhook.F90.php#yomhook>   ,ONLY : LHOOK,   DR_HOOK
58
59
!USE YOMCST, ONLY : RG, RD
60
!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/arp/module/yomcst.F90.php#yomcst>   , ONLY : RG
61
62
!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/support/rg.F.php#rg>       ,RD
63
! USE YOMSTA
64
!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/arp/module/yomsta.F90.php#yomsta>   , ONLY : RDTDZ1
65
66
  IMPLICIT NONE
67
68
include "YOMCST.h"
69
!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA
70
!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART
71
!IM INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF
72
 INTEGER,INTENT(IN)    :: KPROMA
73
 INTEGER,INTENT(IN)    :: KSTART
74
 INTEGER,INTENT(IN)    :: KPROF
75
!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PRPRESS(KPROMA)
76
!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: POROG(KPROMA)
77
!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSTAR(KPROMA)
78
!IM REAL(KIND=JPRB)   ,INTENT(IN)    :: PT0(KPROMA)
79
!IM REAL(KIND=JPRB)   ,INTENT(OUT)   :: PMSLPPP(KPROMA)
80
!IM REAL(KIND=JPRB) :: ZTSTAR(KPROMA)
81
!IM REAL(KIND=JPRB) :: ZALPHA(KPROMA)
82
 REAL,INTENT(IN)    :: PRPRESS(KPROMA)
83
 REAL,INTENT(IN)    :: POROG(KPROMA)
84
 REAL,INTENT(IN)    :: PTSTAR(KPROMA)
85
 REAL,INTENT(IN)    :: PT0(KPROMA)
86
 REAL,INTENT(OUT)   :: PMSLPPP(KPROMA)
87
576
 REAL :: ZTSTAR(KPROMA)
88
576
 REAL :: ZALPHA(KPROMA)
89
90
!IM INTEGER(KIND=JPIM) :: JL
91
 INTEGER :: JL
92
93
!IM REAL(KIND=JPRB) :: ZDTDZSG, ZOROG, ZT0, ZTX, ZTY, ZX, ZY, ZY2
94
!IM REAL(KIND=JPRB) :: ZHOOK_HANDLE
95
 REAL :: ZDTDZSG, ZOROG, ZT0, ZTX, ZTY, ZX, ZY, ZY2
96
 REAL :: ZHOOK_HANDLE
97
!IM beg
98
REAL, PARAMETER                  :: RDTDZ1=-0.0065 !or USE YOMSTA
99
!IM end
100
101
!     ------------------------------------------------------------------
102
103
!*       1.    POST-PROCESS MSL PRESSURE.
104
!              --------------------------
105
106
!*       1.1   COMPUTATION OF MODIFIED ALPHA AND TSTAR.
107
108
!IM IF (LHOOK) CALL DR_HOOK('PPPMER',0,ZHOOK_HANDLE)
109
!IM ZTX=290.5_JPRB
110
!IM ZTY=255.0_JPRB
111
 ZTX=290.5
112
 ZTY=255.0
113
288
 ZDTDZSG=-RDTDZ1/RG
114
!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/support/rg.F.php#rg>
115
286560
 DO JL=KSTART,KPROF
116
117
286272
   IF(PTSTAR(JL) < ZTY) THEN
118
!IM  ZTSTAR(JL)=0.5_JPRB*(ZTY+PTSTAR(JL))
119
29183
     ZTSTAR(JL)=0.5*(ZTY+PTSTAR(JL))
120
257089
   ELSEIF(PTSTAR(JL) < ZTX) THEN
121
150585
     ZTSTAR(JL)=PTSTAR(JL)
122
   ELSE
123
!IM    ZTSTAR(JL)=0.5_JPRB*(ZTX+PTSTAR(JL))
124
106504
     ZTSTAR(JL)=0.5*(ZTX+PTSTAR(JL))
125
   ENDIF
126
127
286272
   ZT0=ZTSTAR(JL)+ZDTDZSG*POROG(JL)
128

286272
   IF(ZTX > ZTSTAR(JL) .AND. ZT0 > ZTX) THEN
129
     ZT0=ZTX
130

281410
   ELSEIF(ZTX <= ZTSTAR(JL) .AND. ZT0 > ZTSTAR(JL)) THEN
131
     ZT0=ZTSTAR(JL)
132
   ELSE
133
241550
     ZT0=PT0(JL)
134
   ENDIF
135
136
!IM  ZOROG=SIGN(MAX(1.0_JPRB,ABS(POROG(JL))),POROG(JL))
137
286272
   ZOROG=SIGN(MAX(1.0,ABS(POROG(JL))),POROG(JL))
138
286560
   ZALPHA(JL)=RD*(ZT0-ZTSTAR(JL))/ZOROG
139
 ENDDO
140
141
!*       1.2   COMPUTATION OF MSL PRESSURE.
142
143
286560
 DO JL=KSTART,KPROF
144
!IM  IF (ABS(POROG(JL)) >= 0.001_JPRB) THEN
145
286560
   IF (ABS(POROG(JL)) >= 0.001) THEN
146
133632
     ZX=POROG(JL)/(RD*ZTSTAR(JL))
147
133632
     ZY=ZALPHA(JL)*ZX
148
133632
     ZY2=ZY*ZY
149
150
!IM    PMSLPPP(JL)=PRPRESS(JL)*EXP(ZX*(1.0_JPRB-0.5_JPRB*ZY+1.0_JPRB/3._JPRB*ZY2))
151
133632
     PMSLPPP(JL)=PRPRESS(JL)*EXP(ZX*(1.0-0.5*ZY+1.0/3.*ZY2))
152
   ELSE
153
152640
     PMSLPPP(JL)=PRPRESS(JL)
154
   ENDIF
155
 ENDDO
156
157
158
!     ------------------------------------------------------------------
159
160
!IM IF (LHOOK) CALL DR_HOOK('PPPMER',1,ZHOOK_HANDLE)
161
288
 END SUBROUTINE PPPMER