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

Last change on this file since 3701 was 3685, checked in by knoop, 6 years ago

Some interface calls moved to module_interface + cleanup

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