source: palm/trunk/SOURCE/gust_mod.f90

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

local namelist parameter added to switch off the module although the respective module namelist appears in the namelist file, further copyright updates

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