source: LMDZ5/trunk/libf/phylmd/pppmer.F90 @ 3999

Last change on this file since 3999 was 2386, checked in by musat, 9 years ago

Ajout routines calcul slp

File size: 5.0 KB
RevLine 
[2386]1SUBROUTINE 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
68include "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 REAL :: ZTSTAR(KPROMA)
88 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
98REAL, 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 ZDTDZSG=-RDTDZ1/RG
114!<http://intra.cnrm.meteo.fr/eac/ARPCLI5.2/doci/code/arpcli5.2/xrd/support/rg.F.php#rg>
115 DO JL=KSTART,KPROF
116
117   IF(PTSTAR(JL) < ZTY) THEN
118!IM  ZTSTAR(JL)=0.5_JPRB*(ZTY+PTSTAR(JL))
119     ZTSTAR(JL)=0.5*(ZTY+PTSTAR(JL))
120   ELSEIF(PTSTAR(JL) < ZTX) THEN
121     ZTSTAR(JL)=PTSTAR(JL)
122   ELSE
123!IM    ZTSTAR(JL)=0.5_JPRB*(ZTX+PTSTAR(JL))
124     ZTSTAR(JL)=0.5*(ZTX+PTSTAR(JL))
125   ENDIF
126
127   ZT0=ZTSTAR(JL)+ZDTDZSG*POROG(JL)
128   IF(ZTX > ZTSTAR(JL) .AND. ZT0 > ZTX) THEN
129     ZT0=ZTX
130   ELSEIF(ZTX <= ZTSTAR(JL) .AND. ZT0 > ZTSTAR(JL)) THEN
131     ZT0=ZTSTAR(JL)
132   ELSE
133     ZT0=PT0(JL)
134   ENDIF
135
136!IM  ZOROG=SIGN(MAX(1.0_JPRB,ABS(POROG(JL))),POROG(JL))
137   ZOROG=SIGN(MAX(1.0,ABS(POROG(JL))),POROG(JL))
138   ZALPHA(JL)=RD*(ZT0-ZTSTAR(JL))/ZOROG
139 ENDDO
140
141!*       1.2   COMPUTATION OF MSL PRESSURE.
142
143 DO JL=KSTART,KPROF
144!IM  IF (ABS(POROG(JL)) >= 0.001_JPRB) THEN
145   IF (ABS(POROG(JL)) >= 0.001) THEN
146     ZX=POROG(JL)/(RD*ZTSTAR(JL))
147     ZY=ZALPHA(JL)*ZX
148     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     PMSLPPP(JL)=PRPRESS(JL)*EXP(ZX*(1.0-0.5*ZY+1.0/3.*ZY2))
152   ELSE
153     PMSLPPP(JL)=PRPRESS(JL)
154   ENDIF
155 ENDDO
156
157
158!     ------------------------------------------------------------------
159
160!IM IF (LHOOK) CALL DR_HOOK('PPPMER',1,ZHOOK_HANDLE)
161 END SUBROUTINE PPPMER
Note: See TracBrowser for help on using the repository browser.