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

Last change on this file since 3878 was 3837, checked in by knoop, 5 years ago

Added module_interface for prognostic_equations

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