source: palm/trunk/SOURCE/user_module.f90 @ 4517

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

added restart with MPI-IO for reading local arrays

  • Property svn:keywords set to Id
File size: 42.2 KB
RevLine 
[1873]1!> @file user_module.f90
[4497]2!--------------------------------------------------------------------------------------------------!
[2696]3! This file is part of the PALM model system.
[1036]4!
[4497]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.
[1036]8!
[4497]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.
[1036]12!
[4497]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/>.
[1036]15!
[4360]16! Copyright 1997-2020 Leibniz Universitaet Hannover
[4497]17!--------------------------------------------------------------------------------------------------!
[1036]18!
[4497]19!
[484]20! Current revisions:
[211]21! -----------------
[1683]22!
[4517]23!
[1321]24! Former revisions:
25! -----------------
26! $Id: user_module.f90 4517 2020-05-03 14:29:30Z raasch $
[4517]27! added restart with MPI-IO for reading local arrays
28!
29! 4504 2020-04-20 12:11:24Z raasch
[4504]30! hint for setting rmask arrays added
31!
32! 4497 2020-04-15 10:20:51Z raasch
[4497]33! file re-formatted to follow the PALM coding standard
34!
35! 4495 2020-04-13 20:11:20Z raasch
[4495]36! restart data handling with MPI-IO added
[4497]37!
[4495]38! 4360 2020-01-07 11:25:50Z suehring
[4497]39! Introduction of wall_flags_total_0, which currently sets bits based on static topography
40! information used in wall_flags_static_0
41!
[4346]42! 4329 2019-12-10 15:46:36Z motisi
[4329]43! Renamed wall_flags_0 to wall_flags_static_0
[4497]44!
[4329]45! 4287 2019-11-01 14:50:20Z raasch
[4287]46! reading of namelist file and actions in case of namelist errors revised so that statement labels
[4497]47! and goto statements are not required any more; this revision also removes a previous bug which
48! appeared when the namelist has been commented out in the namelist file
49!
[4287]50! 4182 2019-08-22 15:20:23Z scharf
[4182]51! Corrected "Former revisions" section
[4497]52!
[4182]53! 3986 2019-05-20 14:08:14Z Giersch
[3986]54! Redundant integration of control parameters in user_rrd_global removed
[4497]55!
[3986]56! 3911 2019-04-17 12:26:19Z knoop
[3911]57! Bugfix: added before_prognostic_equations case in user_actions
[4497]58!
[3911]59! 3768 2019-02-27 14:35:58Z raasch
[3768]60! variables commented + statements added to avoid compiler warnings about unused variables
61!
62! 3767 2019-02-27 08:18:02Z raasch
[3767]63! unused variable for file index removed from rrd-subroutines parameter list
[4497]64!
[3767]65! 3747 2019-02-16 15:15:23Z gronemeier
[3747]66! Add routine user_init_arrays
[4497]67!
[3747]68! 3703 2019-01-29 16:43:53Z knoop
[2894]69! An example for a user defined global variable has been added (Giersch)
[1321]70!
[4182]71! Revision 1.1  1998/03/24 15:29:04  raasch
72! Initial revision
73!
74!
[211]75! Description:
76! ------------
[4497]77!> Declaration of user-defined variables. This module may only be used in the user-defined routines
78!> (contained in user_interface.f90).
79!--------------------------------------------------------------------------------------------------!
[1682]80 MODULE user
[211]81
[3687]82    USE arrays_3d
83
84    USE control_parameters
85
86    USE cpulog
87
88    USE indices
89
[1320]90    USE kinds
[211]91
[3687]92    USE pegrid
93
94    USE statistics
95
96    USE surface_mod
97
[1320]98    IMPLICIT NONE
99
[4497]100    INTEGER(iwp) ::  dots_num_palm      !<
101    INTEGER(iwp) ::  dots_num_user = 0  !<
102    INTEGER(iwp) ::  user_idummy        !<
[1320]103
[4497]104    LOGICAL ::  user_module_enabled = .FALSE.  !<
105
106    REAL(wp) ::  user_rdummy  !<
107
[211]108!
109!-- Sample for user-defined output
[4497]110!    REAL(wp) :: global_parameter  !< user defined global parameter
[2894]111!
[4497]112!    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u2      !< user defined array
113!    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u2_av   !< user defined array
114!    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ustvst  !< user defined array
[211]115
116    SAVE
117
[3701]118    PRIVATE
[3687]119
120!
121!- Public functions
[4497]122    PUBLIC                                                                                         &
123       user_actions,                                                                               &
124       user_check_data_output,                                                                     &
125       user_check_data_output_pr,                                                                  &
126       user_check_data_output_ts,                                                                  &
127       user_check_parameters,                                                                      &
128       user_data_output_2d,                                                                        &
129       user_data_output_3d,                                                                        &
130       user_define_netcdf_grid,                                                                    &
131       user_header,                                                                                &
132       user_init,                                                                                  &
133       user_init_arrays,                                                                           &
134       user_last_actions,                                                                          &
135       user_parin,                                                                                 &
136       user_rrd_global,                                                                            &
137       user_rrd_local,                                                                             &
138       user_statistics,                                                                            &
139       user_3d_data_averaging,                                                                     &
140       user_wrd_global,                                                                            &
141       user_wrd_local
[3687]142
[4497]143
[3687]144!
145!- Public parameters, constants and initial values
[4497]146   PUBLIC                                                                                          &
[3701]147      user_module_enabled
[3687]148
149    INTERFACE user_parin
150       MODULE PROCEDURE user_parin
151    END INTERFACE user_parin
152
153    INTERFACE user_check_parameters
154       MODULE PROCEDURE user_check_parameters
155    END INTERFACE user_check_parameters
156
[3700]157    INTERFACE user_check_data_output_ts
158       MODULE PROCEDURE user_check_data_output_ts
159    END INTERFACE user_check_data_output_ts
160
[3687]161    INTERFACE user_check_data_output_pr
162       MODULE PROCEDURE user_check_data_output_pr
163    END INTERFACE user_check_data_output_pr
164
165    INTERFACE user_check_data_output
166       MODULE PROCEDURE user_check_data_output
167    END INTERFACE user_check_data_output
168
[3701]169    INTERFACE user_define_netcdf_grid
170       MODULE PROCEDURE user_define_netcdf_grid
171    END INTERFACE user_define_netcdf_grid
172
[3687]173    INTERFACE user_init
174       MODULE PROCEDURE user_init
175    END INTERFACE user_init
176
[3747]177    INTERFACE user_init_arrays
178       MODULE PROCEDURE user_init_arrays
179    END INTERFACE user_init_arrays
180
[3687]181    INTERFACE user_header
182       MODULE PROCEDURE user_header
183    END INTERFACE user_header
184
185    INTERFACE user_actions
186       MODULE PROCEDURE user_actions
187       MODULE PROCEDURE user_actions_ij
188    END INTERFACE user_actions
189
190    INTERFACE user_3d_data_averaging
191       MODULE PROCEDURE user_3d_data_averaging
192    END INTERFACE user_3d_data_averaging
193
194    INTERFACE user_data_output_2d
195       MODULE PROCEDURE user_data_output_2d
196    END INTERFACE user_data_output_2d
197
198    INTERFACE user_data_output_3d
199       MODULE PROCEDURE user_data_output_3d
200    END INTERFACE user_data_output_3d
201
202    INTERFACE user_statistics
203       MODULE PROCEDURE user_statistics
204    END INTERFACE user_statistics
205
206    INTERFACE user_rrd_global
[4495]207       MODULE PROCEDURE user_rrd_global_ftn
208       MODULE PROCEDURE user_rrd_global_mpi
[3687]209    END INTERFACE user_rrd_global
210
211    INTERFACE user_rrd_local
[4517]212       MODULE PROCEDURE user_rrd_local_ftn
213       MODULE PROCEDURE user_rrd_local_mpi
[3687]214    END INTERFACE user_rrd_local
215
216    INTERFACE user_wrd_global
217       MODULE PROCEDURE user_wrd_global
218    END INTERFACE user_wrd_global
219
220    INTERFACE user_wrd_local
221       MODULE PROCEDURE user_wrd_local
222    END INTERFACE user_wrd_local
223
[3701]224    INTERFACE user_last_actions
225       MODULE PROCEDURE user_last_actions
226    END INTERFACE user_last_actions
[3687]227
[3701]228
[3687]229 CONTAINS
230
231
[4497]232!--------------------------------------------------------------------------------------------------!
[3687]233! Description:
234! ------------
235!> Parin for &user_parameters for user module
[4497]236!--------------------------------------------------------------------------------------------------!
[3687]237 SUBROUTINE user_parin
238
[4497]239    CHARACTER (LEN=80) ::  line  !< string containing the last line read from namelist file
[3687]240
[4497]241    INTEGER(iwp) ::  i          !<
242    INTEGER(iwp) ::  io_status  !< status after reading the namelist file
243    INTEGER(iwp) ::  j          !<
[3687]244
245
[4287]246    NAMELIST /user_parameters/                                                                     &
247       data_output_masks_user,                                                                     &
248       data_output_pr_user,                                                                        &
249       data_output_user,                                                                           &
250       region
[3687]251
252!
[3768]253!-- Next statement is to avoid compiler warnings about unused variables. Please remove in case
254!-- that you are using them.
255    IF ( dots_num_palm == 0  .OR.  dots_num_user == 0  .OR.  user_idummy == 0  .OR.                &
256         user_rdummy == 0.0_wp )  CONTINUE
257
258!
[4497]259!-- Set revision number of this default interface version. It will be checked within the main
260!-- program (palm). Please change the revision number in case that the current revision does not
261!-- match with previous revisions (e.g. if routines have been added/deleted or if parameter lists
262!-- in subroutines have been changed).
[4495]263    user_interface_current_revision = 'r4495'
[3687]264
265!
[4497]266!-- Position the namelist-file at the beginning (it has already been opened in parin), and try to
267!-- read (find) a namelist named "user_parameters".
[3687]268    REWIND ( 11 )
[4287]269    READ( 11, user_parameters, IOSTAT=io_status )
[3687]270
[4287]271!
272!-- Actions depending on the READ status
273    IF ( io_status == 0 )  THEN
274!
275!--    User namelist found and correctly read. Set default module switch to true. This activates
276!--    calls of the user-interface subroutines.
277       user_module_enabled = .TRUE.
[3687]278
[4287]279    ELSEIF ( io_status > 0 )  THEN
280!
281!--    User namelist was found, but contained errors. Print an error message containing the line
282!--    that caused the problem
283       BACKSPACE( 11 )
284       READ( 11 , '(A)') line
285       CALL parin_fail_message( 'user_parameters', line )
[3701]286
[4287]287    ENDIF
[3687]288
289!
[4497]290!-- Determine the number of user-defined profiles and append them to the standard data output
291!-- (data_output_pr)
[3701]292    IF ( user_module_enabled )  THEN
[3687]293       IF ( data_output_pr_user(1) /= ' ' )  THEN
294          i = 1
295          DO WHILE ( data_output_pr(i) /= ' '  .AND.  i <= 100 )
296             i = i + 1
297          ENDDO
298          j = 1
299          DO WHILE ( data_output_pr_user(j) /= ' '  .AND.  j <= 100 )
300             data_output_pr(i) = data_output_pr_user(j)
301             max_pr_user_tmp   = max_pr_user_tmp + 1
302             i = i + 1
303             j = j + 1
304          ENDDO
305       ENDIF
306    ENDIF
307
[3701]308
[3687]309 END SUBROUTINE user_parin
310
311
[4497]312!--------------------------------------------------------------------------------------------------!
[3687]313! Description:
314! ------------
315!> Check &userpar control parameters and deduce further quantities.
[4497]316!--------------------------------------------------------------------------------------------------!
[3687]317 SUBROUTINE user_check_parameters
318
[4497]319!
320!-- Here the user may add code to check the validity of further &userpar control parameters or
321!-- deduce further quantities.
[3687]322
323
324 END SUBROUTINE user_check_parameters
325
326
[4497]327!--------------------------------------------------------------------------------------------------!
[3687]328! Description:
329! ------------
[3700]330!> Set module-specific timeseries units and labels
[4497]331!--------------------------------------------------------------------------------------------------!
[3700]332 SUBROUTINE user_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
333
[4497]334    INTEGER(iwp),      INTENT(IN)     ::  dots_max  !<
335    INTEGER(iwp),      INTENT(INOUT)  ::  dots_num  !<
[3700]336
[4497]337    CHARACTER(LEN=*), DIMENSION(dots_max), INTENT(INOUT)  ::  dots_label  !<
338    CHARACTER(LEN=*), DIMENSION(dots_max), INTENT(INOUT)  ::  dots_unit   !<
[3700]339
[3768]340!
341!-- Next line is to avoid compiler warning about unused variables. Please remove.
342    IF ( dots_num == 0  .OR.  dots_label(1)(1:1) == ' '  .OR.  dots_unit(1)(1:1) == ' ' )  CONTINUE
[3700]343
[3768]344!
[4497]345!-- Sample for user-defined time series:
346!-- For each time series quantity you have to give a label and a unit, which will be used for the
347!-- NetCDF file. They must not contain more than seven characters. The value of dots_num has to be
348!-- increased by the number of new time series quantities. Its old value has to be stored in
349!-- dots_num_palm. See routine user_statistics on how to calculate and output these quantities.
[3700]350
351!    dots_num_palm = dots_num
352
353!    dots_num = dots_num + 1
354!    dots_num_user = dots_num_user + 1
355!    dots_label(dots_num) = 'abs_umx'
356!    dots_unit(dots_num)  = 'm/s'
357
358!    dots_num = dots_num + 1
359!    dots_num_user = dots_num_user + 1
360!    dots_label(dots_num) = 'abs_vmx'
361!    dots_unit(dots_num)  = 'm/s'
362
363
364 END SUBROUTINE user_check_data_output_ts
365
366
[4497]367!--------------------------------------------------------------------------------------------------!
[3700]368! Description:
369! ------------
[4497]370!> Set the unit of user defined profile output quantities. For those variables not recognized by the
371!> user, the parameter unit is set to "illegal", which tells the calling routine that the
372!> output variable is not defined and leads to a program abort.
373!--------------------------------------------------------------------------------------------------!
[3700]374 SUBROUTINE user_check_data_output_pr( variable, var_count, unit, dopr_unit )
[3687]375
376
377    USE profil_parameter
378
379
[4497]380    CHARACTER (LEN=*) ::  unit      !<
381    CHARACTER (LEN=*) ::  variable  !<
[3700]382    CHARACTER (LEN=*) ::  dopr_unit !< local value of dopr_unit
[3687]383
[4497]384!    INTEGER(iwp) ::  user_pr_index  !<
385    INTEGER(iwp) ::  var_count      !<
[3687]386
[3768]387!
388!-- Next line is to avoid compiler warning about unused variables. Please remove.
389    IF ( unit(1:1) == ' '  .OR.  dopr_unit(1:1) == ' '  .OR.  var_count == 0 )  CONTINUE
390
[3687]391    SELECT CASE ( TRIM( variable ) )
392
393!
394!--    Uncomment and extend the following lines, if necessary.
[4497]395!--    Add additional CASE statements depending on the number of quantities for which profiles are
396!--    to be calculated. The respective calculations to be performed have to be added in routine
397!--    user_statistics. The quantities are (internally) identified by a user-profile-number
398!--    (see variable "user_pr_index" below). The first user-profile must be assigned the number
399!--    "pr_palm+1", the second one "pr_palm+2", etc. The respective user-profile-numbers have also
400!--    to be used in routine user_statistics!
401!       CASE ( 'u*v*' )                      ! quantity string as given in data_output_pr_user
[3687]402!          user_pr_index = pr_palm + 1
403!          dopr_index(var_count)  = user_pr_index    ! quantities' user-profile-number
[3700]404!          dopr_unit = 'm2/s2'  ! quantity unit
405!          unit = dopr_unit
[4497]406!          hom(:,2,user_pr_index,:) = SPREAD( zu, 2, statistic_regions+1 )
407!                                            ! grid on which the quantity is defined (use zu or zw)
408!
[3687]409
410       CASE DEFAULT
411          unit = 'illegal'
412
413    END SELECT
414
415
416 END SUBROUTINE user_check_data_output_pr
417
418
[4497]419!--------------------------------------------------------------------------------------------------!
[3687]420! Description:
421! ------------
[4497]422!> Set the unit of user defined output quantities. For those variables not recognized by the user,
423!> the parameter unit is set to "illegal", which tells the calling routine that the output variable
424!> is not defined and leads to a program abort.
425!--------------------------------------------------------------------------------------------------!
[3687]426 SUBROUTINE user_check_data_output( variable, unit )
427
428
[4497]429    CHARACTER (LEN=*) ::  unit      !<
430    CHARACTER (LEN=*) ::  variable  !<
[3687]431
432
433    SELECT CASE ( TRIM( variable ) )
434
435!
436!--    Uncomment and extend the following lines, if necessary
437!       CASE ( 'u2' )
438!          unit = 'm2/s2'
439!
440!       CASE ( 'u*v*' )
441!          unit = 'm2/s2'
442!
443       CASE DEFAULT
444          unit = 'illegal'
445
446    END SELECT
447
448
449 END SUBROUTINE user_check_data_output
450
451
[4497]452!--------------------------------------------------------------------------------------------------!
[3687]453! Description:
454! ------------
[3747]455!> Initialize user-defined arrays
[4497]456!--------------------------------------------------------------------------------------------------!
[3747]457 SUBROUTINE user_init_arrays
458
459
[3768]460!    INTEGER(iwp) :: i       !< loop index
461!    INTEGER(iwp) :: j       !< loop index
462!    INTEGER(iwp) :: region  !< index for loop over statistic regions
[3747]463
464!
465!-- Allocate user-defined arrays and set flags for statistic regions.
466!-- Sample for user-defined output
467!    ALLOCATE( u2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
468!    ALLOCATE( ustvst(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
469
470!
471!-- Example for defining a statistic region:
[4504]472!-- ATTENTION: rmask = 0 is required at the ghost boundaries to guarantee correct statistic
473!--            evaluations (otherwise ghost points would be counted twice). This setting has
474!--            already been cared for in routine init_3d_model. Please don't set the ghost points
475!--            /= 0. i.e. run the following loop only over nxl,nxr and nys,nyn.
[3747]476!     IF ( statistic_regions >= 1 )  THEN
477!        region = 1
[4497]478!
[3747]479!        rmask(:,:,region) = 0.0_wp
480!        DO  i = nxl, nxr
481!           IF ( i >= INT( 0.25 * nx ) .AND. i <= INT( 0.75 * nx ) )  THEN
482!              DO  j = nys, nyn
483!                 IF ( i >= INT( 0.25 * ny ) .AND. i <= INT( 0.75 * ny ) )  THEN
484!                    rmask(j,i,region) = 1.0_wp
485!                 ENDIF
486!              ENDDO
487!           ENDIF
488!        ENDDO
[4497]489!
[3747]490!     ENDIF
491
492 END SUBROUTINE user_init_arrays
493
494
[4497]495!--------------------------------------------------------------------------------------------------!
[3747]496! Description:
497! ------------
[3687]498!> Execution of user-defined initializing actions
[4497]499!--------------------------------------------------------------------------------------------------!
[3687]500 SUBROUTINE user_init
501
502
[4497]503!    CHARACTER(LEN=20) :: field_char  !<
[3687]504!
505!-- Here the user-defined initializing actions follow:
506!-- Sample for user-defined output
[3747]507!    ustvst = 0.0_wp
[3687]508
509
510 END SUBROUTINE user_init
511
512
[4497]513!--------------------------------------------------------------------------------------------------!
[3687]514! Description:
515! ------------
[4497]516!> Set the grids on which user-defined output quantities are defined. Allowed values for grid_x are
517!> "x" and "xu", for grid_y "y" and "yv", and for grid_z "zu" and "zw".
518!--------------------------------------------------------------------------------------------------!
[3700]519 SUBROUTINE user_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z )
520
521
522    CHARACTER (LEN=*) ::  grid_x     !<
523    CHARACTER (LEN=*) ::  grid_y     !<
524    CHARACTER (LEN=*) ::  grid_z     !<
525    CHARACTER (LEN=*) ::  variable   !<
526
527    LOGICAL ::  found   !<
528
529
530    SELECT CASE ( TRIM( variable ) )
531
532!
533!--    Uncomment and extend the following lines, if necessary
534!       CASE ( 'u2', 'u2_xy', 'u2_xz', 'u2_yz' )
535!          found  = .TRUE.
536!          grid_x = 'xu'
537!          grid_y = 'y'
538!          grid_z = 'zu'
539
540!       CASE ( 'u*v*', 'u*v*_xy', 'u*v*_xz', 'u*v*_yz' )
541!          found  = .TRUE.
542!          grid_x = 'x'
543!          grid_y = 'y'
544!          grid_z = 'zu'
545
546       CASE DEFAULT
547          found  = .FALSE.
548          grid_x = 'none'
549          grid_y = 'none'
550          grid_z = 'none'
551
552    END SELECT
553
554
555 END SUBROUTINE user_define_netcdf_grid
556
557
558
559
[4497]560!--------------------------------------------------------------------------------------------------!
[3700]561! Description:
562! ------------
[3687]563!> Print a header with user-defined information.
[4497]564!--------------------------------------------------------------------------------------------------!
[3687]565 SUBROUTINE user_header( io )
566
567
[4497]568    INTEGER(iwp) ::  i   !<
569    INTEGER(iwp) ::  io  !<
[3687]570
571!
[4497]572!-- If no user-defined variables are read from the namelist-file, no information will be printed.
[3701]573    IF ( .NOT. user_module_enabled )  THEN
[3687]574       WRITE ( io, 100 )
575       RETURN
576    ENDIF
577
578!
579!-- Printing the information.
580    WRITE ( io, 110 )
581
582    IF ( statistic_regions /= 0 )  THEN
583       WRITE ( io, 200 )
584       DO  i = 0, statistic_regions
585          WRITE ( io, 201 )  i, region(i)
586       ENDDO
587    ENDIF
588
589!
590!-- Format-descriptors
591100 FORMAT (//' *** no user-defined variables found'/)
[4497]592110 FORMAT (//1X,78('#') // ' User-defined variables and actions:' /                               &
593            ' -----------------------------------'//)
[3687]594200 FORMAT (' Output of profiles and time series for following regions:' /)
595201 FORMAT (4X,'Region ',I1,':   ',A)
596
597
598 END SUBROUTINE user_header
599
600
[4497]601!--------------------------------------------------------------------------------------------------!
[3687]602! Description:
603! ------------
604!> Call for all grid points
[4497]605!--------------------------------------------------------------------------------------------------!
[3687]606 SUBROUTINE user_actions( location )
607
608
[4497]609    CHARACTER(LEN=*) ::  location  !<
[3687]610
[4497]611!    INTEGER(iwp) ::  i  !<
612!    INTEGER(iwp) ::  j  !<
613!    INTEGER(iwp) ::  k  !<
[3687]614
615    CALL cpu_log( log_point(24), 'user_actions', 'start' )
616
617!
[4497]618!-- Here the user-defined actions follow. No calls for single grid points are allowed at locations
619!-- before and after the timestep, since these calls are not within an i,j-loop
[3687]620    SELECT CASE ( location )
621
622       CASE ( 'before_timestep' )
623!
624!--       Enter actions to be done before every timestep here
625
[3911]626       CASE ( 'before_prognostic_equations' )
627!
628!--       Enter actions to be done before all prognostic equations here
[3687]629
630       CASE ( 'after_integration' )
631!
[4497]632!--       Enter actions to be done after every time integration (before data output)
[3687]633!--       Sample for user-defined output:
634!          DO  i = nxlg, nxrg
635!             DO  j = nysg, nyng
636!                DO  k = nzb, nzt
637!                   u2(k,j,i) = u(k,j,i)**2
638!                ENDDO
639!             ENDDO
640!          ENDDO
641!          DO  i = nxlg, nxr
642!             DO  j = nysg, nyn
643!                DO  k = nzb, nzt+1
644!                   ustvst(k,j,i) =  &
[4497]645!                      ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,0) ) *                      &
[3687]646!                      ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,0) )
647!                ENDDO
648!             ENDDO
649!          ENDDO
650
651
652       CASE ( 'after_timestep' )
653!
654!--       Enter actions to be done after every timestep here
655
656
657       CASE ( 'u-tendency' )
658!
659!--       Enter actions to be done in the u-tendency term here
660
661
662       CASE ( 'v-tendency' )
663
664
665       CASE ( 'w-tendency' )
666
667
668       CASE ( 'pt-tendency' )
669
670
671       CASE ( 'sa-tendency' )
672
673
674       CASE ( 'e-tendency' )
675
676
677       CASE ( 'q-tendency' )
678
679
680       CASE ( 's-tendency' )
681
682
683       CASE DEFAULT
[3911]684          CONTINUE
[3687]685
686    END SELECT
687
688    CALL cpu_log( log_point(24), 'user_actions', 'stop' )
689
690 END SUBROUTINE user_actions
691
692
[4497]693!--------------------------------------------------------------------------------------------------!
[3687]694! Description:
695! ------------
696!> Call for grid point i,j
[4497]697!--------------------------------------------------------------------------------------------------!
[3687]698 SUBROUTINE user_actions_ij( i, j, location )
699
700
[4497]701    CHARACTER(LEN=*) ::  location  !<
[3687]702
[4497]703    INTEGER(iwp) ::  i  !<
704    INTEGER(iwp) ::  j  !<
[3687]705
706!
707!-- Here the user-defined actions follow
708    SELECT CASE ( location )
709
710       CASE ( 'u-tendency' )
[3768]711
[3687]712!
[3768]713!--       Next line is to avoid compiler warning about unused variables. Please remove.
714          IF ( i == 0  .OR.  j == 0 )  CONTINUE
715
716!
[3687]717!--       Enter actions to be done in the u-tendency term here
718
719
720       CASE ( 'v-tendency' )
721
722
723       CASE ( 'w-tendency' )
724
725
726       CASE ( 'pt-tendency' )
727
728
729       CASE ( 'sa-tendency' )
730
731
732       CASE ( 'e-tendency' )
733
734
735       CASE ( 'q-tendency' )
736
737
738       CASE ( 's-tendency' )
739
740
741       CASE DEFAULT
[3911]742          CONTINUE
[3687]743
744    END SELECT
745
746 END SUBROUTINE user_actions_ij
747
748
[4497]749!--------------------------------------------------------------------------------------------------!
[3687]750! Description:
751! ------------
[4497]752!> Sum up and time-average user-defined output quantities as well as allocate the array necessary
753!> for storing the average.
754!--------------------------------------------------------------------------------------------------!
[3687]755 SUBROUTINE user_3d_data_averaging( mode, variable )
756
757
[4497]758    CHARACTER(LEN=*) ::  mode      !<
759    CHARACTER(LEN=*) ::  variable  !<
[3687]760
[4497]761!    INTEGER(iwp) ::  i  !<
762!    INTEGER(iwp) ::  j  !<
763!    INTEGER(iwp) ::  k  !<
[3687]764
765    IF ( mode == 'allocate' )  THEN
766
767       SELECT CASE ( TRIM( variable ) )
768
769!
770!--       Uncomment and extend the following lines, if necessary.
[4497]771!--       The arrays for storing the user defined quantities (here u2_av) have to be declared and
772!--       defined by the user!
[3687]773!--       Sample for user-defined output:
774!          CASE ( 'u2' )
775!             IF ( .NOT. ALLOCATED( u2_av ) )  THEN
776!                ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
777!             ENDIF
778!             u2_av = 0.0_wp
779
780          CASE DEFAULT
781             CONTINUE
782
783       END SELECT
784
785    ELSEIF ( mode == 'sum' )  THEN
786
787       SELECT CASE ( TRIM( variable ) )
788
789!
790!--       Uncomment and extend the following lines, if necessary.
[4497]791!--       The arrays for storing the user defined quantities (here u2 and u2_av) have to be declared
792!--       and defined by the user!
[3687]793!--       Sample for user-defined output:
794!          CASE ( 'u2' )
[4497]795!             IF ( ALLOCATED( u2_av ) )  THEN
[3687]796!                DO  i = nxlg, nxrg
797!                   DO  j = nysg, nyng
798!                      DO  k = nzb, nzt+1
799!                         u2_av(k,j,i) = u2_av(k,j,i) + u2(k,j,i)
800!                      ENDDO
801!                   ENDDO
802!                ENDDO
803!             ENDIF
804
805          CASE DEFAULT
806             CONTINUE
807
808       END SELECT
809
810    ELSEIF ( mode == 'average' )  THEN
811
812       SELECT CASE ( TRIM( variable ) )
813
814!
815!--       Uncomment and extend the following lines, if necessary.
[4497]816!--       The arrays for storing the user defined quantities (here u2_av) have to be declared and
817!--       defined by the user!
[3687]818!--       Sample for user-defined output:
819!          CASE ( 'u2' )
[4497]820!             IF ( ALLOCATED( u2_av ) )  THEN
[3687]821!                DO  i = nxlg, nxrg
822!                   DO  j = nysg, nyng
823!                      DO  k = nzb, nzt+1
824!                         u2_av(k,j,i) = u2_av(k,j,i) / REAL( average_count_3d, KIND=wp )
825!                      ENDDO
826!                   ENDDO
827!                ENDDO
828!             ENDIF
829
830       END SELECT
831
832    ENDIF
833
834
835 END SUBROUTINE user_3d_data_averaging
836
837
[4497]838!--------------------------------------------------------------------------------------------------!
[3687]839! Description:
840! ------------
[4497]841!> Resorts the user-defined output quantity with indices (k,j,i) to a temporary array with indices
842!> (i,j,k) and sets the grid on which it is defined. Allowed values for grid are "zu" and "zw".
843!--------------------------------------------------------------------------------------------------!
[3687]844 SUBROUTINE user_data_output_2d( av, variable, found, grid, local_pf, two_d, nzb_do, nzt_do )
845
846
[4497]847    CHARACTER(LEN=*) ::  grid      !<
848    CHARACTER(LEN=*) ::  variable  !<
[3687]849
[4497]850    INTEGER(iwp) ::  av      !< flag to control data output of instantaneous or time-averaged data
851!    INTEGER(iwp) ::  i       !< grid index along x-direction
852!    INTEGER(iwp) ::  j       !< grid index along y-direction
853!    INTEGER(iwp) ::  k       !< grid index along z-direction
854!    INTEGER(iwp) ::  m       !< running index surface elements
855    INTEGER(iwp) ::  nzb_do  !< lower limit of the domain (usually nzb)
856    INTEGER(iwp) ::  nzt_do  !< upper limit of the domain (usually nzt+1)
[3687]857
[4497]858    LOGICAL      ::  found  !<
859    LOGICAL      ::  two_d  !< flag parameter that indicates 2D variables (horizontal cross sections)
[3687]860
[3768]861!    REAL(wp) ::  fill_value = -999.0_wp    !< value for the _FillValue attribute
[3687]862
[4497]863    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !<
[3687]864
[3768]865!
866!-- Next line is to avoid compiler warning about unused variables. Please remove.
867    IF ( av == 0  .OR.  local_pf(nxl,nys,nzb_do) == 0.0_wp  .OR.  two_d )  CONTINUE
[3687]868
[3768]869
[3687]870    found = .TRUE.
871
872    SELECT CASE ( TRIM( variable ) )
873
874!
875!--    Uncomment and extend the following lines, if necessary.
[4497]876!--    The arrays for storing the user defined quantities (here u2 and u2_av) have to be declared
877!--    and defined by the user!
[3687]878!--    Sample for user-defined output:
879!       CASE ( 'u2_xy', 'u2_xz', 'u2_yz' )
880!          IF ( av == 0 )  THEN
881!             DO  i = nxl, nxr
882!                DO  j = nys, nyn
883!                   DO  k = nzb_do, nzt_do
884!                      local_pf(i,j,k) = u2(k,j,i)
885!                   ENDDO
886!                ENDDO
887!             ENDDO
888!          ELSE
[4497]889!             IF ( .NOT. ALLOCATED( u2_av ) )  THEN
[3687]890!                ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
891!                u2_av = REAL( fill_value, KIND = wp )
892!             ENDIF
893!             DO  i = nxl, nxr
894!                DO  j = nys, nyn
895!                   DO  k = nzb_do, nzt_do
896!                      local_pf(i,j,k) = u2_av(k,j,i)
897!                   ENDDO
898!                ENDDO
899!             ENDDO
900!          ENDIF
901!
902!          grid = 'zu'
903!
[4497]904!--    In case two-dimensional surface variables are output, the user has to access related
905!--    surface-type. Uncomment and extend following lines appropriately (example output of vertical
906!--    surface momentum flux of u-component). Please note, surface elements can be distributed over
907!--    several data types, depending on their respective surface properties.
[3687]908!       CASE ( 'usws_xy' )
909!          IF ( av == 0 )  THEN
910!
911!--           Horizontal default-type surfaces
912!             DO  m = 1, surf_def_h(0)%ns
913!                i = surf_def_h(0)%i(m)
914!                j = surf_def_h(0)%j(m)
915!                local_pf(i,j,1) = surf_def_h(0)%usws(m)
916!             ENDDO
917!
918!--           Horizontal natural-type surfaces
919!             DO  m = 1, surf_lsm_h%ns
920!                i = surf_lsm_h%i(m)
921!                j = surf_lsm_h%j(m)
922!                local_pf(i,j,1) = surf_lsm_h%usws(m)
923!             ENDDO
924!
925!--           Horizontal urban-type surfaces
926!             DO  m = 1, surf_usm_h%ns
927!                i = surf_usm_h%i(m)
928!                j = surf_usm_h%j(m)
929!                local_pf(i,j,1) = surf_usm_h%usws(m)
930!             ENDDO
931!          ENDIF
932!
933!          grid = 'zu'
[4497]934!--
[3687]935
936
937       CASE DEFAULT
938          found = .FALSE.
939          grid  = 'none'
940
941    END SELECT
942
943
944 END SUBROUTINE user_data_output_2d
945
946
[4497]947!--------------------------------------------------------------------------------------------------!
[3687]948! Description:
949! ------------
[4497]950!> Resorts the user-defined output quantity with indices (k,j,i) to a temporary array with indices
951!> (i,j,k).
952!--------------------------------------------------------------------------------------------------!
[3687]953 SUBROUTINE user_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
954
955
[4497]956    CHARACTER(LEN=*) ::  variable  !<
[3687]957
[4497]958    INTEGER(iwp) ::  av     !<
959!    INTEGER(iwp) ::  i      !<
960!    INTEGER(iwp) ::  j      !<
961!    INTEGER(iwp) ::  k      !<
[3687]962    INTEGER(iwp) ::  nzb_do !< lower limit of the data output (usually 0)
963    INTEGER(iwp) ::  nzt_do !< vertical upper limit of the data output (usually nz_do3d)
964
[4497]965    LOGICAL      ::  found  !<
[3687]966
[4497]967!    REAL(wp) ::  fill_value = -999.0_wp  !< value for the _FillValue attribute
[3687]968
[4497]969    REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) ::  local_pf  !<
[3687]970
[3768]971!
972!-- Next line is to avoid compiler warning about unused variables. Please remove.
973    IF ( av == 0  .OR.  local_pf(nxl,nys,nzb_do) == 0.0_wp )  CONTINUE
[3687]974
[3768]975
[3687]976    found = .TRUE.
977
978    SELECT CASE ( TRIM( variable ) )
979
980!
981!--    Uncomment and extend the following lines, if necessary.
[4497]982!--    The arrays for storing the user defined quantities (here u2 and u2_av) have to be declared
983!--    and defined by the user!
[3687]984!--    Sample for user-defined output:
985!       CASE ( 'u2' )
986!          IF ( av == 0 )  THEN
987!             DO  i = nxl, nxr
988!                DO  j = nys, nyn
989!                   DO  k = nzb_do, nzt_do
990!                      local_pf(i,j,k) = u2(k,j,i)
991!                   ENDDO
992!                ENDDO
993!             ENDDO
994!          ELSE
[4497]995!             IF ( .NOT. ALLOCATED( u2_av ) )  THEN
[3687]996!                ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
997!                u2_av = REAL( fill_value, KIND = wp )
998!             ENDIF
999!             DO  i = nxl, nxr
1000!                DO  j = nys, nyn
1001!                   DO  k = nzb_do, nzt_do
1002!                      local_pf(i,j,k) = u2_av(k,j,i)
1003!                   ENDDO
1004!                ENDDO
1005!             ENDDO
1006!          ENDIF
1007!
1008
1009       CASE DEFAULT
1010          found = .FALSE.
1011
1012    END SELECT
1013
1014
1015 END SUBROUTINE user_data_output_3d
1016
1017
[4497]1018!--------------------------------------------------------------------------------------------------!
[3687]1019! Description:
1020! ------------
[4497]1021!> Calculation of user-defined statistics, i.e. horizontally averaged profiles and time series.
1022!> This routine is called for every statistic region sr defined by the user, but at least for the
1023!> region "total domain" (sr=0). See section 3.5.4 on how to define, calculate, and output user
1024!> defined quantities.
1025!--------------------------------------------------------------------------------------------------!
[3687]1026 SUBROUTINE user_statistics( mode, sr, tn )
1027
1028
[4497]1029    CHARACTER(LEN=*) ::  mode  !<
1030!    INTEGER(iwp) ::  i   !<
1031!    INTEGER(iwp) ::  j   !<
1032!    INTEGER(iwp) ::  k   !<
1033    INTEGER(iwp) ::  sr  !<
1034    INTEGER(iwp) ::  tn  !<
[3687]1035
[4497]1036!    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ts_value_l  !<
[3687]1037
[3768]1038!
1039!-- Next line is to avoid compiler warning about unused variables. Please remove.
1040    IF ( sr == 0  .OR.  tn == 0 )  CONTINUE
1041
[3687]1042    IF ( mode == 'profiles' )  THEN
1043
1044!
[4497]1045!--    Sample on how to calculate horizontally averaged profiles of user-defined quantities. Each
1046!--    quantity is identified by the index "pr_palm+#" where "#" is an integer starting from 1.
1047!--    These user-profile-numbers must also be assigned to the respective strings given by
1048!--    data_output_pr_user in routine user_check_data_output_pr.
[3687]1049!       !$OMP DO
1050!       DO  i = nxl, nxr
1051!          DO  j = nys, nyn
1052!             DO  k = nzb+1, nzt
1053!!
[4497]1054!!--             Sample on how to calculate the profile of the resolved-scale horizontal momentum
1055!!--             flux u*v*
1056!                sums_l(k,pr_palm+1,tn) = sums_l(k,pr_palm+1,tn) +                                  &
1057!                                         ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,sr) ) *  &
1058!                                         ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,sr) ) *  &
1059!                                         rmask(j,i,sr) * MERGE( 1.0_wp, 0.0_wp,                    &
1060!                                         BTEST( wall_flags_total_0(k,j,i), 0 ) )
[3687]1061!!
[4497]1062!!--             Further profiles can be defined and calculated by increasing the second index of
1063!!--             array sums_l (replace ... appropriately)
1064!                sums_l(k,pr_palm+2,tn) = sums_l(k,pr_palm+2,tn) + ...   * rmask(j,i,sr)
[3687]1065!             ENDDO
1066!          ENDDO
1067!       ENDDO
1068
1069    ELSEIF ( mode == 'time_series' )  THEN
1070
[3700]1071
1072!       ALLOCATE ( ts_value_l(dots_num_user) )
[3687]1073!
1074!--    Sample on how to add values for the user-defined time series quantities.
[4497]1075!--    These have to be defined before in routine user_init. This sample creates two time series for
1076!--    the absolut values of the horizontal velocities u and v.
[3687]1077!       ts_value_l = 0.0_wp
[3700]1078!       ts_value_l(1) = ABS( u_max )
1079!       ts_value_l(2) = ABS( v_max )
[3687]1080!
1081!--     Collect / send values to PE0, because only PE0 outputs the time series.
[4497]1082!--     CAUTION: Collection is done by taking the sum over all processors. You may have to normalize
1083!--              this sum, depending on the quantity that you like to calculate. For serial runs,
1084!--              nothing has to be done.
1085!--     HINT: If the time series value that you are calculating has the same value on all PEs, you
1086!--           can omit the MPI_ALLREDUCE call and assign ts_value(dots_num_palm+1:,sr) = ts_value_l directly.
[3687]1087!#if defined( __parallel )
1088!       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
[4497]1089!       CALL MPI_ALLREDUCE( ts_value_l(1), ts_value(dots_num_palm+1,sr), dots_num_user, MPI_REAL,   &
1090!                           MPI_MAX, comm2d, ierr )
[3687]1091!#else
[3700]1092!       ts_value(dots_num_palm+1:dots_num_palm+dots_num_user,sr) = ts_value_l
[3687]1093!#endif
1094
1095    ENDIF
1096
1097 END SUBROUTINE user_statistics
1098
1099
[4497]1100!--------------------------------------------------------------------------------------------------!
[3687]1101! Description:
1102! ------------
[4495]1103!> Read module-specific global restart data (Fortran binary format).
[4497]1104!--------------------------------------------------------------------------------------------------!
[4495]1105 SUBROUTINE user_rrd_global_ftn( found )
[3687]1106
1107
[4497]1108    LOGICAL, INTENT(OUT)  ::  found  !<
[3687]1109
1110
[3768]1111    found = .TRUE.
[3687]1112
1113
[3768]1114    SELECT CASE ( restart_string(1:length) )
[3687]1115
[3768]1116       CASE ( 'global_paramter' )
1117!          READ ( 13 )  global_parameter
[3687]1118
[3768]1119       CASE DEFAULT
[4497]1120
[3768]1121          found = .FALSE.
[3687]1122
[3768]1123    END SELECT
[3687]1124
1125
[4495]1126 END SUBROUTINE user_rrd_global_ftn
[3687]1127
1128
[4497]1129!--------------------------------------------------------------------------------------------------!
[3687]1130! Description:
1131! ------------
[4495]1132!> Read module-specific global restart data (MPI-IO).
[4497]1133!--------------------------------------------------------------------------------------------------!
[4495]1134 SUBROUTINE user_rrd_global_mpi
1135
[4517]1136!    USE restart_data_mpi_io_mod,                                                                   &
1137!        ONLY:  rrd_mpi_io
1138
[4495]1139!    CALL rrd_mpi_io( 'global_parameter', global_parameter )
1140    CONTINUE
1141
1142 END SUBROUTINE user_rrd_global_mpi
1143
1144
[4497]1145!--------------------------------------------------------------------------------------------------!
[4495]1146! Description:
1147! ------------
[4517]1148!> Read module-specific local restart data arrays (Fortran binary format).
1149!> Subdomain
[4497]1150!> index limits on file are given by nxl_on_file, etc. Indices nxlc, etc. indicate the range of
1151!> gridpoints to be mapped from the subdomain on file (f) to the subdomain of the current PE (c).
1152!> They have been calculated in routine rrd_local.
1153!--------------------------------------------------------------------------------------------------!
[4517]1154 SUBROUTINE user_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync,   &
1155                                nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found )
[3687]1156
1157
[3768]1158    INTEGER(iwp) ::  idum            !<
1159    INTEGER(iwp) ::  k               !<
1160    INTEGER(iwp) ::  nxlc            !<
1161    INTEGER(iwp) ::  nxlf            !<
1162    INTEGER(iwp) ::  nxl_on_file     !<
1163    INTEGER(iwp) ::  nxrc            !<
1164    INTEGER(iwp) ::  nxrf            !<
1165    INTEGER(iwp) ::  nxr_on_file     !<
1166    INTEGER(iwp) ::  nync            !<
1167    INTEGER(iwp) ::  nynf            !<
1168    INTEGER(iwp) ::  nyn_on_file     !<
1169    INTEGER(iwp) ::  nysc            !<
1170    INTEGER(iwp) ::  nysf            !<
1171    INTEGER(iwp) ::  nys_on_file     !<
[3687]1172
[4497]1173    LOGICAL, INTENT(OUT)  ::  found  !<
[3687]1174
[4497]1175    REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d  !<
[3687]1176
1177!
[3768]1178!-- Next line is to avoid compiler warning about unused variables. Please remove.
1179    idum = k + nxlc + nxlf + nxrc + nxrf + nync + nynf + nysc + nysf +                             &
1180           INT( tmp_3d(nzb,nys_on_file,nxl_on_file) )
1181
1182!
[3687]1183!-- Here the reading of user-defined restart data follows:
1184!-- Sample for user-defined output
1185
[3768]1186    found = .TRUE.
[3687]1187
[3768]1188    SELECT CASE ( restart_string(1:length) )
[3687]1189
[3768]1190       CASE ( 'u2_av' )
[4497]1191!          IF ( .NOT. ALLOCATED( u2_av ) )  THEN
[3768]1192!               ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1193!          ENDIF
1194!          IF ( k == 1 )  READ ( 13 )  tmp_3d
[4497]1195!             u2_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =                                    &
1196!             tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
[3687]1197!
[3768]1198       CASE DEFAULT
[3687]1199
[3768]1200          found = .FALSE.
[3687]1201
[3768]1202    END SELECT
[3687]1203
[4517]1204 END SUBROUTINE user_rrd_local_ftn
[3687]1205
1206
[4497]1207!--------------------------------------------------------------------------------------------------!
[3687]1208! Description:
1209! ------------
[4517]1210!> Read module-specific local restart data arrays (MPI-IO).
1211!--------------------------------------------------------------------------------------------------!
1212 SUBROUTINE user_rrd_local_mpi
1213
1214!    USE restart_data_mpi_io_mod,                                                                   &
1215!        ONLY:  rd_mpi_io_check_array, rrd_mpi_io
1216
1217!    CALL rd_mpi_io_check_array( 'u2_av' , found = array_found )
1218!    IF ( array_found )  THEN
1219!       IF ( .NOT. ALLOCATED( u2_av ) )  ALLOCATE( u2_av(nysg:nyng,nxlg:nxrg) )
1220!       CALL rrd_mpi_io( 'rad_u2_av', rad_u2_av )
1221!    ENDIF
1222
1223    CONTINUE
1224
1225 END SUBROUTINE user_rrd_local_mpi
1226
1227
1228!--------------------------------------------------------------------------------------------------!
1229! Description:
1230! ------------
[4497]1231!> Writes global and user-defined restart data into binary file(s) for restart runs.
1232!--------------------------------------------------------------------------------------------------!
[3768]1233 SUBROUTINE user_wrd_global
[3687]1234
[4517]1235!    USE restart_data_mpi_io_mod,                                                                   &
1236!        ONLY:  wrd_mpi_io
1237
[4495]1238    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
[3687]1239
[4495]1240!       CALL wrd_write_string( 'global_parameter' )
1241!       WRITE ( 14 )  global_parameter
1242
1243    ELSEIF ( TRIM( restart_data_format_output ) == 'mpi' )  THEN
1244
1245!    CALL rrd_mpi_io( 'global_parameter', global_parameter )
1246
1247    ENDIF
1248
[3768]1249 END SUBROUTINE user_wrd_global
[3687]1250
1251
[4497]1252!--------------------------------------------------------------------------------------------------!
[3687]1253! Description:
1254! ------------
[4497]1255!> Writes processor specific and user-defined restart data into binary file(s) for restart runs.
1256!--------------------------------------------------------------------------------------------------!
[3768]1257 SUBROUTINE user_wrd_local
[3687]1258
[4517]1259!    USE restart_data_mpi_io_mod,                                                                   &
1260!        ONLY:  wrd_mpi_io
1261
[3687]1262!
1263!-- Here the user-defined actions at the end of a job follow.
1264!-- Sample for user-defined output:
[4495]1265    IF ( TRIM( restart_data_format_output ) == 'fortran_binary' )  THEN
[3687]1266
[4495]1267!       IF ( ALLOCATED( u2_av ) )  THEN
1268!          CALL wrd_write_string( 'u2_av' )
1269!          WRITE ( 14 )  u2_av
1270!       ENDIF
1271
1272    ELSEIF ( TRIM( restart_data_format_output ) == 'mpi' )  THEN
1273
1274!       IF ( ALLOCATED( u2_av ) )  CALL wrd_mpi_io( 'u2_av', u2_av )
1275
1276    ENDIF
1277
[3768]1278 END SUBROUTINE user_wrd_local
[3687]1279
1280
[4497]1281!--------------------------------------------------------------------------------------------------!
[3687]1282! Description:
1283! ------------
1284!> Execution of user-defined actions at the end of a job.
[4497]1285!--------------------------------------------------------------------------------------------------!
[3687]1286 SUBROUTINE user_last_actions
1287
1288!
1289!-- Here the user-defined actions at the end of a job might follow.
1290
1291
1292 END SUBROUTINE user_last_actions
1293
[211]1294 END MODULE user
Note: See TracBrowser for help on using the repository browser.