GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/screenp_mod.F90 Lines: 0 30 0.0 %
Date: 2023-06-30 12:51:15 Branches: 0 18 0.0 %

Line Branch Exec Source
1
!
2
MODULE screenp_mod
3
!
4
! This module contains some procedures for calculation of the first
5
! guess of temperature, specific humidity and wind at a reference level
6
! coefficients for turbulent diffusion at surface
7
!
8
  IMPLICIT NONE
9
10
CONTAINS
11
!
12
!****************************************************************************************
13
!
14
!r original routine
15
!
16
      SUBROUTINE screenp(klon, knon, nsrf, &
17
     &                   speed, tair, qair, &
18
     &                   ts, qsurf, rugos, lmon, &
19
     &                   ustar, testar, qstar, zref, &
20
     &                   delu, delte, delq)
21
      IMPLICIT none
22
!-------------------------------------------------------------------------
23
!
24
! Objet : calcul "predicteur" des anomalies du vent, de la temperature
25
!         potentielle et de l'humidite relative au niveau de reference zref et
26
!         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q)
27
!         a partir des relations de Dyer-Businger.
28
!
29
! Reference : Hess, Colman et McAvaney (1995)
30
!
31
! I. Musat, 01.07.2002
32
!-------------------------------------------------------------------------
33
!
34
! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
35
! knon----input-I- nombre de points pour un type de surface
36
! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
37
! speed---input-R- module du vent au 1er niveau du modele
38
! tair----input-R- temperature de l'air au 1er niveau du modele
39
! qair----input-R- humidite relative au 1er niveau du modele
40
! ts------input-R- temperature de l'air a la surface
41
! qsurf---input-R- humidite relative a la surface
42
! rugos---input-R- rugosite
43
! lmon----input-R- longueur de Monin-Obukov
44
! ustar---input-R- facteur d'echelle pour le vent
45
! testar--input-R- facteur d'echelle pour la temperature potentielle
46
! qstar---input-R- facteur d'echelle pour l'humidite relative
47
! zref----input-R- altitude de reference
48
!
49
! delu----input-R- anomalie du vent par rapport au 1er niveau
50
! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
51
! delq----input-R- anomalie de l'humidite relative par rapport a la surface
52
!
53
      INTEGER, intent(in) :: klon, knon, nsrf
54
      REAL, dimension(klon), intent(in) :: speed, tair, qair
55
      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos
56
      DOUBLE PRECISION, dimension(klon), intent(in) :: lmon
57
      REAL, dimension(klon), intent(in) :: ustar, testar, qstar
58
      REAL, intent(in) :: zref
59
!
60
      REAL, dimension(klon), intent(out) :: delu, delte, delq
61
!
62
!-------------------------------------------------------------------------
63
! Variables locales et constantes :
64
      REAL, PARAMETER :: RKAR=0.40
65
      INTEGER :: i
66
      REAL :: xtmp, xtmp0
67
!-------------------------------------------------------------------------
68
      DO i = 1, knon
69
!
70
        IF (lmon(i).GE.0.) THEN
71
!
72
! STABLE CASE
73
!
74
          IF (speed(i).GT.1.5.AND.lmon(i).LE.1.0                        &
75
     &                      .AND. rugos(i).LE.1.0) THEN
76
            delu(i) = (ustar(i)/RKAR)* &
77
                      (log(zref/(rugos(i))+1.) + &
78
                      min(5.d0, 5.0 *(zref - rugos(i))/lmon(i)))
79
            delte(i) = (testar(i)/RKAR)* &
80
                       (log(zref/(rugos(i))+1.) + &
81
                       min(5.d0, 5.0 * (zref - rugos(i))/lmon(i)))
82
            delq(i) = (qstar(i)/RKAR)* &
83
                      (log(zref/(rugos(i))+1.) + &
84
                      min(5.d0, 5.0 * (zref - rugos(i))/lmon(i)))
85
          ELSE
86
            delu(i)  = 0.1 * speed(i)
87
            delte(i) = 0.1 * (tair(i) - ts(i) )
88
            delq(i)  = 0.1 * (max(qair(i),0.0) - max(qsurf(i),0.0))
89
          ENDIF
90
        ELSE
91
!
92
! UNSTABLE CASE
93
!
94
          IF (speed(i).GT.5.0.AND.abs(lmon(i)).LE.50.0) THEN
95
            xtmp = (1. - 16. * (zref/lmon(i)))**(1./4.)
96
            xtmp0 = (1. - 16. * (rugos(i)/lmon(i)))**(1./4.)
97
            delu(i) = (ustar(i)/RKAR)* &
98
                      (log(zref/(rugos(i))+1.) &
99
                      - 2.*log(0.5*(1. + xtmp)) &
100
                      + 2.*log(0.5*(1. + xtmp0)) &
101
                      - log(0.5*(1. + xtmp*xtmp)) &
102
                      + log(0.5*(1. + xtmp0*xtmp0)) &
103
                      + 2.*atan(xtmp) - 2.*atan(xtmp0))
104
            delte(i) = (testar(i)/RKAR)* &
105
                       (log(zref/(rugos(i))+1.) &
106
                       - 2.0 * log(0.5*(1. + xtmp*xtmp)) &
107
                       + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
108
            delq(i)  = (qstar(i)/RKAR)* &
109
                       (log(zref/(rugos(i))+1.) &
110
                       - 2.0 * log(0.5*(1. + xtmp*xtmp)) &
111
                       + 2.0 * log(0.5*(1. + xtmp0*xtmp0)))
112
          ELSE
113
            delu(i)  = 0.5 * speed(i)
114
            delte(i) = 0.5 * (tair(i) - ts(i) )
115
            delq(i)  = 0.5 * (max(qair(i),0.0) - max(qsurf(i),0.0))
116
          ENDIF
117
        ENDIF
118
!
119
      ENDDO
120
      RETURN
121
      END SUBROUTINE screenp
122
!
123
      SUBROUTINE screenpn(klon, knon, nsrf, &
124
     &                   speed, tair, qair, &
125
     &                   ts, qsurf, rugos, zri1, &
126
     &                   zref, &
127
     &                   delu, delte, delq)
128
      IMPLICIT none
129
!-------------------------------------------------------------------------
130
!
131
! Objet : calcul "predicteur" des anomalies du vent, de la temperature
132
!         potentielle et de l'humidite relative au niveau de reference zref et
133
!         par rapport au 1er niveau (pour u) ou a la surface (pour theta et q)
134
!         a partir des relations de Dyer-Businger.
135
!
136
! Reference : Hess, Colman et McAvaney (1995)
137
!
138
! I. Musat, 01.07.2002
139
!-------------------------------------------------------------------------
140
!
141
! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
142
! knon----input-I- nombre de points pour un type de surface
143
! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
144
! speed---input-R- module du vent au 1er niveau du modele
145
! tair----input-R- temperature de l'air au 1er niveau du modele
146
! qair----input-R- humidite relative au 1er niveau du modele
147
! ts------input-R- temperature de l'air a la surface
148
! qsurf---input-R- humidite relative a la surface
149
! rugos---input-R- rugosite
150
! zref----input-R- altitude de reference
151
!
152
! delu----input-R- anomalie du vent par rapport au 1er niveau
153
! delte---input-R- anomalie de la temperature potentielle par rapport a la surface
154
! delq----input-R- anomalie de l'humidite relative par rapport a la surface
155
!
156
      INTEGER, intent(in) :: klon, knon, nsrf
157
      REAL, dimension(klon), intent(in) :: speed, tair, qair
158
      REAL, dimension(klon), intent(in) :: ts, qsurf, rugos
159
      REAL, dimension(klon), intent(in) :: zri1
160
      REAL, intent(in) :: zref
161
!
162
      REAL, dimension(klon), intent(out) :: delu, delte, delq
163
!
164
!-------------------------------------------------------------------------
165
! Variables locales et constantes :
166
      REAL, PARAMETER :: RKAR=0.40
167
      INTEGER :: i
168
      REAL :: xtmp, xtmp0
169
!-------------------------------------------------------------------------
170
      DO i = 1, knon
171
!
172
       IF (zri1(i).GE.0.) THEN
173
          delu(i)  = 0.1 * speed(i)
174
          delte(i) = 0.1 * (tair(i) - ts(i) )
175
          delq(i)  = 0.1 * (max(qair(i),0.0) - max(qsurf(i),0.0))
176
       ELSE
177
          delu(i)  = 0.5 * speed(i)
178
          delte(i) = 0.5 * (tair(i) - ts(i) )
179
          delq(i)  = 0.5 * (max(qair(i),0.0) - max(qsurf(i),0.0))
180
       ENDIF
181
!
182
      ENDDO
183
      RETURN
184
      END SUBROUTINE screenpn
185
END MODULE screenp_mod