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

Last change on this file since 4380 was 4360, checked in by suehring, 5 years ago

Bugfix in output of time-averaged plant-canopy quanities; Output of plant-canopy data only where tall canopy is defined; land-surface model: fix wrong location strings; tests: update urban test case; all source code files: copyright update

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