GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/rrtm/gppref.F90 Lines: 7 7 100.0 %
Date: 2023-06-30 12:56:34 Branches: 6 8 75.0 %

Line Branch Exec Source
1
1
SUBROUTINE 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
66
USE PARKIND1  ,ONLY : JPIM     ,JPRB
67
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
68
69
USE YOMCT0   , ONLY : LAPRXPK
70
USE YOMDYN   , ONLY : NDLNPR
71
USE YOMCST   , ONLY : RD       ,RCVD
72
USE YOMCVER  , ONLY : LVERTFE
73
USE YOMGEM   , ONLY : VAF      ,VBF      ,TOPPRES
74
75
!     ------------------------------------------------------------------
76
77
IMPLICIT NONE
78
79
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA
80
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLEV
81
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART
82
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF
83
REAL(KIND=JPRB)                  :: PVAH(0:KFLEV) ! Argument NOT used
84
REAL(KIND=JPRB)                  :: PVBH(0:KFLEV) ! Argument NOT used
85
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALPH(KPROMA,KFLEV)
86
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRESH(KPROMA,0:KFLEV)
87
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRESF(KPROMA,KFLEV)
88
89
!     ------------------------------------------------------------------
90
91
INTEGER(KIND=JPIM) :: IFIRST, JLEV, JLON
92
REAL(KIND=JPRB) :: ZMUL
93
REAL(KIND=JPRB) :: ZHOOK_HANDLE
94
95
!     ------------------------------------------------------------------
96
97
1
IF (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
!
113
1
LVERTFE=.TRUE.    !!!!! A REVOIR (MPL) comment faut-il vraiment calculer PRESF ?
114
115
IF ((.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
127
ENDIF
128
129
!     ------------------------------------------------------------------
130
131
!*       2.    COMPUTES FULL LEVEL PRESSURES.
132
!              ------------------------------
133
134
IF (LVERTFE) THEN
135
40
  DO JLEV=1,KFLEV
136
!   print *,'GPPREF: LVERTFE KFLEV KSTART KPROF JLEV',LVERTFE,KFLEV,KSTART,KPROF,JLEV
137
79
    PRESF(KSTART:KPROF,JLEV)=VAF(JLEV)+VBF(JLEV)*PRESH(KSTART:KPROF,KFLEV)
138
  ENDDO
139
ELSE
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
167
ENDIF
168
169
!     ------------------------------------------------------------------
170
171
1
IF (LHOOK) CALL DR_HOOK('GPPREF',1,ZHOOK_HANDLE)
172
1
END SUBROUTINE GPPREF