source: palm/trunk/SOURCE/ls_forcing.f90 @ 1320

Last change on this file since 1320 was 1320, checked in by raasch, 7 years ago

ONLY-attribute added to USE-statements,
kind-parameters added to all INTEGER and REAL declaration statements,
kinds are defined in new module kinds,
old module precision_kind is removed,
revision history before 2012 removed,
comment fields (!:) to be used for variable explanations added to all variable declaration statements

  • Property svn:keywords set to Id
File size: 11.6 KB
Line 
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-2014 Leibniz Universitaet Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! ------------------
22! ONLY-attribute added to USE-statements,
23! kind-parameters added to all INTEGER and REAL declaration statements,
24! kinds are defined in new module kinds,
25! comment fields (!:) to be used for variable explanations added to
26! all variable declaration statements
27!
28! Former revisions:
29! -----------------
30! $Id: ls_forcing.f90 1320 2014-03-20 08:40:49Z raasch $
31!
32! 1318 2014-03-17 13:35:16Z raasch
33! module interfaces removed
34!
35! 1299 2014-03-06 13:15:21Z heinze
36! Ensure a zero large scale vertical velocity at the surface
37! Bugfix: typo in case of boundary condition in if-clause
38!
39! 1276 2014-01-15 13:40:41Z heinze
40! Use LSF_DATA also in case of Dirichlet bottom boundary condition for scalars
41!
42! 1249 2013-11-06 10:45:47Z heinze
43! remove call of user module
44! reformatting
45!
46! 1241 2013-10-30 11:36:58Z heinze
47! Initial revision
48!
49! Description:
50! ------------
51! Calculates large scale forcings (geostrophic wind and subsidence velocity) as
52! well as surfaces fluxes dependent on time given in an external file (LSF_DATA).
53! Code is based in parts on DALES and UCLA-LES.
54!--------------------------------------------------------------------------------!
55
56    PRIVATE
57    PUBLIC init_ls_forcing, ls_forcing_surf, ls_forcing_vert
58    SAVE
59
60
61 CONTAINS
62
63    SUBROUTINE init_ls_forcing
64
65       USE arrays_3d,                                                          &
66           ONLY:  p_surf, pt_surf, q_surf, qsws_surf, shf_surf, time_surf,     &
67                  time_vert, ug_vert, vg_vert, wsubs_vert, zu
68
69       USE control_parameters,                                                 &
70           ONLY:  end_time, lsf_surf, lsf_vert, message_string, nlsf
71
72       USE indices,                                                            &
73           ONLY:  nzb, nzt
74
75       USE kinds
76
77
78       IMPLICIT NONE
79
80       CHARACTER(100) ::  chmess              !:
81       CHARACTER(1)   ::  hash                !:
82
83       INTEGER(iwp) ::  ierrn                 !:
84       INTEGER(iwp) ::  finput = 90           !:
85       INTEGER(iwp) ::  k                     !:
86       INTEGER(iwp) ::  t                     !:
87
88       REAL(wp) ::  fac                       !:
89       REAL(wp) ::  highheight                !:
90       REAL(wp) ::  highug_vert               !:
91       REAL(wp) ::  highvg_vert               !:
92       REAL(wp) ::  highwsubs_vert            !:
93       REAL(wp) ::  lowheight                 !:
94       REAL(wp) ::  lowug_vert                !:
95       REAL(wp) ::  lowvg_vert                !:
96       REAL(wp) ::  lowwsubs_vert             !:
97       REAL(wp) ::  r_dummy                   !:
98
99       ALLOCATE( p_surf(0:nlsf), pt_surf(0:nlsf), q_surf(0:nlsf),         &
100                 qsws_surf(0:nlsf), shf_surf(0:nlsf), time_vert(0:nlsf),  &
101                 time_surf(0:nlsf), ug_vert(nzb:nzt+1,0:nlsf),            &
102                 vg_vert(nzb:nzt+1,0:nlsf), wsubs_vert(nzb:nzt+1,0:nlsf) )
103
104       p_surf = 0.0; pt_surf = 0.0; q_surf = 0.0; qsws_surf = 0.0
105       shf_surf = 0.0; time_vert = 0.0; time_surf = 0.0; ug_vert = 0.0
106       vg_vert = 0.0; wsubs_vert = 0.0
107
108
109       OPEN ( finput, FILE='LSF_DATA', STATUS='OLD', &
110              FORM='FORMATTED', IOSTAT=ierrn )
111
112       IF ( ierrn /= 0 )  THEN
113          message_string = 'file LSF_DATA does not exist'
114          CALL message( 'ls_forcing', 'PA0368', 1, 2, 0, 6, 0 )
115       ENDIF
116
117       ierrn = 0
118!
119!--    First three lines of LSF_DATA contain header
120       READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess
121       READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess
122       READ ( finput, FMT='(a100)', IOSTAT=ierrn ) chmess
123
124       IF ( ierrn /= 0 )  THEN
125          message_string = 'errors in file LSF_DATA'
126          CALL message( 'ls_forcing', 'PA0369', 1, 2, 0, 6, 0 )
127       ENDIF
128
129!
130!--    Surface values are read in
131       t     = 0
132       ierrn = 0
133
134       DO WHILE ( time_surf(t) < end_time )
135          t = t + 1
136          READ ( finput, *, IOSTAT = ierrn ) time_surf(t), shf_surf(t), &
137                                             qsws_surf(t), pt_surf(t),  &
138                                             q_surf(t), p_surf(t)
139
140          IF ( ierrn < 0 )  THEN
141            WRITE ( message_string, * ) 'No time dependent surface variables ',&
142                              'in&LSF_DATA for end of run found'
143
144             CALL message( 'ls_forcing', 'PA0370', 1, 2, 0, 6, 0 )
145          ENDIF
146       ENDDO
147
148
149       IF ( time_surf(1) > end_time )  THEN
150          WRITE ( message_string, * ) 'No time dependent surface variables in ',&
151                                     '&LSF_DATA for end of run found - ',  &
152                                     'lsf_surf is set to FALSE'
153          CALL message( 'ls_forcing', 'PA0371', 0, 0, 0, 6, 0 )
154          lsf_surf = .FALSE.
155       ENDIF
156
157!
158!--    Go to the end of the list with surface variables
159       DO WHILE ( ierrn == 0 )
160          READ ( finput, *, IOSTAT = ierrn ) r_dummy
161       ENDDO
162
163!
164!--    Profiles of ug, vg and w_subs are read in (large scale forcing)
165
166       t = 0
167       DO WHILE ( time_vert(t) < end_time )
168          t = t + 1
169          hash = "#"
170          ierrn = 1 ! not zero
171!
172!--       Search for the next line consisting of "# time",
173!--       from there onwards the profiles will be read
174          DO WHILE ( .NOT. ( hash == "#" .AND. ierrn == 0 ) ) 
175             READ ( finput, *, IOSTAT=ierrn ) hash, time_vert(t)
176             IF ( ierrn < 0 )  THEN
177                WRITE( message_string, * ) 'No time dependent vertical profiles',&
178                                 ' in&LSF_DATA for end of run found'
179                CALL message( 'ls_forcing', 'PA0372', 1, 2, 0, 6, 0 )
180             ENDIF
181          ENDDO
182
183          IF ( t == 1 .AND. time_vert(t) > end_time ) EXIT
184
185          READ ( finput, *, IOSTAT=ierrn ) lowheight, lowug_vert, lowvg_vert, &
186                                           lowwsubs_vert
187          IF ( ierrn /= 0 )  THEN
188             message_string = 'errors in file LSF_DATA'
189             CALL message( 'ls_forcing', 'PA0369', 1, 2, 0, 6, 0 )
190          ENDIF
191
192          READ ( finput, *, IOSTAT=ierrn ) highheight, highug_vert, highvg_vert, &
193                                           highwsubs_vert
194     
195          IF ( ierrn /= 0 )  THEN
196             message_string = 'errors in file LSF_DATA'
197             CALL message( 'ls_forcing', 'PA0369', 1, 2, 0, 6, 0 )
198          ENDIF
199
200
201          DO  k = nzb, nzt+1
202             IF ( highheight < zu(k) )  THEN
203                lowheight     = highheight
204                lowug_vert    = highug_vert
205                lowvg_vert    = highvg_vert
206                lowwsubs_vert = highwsubs_vert
207
208                ierrn = 0
209                READ ( finput, *, IOSTAT=ierrn ) highheight, highug_vert, &
210                                                 highvg_vert, highwsubs_vert
211
212                IF ( ierrn /= 0 )  THEN
213                   message_string = 'errors in file LSF_DATA'
214                   CALL message( 'ls_forcing', 'PA0369', 1, 2, 0, 6, 0 )
215                ENDIF
216
217             ENDIF
218
219!
220!--          Interpolation of prescribed profiles in space
221             fac = (highheight-zu(k))/(highheight - lowheight)
222
223             ug_vert(k,t)    = fac*lowug_vert    + (1-fac)*highug_vert
224             vg_vert(k,t)    = fac*lowvg_vert    + (1-fac)*highvg_vert
225             wsubs_vert(k,t) = fac*lowwsubs_vert + (1-fac)*highwsubs_vert
226
227          ENDDO
228
229       ENDDO
230
231!
232!--    Large scale vertical velocity has to be zero at the surface
233       wsubs_vert(nzb,:) = 0.0
234 
235       IF ( time_vert(1) > end_time )  THEN
236          WRITE ( message_string, * ) 'Time dependent large scale profile ',&
237                             'forcing from&LSF_DATA sets in after end of ' ,&
238                             'simulation - lsf_vert is set to FALSE'
239          CALL message( 'ls_forcing', 'PA0373', 0, 0, 0, 6, 0 )
240          lsf_vert = .FALSE.
241       ENDIF
242
243       CLOSE( finput )
244
245
246    END SUBROUTINE init_ls_forcing
247
248
249    SUBROUTINE ls_forcing_surf ( time )
250
251       USE arrays_3d,                                                          &
252           ONLY:  p_surf, pt_surf, q_surf, qsws, qsws_surf, shf, shf_surf,     &
253                  time_surf, time_vert, ug, ug_vert, vg, vg_vert
254
255       USE control_parameters,                                                 &
256           ONLY:  bc_q_b, ibc_pt_b, ibc_q_b, pt_surface, q_surface,            &
257                  surface_pressure
258
259       USE kinds
260
261
262       IMPLICIT NONE
263
264       INTEGER(iwp) ::  t                     !:
265
266       REAL(wp)             :: fac            !:
267       REAL(wp), INTENT(in) :: time           !:
268
269!
270!--    Interpolation in time of LSF_DATA at the surface
271       t = 1
272       DO WHILE ( time > time_surf(t) )
273          t = t + 1
274       ENDDO
275       IF ( time /= time_surf(t) )  THEN
276         t = t - 1
277       ENDIF
278
279       fac = ( time -time_surf(t) ) / ( time_surf(t+1) - time_surf(t) )
280
281       IF ( ibc_pt_b == 0 )  THEN
282!
283!--       In case of Dirichlet boundary condition shf must not
284!--       be set - it is calculated via MOST in prandtl_fluxes
285          pt_surface = pt_surf(t) + fac * ( pt_surf(t+1) - pt_surf(t) )
286
287       ELSEIF ( ibc_pt_b == 1 )  THEN
288!
289!--       In case of Neumann boundary condition pt_surface is needed for
290!--       calculation of reference density
291          shf        = shf_surf(t) + fac * ( shf_surf(t+1) - shf_surf(t) )
292          pt_surface = pt_surf(t) + fac * ( pt_surf(t+1) - pt_surf(t) )
293
294       ENDIF
295
296       IF ( ibc_q_b == 0 )  THEN
297!
298!--       In case of Dirichlet boundary condition qsws must not
299!--       be set - it is calculated via MOST in prandtl_fluxes
300          q_surface = q_surf(t) + fac * ( q_surf(t+1) - q_surf(t) )
301
302       ELSEIF ( ibc_q_b == 1 )  THEN
303
304          qsws = qsws_surf(t) + fac * ( qsws_surf(t+1) - qsws_surf(t) )
305
306       ENDIF
307
308       surface_pressure = p_surf(t) + fac * ( p_surf(t+1) - p_surf(t) )
309
310    END SUBROUTINE ls_forcing_surf
311
312
313    SUBROUTINE ls_forcing_vert ( time )
314
315       USE arrays_3d,                                                          &
316           ONLY:  time_vert, ug, ug_vert, vg, vg_vert, w_subs, wsubs_vert
317
318       USE control_parameters,                                                 &
319           ONLY:  large_scale_subsidence
320
321       USE kinds
322
323
324       IMPLICIT NONE
325
326       INTEGER(iwp) ::  t                     !:
327
328       REAL(wp)             ::  fac           !:
329       REAL(wp), INTENT(in) ::  time          !:
330
331!
332!--    Interpolation in time of LSF_DATA for ug, vg and w_subs
333       t = 1
334       DO WHILE ( time > time_vert(t) )
335          t = t + 1
336       ENDDO
337       IF ( time /= time_vert(t) )  THEN
338         t = t - 1
339       ENDIF
340
341       fac = ( time-time_vert(t) ) / ( time_vert(t+1)-time_vert(t) )
342
343       ug     = ug_vert(:,t) + fac * ( ug_vert(:,t+1) - ug_vert(:,t) )
344       vg     = vg_vert(:,t) + fac * ( vg_vert(:,t+1) - vg_vert(:,t) )
345
346       IF ( large_scale_subsidence )  THEN
347          w_subs = wsubs_vert(:,t) + fac * ( wsubs_vert(:,t+1) - wsubs_vert(:,t) )
348       ENDIF
349
350    END SUBROUTINE ls_forcing_vert
351
352
353 END MODULE ls_forcing_mod
Note: See TracBrowser for help on using the repository browser.