MODULE user !------------------------------------------------------------------------------! ! Actual revisions: ! ----------------- ! ! ! Former revisions: ! ----------------- ! $Id: user_interface.f90 4 2007-02-13 11:33:16Z raasch $ ! 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 :: 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 statistics USE user IMPLICIT NONE CHARACTER (LEN=80) :: zeile NAMELIST /userpar/ 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. 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 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_chr ! DO WHILE ( TRIM( field_chr ) /= '*** end user ***' ) ! ! SELECT CASE ( TRIM( field_chr ) ) ! ! 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_chr ), '" found in' ! PRINT*, ' data from prior run on PE ', myid ! CALL local_stop ! ! END SELECT ! ENDDO ! ENDIF END SUBROUTINE user_init SUBROUTINE user_init_grid( nzb_local ) !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Execution of user-defined grid initializing actions !------------------------------------------------------------------------------! USE control_parameters USE indices USE user IMPLICIT NONE INTEGER, DIMENSION(-1:ny+1,-1:nx+1) :: 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 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 ( '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 ( '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 !------------------------------------------------------------------------------! ! ! Description: ! ------------ ! Calculation of user-defined statistics !------------------------------------------------------------------------------! USE statistics USE user IMPLICIT NONE 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_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_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_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) and sets the grid on which it is defined. ! Allowed values for grid are "zu" and "zw". !------------------------------------------------------------------------------! 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 ! ! grid = 'zu' 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