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

Last change on this file since 4655 was 4646, checked in by raasch, 4 years ago

files re-formatted to follow the PALM coding standard

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