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

Last change on this file since 2932 was 2932, checked in by maronga, 3 years ago

renamed all Fortran NAMELISTS

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