source: LMDZ5/branches/IPSLCM5A2.1_ISO/libf/phyiso/rrtm/gppref.F90 @ 5308

Last change on this file since 5308 was 3331, checked in by acozic, 6 years ago

Add modification for isotopes

  • Property svn:executable set to *
File size: 5.5 KB
RevLine 
[3331]1SUBROUTINE GPPREF(KPROMA,KSTART,KPROF,KFLEV,PVAH,PVBH,PALPH,PRESH,PRESF)
2
3!**** *GPPREF* - Computes full level pressure
4
5!     Purpose.
6!     --------
7!           Computes pressures at half and full model levels.
8
9!**   Interface.
10!     ----------
11!        *CALL* *GPPREF(...)
12
13!        Explicit arguments :
14!        --------------------
15!                              KPROMA :  dimensioning
16!                              KSTART :  start of work
17!                              KPROF  :  depth of work
18!                              KFLEV     : vert. dimensioning
19!                              PVAH(KFLEV),PVBH(KFLEV)- vertical coordinate
20!                              PALPH (KPROMA,KFLEV)  - COEFF OF THE HYDROST
21!                              PRESH(KPROMA,0:KFLEV) - HALF LEVEL PRESSURE
22!                              PRESF(KPROMA,KFLEV)   - FULL LEVEL PRESSURE
23!
24!        Implicit arguments :  NONE.
25!        --------------------
26
27!     Method.
28!     -------
29!        See documentation
30
31!     Externals.  None.
32!     ----------
33
34!     Reference.
35!     ----------
36!        ECMWF Research Department documentation of the IFS
37
38!                                PHk*ln(PHk) - PHk-1*ln(PHk-1)
39!     Full level P: ln(PFk) = [ ------------------------------- - 1. ]
40!                                        PHk - PHk-1
41
42!     which simplifies to:  PFk = Pk+1/2 * exp(-ALPHA)
43
44!     In case of NDLNPR=1 it becomes even simpler (no need of LAPRXP any
45!     more in principle !) :
46!                           PFk = Pk+1/2 * (1.-ALPHA) except at the top
47!     level :
48!                           PF1 = P1.5 / (2+Cv/R)
49
50!     Author.
51!     -------
52!        Erik Andersson, Mats Hamrud and Philippe Courtier  *ECMWF*
53
54!     Modifications.
55!     --------------
56!        Original : 92-11-23
57!        Modified : 95-01-31 by Radmila Bubnova: correction in the case
58!                            of the other approximation of d (ln p).
59!        Modified : 00-11-22 by Agathe Untch: modifications for vertical
60!                            finite elements
61!        M.Hamrud      01-Oct-2003 CY28 Cleaning
62!        Modified : 04-11-15 by K. YESSAD: improve the hierarchy of tests
63!        Modified : 15-Feb-2005 by K. YESSAD: ZTOPPRES becomes TOPPRES
64!     ------------------------------------------------------------------
65
66USE PARKIND1  ,ONLY : JPIM     ,JPRB
67USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
68
69USE YOMCT0   , ONLY : LAPRXPK
70USE YOMDYN   , ONLY : NDLNPR
71USE YOMCST   , ONLY : RD       ,RCVD
72USE YOMCVER  , ONLY : LVERTFE
73USE YOMGEM   , ONLY : VAF      ,VBF      ,TOPPRES
74
75!     ------------------------------------------------------------------
76
77IMPLICIT NONE
78
79INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA
80INTEGER(KIND=JPIM),INTENT(IN)    :: KFLEV
81INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART
82INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF
83REAL(KIND=JPRB)                  :: PVAH(0:KFLEV) ! Argument NOT used
84REAL(KIND=JPRB)                  :: PVBH(0:KFLEV) ! Argument NOT used
85REAL(KIND=JPRB)   ,INTENT(IN)    :: PALPH(KPROMA,KFLEV)
86REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESH(KPROMA,0:KFLEV)
87REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRESF(KPROMA,KFLEV)
88
89!     ------------------------------------------------------------------
90
91INTEGER(KIND=JPIM) :: IFIRST, JLEV, JLON
92REAL(KIND=JPRB) :: ZMUL
93REAL(KIND=JPRB) :: ZHOOK_HANDLE
94
95!     ------------------------------------------------------------------
96
97IF (LHOOK) CALL DR_HOOK('GPPREF',0,ZHOOK_HANDLE)
98
99!     ------------------------------------------------------------------
100
101!*       1.    Level to begin normal computations
102!              ----------------------------------
103
104! This is introduced to allow the use of GPPREF without the implicit
105! assumption that the top level input for pressure is 0 hPa.
106! This restriction is only necessary in the case of use of NDLNPR=1.
107!
108! LVERTFE : .T./.F. Finite element/conventional vertical discretisation.
109! NDLNPR  : NDLNPR=0: conventional formulation of delta, i.e. ln(P(l)/P(l-1)).
110!           NDLNPR=1: formulation of delta used in non hydrostatic model,
111! LAPRXPK : way of computing full-levels pressures in primitive equation
112!
113LVERTFE=.TRUE.    !!!!! A REVOIR (MPL) comment faut-il vraiment calculer PRESF ?
114
115IF ((.NOT.LVERTFE).AND.(NDLNPR == 1)) THEN
116  IF(PRESH(KSTART,0) <= TOPPRES)THEN
117    IFIRST=2
118  ELSE
119    IFIRST=1
120    DO JLON=KSTART,KPROF
121      IF(PRESH(JLON,0) <= TOPPRES)THEN
122        IFIRST=2
123        EXIT
124      ENDIF
125    ENDDO
126  ENDIF
127ENDIF
128
129!     ------------------------------------------------------------------
130
131!*       2.    COMPUTES FULL LEVEL PRESSURES.
132!              ------------------------------
133
134IF (LVERTFE) THEN
135  DO JLEV=1,KFLEV
136!   print *,'GPPREF: LVERTFE KFLEV KSTART KPROF JLEV',LVERTFE,KFLEV,KSTART,KPROF,JLEV
137    PRESF(KSTART:KPROF,JLEV)=VAF(JLEV)+VBF(JLEV)*PRESH(KSTART:KPROF,KFLEV) 
138  ENDDO
139ELSE
140  IF (NDLNPR == 0) THEN
141    IF (LAPRXPK) THEN
142      DO JLEV=1,KFLEV
143        DO JLON=KSTART,KPROF
144          PRESF(JLON,JLEV)=(PRESH(JLON,JLEV-1)+PRESH(JLON,JLEV))*0.5_JPRB
145        ENDDO
146      ENDDO
147    ELSE
148      DO JLEV=1,KFLEV
149        DO JLON=KSTART,KPROF
150          PRESF(JLON,JLEV)=EXP(-PALPH(JLON,JLEV))*PRESH(JLON,JLEV)
151        ENDDO
152      ENDDO
153    ENDIF
154  ELSEIF (NDLNPR == 1) THEN
155    DO JLEV=IFIRST,KFLEV
156      DO JLON=KSTART,KPROF
157        PRESF(JLON,JLEV)=(1.0_JPRB-PALPH(JLON,JLEV))*PRESH(JLON,JLEV)
158      ENDDO
159    ENDDO
160    ZMUL=1.0_JPRB/(2.0_JPRB+RCVD/RD)
161    DO JLEV=1,IFIRST-1
162      DO JLON=KSTART,KPROF
163        PRESF(JLON,JLEV)=PRESH(JLON,JLEV)*ZMUL
164      ENDDO
165    ENDDO
166  ENDIF
167ENDIF
168
169!     ------------------------------------------------------------------
170
171IF (LHOOK) CALL DR_HOOK('GPPREF',1,ZHOOK_HANDLE)
172END SUBROUTINE GPPREF
Note: See TracBrowser for help on using the repository browser.