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

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

Bugfix: made "unit" and "found" intend INOUT in module interface subroutines + automatic copyright update

  • Property svn:keywords set to Id
File size: 16.9 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 3655 2019-01-07 16:51:22Z knoop $
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, mode, local_pf, &
396                                    two_d, nzb_do, nzt_do, fill_value )
397
398
399       IMPLICIT NONE
400
401       CHARACTER (LEN=*), INTENT(INOUT) ::  grid       !< name of vertical grid
402       CHARACTER (LEN=*), INTENT(IN) ::  mode       !< either 'xy', 'xz' or 'yz'
403       CHARACTER (LEN=*), INTENT(IN) ::  variable   !< name of variable
404
405       INTEGER(iwp), INTENT(IN) ::  av        !< flag for (non-)average output
406       INTEGER(iwp), INTENT(IN) ::  nzb_do    !< vertical output index (bottom)
407       INTEGER(iwp), INTENT(IN) ::  nzt_do    !< vertical output index (top)
408
409       LOGICAL, INTENT(INOUT) ::  found   !< flag if output variable is found
410       LOGICAL, INTENT(INOUT) ::  two_d !< flag parameter that indicates 2D variables (horizontal cross sections)
411
412       REAL(wp), INTENT(IN) ::  fill_value !< value for the _FillValue attribute
413
414       REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do), INTENT(INOUT) ::  local_pf !< local
415          !< array to which output data is resorted to
416
417
418    END SUBROUTINE gust_data_output_2d
419
420
421!------------------------------------------------------------------------------!
422!
423! Description:
424! ------------
425!> Subroutine defining 3D output variables
426!------------------------------------------------------------------------------!
427    SUBROUTINE gust_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
428
429
430       IMPLICIT NONE
431
432       CHARACTER (LEN=*), INTENT(IN) ::  variable   !< name of variable
433
434       INTEGER(iwp), INTENT(IN) ::  av        !< flag for (non-)average output
435       INTEGER(iwp), INTENT(IN) ::  nzb_do    !< lower limit of the data output (usually 0)
436       INTEGER(iwp), INTENT(IN) ::  nzt_do    !< vertical upper limit of the data output (usually nz_do3d)
437
438       LOGICAL, INTENT(INOUT) ::  found     !< flag if output variable is found
439
440       REAL(wp), INTENT(IN) ::  fill_value !< value for the _FillValue attribute
441
442       REAL(sp), 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    END SUBROUTINE gust_data_output_3d
447
448
449!------------------------------------------------------------------------------!
450! Description:
451! ------------
452!> This routine computes profile and timeseries data for the gust module.
453!------------------------------------------------------------------------------!
454    SUBROUTINE gust_statistics( mode, sr, tn, dots_max )
455
456
457       IMPLICIT NONE
458
459       CHARACTER (LEN=*) ::  mode   !<
460
461       INTEGER(iwp) ::  sr   !<
462       INTEGER(iwp) ::  tn   !<
463       INTEGER(iwp) ::  dots_max   !<
464
465
466    END SUBROUTINE gust_statistics
467
468
469!------------------------------------------------------------------------------!
470! Description:
471! ------------
472!> This routine reads the respective restart data for the gust module.
473!------------------------------------------------------------------------------!
474    SUBROUTINE gust_rrd_global( found )
475
476
477       USE control_parameters,                                                 &
478           ONLY: length, restart_string
479
480
481       IMPLICIT NONE
482
483       LOGICAL, INTENT(OUT)  ::  found
484
485
486       found = .TRUE.
487
488
489       SELECT CASE ( restart_string(1:length) )
490
491          CASE ( 'global_paramter' )
492!             READ ( 13 )  global_parameter
493
494          CASE DEFAULT
495
496             found = .FALSE.
497
498       END SELECT
499
500
501    END SUBROUTINE gust_rrd_global
502
503
504!------------------------------------------------------------------------------!
505! Description:
506! ------------
507!> This routine reads the respective restart data for the gust module.
508!------------------------------------------------------------------------------!
509    SUBROUTINE gust_rrd_local( i, k, nxlf, nxlc, nxl_on_file, nxrf, nxrc,      &
510                               nxr_on_file, nynf, nync, nyn_on_file, nysf,     &
511                               nysc, nys_on_file, tmp_2d, tmp_3d, found )
512
513
514       USE control_parameters
515
516       USE indices
517
518       USE kinds
519
520       USE pegrid
521
522
523       IMPLICIT NONE
524
525       INTEGER(iwp) ::  i               !<
526       INTEGER(iwp) ::  k               !<
527       INTEGER(iwp) ::  nxlc            !<
528       INTEGER(iwp) ::  nxlf            !<
529       INTEGER(iwp) ::  nxl_on_file     !<
530       INTEGER(iwp) ::  nxrc            !<
531       INTEGER(iwp) ::  nxrf            !<
532       INTEGER(iwp) ::  nxr_on_file     !<
533       INTEGER(iwp) ::  nync            !<
534       INTEGER(iwp) ::  nynf            !<
535       INTEGER(iwp) ::  nyn_on_file     !<
536       INTEGER(iwp) ::  nysc            !<
537       INTEGER(iwp) ::  nysf            !<
538       INTEGER(iwp) ::  nys_on_file     !<
539
540       LOGICAL, INTENT(OUT)  ::  found
541
542       REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_2d   !<
543       REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d   !<
544
545!
546!-- Here the reading of user-defined restart data follows:
547!-- Sample for user-defined output
548
549
550       found = .TRUE.
551
552
553       SELECT CASE ( restart_string(1:length) )
554
555          CASE ( 'u2_av' )
556!             IF ( .NOT. ALLOCATED( u2_av ) ) THEN
557!                  ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
558!             ENDIF
559!             IF ( k == 1 )  READ ( 13 )  tmp_3d
560!                u2_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =         &
561!                   tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
562!
563          CASE DEFAULT
564
565             found = .FALSE.
566
567          END SELECT
568
569
570    END SUBROUTINE gust_rrd_local
571
572
573!------------------------------------------------------------------------------!
574! Description:
575! ------------
576!> This routine writes the respective restart data for the gust module.
577!------------------------------------------------------------------------------!
578    SUBROUTINE gust_wrd_global
579
580
581       IMPLICIT NONE
582
583! needs preceeding allocation if array
584!       CALL wrd_write_string( 'global_parameter' )
585!       WRITE ( 14 )  global_parameter
586
587!       IF ( ALLOCATED( inflow_damping_factor ) )  THEN
588!          CALL wrd_write_string( 'inflow_damping_factor' )
589!          WRITE ( 14 )  inflow_damping_factor
590!       ENDIF
591
592
593    END SUBROUTINE gust_wrd_global
594
595
596!------------------------------------------------------------------------------!
597! Description:
598! ------------
599!> This routine writes the respective restart data for the gust module.
600!------------------------------------------------------------------------------!
601    SUBROUTINE gust_wrd_local
602
603
604       IMPLICIT NONE
605
606
607! needs preceeding allocation because sould be array
608!          IF ( ALLOCATED( u2_av ) )  THEN
609!             CALL wrd_write_string( 'u2_av' )
610!             WRITE ( 14 )  u2_av
611!          ENDIF
612
613
614    END SUBROUTINE gust_wrd_local
615
616
617
618 END MODULE gust_mod
Note: See TracBrowser for help on using the repository browser.