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

Last change on this file since 4842 was 4842, checked in by raasch, 3 years ago

reading of namelist file and actions in case of namelist errors revised so that statement labels and goto statements are not required any more, deprecated namelists removed

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