1 | MODULE ls_forcing_mod |
---|
2 | |
---|
3 | !--------------------------------------------------------------------------------! |
---|
4 | ! This file is part of PALM. |
---|
5 | ! |
---|
6 | ! PALM is free software: you can redistribute it and/or modify it under the terms |
---|
7 | ! of the GNU General Public License as published by the Free Software Foundation, |
---|
8 | ! either version 3 of the License, or (at your option) any later version. |
---|
9 | ! |
---|
10 | ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY |
---|
11 | ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR |
---|
12 | ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. |
---|
13 | ! |
---|
14 | ! You should have received a copy of the GNU General Public License along with |
---|
15 | ! PALM. If not, see <http://www.gnu.org/licenses/>. |
---|
16 | ! |
---|
17 | ! Copyright 1997-2012 Leibniz University Hannover |
---|
18 | !--------------------------------------------------------------------------------! |
---|
19 | ! |
---|
20 | ! Current revisions: |
---|
21 | ! ------------------ |
---|
22 | ! |
---|
23 | ! |
---|
24 | ! Former revisions: |
---|
25 | ! ----------------- |
---|
26 | ! $Id: ls_forcing.f90 1250 2013-11-06 10:47:15Z heinze $ |
---|
27 | ! |
---|
28 | ! 1249 2013-11-06 10:45:47Z heinze |
---|
29 | ! remove call of user module |
---|
30 | ! reformatting |
---|
31 | ! |
---|
32 | ! 1241 2013-10-30 11:36:58Z heinze |
---|
33 | ! Initial revision |
---|
34 | ! |
---|
35 | ! Description: |
---|
36 | ! ------------ |
---|
37 | ! Calculates large scale forcings (geostrophic wind and subsidence velocity) as |
---|
38 | ! well as surfaces fluxes dependend on time given in an external file (LSF_DATA). |
---|
39 | ! Code is based in parts on DALES and UCLA-LES. |
---|
40 | !--------------------------------------------------------------------------------! |
---|
41 | |
---|
42 | PRIVATE |
---|
43 | PUBLIC init_ls_forcing, ls_forcing_surf, ls_forcing_vert |
---|
44 | SAVE |
---|
45 | |
---|
46 | |
---|
47 | CONTAINS |
---|
48 | |
---|
49 | SUBROUTINE init_ls_forcing |
---|
50 | |
---|
51 | USE arrays_3d |
---|
52 | USE control_parameters |
---|
53 | USE cpulog |
---|
54 | USE indices |
---|
55 | USE interfaces |
---|
56 | USE pegrid |
---|
57 | |
---|
58 | IMPLICIT NONE |
---|
59 | |
---|
60 | INTEGER :: finput = 90, ierrn, k, t |
---|
61 | CHARACTER (100):: chmess |
---|
62 | CHARACTER(1) :: hash |
---|
63 | REAL :: r_dummy, fac |
---|
64 | REAL :: highheight, highug_vert, highvg_vert, highwsubs_vert |
---|
65 | REAL :: lowheight, lowug_vert, lowvg_vert, lowwsubs_vert |
---|
66 | |
---|
67 | ALLOCATE( p_surf(0:nlsf), pt_surf(0:nlsf), q_surf(0:nlsf), & |
---|
68 | qsws_surf(0:nlsf), shf_surf(0:nlsf), time_vert(0:nlsf), & |
---|
69 | time_surf(0:nlsf), ug_vert(nzb:nzt+1,0:nlsf), & |
---|
70 | vg_vert(nzb:nzt+1,0:nlsf), wsubs_vert(nzb:nzt+1,0:nlsf) ) |
---|
71 | |
---|
72 | p_surf = 0.0; pt_surf = 0.0; q_surf = 0.0; qsws_surf = 0.0 |
---|
73 | shf_surf = 0.0; time_vert = 0.0; time_surf = 0.0; ug_vert = 0.0 |
---|
74 | vg_vert = 0.0; wsubs_vert = 0.0 |
---|
75 | |
---|
76 | |
---|
77 | OPEN ( finput, FILE='LSF_DATA', STATUS='OLD', & |
---|
78 | FORM='FORMATTED', IOSTAT=ierrn ) |
---|
79 | |
---|
80 | IF ( ierrn /= 0 ) THEN |
---|
81 | message_string = 'file LSF_DATA does not exist' |
---|
82 | CALL message( 'ls_forcing', 'PA0368', 1, 2, 0, 6, 0 ) |
---|
83 | ENDIF |
---|
84 | |
---|
85 | ierrn = 0 |
---|
86 | ! |
---|
87 | !-- First three lines of LSF_DATA contain header |
---|
88 | READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess |
---|
89 | READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess |
---|
90 | READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess |
---|
91 | |
---|
92 | IF ( ierrn /= 0 ) THEN |
---|
93 | message_string = 'errors in file LSF_DATA' |
---|
94 | CALL message( 'ls_forcing', 'PA0369', 1, 2, 0, 6, 0 ) |
---|
95 | ENDIF |
---|
96 | |
---|
97 | ! |
---|
98 | !-- Surface values are read in |
---|
99 | t = 0 |
---|
100 | ierrn = 0 |
---|
101 | |
---|
102 | DO WHILE ( time_surf(t) < end_time ) |
---|
103 | t = t + 1 |
---|
104 | READ ( finput, *, IOSTAT = ierrn ) time_surf(t), shf_surf(t), & |
---|
105 | qsws_surf(t), pt_surf(t), & |
---|
106 | q_surf(t), p_surf(t) |
---|
107 | |
---|
108 | IF ( ierrn < 0 ) THEN |
---|
109 | WRITE ( message_string, * ) 'No time dependend surface variables ',& |
---|
110 | 'in&LSF_DATA for end of run found' |
---|
111 | |
---|
112 | CALL message( 'ls_forcing', 'PA0370', 1, 2, 0, 6, 0 ) |
---|
113 | ENDIF |
---|
114 | ENDDO |
---|
115 | |
---|
116 | |
---|
117 | IF ( time_surf(1) > end_time ) THEN |
---|
118 | WRITE ( message_string, * ) 'No time dependend surface variables in ',& |
---|
119 | '&LSF_DATA for end of run found - ', & |
---|
120 | 'lsf_surf is set to FALSE' |
---|
121 | CALL message( 'ls_forcing', 'PA0371', 0, 0, 0, 6, 0 ) |
---|
122 | lsf_surf = .FALSE. |
---|
123 | ENDIF |
---|
124 | |
---|
125 | ! |
---|
126 | !-- Go to the end of the list with surface variables |
---|
127 | DO WHILE ( ierrn == 0 ) |
---|
128 | READ ( finput, *, IOSTAT = ierrn ) r_dummy |
---|
129 | ENDDO |
---|
130 | |
---|
131 | ! |
---|
132 | !-- Profiles of ug, vg and w_subs are read in (large scale forcing) |
---|
133 | |
---|
134 | t = 0 |
---|
135 | DO WHILE ( time_vert(t) < end_time ) |
---|
136 | t = t + 1 |
---|
137 | hash = "#" |
---|
138 | ierrn = 1 ! not zero |
---|
139 | ! |
---|
140 | !-- Search for the next line consisting of "# time", |
---|
141 | !-- from there onwards the profiles will be read |
---|
142 | DO WHILE ( .NOT. ( hash == "#" .AND. ierrn == 0 ) ) |
---|
143 | READ ( finput, *, IOSTAT=ierrn ) hash, time_vert(t) |
---|
144 | IF ( ierrn < 0 ) THEN |
---|
145 | WRITE( message_string, * ) 'No time dependend vertical profiles',& |
---|
146 | ' in&LSF_DATA for end of run found' |
---|
147 | CALL message( 'ls_forcing', 'PA0372', 1, 2, 0, 6, 0 ) |
---|
148 | ENDIF |
---|
149 | ENDDO |
---|
150 | |
---|
151 | IF ( t == 1 .AND. time_vert(t) > end_time ) EXIT |
---|
152 | |
---|
153 | READ ( finput, *, IOSTAT=ierrn ) lowheight, lowug_vert, lowvg_vert, & |
---|
154 | lowwsubs_vert |
---|
155 | IF ( ierrn /= 0 ) THEN |
---|
156 | message_string = 'errors in file LSF_DATA' |
---|
157 | CALL message( 'nudging', 'PA0369', 1, 2, 0, 6, 0 ) |
---|
158 | ENDIF |
---|
159 | |
---|
160 | READ ( finput, *, IOSTAT=ierrn ) highheight, highug_vert, highvg_vert, & |
---|
161 | highwsubs_vert |
---|
162 | |
---|
163 | IF ( ierrn /= 0 ) THEN |
---|
164 | message_string = 'errors in file LSF_DATA' |
---|
165 | CALL message( 'nudging', 'PA0369', 1, 2, 0, 6, 0 ) |
---|
166 | ENDIF |
---|
167 | |
---|
168 | |
---|
169 | DO k = nzb, nzt+1 |
---|
170 | IF ( highheight < zu(k) ) THEN |
---|
171 | lowheight = highheight |
---|
172 | lowug_vert = highug_vert |
---|
173 | lowvg_vert = highvg_vert |
---|
174 | lowwsubs_vert = highwsubs_vert |
---|
175 | |
---|
176 | ierrn = 0 |
---|
177 | READ ( finput, *, IOSTAT=ierrn ) highheight, highug_vert, & |
---|
178 | highvg_vert, highwsubs_vert |
---|
179 | |
---|
180 | IF ( ierrn /= 0 ) THEN |
---|
181 | message_string = 'errors in file LSF_DATA' |
---|
182 | CALL message( 'nudging', 'PA0369', 1, 2, 0, 6, 0 ) |
---|
183 | ENDIF |
---|
184 | |
---|
185 | ENDIF |
---|
186 | |
---|
187 | ! |
---|
188 | !-- Interpolation of prescribed profiles in space |
---|
189 | fac = (highheight-zu(k))/(highheight - lowheight) |
---|
190 | |
---|
191 | ug_vert(k,t) = fac*lowug_vert + (1-fac)*highug_vert |
---|
192 | vg_vert(k,t) = fac*lowvg_vert + (1-fac)*highvg_vert |
---|
193 | wsubs_vert(k,t) = fac*lowwsubs_vert + (1-fac)*highwsubs_vert |
---|
194 | |
---|
195 | ENDDO |
---|
196 | |
---|
197 | ENDDO |
---|
198 | |
---|
199 | IF ( time_vert(1) > end_time ) THEN |
---|
200 | WRITE ( message_string, * ) 'Time dependent large scale profile ',& |
---|
201 | 'forcing from&LSF_DATA sets in after end of ' ,& |
---|
202 | 'simulation - lsf_vert is set to FALSE' |
---|
203 | CALL message( 'ls_forcing', 'PA0373', 0, 0, 0, 6, 0 ) |
---|
204 | lsf_vert = .FALSE. |
---|
205 | ENDIF |
---|
206 | |
---|
207 | CLOSE( finput ) |
---|
208 | |
---|
209 | |
---|
210 | END SUBROUTINE init_ls_forcing |
---|
211 | |
---|
212 | |
---|
213 | SUBROUTINE ls_forcing_surf ( time ) |
---|
214 | |
---|
215 | USE arrays_3d |
---|
216 | USE control_parameters |
---|
217 | USE cpulog |
---|
218 | USE indices |
---|
219 | USE interfaces |
---|
220 | USE pegrid |
---|
221 | |
---|
222 | IMPLICIT NONE |
---|
223 | |
---|
224 | REAL, INTENT(in) :: time |
---|
225 | REAL :: fac |
---|
226 | INTEGER :: t |
---|
227 | |
---|
228 | ! |
---|
229 | !-- Interpolation in time of LSF_DATA at the surface |
---|
230 | t = 1 |
---|
231 | DO WHILE ( time > time_surf(t) ) |
---|
232 | t = t + 1 |
---|
233 | ENDDO |
---|
234 | IF ( time /= time_surf(t) ) THEN |
---|
235 | t = t - 1 |
---|
236 | ENDIF |
---|
237 | |
---|
238 | fac = ( time -time_surf(t) ) / ( time_surf(t+1) - time_surf(t) ) |
---|
239 | |
---|
240 | shf = shf_surf(t) + fac * ( shf_surf(t+1) - shf_surf(t) ) |
---|
241 | qsws = qsws_surf(t) + fac * ( qsws_surf(t+1) - qsws_surf(t) ) |
---|
242 | pt_surface = pt_surf(t) + fac * ( pt_surf(t+1) - pt_surf(t) ) |
---|
243 | surface_pressure = p_surf(t) + fac * ( p_surf(t+1) - p_surf(t) ) |
---|
244 | |
---|
245 | END SUBROUTINE ls_forcing_surf |
---|
246 | |
---|
247 | |
---|
248 | SUBROUTINE ls_forcing_vert ( time ) |
---|
249 | |
---|
250 | USE arrays_3d |
---|
251 | USE control_parameters |
---|
252 | USE cpulog |
---|
253 | USE indices |
---|
254 | USE interfaces |
---|
255 | USE pegrid |
---|
256 | |
---|
257 | IMPLICIT NONE |
---|
258 | |
---|
259 | REAL, INTENT(in) :: time |
---|
260 | REAL :: fac |
---|
261 | INTEGER :: t |
---|
262 | |
---|
263 | ! |
---|
264 | !-- Interpolation in time of LSF_DATA for ug, vg and w_subs |
---|
265 | t = 1 |
---|
266 | DO WHILE ( time > time_vert(t) ) |
---|
267 | t = t + 1 |
---|
268 | ENDDO |
---|
269 | IF ( time /= time_vert(t) ) THEN |
---|
270 | t = t - 1 |
---|
271 | ENDIF |
---|
272 | |
---|
273 | fac = ( time-time_vert(t) ) / ( time_vert(t+1)-time_vert(t) ) |
---|
274 | |
---|
275 | ug = ug_vert(:,t) + fac * ( ug_vert(:,t+1) - ug_vert(:,t) ) |
---|
276 | vg = vg_vert(:,t) + fac * ( vg_vert(:,t+1) - vg_vert(:,t) ) |
---|
277 | |
---|
278 | IF ( large_scale_subsidence ) THEN |
---|
279 | w_subs = wsubs_vert(:,t) + fac * ( wsubs_vert(:,t+1) - wsubs_vert(:,t) ) |
---|
280 | ENDIF |
---|
281 | |
---|
282 | END SUBROUTINE ls_forcing_vert |
---|
283 | |
---|
284 | |
---|
285 | END MODULE ls_forcing_mod |
---|