source: palm/trunk/SOURCE/gust_mod.f90 @ 3117

Last change on this file since 3117 was 3014, checked in by maronga, 7 years ago

series of bugfixes

File size: 16.4 KB
Line 
1!> @file gust_mod.f90
2!------------------------------------------------------------------------------!
3! This file is part of PALM.
4!
5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! 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-2018 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id$
27! Bugfix: domain bounds of local_pf corrected
28!
29!
30! Interfaces concerning data output updated
31!
32!
33! renamed gust_par to gust_parameters
34!
35!
36! Initial interface definition
37!
38!
39! Description:
40! ------------
41!> Gust model.
42!>
43!> @todo This is just a dummy module. The actual module ist not released yet.
44!------------------------------------------------------------------------------!
45 MODULE gust_mod
46
47    USE indices,                                                               &
48        ONLY:  nxl, nxlg, nxr, nxrg, nys, nysg, nyn, nyng, nzb, nzt
49
50    USE kinds
51
52    IMPLICIT NONE
53
54    LOGICAL  ::  gust_module_enabled = .FALSE.       !< switch, if the entire module is used at all
55
56    SAVE
57
58    PRIVATE
59
60!
61!-- Public functions
62    PUBLIC &
63       gust_parin, &
64       gust_check_parameters, &
65       gust_check_data_output_pr, &
66       gust_check_data_output, &
67       gust_init_arrays, &
68       gust_init, &
69       gust_define_netcdf_grid, &
70       gust_header, &
71       gust_actions, &
72       gust_swap_timelevel, &
73       gust_3d_data_averaging, &
74       gust_data_output_2d, &
75       gust_data_output_3d, &
76       gust_statistics, &
77       gust_rrd_global, &
78       gust_wrd_global, &
79       gust_rrd_local, &
80       gust_wrd_local
81!
82!-- Public parameters, constants and initial values
83    PUBLIC &
84       gust_module_enabled
85
86
87    INTERFACE gust_parin
88       MODULE PROCEDURE gust_parin
89    END INTERFACE gust_parin
90
91    INTERFACE gust_check_parameters
92       MODULE PROCEDURE gust_check_parameters
93    END INTERFACE gust_check_parameters
94
95    INTERFACE gust_check_data_output_pr
96       MODULE PROCEDURE gust_check_data_output_pr
97    END INTERFACE gust_check_data_output_pr
98
99    INTERFACE gust_check_data_output
100       MODULE PROCEDURE gust_check_data_output
101    END INTERFACE gust_check_data_output
102
103    INTERFACE gust_init_arrays
104       MODULE PROCEDURE gust_init_arrays
105    END INTERFACE gust_init_arrays
106
107    INTERFACE gust_init
108       MODULE PROCEDURE gust_init
109    END INTERFACE gust_init
110
111    INTERFACE gust_define_netcdf_grid
112       MODULE PROCEDURE gust_define_netcdf_grid
113    END INTERFACE gust_define_netcdf_grid
114
115    INTERFACE gust_header
116       MODULE PROCEDURE gust_header
117    END INTERFACE gust_header
118
119    INTERFACE gust_actions
120       MODULE PROCEDURE gust_actions
121       MODULE PROCEDURE gust_actions_ij
122    END INTERFACE gust_actions
123
124    INTERFACE gust_swap_timelevel
125       MODULE PROCEDURE gust_swap_timelevel
126    END INTERFACE gust_swap_timelevel
127
128    INTERFACE gust_3d_data_averaging
129       MODULE PROCEDURE gust_3d_data_averaging
130    END INTERFACE gust_3d_data_averaging
131
132    INTERFACE gust_data_output_2d
133       MODULE PROCEDURE gust_data_output_2d
134    END INTERFACE gust_data_output_2d
135
136    INTERFACE gust_data_output_3d
137       MODULE PROCEDURE gust_data_output_3d
138    END INTERFACE gust_data_output_3d
139
140    INTERFACE gust_statistics
141       MODULE PROCEDURE gust_statistics
142    END INTERFACE gust_statistics
143
144    INTERFACE gust_rrd_global
145       MODULE PROCEDURE gust_rrd_global
146    END INTERFACE gust_rrd_global
147
148    INTERFACE gust_wrd_global
149       MODULE PROCEDURE gust_wrd_global
150    END INTERFACE gust_wrd_global
151
152    INTERFACE gust_rrd_local
153       MODULE PROCEDURE gust_rrd_local
154    END INTERFACE gust_rrd_local
155
156    INTERFACE gust_wrd_local
157       MODULE PROCEDURE gust_wrd_local
158    END INTERFACE gust_wrd_local
159
160 CONTAINS
161
162
163!------------------------------------------------------------------------------!
164! Description:
165! ------------
166!> Parin for &gust_parameters for gust module
167!------------------------------------------------------------------------------!
168    SUBROUTINE gust_parin
169
170
171       IMPLICIT NONE
172
173       CHARACTER (LEN=80)  ::  line  !< dummy string that contains the current line of the parameter file
174
175       NAMELIST /gust_parameters/  &
176          gust_module_enabled
177
178       line = ' '
179!
180!--    Try to find gust module package
181       REWIND ( 11 )
182       line = ' '
183       DO   WHILE ( INDEX( line, '&gust_parameters' ) == 0 )
184          READ ( 11, '(A)', END=10 )  line
185       ENDDO
186       BACKSPACE ( 11 )
187!
188!--    Read user-defined namelist
189       READ ( 11, gust_parameters )
190!
191!--    Set flag that indicates that the gust module is switched on
192       gust_module_enabled = .TRUE.
193
19410     CONTINUE
195
196
197    END SUBROUTINE gust_parin
198
199
200!------------------------------------------------------------------------------!
201! Description:
202! ------------
203!> Check parameters routine for gust module
204!------------------------------------------------------------------------------!
205    SUBROUTINE gust_check_parameters
206
207
208       IMPLICIT NONE
209
210
211    END SUBROUTINE gust_check_parameters
212
213
214!------------------------------------------------------------------------------!
215! Description:
216! ------------
217!> Check data output of profiles for gust module
218!------------------------------------------------------------------------------!
219    SUBROUTINE gust_check_data_output_pr( variable, var_count, unit, dopr_unit )
220
221
222       IMPLICIT NONE
223
224       CHARACTER (LEN=*) ::  unit      !<
225       CHARACTER (LEN=*) ::  variable  !<
226       CHARACTER (LEN=*) ::  dopr_unit !< local value of dopr_unit
227
228       INTEGER(iwp) ::  var_count      !<
229
230
231    END SUBROUTINE gust_check_data_output_pr
232
233!------------------------------------------------------------------------------!
234! Description:
235! ------------
236!> Check data output for gust module
237!------------------------------------------------------------------------------!
238    SUBROUTINE gust_check_data_output( var, unit )
239
240
241       IMPLICIT NONE
242
243       CHARACTER (LEN=*) ::  unit  !<
244       CHARACTER (LEN=*) ::  var   !<
245
246
247    END SUBROUTINE gust_check_data_output
248
249
250!------------------------------------------------------------------------------!
251! Description:
252! ------------
253!> Allocate gust module arrays and define pointers
254!------------------------------------------------------------------------------!
255    SUBROUTINE gust_init_arrays
256
257
258       IMPLICIT NONE
259
260
261    END SUBROUTINE gust_init_arrays
262
263
264!------------------------------------------------------------------------------!
265! Description:
266! ------------
267!> Initialization of the gust module
268!------------------------------------------------------------------------------!
269    SUBROUTINE gust_init( dots_label, dots_unit, dots_num, dots_max )
270
271
272       IMPLICIT NONE
273
274       INTEGER(iwp) ::  dots_num
275       INTEGER(iwp) ::  dots_max
276       CHARACTER (LEN=13), DIMENSION(dots_max) :: dots_unit
277       CHARACTER (LEN=13), DIMENSION(dots_max) :: dots_label
278
279
280    END SUBROUTINE gust_init
281
282
283!------------------------------------------------------------------------------!
284!
285! Description:
286! ------------
287!> Subroutine defining appropriate grid for netcdf variables.
288!> It is called out from subroutine netcdf.
289!------------------------------------------------------------------------------!
290    SUBROUTINE gust_define_netcdf_grid( var, found, grid_x, grid_y, grid_z )
291
292
293       IMPLICIT NONE
294
295       CHARACTER (LEN=*), INTENT(IN)  ::  var         !<
296       LOGICAL, INTENT(IN)           ::  found       !<
297       CHARACTER (LEN=*), INTENT(IN) ::  grid_x      !<
298       CHARACTER (LEN=*), INTENT(IN) ::  grid_y      !<
299       CHARACTER (LEN=*), INTENT(IN) ::  grid_z      !<
300
301
302    END SUBROUTINE gust_define_netcdf_grid
303
304
305!------------------------------------------------------------------------------!
306! Description:
307! ------------
308!> Header output for gust module
309!------------------------------------------------------------------------------!
310    SUBROUTINE gust_header ( io )
311
312
313       IMPLICIT NONE
314
315       INTEGER(iwp), INTENT(IN) ::  io  !< Unit of the output file
316
317
318    END SUBROUTINE gust_header
319
320
321!------------------------------------------------------------------------------!
322! Description:
323! ------------
324!> Call for all grid points
325!------------------------------------------------------------------------------!
326    SUBROUTINE gust_actions( location )
327
328
329       IMPLICIT NONE
330
331       CHARACTER (LEN=*) ::  location !<
332
333
334    END SUBROUTINE gust_actions
335
336
337!------------------------------------------------------------------------------!
338! Description:
339! ------------
340!> Call for grid point i,j
341!------------------------------------------------------------------------------!
342    SUBROUTINE gust_actions_ij( i, j, location )
343
344
345       IMPLICIT NONE
346
347       CHARACTER (LEN=*) ::  location
348
349       INTEGER(iwp) ::  i
350       INTEGER(iwp) ::  j
351
352
353    END SUBROUTINE gust_actions_ij
354
355
356!------------------------------------------------------------------------------!
357! Description:
358! ------------
359!> Swapping of timelevels
360!------------------------------------------------------------------------------!
361    SUBROUTINE gust_swap_timelevel ( mod_count )
362
363
364       IMPLICIT NONE
365
366       INTEGER, INTENT(IN) :: mod_count
367
368
369    END SUBROUTINE gust_swap_timelevel
370
371
372!------------------------------------------------------------------------------!
373!
374! Description:
375! ------------
376!> Subroutine for averaging 3D data
377!------------------------------------------------------------------------------!
378    SUBROUTINE gust_3d_data_averaging( mode, variable )
379
380
381       IMPLICIT NONE
382
383       CHARACTER (LEN=*) ::  mode    !<
384       CHARACTER (LEN=*) :: variable !<
385
386
387    END SUBROUTINE gust_3d_data_averaging
388
389!------------------------------------------------------------------------------!
390!
391! Description:
392! ------------
393!> Subroutine defining 2D output variables
394!------------------------------------------------------------------------------!
395    SUBROUTINE gust_data_output_2d( av, variable, found, grid, local_pf,       &
396                                    two_d, nzb_do, nzt_do )
397
398
399       IMPLICIT NONE
400
401       CHARACTER (LEN=*) ::  grid     !<
402       CHARACTER (LEN=*) ::  variable !<
403
404       INTEGER(iwp) ::  av     !< flag to control data output of instantaneous or time-averaged data
405       INTEGER(iwp) ::  nzb_do !< lower limit of the data output (usually 0)
406       INTEGER(iwp) ::  nzt_do !< vertical upper limit of the data output (usually nz_do3d)
407
408       LOGICAL      ::  found !<
409       LOGICAL      ::  two_d !< flag parameter that indicates 2D variables (horizontal cross sections)
410
411       REAL(wp) ::  fill_value = -999.0_wp    !< value for the _FillValue attribute
412
413       REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf !<
414
415
416    END SUBROUTINE gust_data_output_2d
417
418
419!------------------------------------------------------------------------------!
420!
421! Description:
422! ------------
423!> Subroutine defining 3D output variables
424!------------------------------------------------------------------------------!
425    SUBROUTINE gust_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
426
427
428       IMPLICIT NONE
429
430       CHARACTER (LEN=*) ::  variable !<
431
432       INTEGER(iwp) ::  av    !<
433       INTEGER(iwp) ::  nzb_do !< lower limit of the data output (usually 0)
434       INTEGER(iwp) ::  nzt_do !< vertical upper limit of the data output (usually nz_do3d)
435
436       LOGICAL      ::  found !<
437
438       REAL(wp) ::  fill_value = -999.0_wp    !< value for the _FillValue attribute
439
440       REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf !<
441
442
443    END SUBROUTINE gust_data_output_3d
444
445
446!------------------------------------------------------------------------------!
447! Description:
448! ------------
449!> This routine computes profile and timeseries data for the gust module.
450!------------------------------------------------------------------------------!
451    SUBROUTINE gust_statistics( mode, sr, tn, dots_max )
452
453
454       IMPLICIT NONE
455
456       CHARACTER (LEN=*) ::  mode   !<
457
458       INTEGER(iwp) ::  sr   !<
459       INTEGER(iwp) ::  tn   !<
460       INTEGER(iwp) ::  dots_max   !<
461
462
463    END SUBROUTINE gust_statistics
464
465
466!------------------------------------------------------------------------------!
467! Description:
468! ------------
469!> This routine reads the respective restart data for the gust module.
470!------------------------------------------------------------------------------!
471    SUBROUTINE gust_rrd_global( found )
472
473
474       USE control_parameters,                                                 &
475           ONLY: length, restart_string
476
477
478       IMPLICIT NONE
479
480       LOGICAL, INTENT(OUT)  ::  found
481
482
483       found = .TRUE.
484
485
486       SELECT CASE ( restart_string(1:length) )
487
488          CASE ( 'global_paramter' )
489!             READ ( 13 )  global_parameter
490
491          CASE DEFAULT
492
493             found = .FALSE.
494
495       END SELECT
496
497
498    END SUBROUTINE gust_rrd_global
499
500
501!------------------------------------------------------------------------------!
502! Description:
503! ------------
504!> This routine reads the respective restart data for the gust module.
505!------------------------------------------------------------------------------!
506    SUBROUTINE gust_rrd_local( i, k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,      &
507                               nxr_on_file, nynf, nync, nyn_on_file, nysf,     &
508                               nysc, nys_on_file, tmp_2d, tmp_3d, found )
509
510
511       USE control_parameters
512
513       USE indices
514
515       USE kinds
516
517       USE pegrid
518
519
520       IMPLICIT NONE
521
522       INTEGER(iwp) ::  i               !<
523       INTEGER(iwp) ::  k               !<
524       INTEGER(iwp) ::  nxlc            !<
525       INTEGER(iwp) ::  nxlf            !<
526       INTEGER(iwp) ::  nxl_on_file     !<
527       INTEGER(iwp) ::  nxrc            !<
528       INTEGER(iwp) ::  nxrf            !<
529       INTEGER(iwp) ::  nxr_on_file     !<
530       INTEGER(iwp) ::  nync            !<
531       INTEGER(iwp) ::  nynf            !<
532       INTEGER(iwp) ::  nyn_on_file     !<
533       INTEGER(iwp) ::  nysc            !<
534       INTEGER(iwp) ::  nysf            !<
535       INTEGER(iwp) ::  nys_on_file     !<
536
537       LOGICAL, INTENT(OUT)  ::  found
538
539       REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_2d   !<
540       REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d   !<
541
542!
543!-- Here the reading of user-defined restart data follows:
544!-- Sample for user-defined output
545
546
547       found = .TRUE.
548
549
550       SELECT CASE ( restart_string(1:length) )
551
552          CASE ( 'u2_av' )
553!             IF ( .NOT. ALLOCATED( u2_av ) ) THEN
554!                  ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
555!             ENDIF
556!             IF ( k == 1 )  READ ( 13 )  tmp_3d
557!                u2_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =         &
558!                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
559!
560          CASE DEFAULT
561
562             found = .FALSE.
563
564          END SELECT
565
566
567    END SUBROUTINE gust_rrd_local
568
569
570!------------------------------------------------------------------------------!
571! Description:
572! ------------
573!> This routine writes the respective restart data for the gust module.
574!------------------------------------------------------------------------------!
575    SUBROUTINE gust_wrd_global
576
577
578       IMPLICIT NONE
579
580! needs preceeding allocation if array
581!       CALL wrd_write_string( 'global_parameter' )
582!       WRITE ( 14 )  global_parameter
583
584!       IF ( ALLOCATED( inflow_damping_factor ) )  THEN
585!          CALL wrd_write_string( 'inflow_damping_factor' )
586!          WRITE ( 14 )  inflow_damping_factor
587!       ENDIF
588
589
590    END SUBROUTINE gust_wrd_global
591
592
593!------------------------------------------------------------------------------!
594! Description:
595! ------------
596!> This routine writes the respective restart data for the gust module.
597!------------------------------------------------------------------------------!
598    SUBROUTINE gust_wrd_local
599
600
601       IMPLICIT NONE
602
603
604! needs preceeding allocation because sould be array
605!          IF ( ALLOCATED( u2_av ) )  THEN
606!             CALL wrd_write_string( 'u2_av' )
607!             WRITE ( 14 )  u2_av
608!          ENDIF
609
610
611    END SUBROUTINE gust_wrd_local
612
613
614
615 END MODULE gust_mod
Note: See TracBrowser for help on using the repository browser.