MODULE user !------------------------------------------------------------------------------! ! Actual revisions: ! ----------------- ! ! ! Former revisions: ! ----------------- ! $Id: user_interface.f90 139 2007-11-29 09:37:41Z raasch $ ! ! 138 2007-11-28 10:03:58Z letzel ! new subroutines user_init_plant_canopy, user_data_output_dvrp ! +argument gls in user_init_grid ! ! 105 2007-08-08 07:12:55Z raasch ! +dots_num_palm in module user, +module netcdf_control in user_init ! ! 95 2007-06-02 16:48:38Z raasch ! user action for salinity added ! ! 89 2007-05-25 12:08:31Z raasch ! Calculation and output of user-defined profiles: new routine ! user_check_data_output_pr, +data_output_pr_user, max_pr_user in userpar, ! routine user_statistics has got two more arguments ! Bugfix: field_chr renamed field_char ! ! 60 2007-03-11 11:50:04Z raasch ! New routine user_init_3d_model which allows the initial setting of all 3d ! arrays under control of the user, new routine user_advec_particles, ! routine user_statistics now has one argument (sr), ! sample for generating time series quantities added ! Bugfix in sample for reading user defined data from restart file (user_init) ! ! RCS Log replace by Id keyword, revision history cleaned up ! ! Revision 1.18 2006/06/02 15:25:00 raasch ! +change of grid-defining arguments in routine user_define_netcdf_grid, ! new argument "found" in user_data_output_2d and user_data_output_3d ! ! Revision 1.1 1998/03/24 15:29:04 raasch ! Initial revision ! ! ! Description: ! ------------ ! Declaration of user-defined variables. This module may only be used ! in the user-defined routines (contained in user_interface.f90). !------------------------------------------------------------------------------! INTEGER :: dots_num_palm, user_idummy LOGICAL :: user_defined_namelist_found = .FALSE. REAL :: user_dummy ! !-- Sample for user-defined output ! REAL, DIMENSION(:,:,:), ALLOCATABLE :: u2, u2_av SAVE END MODULE user SUBROUTINE user_parin !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Interface to read user-defined namelist-parameters. !------------------------------------------------------------------------------! USE control_parameters USE pegrid USE statistics USE user IMPLICIT NONE CHARACTER (LEN=80) :: zeile INTEGER :: i, j NAMELIST /userpar/ data_output_pr_user, data_output_user, region ! !-- Position the namelist-file at the beginning (it was already opened in !-- parin), search for user-defined namelist-group ("userpar", but any other !-- name can be choosed) and position the file at this line. REWIND ( 11 ) zeile = ' ' DO WHILE ( INDEX( zeile, '&userpar' ) == 0 ) READ ( 11, '(A)', END=100 ) zeile ENDDO BACKSPACE ( 11 ) ! !-- Read user-defined namelist READ ( 11, userpar ) user_defined_namelist_found = .TRUE. ! !-- Determine the number of user-defined profiles and append them to the !-- standard data output (data_output_pr) IF ( data_output_pr_user(1) /= ' ' ) THEN i = 1 DO WHILE ( data_output_pr(i) /= ' ' .AND. i <= 100 ) i = i + 1 ENDDO j = 1 DO WHILE ( data_output_pr_user(j) /= ' ' .AND. j <= 100 ) data_output_pr(i) = data_output_pr_user(j) max_pr_user = max_pr_user + 1 i = i + 1 j = j + 1 ENDDO ENDIF 100 RETURN END SUBROUTINE user_parin SUBROUTINE user_header( io ) !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Print a header with user-defined informations. !------------------------------------------------------------------------------! USE statistics USE user IMPLICIT NONE INTEGER :: i, io ! !-- If no user-defined variables are read from the namelist-file, no !-- informations will be printed. IF ( .NOT. user_defined_namelist_found ) THEN WRITE ( io, 100 ) RETURN ENDIF ! !-- Printing the informations. WRITE ( io, 110 ) IF ( statistic_regions /= 0 ) THEN WRITE ( io, 200 ) DO i = 0, statistic_regions WRITE ( io, 201 ) i, region(i) ENDDO ENDIF ! !-- Format-descriptors 100 FORMAT (//' *** no user-defined variables found'/) 110 FORMAT (//1X,78('#') & //' User-defined variables and actions:'/ & ' -----------------------------------'//) 200 FORMAT (' Output of profiles and time series for following regions:' /) 201 FORMAT (4X,'Region ',I1,': ',A) END SUBROUTINE user_header SUBROUTINE user_init !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Execution of user-defined initializing actions !------------------------------------------------------------------------------! USE control_parameters USE indices USE netcdf_control USE pegrid USE user IMPLICIT NONE CHARACTER (LEN=20) :: field_char ! !-- Here the user-defined initializing actions follow: !-- Sample for user-defined output ! ALLOCATE( u2(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) ! ! IF ( initializing_actions == 'read_restart_data' ) THEN ! READ ( 13 ) field_char ! DO WHILE ( TRIM( field_char ) /= '*** end user ***' ) ! ! SELECT CASE ( TRIM( field_char ) ) ! ! CASE ( 'u2_av' ) ! ALLOCATE( u2_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) ! READ ( 13 ) u2_av ! ! CASE DEFAULT ! PRINT*, '+++ user_init: unknown variable named "', & ! TRIM( field_char ), '" found in' ! PRINT*, ' data from prior run on PE ', myid ! CALL local_stop ! ! END SELECT ! ! READ ( 13 ) field_char ! ! ENDDO ! ENDIF ! !-- Sample for user-defined time series !-- For each time series quantity you have to give a label and a unit, !-- which will be used for the NetCDF file. They must not contain more than !-- seven characters. The value of dots_num has to be increased by the !-- number of new time series quantities. Its old value has to be store in !-- dots_num_palm. See routine user_statistics on how to output calculate !-- and output these quantities. ! dots_label(dots_num+1) = 'abs_umx' ! dots_unit(dots_num+1) = 'm/s' ! dots_label(dots_num+2) = 'abs_vmx' ! dots_unit(dots_num+2) = 'm/s' ! ! dots_num_palm = dots_num ! dots_num = dots_num + 2 END SUBROUTINE user_init SUBROUTINE user_init_grid( gls, nzb_local ) !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Execution of user-defined grid initializing actions ! First argument gls contains the number of ghost layers, which is > 1 if the ! multigrid method for the pressure solver is used !------------------------------------------------------------------------------! USE control_parameters USE indices USE user IMPLICIT NONE INTEGER :: gls INTEGER, DIMENSION(-gls:ny+gls,-gls:nx+gls) :: nzb_local ! !-- Here the user-defined grid initializing actions follow: ! !-- Set the index array nzb_local for non-flat topography. !-- Here consistency checks concerning domain size and periodicity are necessary SELECT CASE ( TRIM( topography ) ) CASE ( 'flat', 'single_building' ) ! !-- Not allowed here since these are the standard cases used in init_grid. CASE ( 'user_defined_topography_1' ) ! !-- Here the user can define his own topography. After definition, please !-- remove the following three lines! PRINT*, '+++ user_init_grid: topography "', & topography, '" not available yet' CALL local_stop CASE DEFAULT ! !-- The DEFAULT case is reached if the parameter topography contains a !-- wrong character string that is neither recognized in init_grid nor !-- here in user_init_grid. PRINT*, '+++ (user_)init_grid: unknown topography "', & topography, '"' CALL local_stop END SELECT END SUBROUTINE user_init_grid SUBROUTINE user_init_plant_canopy !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Initialisation of the leaf area density array (for scalar grid points) and ! the array of the canopy drag coefficient, if the user has not chosen any ! of the default cases !------------------------------------------------------------------------------! USE arrays_3d USE control_parameters USE indices USE user IMPLICIT NONE INTEGER :: i, j ! !-- Here the user-defined grid initializing actions follow: ! !-- Set the 3D-arrays lad_s and cdc for user defined canopies SELECT CASE ( TRIM( canopy_mode ) ) CASE ( 'block' ) ! !-- Not allowed here since this is the standard case used in init_3d_model. CASE ( 'user_defined_canopy_1' ) ! !-- Here the user can define his own topography. !-- The following lines contain an example in that the !-- plant canopy extends only over the second half of the !-- model domain along x ! DO i = nxl-1, nxr+1 ! IF ( i >= INT(nx+1/2) ) THEN ! DO j = nys-1, nyn+1 ! lad_s(:,j,i) = lad(:) ! cdc(:,j,i) = drag_coefficient ! ENDDO ! ELSE ! lad_s(:,:,i) = 0.0 ! cdc(:,:,i) = 0.0 ! ENDIF ! ENDDO !-- After definition, please !-- remove the following three lines! PRINT*, '+++ user_init_plant_canopy: canopy_mode "', & canopy_mode, '" not available yet' CASE DEFAULT ! !-- The DEFAULT case is reached if the parameter canopy_mode contains a !-- wrong character string that is neither recognized in init_3d_model nor !-- here in user_init_plant_canopy. PRINT*, '+++ user_init_plant_canopy: unknown canopy_mode "', & canopy_mode, '"' CALL local_stop END SELECT END SUBROUTINE user_init_plant_canopy SUBROUTINE user_init_3d_model !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Allows the complete initialization of the 3d model. ! ! CAUTION: The user is responsible to set at least all those quantities which ! ------ are normally set within init_3d_model! !------------------------------------------------------------------------------! USE arrays_3d USE control_parameters USE indices USE user IMPLICIT NONE END SUBROUTINE user_init_3d_model MODULE user_actions_mod !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Execution of user-defined actions before or after single timesteps !------------------------------------------------------------------------------! PRIVATE PUBLIC user_actions INTERFACE user_actions MODULE PROCEDURE user_actions MODULE PROCEDURE user_actions_ij END INTERFACE user_actions CONTAINS !------------------------------------------------------------------------------! ! Call for all grid points !------------------------------------------------------------------------------! SUBROUTINE user_actions( location ) USE control_parameters USE cpulog USE indices USE interfaces USE pegrid USE user USE arrays_3d IMPLICIT NONE CHARACTER (LEN=*) :: location INTEGER :: i, j, k CALL cpu_log( log_point(24), 'user_actions', 'start' ) ! !-- Here the user-defined actions follow !-- No calls for single grid points are allowed at locations before and !-- after the timestep, since these calls are not within an i,j-loop SELECT CASE ( location ) CASE ( 'before_timestep' ) ! !-- Enter actions to be done before every timestep here CASE ( 'after_integration' ) ! !-- Enter actions to be done after every time integration (before !-- data output) !-- Sample for user-defined output: ! DO i = nxl-1, nxr+1 ! DO j = nys-1, nyn+1 ! DO k = nzb, nzt+1 ! u2(k,j,i) = u(k,j,i)**2 ! ENDDO ! ENDDO ! ENDDO CASE ( 'after_timestep' ) ! !-- Enter actions to be done after every timestep here CASE ( 'u-tendency' ) ! !-- Enter actions to be done in the u-tendency term here CASE ( 'v-tendency' ) CASE ( 'w-tendency' ) CASE ( 'pt-tendency' ) CASE ( 'sa-tendency' ) CASE ( 'e-tendency' ) CASE ( 'q-tendency' ) CASE DEFAULT IF ( myid == 0 ) PRINT*, '+++ user_actions: unknown location "', & location, '"' CALL local_stop END SELECT CALL cpu_log( log_point(24), 'user_actions', 'stop' ) END SUBROUTINE user_actions !------------------------------------------------------------------------------! ! Call for grid point i,j !------------------------------------------------------------------------------! SUBROUTINE user_actions_ij( i, j, location ) USE control_parameters USE pegrid USE user IMPLICIT NONE CHARACTER (LEN=*) :: location INTEGER :: i, idum, j ! !-- Here the user-defined actions follow SELECT CASE ( location ) CASE ( 'u-tendency' ) ! !-- Enter actions to be done in the u-tendency term here CASE ( 'v-tendency' ) CASE ( 'w-tendency' ) CASE ( 'pt-tendency' ) CASE ( 'sa-tendency' ) CASE ( 'e-tendency' ) CASE ( 'q-tendency' ) CASE ( 'before_timestep', 'after_integration', 'after_timestep' ) IF ( myid == 0 ) THEN PRINT*, '+++ user_actions: location "', location, '" is not ', & 'allowed to be called with parameters "i" and "j"' ENDIF CALL local_stop CASE DEFAULT IF ( myid == 0 ) PRINT*, '+++ user_actions: unknown location "', & location, '"' CALL local_stop END SELECT END SUBROUTINE user_actions_ij END MODULE user_actions_mod SUBROUTINE user_statistics( mode, sr, tn ) !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Calculation of user-defined statistics, i.e. horizontally averaged profiles ! and time series. ! This routine is called for every statistic region sr defined by the user, ! but at least for the region "total domain" (sr=0). ! See section 3.5.4 on how to define, calculate, and output user defined ! quantities. !------------------------------------------------------------------------------! USE arrays_3d USE indices USE statistics USE user IMPLICIT NONE CHARACTER (LEN=*) :: mode INTEGER :: i, j, k, sr, tn IF ( mode == 'profiles' ) THEN ! !-- Sample on how to calculate horizontally averaged profiles of user- !-- defined quantities. Each quantity is identified by the index !-- "pr_palm+#" where "#" is an integer starting from 1. These !-- user-profile-numbers must also be assigned to the respective strings !-- given by data_output_pr_user in routine user_check_data_output_pr. ! !$OMP DO ! DO i = nxl, nxr ! DO j = nys, nyn ! DO k = nzb_s_outer(j,i)+1, nzt !! !!-- Sample on how to calculate the profile of the resolved-scale !!-- horizontal momentum flux u*v* ! sums_l(k,pr_palm+1,tn) = sums_l(k,pr_palm+1,tn) + & ! ( 0.5 * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,sr) ) * & ! ( 0.5 * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,sr) ) * & ! * rmask(j,i,sr) !! !!-- Further profiles can be defined and calculated by increasing !!-- the second index of array sums_l (replace ... appropriately) ! sums_l(k,pr_palm+2,tn) = sums_l(k,pr_palm+2,tn) + ... & ! * rmask(j,i,sr) ! ENDDO ! ENDDO ! ENDDO ELSEIF ( mode == 'time_series' ) THEN ! !-- Sample on how to add values for the user-defined time series quantities. !-- These have to be defined before in routine user_init. This sample !-- creates two time series for the absolut values of the horizontal !-- velocities u and v. ! ts_value(dots_num_palm+1,sr) = ABS( u_max ) ! ts_value(dots_num_palm+2,sr) = ABS( v_max ) ENDIF END SUBROUTINE user_statistics SUBROUTINE user_last_actions !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Execution of user-defined actions at the end of a job. !------------------------------------------------------------------------------! USE user IMPLICIT NONE ! !-- Here the user-defined actions at the end of a job follow. !-- Sample for user-defined output: ! IF ( ALLOCATED( u2_av ) ) THEN ! WRITE ( 14 ) 'u2_av '; WRITE ( 14 ) u2_av ! ENDIF WRITE ( 14 ) '*** end user *** ' END SUBROUTINE user_last_actions SUBROUTINE user_init_particles !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Modification of initial particles by the user. !------------------------------------------------------------------------------! USE particle_attributes USE user IMPLICIT NONE INTEGER :: n ! !-- Here the user-defined actions follow ! DO n = 1, number_of_initial_particles ! ENDDO END SUBROUTINE user_init_particles SUBROUTINE user_advec_particles !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Modification of initial particles by the user. !------------------------------------------------------------------------------! USE particle_attributes USE user IMPLICIT NONE INTEGER :: n ! !-- Here the user-defined actions follow ! DO n = 1, number_of_initial_particles ! ENDDO END SUBROUTINE user_advec_particles SUBROUTINE user_particle_attributes !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Define the actual particle attributes (size, colour) by the user. !------------------------------------------------------------------------------! USE particle_attributes USE user IMPLICIT NONE INTEGER :: n ! !-- Here the user-defined actions follow ! DO n = 1, number_of_initial_particles ! ENDDO END SUBROUTINE user_particle_attributes SUBROUTINE user_dvrp_coltab( mode, variable ) !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Definition of the colour table to be used by the dvrp software. !------------------------------------------------------------------------------! USE dvrp_variables USE pegrid USE user IMPLICIT NONE CHARACTER (LEN=*) :: mode CHARACTER (LEN=*) :: variable ! !-- Here the user-defined actions follow SELECT CASE ( mode ) CASE ( 'particles' ) CASE ( 'slicer' ) CASE DEFAULT IF ( myid == 0 ) PRINT*, '+++ user_dvrp_coltab: unknown mode "', & mode, '"' CALL local_stop END SELECT END SUBROUTINE user_dvrp_coltab SUBROUTINE user_check_data_output( variable, unit ) !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Set the unit of user defined output quantities. For those variables ! not recognized by the user, the parameter unit is set to "illegal", which ! tells the calling routine that the output variable is not defined and leads ! to a program abort. !------------------------------------------------------------------------------! USE user IMPLICIT NONE CHARACTER (LEN=*) :: unit, variable SELECT CASE ( TRIM( variable ) ) ! !-- Uncomment and extend the following lines, if necessary ! CASE ( 'u2' ) ! unit = 'm2/s2' ! CASE DEFAULT unit = 'illegal' END SELECT END SUBROUTINE user_check_data_output SUBROUTINE user_check_data_output_pr( variable, var_count, unit ) !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Set the unit of user defined profile output quantities. For those variables ! not recognized by the user, the parameter unit is set to "illegal", which ! tells the calling routine that the output variable is not defined and leads ! to a program abort. !------------------------------------------------------------------------------! USE arrays_3d USE indices USE netcdf_control USE profil_parameter USE statistics USE user IMPLICIT NONE CHARACTER (LEN=*) :: unit, variable INTEGER :: index, var_count SELECT CASE ( TRIM( variable ) ) ! !-- Uncomment and extend the following lines, if necessary. !-- Add additional CASE statements depending on the number of quantities !-- for which profiles are to be calculated. The respective calculations !-- to be performed have to be added in routine user_statistics. !-- The quantities are (internally) identified by a user-profile-number !-- (see variable "index" below). The first user-profile must be assigned !-- the number "pr_palm+1", the second one "pr_palm+2", etc. The respective !-- user-profile-numbers have also to be used in routine user_statistics! ! CASE ( 'u*v*' ) ! quantity string as given in ! ! data_output_pr_user ! index = pr_palm + 1 ! dopr_index(var_count) = index ! quantities' user-profile-number ! dopr_unit(var_count) = 'm2/s2' ! quantity unit ! hom(:,2,index,:) = SPREAD( zu, 2, statistic_regions+1 ) ! ! grid on which the quantity is ! ! defined (use zu or zw) CASE DEFAULT unit = 'illegal' END SELECT END SUBROUTINE user_check_data_output_pr SUBROUTINE user_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z ) !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Set the grids on which user-defined output quantities are defined. ! Allowed values for grid_x are "x" and "xu", for grid_y "y" and "yv", and ! for grid_z "zu" and "zw". !------------------------------------------------------------------------------! USE user IMPLICIT NONE CHARACTER (LEN=*) :: grid_x, grid_y, grid_z, variable LOGICAL :: found SELECT CASE ( TRIM( variable ) ) ! !-- Uncomment and extend the following lines, if necessary ! CASE ( 'u2', 'u2_xy', 'u2_xz', 'u2_yz' ) ! grid_x = 'xu' ! grid_y = 'y' ! grid_z = 'zu' CASE DEFAULT found = .FALSE. grid_x = 'none' grid_y = 'none' grid_z = 'none' END SELECT END SUBROUTINE user_define_netcdf_grid SUBROUTINE user_data_output_dvrp( output_variable, local_pf ) !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Execution of user-defined dvrp output !------------------------------------------------------------------------------! USE control_parameters USE indices USE pegrid USE user IMPLICIT NONE CHARACTER (LEN=*) :: output_variable INTEGER :: i, j, k REAL, DIMENSION(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d) :: local_pf ! !-- Here the user-defined DVRP output follows: ! !-- Move original array to intermediate array SELECT CASE ( output_variable ) ! CASE ( 'u2', 'u2_xy', 'u2_xz', 'u2_yz' ) !! !!-- Here the user can add user_defined output quantities. !!-- Uncomment and extend the following lines, if necessary. ! DO i = nxl, nxr+1 ! DO j = nys, nyn+1 ! DO k = nzb, nz_do3d ! local_pf(i,j,k) = u2(k,j,i) ! ENDDO ! ENDDO ! ENDDO CASE DEFAULT ! !-- The DEFAULT case is reached if output_variable contains a !-- wrong character string that is neither recognized in data_output_dvrp !-- nor here in user_data_output_dvrp. IF ( myid == 0 ) THEN PRINT*,'+++ (user_)data_output_dvrp: no output possible for: ', & output_variable ENDIF END SELECT END SUBROUTINE user_data_output_dvrp SUBROUTINE user_data_output_2d( av, variable, found, grid, local_pf ) !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Resorts the user-defined output quantity with indices (k,j,i) to a ! temporary array with indices (i,j,k) and sets the grid on which it is defined. ! Allowed values for grid are "zu" and "zw". !------------------------------------------------------------------------------! USE indices USE user IMPLICIT NONE CHARACTER (LEN=*) :: grid, variable INTEGER :: av, i, j, k LOGICAL :: found REAL, DIMENSION(nxl-1:nxr+1,nys-1:nyn+1,nzb:nzt+1) :: local_pf found = .TRUE. SELECT CASE ( TRIM( variable ) ) ! !-- Uncomment and extend the following lines, if necessary. !-- The arrays for storing the user defined quantities (here u2 and u2_av) !-- have to be declared and defined by the user! !-- Sample for user-defined output: ! CASE ( 'u2_xy', 'u2_xz', 'u2_yz' ) ! IF ( av == 0 ) THEN ! DO i = nxl-1, nxr+1 ! DO j = nys-1, nyn+1 ! DO k = nzb, nzt+1 ! local_pf(i,j,k) = u2(k,j,i) ! ENDDO ! ENDDO ! ENDDO ! ELSE ! DO i = nxl-1, nxr+1 ! DO j = nys-1, nyn+1 ! DO k = nzb, nzt+1 ! local_pf(i,j,k) = u2_av(k,j,i) ! ENDDO ! ENDDO ! ENDDO ! ENDIF ! ! grid = 'zu' CASE DEFAULT found = .FALSE. grid = 'none' END SELECT END SUBROUTINE user_data_output_2d SUBROUTINE user_data_output_3d( av, variable, found, local_pf, nz_do ) !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Resorts the user-defined output quantity with indices (k,j,i) to a ! temporary array with indices (i,j,k). !------------------------------------------------------------------------------! USE array_kind USE indices USE user IMPLICIT NONE CHARACTER (LEN=*) :: variable INTEGER :: av, i, j, k, nz_do LOGICAL :: found REAL(spk), DIMENSION(nxl-1:nxr+1,nys-1:nyn+1,nzb:nz_do) :: local_pf found = .TRUE. SELECT CASE ( TRIM( variable ) ) ! !-- Uncomment and extend the following lines, if necessary. !-- The arrays for storing the user defined quantities (here u2 and u2_av) !-- have to be declared and defined by the user! !-- Sample for user-defined output: ! CASE ( 'u2' ) ! IF ( av == 0 ) THEN ! DO i = nxl-1, nxr+1 ! DO j = nys-1, nyn+1 ! DO k = nzb, nz_do ! local_pf(i,j,k) = u2(k,j,i) ! ENDDO ! ENDDO ! ENDDO ! ELSE ! DO i = nxl-1, nxr+1 ! DO j = nys-1, nyn+1 ! DO k = nzb, nz_do ! local_pf(i,j,k) = u2_av(k,j,i) ! ENDDO ! ENDDO ! ENDDO ! ENDIF ! CASE DEFAULT found = .FALSE. END SELECT END SUBROUTINE user_data_output_3d SUBROUTINE user_3d_data_averaging( mode, variable ) !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Sum up and time-average user-defined output quantities as well as allocate ! the array necessary for storing the average. !------------------------------------------------------------------------------! USE control_parameters USE indices USE user IMPLICIT NONE CHARACTER (LEN=*) :: mode, variable INTEGER :: i, j, k IF ( mode == 'allocate' ) THEN SELECT CASE ( TRIM( variable ) ) ! !-- Uncomment and extend the following lines, if necessary. !-- The arrays for storing the user defined quantities (here u2_av) have !-- to be declared and defined by the user! !-- Sample for user-defined output: ! CASE ( 'u2' ) ! IF ( .NOT. ALLOCATED( u2_av ) ) THEN ! ALLOCATE( u2_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) ! ENDIF ! u2_av = 0.0 CASE DEFAULT CONTINUE END SELECT ELSEIF ( mode == 'sum' ) THEN SELECT CASE ( TRIM( variable ) ) ! !-- Uncomment and extend the following lines, if necessary. !-- The arrays for storing the user defined quantities (here u2 and !-- u2_av) have to be declared and defined by the user! !-- Sample for user-defined output: ! CASE ( 'u2' ) ! DO i = nxl-1, nxr+1 ! DO j = nys-1, nyn+1 ! DO k = nzb, nzt+1 ! u2_av(k,j,i) = u2_av(k,j,i) + u2(k,j,i) ! ENDDO ! ENDDO ! ENDDO CASE DEFAULT CONTINUE END SELECT ELSEIF ( mode == 'average' ) THEN SELECT CASE ( TRIM( variable ) ) ! !-- Uncomment and extend the following lines, if necessary. !-- The arrays for storing the user defined quantities (here u2_av) have !-- to be declared and defined by the user! !-- Sample for user-defined output: ! CASE ( 'u2' ) ! DO i = nxl-1, nxr+1 ! DO j = nys-1, nyn+1 ! DO k = nzb, nzt+1 ! u2_av(k,j,i) = u2_av(k,j,i) / REAL( average_count_3d ) ! ENDDO ! ENDDO ! ENDDO END SELECT ENDIF END SUBROUTINE user_3d_data_averaging