Index: /palm/trunk/UTIL/inifor/src/inifor.f90 =================================================================== --- /palm/trunk/UTIL/inifor/src/inifor.f90 (revision 4522) +++ /palm/trunk/UTIL/inifor/src/inifor.f90 (revision 4523) @@ -26,4 +26,8 @@ ! ----------------- ! $Id$ +! respect integer working precision (iwp) specified in inifor_defs.f90 +! +! +! 4481 2020-03-31 18:55:54Z maronga ! Alert user to warnings if any ! @@ -128,6 +132,4 @@ ONLY: average_pressure_perturbation, & average_profile, & - extrapolate_density, & - extrapolate_pressure, & geostrophic_winds, & get_surface_pressure, & @@ -141,7 +143,7 @@ IMPLICIT NONE - INTEGER :: igroup !< loop index for IO groups - INTEGER :: ivar !< loop index for output variables - INTEGER :: iter !< loop index for time steps + INTEGER(iwp) :: igroup !< loop index for IO groups + INTEGER(iwp) :: ivar !< loop index for output variables + INTEGER(iwp) :: iter !< loop index for time steps REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: output_arr !< array buffer for interpolated quantities Index: /palm/trunk/UTIL/inifor/src/inifor_control.f90 =================================================================== --- /palm/trunk/UTIL/inifor/src/inifor_control.f90 (revision 4522) +++ /palm/trunk/UTIL/inifor/src/inifor_control.f90 (revision 4523) @@ -26,4 +26,8 @@ ! ----------------- ! $Id$ +! respect integer working precision (iwp) specified in inifor_defs.f90 +! +! +! 4481 2020-03-31 18:55:54Z maronga ! Change output format in routine report to allow for better message formatting ! @@ -83,5 +87,5 @@ USE inifor_defs, & - ONLY: COPYRIGHT, LNAME, LOG_FILE_NAME, VERSION, wp + ONLY: COPYRIGHT, LNAME, LOG_FILE_NAME, VERSION, iwp, wp USE inifor_util, & ONLY: real_to_str, real_to_str_f @@ -91,6 +95,6 @@ CHARACTER (LEN=5000) :: message = '' !< log message buffer CHARACTER (LEN=5000) :: tip = '' !< optional log message buffer for tips on how to rectify encountered errors - INTEGER, SAVE :: u !< Fortran file unit for the log file - INTEGER, SAVE :: n_wrngs = 0 !< Fortran file unit for the log file + INTEGER(iwp), SAVE :: u !< Fortran file unit for the log file + INTEGER(iwp), SAVE :: n_wrngs = 0 !< Fortran file unit for the log file CONTAINS Index: /palm/trunk/UTIL/inifor/src/inifor_defs.f90 =================================================================== --- /palm/trunk/UTIL/inifor/src/inifor_defs.f90 (revision 4522) +++ /palm/trunk/UTIL/inifor/src/inifor_defs.f90 (revision 4523) @@ -141,5 +141,5 @@ ! !-- COSMO parameters - INTEGER, PARAMETER :: WATER_ID = 9 !< Integer corresponding to the water soil type in COSMO-DE [-] + INTEGER(iwp), PARAMETER :: WATER_ID = 9 !< Integer corresponding to the water soil type in COSMO-DE [-] REAL(wp), PARAMETER :: EARTH_RADIUS = 6371229.0_wp !< Earth radius used in COSMO-DE [m] REAL(wp), PARAMETER :: P_SL = 1e5_wp !< Reference pressure for computation of COSMO-DE's basic state pressure [Pa] @@ -181,12 +181,12 @@ ! !-- INIFOR parameters - INTEGER, PARAMETER :: FILL_ITERATIONS = 5 !< Number of iterations for extrapolating soil data into COSMO-DE + INTEGER(iwp), PARAMETER :: FILL_ITERATIONS = 5 !< Number of iterations for extrapolating soil data into COSMO-DE !< water cells [-] - INTEGER, PARAMETER :: FORCING_STEP = 1 !< Number of hours between forcing time steps [h] + INTEGER(iwp), PARAMETER :: FORCING_STEP = 1 !< Number of hours between forcing time steps [h] REAL(wp), PARAMETER :: NUDGING_TAU = 21600.0_wp !< Nudging relaxation time scale [s] CHARACTER(LEN=*), PARAMETER :: COPYRIGHT = 'Copyright 2017-2020 Leibniz Universitaet Hannover' // & ACHAR( 10 ) // ' Copyright 2017-2020 Deutscher Wetterdienst Offenbach' !< Copyright notice CHARACTER(LEN=*), PARAMETER :: LOG_FILE_NAME = 'inifor.log' !< Name of INIFOR's log file - CHARACTER(LEN=*), PARAMETER :: VERSION = '1.4.12' !< INIFOR version number + CHARACTER(LEN=*), PARAMETER :: VERSION = '1.4.13' !< INIFOR version number END MODULE inifor_defs Index: /palm/trunk/UTIL/inifor/src/inifor_grid.f90 =================================================================== --- /palm/trunk/UTIL/inifor/src/inifor_grid.f90 (revision 4522) +++ /palm/trunk/UTIL/inifor/src/inifor_grid.f90 (revision 4523) @@ -26,4 +26,8 @@ ! ----------------- ! $Id$ +! respect integer working precision (iwp) specified in inifor_defs.f90 +! +! +! 4481 2020-03-31 18:55:54Z maronga ! Bugfix: check if namelist file could be opened without error ! @@ -155,5 +159,5 @@ USE inifor_defs, & ONLY: DATE, EARTH_RADIUS, TO_RADIANS, TO_DEGREES, PI, & - SNAME, LNAME, PATH, FORCING_STEP, WATER_ID, FILL_ITERATIONS, & + SNAME, LNAME, PATH, FORCING_STEP, FILL_ITERATIONS, & BETA, P_SL, T_SL, BETA, RD, RV, G, P_REF, RD_PALM, CP_PALM, & RHO_L, OMEGA, HECTO, wp, iwp, & @@ -167,5 +171,5 @@ USE inifor_transform, & ONLY: average_2d, rotate_to_cosmo, find_horizontal_neighbours, & - compute_horizontal_interp_weights, & + compute_horizontal_interp_weights, fill_water_cells, & find_vertical_neighbours_and_weights_interp, & find_vertical_neighbours_and_weights_average, interpolate_2d, & @@ -257,22 +261,22 @@ INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: soiltyp !< COSMO-DE soil type map - INTEGER :: dz_stretch_level_end_index(9) !< vertical grid level index until which the vertical grid spacing is stretched - INTEGER :: dz_stretch_level_start_index(9) !< vertical grid level index above which the vertical grid spacing is stretched - INTEGER :: iostat !< return status of READ statement - INTEGER :: nt !< number of output time steps - INTEGER :: nx !< number of PALM-4U grid points in x direction - INTEGER :: ny !< number of PALM-4U grid points in y direction - INTEGER :: nz !< number of PALM-4U grid points in z direction - INTEGER :: nlon !< number of longitudal points in target grid (COSMO-DE) - INTEGER :: nlat !< number of latitudal points in target grid (COSMO-DE) - INTEGER :: nlev !< number of levels in target grid (COSMO-DE) - INTEGER :: ndepths !< number of COSMO-DE soil layers - INTEGER :: start_hour_flow !< start of flow forcing in number of hours relative to start_date - INTEGER :: start_hour_soil !< start of soil forcing in number of hours relative to start_date, typically equals start_hour_flow - INTEGER :: start_hour_radiation !< start of radiation forcing in number of hours relative to start_date, 0 to 2 hours before start_hour_flow to reconstruct hourly averages from one- to three hourly averages of the input data - INTEGER :: start_hour_soilmoisture !< start of forcing for the soil moisture spin-up in number of hours relative to start_date, typically -672 (-4 weeks) - INTEGER :: end_hour !< simulation time in hours - INTEGER :: end_hour_soilmoisture !< end of soil moisture spin-up in hours relative to start_hour_flow - INTEGER :: step_hour !< number of hours between forcing time steps + INTEGER(iwp) :: dz_stretch_level_end_index(9) !< vertical grid level index until which the vertical grid spacing is stretched + INTEGER(iwp) :: dz_stretch_level_start_index(9) !< vertical grid level index above which the vertical grid spacing is stretched + INTEGER(iwp) :: iostat !< return status of READ statement + INTEGER(iwp) :: nt !< number of output time steps + INTEGER(iwp) :: nx !< number of PALM-4U grid points in x direction + INTEGER(iwp) :: ny !< number of PALM-4U grid points in y direction + INTEGER(iwp) :: nz !< number of PALM-4U grid points in z direction + INTEGER(iwp) :: nlon !< number of longitudal points in target grid (COSMO-DE) + INTEGER(iwp) :: nlat !< number of latitudal points in target grid (COSMO-DE) + INTEGER(iwp) :: nlev !< number of levels in target grid (COSMO-DE) + INTEGER(iwp) :: ndepths !< number of COSMO-DE soil layers + INTEGER(iwp) :: start_hour_flow !< start of flow forcing in number of hours relative to start_date + INTEGER(iwp) :: start_hour_soil !< start of soil forcing in number of hours relative to start_date, typically equals start_hour_flow + INTEGER(iwp) :: start_hour_radiation !< start of radiation forcing in number of hours relative to start_date, 0 to 2 hours before start_hour_flow to reconstruct hourly averages from one- to three hourly averages of the input data + INTEGER(iwp) :: start_hour_soilmoisture !< start of forcing for the soil moisture spin-up in number of hours relative to start_date, typically -672 (-4 weeks) + INTEGER(iwp) :: end_hour !< simulation time in hours + INTEGER(iwp) :: end_hour_soilmoisture !< end of soil moisture spin-up in hours relative to start_hour_flow + INTEGER(iwp) :: step_hour !< number of hours between forcing time steps LOGICAL :: init_variables_required !< flag controlling whether init variables are to be processed @@ -858,5 +862,5 @@ ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = 0, ny = ny, nz = nz, z=z) + nx = 0_iwp, ny = ny, nz = nz, z=z) CALL init_grid_definition('boundary', grid=scalars_west_grid, & @@ -864,5 +868,5 @@ ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = 0, ny = ny, nz = nz, z=z) + nx = 0_iwp, ny = ny, nz = nz, z=z) CALL init_grid_definition('boundary', grid=scalars_north_grid, & @@ -870,5 +874,5 @@ ymin = ly + 0.5_wp * dy, ymax = ly + 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = nx, ny = 0, nz = nz, z=z) + nx = nx, ny = 0_iwp, nz = nz, z=z) CALL init_grid_definition('boundary', grid=scalars_south_grid, & @@ -876,5 +880,5 @@ ymin = -0.5_wp * dy, ymax = -0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = nx, ny = 0, nz = nz, z=z) + nx = nx, ny = 0_iwp, nz = nz, z=z) CALL init_grid_definition('boundary', grid=scalars_top_grid, & @@ -882,5 +886,5 @@ ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = nx, ny = ny, nz = 1, z=z_top) + nx = nx, ny = ny, nz = 1_iwp, z=z_top) CALL init_grid_definition('boundary', grid=u_east_grid, & @@ -888,5 +892,5 @@ ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = 0, ny = ny, nz = nz, z=z) + nx = 0_iwp, ny = ny, nz = nz, z=z) CALL init_grid_definition('boundary', grid=u_west_grid, & @@ -894,5 +898,5 @@ ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = 0, ny = ny, nz = nz, z=z) + nx = 0_iwp, ny = ny, nz = nz, z=z) CALL init_grid_definition('boundary', grid=u_north_grid, & @@ -900,5 +904,5 @@ ymin = ly + 0.5_wp * dy, ymax = ly + 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = nx-1, ny = 0, nz = nz, z=z) + nx = nx-1, ny = 0_iwp, nz = nz, z=z) CALL init_grid_definition('boundary', grid=u_south_grid, & @@ -906,5 +910,5 @@ ymin = -0.5_wp * dy, ymax = -0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = nx-1, ny = 0, nz = nz, z=z) + nx = nx-1, ny = 0_iwp, nz = nz, z=z) CALL init_grid_definition('boundary', grid=u_top_grid, & @@ -912,5 +916,5 @@ ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = nx-1, ny = ny, nz = 1, z=z_top) + nx = nx-1, ny = ny, nz = 1_iwp, z=z_top) CALL init_grid_definition('boundary', grid=v_east_grid, & @@ -918,5 +922,5 @@ ymin = dy, ymax = ly - dy, & x0=x0, y0=y0, z0 = z0, & - nx = 0, ny = ny-1, nz = nz, z=z) + nx = 0_iwp, ny = ny-1, nz = nz, z=z) CALL init_grid_definition('boundary', grid=v_west_grid, & @@ -924,5 +928,5 @@ ymin = dy, ymax = ly - dy, & x0=x0, y0=y0, z0 = z0, & - nx = 0, ny = ny-1, nz = nz, z=z) + nx = 0_iwp, ny = ny-1, nz = nz, z=z) CALL init_grid_definition('boundary', grid=v_north_grid, & @@ -930,5 +934,5 @@ ymin = ly, ymax = ly, & x0=x0, y0=y0, z0 = z0, & - nx = nx, ny = 0, nz = nz, z=z) + nx = nx, ny = 0_iwp, nz = nz, z=z) CALL init_grid_definition('boundary', grid=v_south_grid, & @@ -936,5 +940,5 @@ ymin = 0.0_wp, ymax = 0.0_wp, & x0=x0, y0=y0, z0 = z0, & - nx = nx, ny = 0, nz = nz, z=z) + nx = nx, ny = 0_iwp, nz = nz, z=z) CALL init_grid_definition('boundary', grid=v_top_grid, & @@ -942,5 +946,5 @@ ymin = dy, ymax = ly - dy, & x0=x0, y0=y0, z0 = z0, & - nx = nx, ny = ny-1, nz = 1, z=(/z_top/)) + nx = nx, ny = ny-1, nz = 1_iwp, z=(/z_top/)) CALL init_grid_definition('boundary', grid=w_east_grid, & @@ -948,5 +952,5 @@ ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = 0, ny = ny, nz = nz - 1, z=zw) + nx = 0_iwp, ny = ny, nz = nz - 1, z=zw) CALL init_grid_definition('boundary', grid=w_west_grid, & @@ -954,5 +958,5 @@ ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = 0, ny = ny, nz = nz - 1, z=zw) + nx = 0_iwp, ny = ny, nz = nz - 1, z=zw) CALL init_grid_definition('boundary', grid=w_north_grid, & @@ -960,5 +964,5 @@ ymin = ly + 0.5_wp * dy, ymax = ly + 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = nx, ny = 0, nz = nz - 1, z=zw) + nx = nx, ny = 0_iwp, nz = nz - 1, z=zw) CALL init_grid_definition('boundary', grid=w_south_grid, & @@ -966,5 +970,5 @@ ymin = -0.5_wp * dy, ymax = -0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = nx, ny = 0, nz = nz - 1, z=zw) + nx = nx, ny = 0_iwp, nz = nz - 1, z=zw) CALL init_grid_definition('boundary', grid=w_top_grid, & @@ -972,5 +976,5 @@ ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = nx, ny = ny, nz = 1, z=zw_top) + nx = nx, ny = ny, nz = 1_iwp, z=zw_top) CALL init_grid_definition('boundary intermediate', grid=scalars_east_intermediate, & @@ -978,5 +982,5 @@ ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = 0, ny = ny, nz = nlev - 2) + nx = 0_iwp, ny = ny, nz = nlev - 2) CALL init_grid_definition('boundary intermediate', grid=scalars_west_intermediate, & @@ -984,5 +988,5 @@ ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = 0, ny = ny, nz = nlev - 2) + nx = 0_iwp, ny = ny, nz = nlev - 2) CALL init_grid_definition('boundary intermediate', grid=scalars_north_intermediate, & @@ -990,5 +994,5 @@ ymin = ly + 0.5_wp * dy, ymax = ly + 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = nx, ny = 0, nz = nlev - 2) + nx = nx, ny = 0_iwp, nz = nlev - 2) CALL init_grid_definition('boundary intermediate', grid=scalars_south_intermediate, & @@ -996,5 +1000,5 @@ ymin = -0.5_wp * dy, ymax = -0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = nx, ny = 0, nz = nlev - 2) + nx = nx, ny = 0_iwp, nz = nlev - 2) CALL init_grid_definition('boundary intermediate', grid=scalars_top_intermediate, & @@ -1008,5 +1012,5 @@ ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = 0, ny = ny, nz = nlev - 2) + nx = 0_iwp, ny = ny, nz = nlev - 2) CALL init_grid_definition('boundary intermediate', grid=u_west_intermediate, & @@ -1014,5 +1018,5 @@ ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = 0, ny = ny, nz = nlev - 2) + nx = 0_iwp, ny = ny, nz = nlev - 2) CALL init_grid_definition('boundary intermediate', grid=u_north_intermediate, & @@ -1020,5 +1024,5 @@ ymin = ly + 0.5_wp * dy, ymax = ly + 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = nx-1, ny = 0, nz = nlev - 2) + nx = nx-1, ny = 0_iwp, nz = nlev - 2) CALL init_grid_definition('boundary intermediate', grid=u_south_intermediate, & @@ -1026,5 +1030,5 @@ ymin = -0.5_wp * dy, ymax = -0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = nx-1, ny = 0, nz = nlev - 2) + nx = nx-1, ny = 0_iwp, nz = nlev - 2) CALL init_grid_definition('boundary intermediate', grid=u_top_intermediate, & @@ -1038,5 +1042,5 @@ ymin = dy, ymax = ly - dy, & x0=x0, y0=y0, z0 = z0, & - nx = 0, ny = ny-1, nz = nlev - 2) + nx = 0_iwp, ny = ny-1, nz = nlev - 2) CALL init_grid_definition('boundary intermediate', grid=v_west_intermediate, & @@ -1044,5 +1048,5 @@ ymin = dy, ymax = ly - dy, & x0=x0, y0=y0, z0 = z0, & - nx = 0, ny = ny-1, nz = nlev - 2) + nx = 0_iwp, ny = ny-1, nz = nlev - 2) CALL init_grid_definition('boundary intermediate', grid=v_north_intermediate, & @@ -1050,5 +1054,5 @@ ymin = ly, ymax = ly, & x0=x0, y0=y0, z0 = z0, & - nx = nx, ny = 0, nz = nlev - 2) + nx = nx, ny = 0_iwp, nz = nlev - 2) CALL init_grid_definition('boundary intermediate', grid=v_south_intermediate, & @@ -1056,5 +1060,5 @@ ymin = 0.0_wp, ymax = 0.0_wp, & x0=x0, y0=y0, z0 = z0, & - nx = nx, ny = 0, nz = nlev - 2) + nx = nx, ny = 0_iwp, nz = nlev - 2) CALL init_grid_definition('boundary intermediate', grid=v_top_intermediate, & @@ -1068,5 +1072,5 @@ ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = 0, ny = ny, nz = nlev - 1) + nx = 0_iwp, ny = ny, nz = nlev - 1) CALL init_grid_definition('boundary intermediate', grid=w_west_intermediate, & @@ -1074,5 +1078,5 @@ ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = 0, ny = ny, nz = nlev - 1) + nx = 0_iwp, ny = ny, nz = nlev - 1) CALL init_grid_definition('boundary intermediate', grid=w_north_intermediate, & @@ -1080,5 +1084,5 @@ ymin = ly + 0.5_wp * dy, ymax = ly + 0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = nx, ny = 0, nz = nlev - 1) + nx = nx, ny = 0_iwp, nz = nlev - 1) CALL init_grid_definition('boundary intermediate', grid=w_south_intermediate, & @@ -1086,5 +1090,5 @@ ymin = -0.5_wp * dy, ymax = -0.5_wp * dy, & x0=x0, y0=y0, z0 = z0, & - nx = nx, ny = 0, nz = nlev - 1) + nx = nx, ny = 0_iwp, nz = nlev - 1) CALL init_grid_definition('boundary intermediate', grid=w_top_intermediate, & @@ -1344,5 +1348,5 @@ CHARACTER(LEN=*), INTENT(IN) :: kind CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: ic_mode - INTEGER, INTENT(IN) :: nx, ny, nz + INTEGER(iwp), INTENT(IN) :: nx, ny, nz REAL(wp), INTENT(IN) :: xmin, xmax, ymin, ymax REAL(wp), INTENT(IN) :: x0, y0, z0 @@ -1671,5 +1675,5 @@ REAL(wp) :: dlon, dlat - INTEGER :: i, j, imin, imax, jmin, jmax, l, nx, ny + INTEGER(iwp) :: i, j, imin, imax, jmin, jmax, l, nx, ny @@ -1749,14 +1753,14 @@ REAL(wp), INTENT(IN) :: dz_max, dz_stretch_factor, dz_stretch_level - INTEGER :: number_stretch_level_start !< number of user-specified start levels for stretching - INTEGER :: number_stretch_level_end !< number of user-specified end levels for stretching + INTEGER(iwp) :: number_stretch_level_start !< number of user-specified start levels for stretching + INTEGER(iwp) :: number_stretch_level_end !< number of user-specified end levels for stretching REAL(wp), DIMENSION(:), ALLOCATABLE :: min_dz_stretch_level_end REAL(wp) :: dz_level_end, dz_stretched - INTEGER :: dz_stretch_level_end_index(9) !< vertical grid level index until which the vertical grid spacing is stretched - INTEGER :: dz_stretch_level_start_index(9) !< vertical grid level index above which the vertical grid spacing is stretched - INTEGER :: dz_stretch_level_index = 0 - INTEGER :: k, n, number_dz + INTEGER(iwp) :: dz_stretch_level_end_index(9) !< vertical grid level index until which the vertical grid spacing is stretched + INTEGER(iwp) :: dz_stretch_level_start_index(9) !< vertical grid level index above which the vertical grid spacing is stretched + INTEGER(iwp) :: dz_stretch_level_index = 0 + INTEGER(iwp) :: k, n, number_dz ! @@ -1990,9 +1994,9 @@ REAL(wp), DIMENSION(:), INTENT(IN) :: dz_stretch_level_end, dz_stretch_level_start - INTEGER :: iterations !< number of iterations until stretch_factor_lower/upper_limit is reached - INTEGER :: l_rounded !< after l_rounded grid levels dz(n) is strechted to dz(n+1) with stretch_factor_2 - INTEGER :: n !< loop variable for stretching + INTEGER(iwp) :: iterations !< number of iterations until stretch_factor_lower/upper_limit is reached + INTEGER(iwp) :: l_rounded !< after l_rounded grid levels dz(n) is strechted to dz(n+1) with stretch_factor_2 + INTEGER(iwp) :: n !< loop variable for stretching - INTEGER, INTENT(IN) :: number_end !< number of user-specified end levels for stretching + INTEGER(iwp), INTENT(IN) :: number_end !< number of user-specified end levels for stretching REAL(wp) :: delta_l !< absolute difference between l and l_rounded @@ -2130,5 +2134,5 @@ REAL(wp), INTENT(OUT) :: zw(1:) - INTEGER :: k + INTEGER(iwp) :: k DO k = 1, UBOUND(zw, 1) @@ -2145,5 +2149,5 @@ SUBROUTINE setup_io_groups() - INTEGER :: ngroups + INTEGER(iwp) :: ngroups ngroups = 16 @@ -2180,5 +2184,5 @@ input_var_table(4) /), & kind = 'thermodynamics', & - n_output_quantities = 4 & ! P, Theta, Rho, qv + n_output_quantities = 4_iwp & ! P, Theta, Rho, qv ) @@ -2323,5 +2327,5 @@ TYPE(nc_var), INTENT(IN) :: out_vars(:) TYPE(nc_var), INTENT(IN) :: in_var_list(:) - INTEGER, OPTIONAL :: n_output_quantities + INTEGER(iwp), OPTIONAL :: n_output_quantities TYPE(io_group) :: group @@ -2391,6 +2395,6 @@ SUBROUTINE setup_variable_tables(ic_mode) CHARACTER(LEN=*), INTENT(IN) :: ic_mode - INTEGER :: n_invar = 0 !< number of variables in the input variable table - INTEGER :: n_outvar = 0 !< number of variables in the output variable table + INTEGER(iwp) :: n_invar = 0 !< number of variables in the input variable table + INTEGER(iwp) :: n_outvar = 0 !< number of variables in the output variable table TYPE(nc_var), POINTER :: var @@ -2510,5 +2514,5 @@ units = "K", & kind = "init soil", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = palm_grid, & @@ -2522,5 +2526,5 @@ units = "m^3/m^3", & kind = "init soil", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = palm_grid, & @@ -2534,5 +2538,5 @@ units = "K", & kind = "init scalar", & - input_id = 1, & ! first in (T, p) IO group + input_id = 1_iwp, & ! first in (T, p) IO group output_file = output_file, & grid = palm_grid, & @@ -2550,5 +2554,5 @@ units = "K", & kind = "left scalar", & - input_id = 1, & + input_id = 1_iwp, & grid = scalars_west_grid, & intermediate_grid = scalars_west_intermediate, & @@ -2562,5 +2566,5 @@ units = "K", & kind = "right scalar", & - input_id = 1, & + input_id = 1_iwp, & grid = scalars_east_grid, & intermediate_grid = scalars_east_intermediate, & @@ -2574,5 +2578,5 @@ units = "K", & kind = "north scalar", & - input_id = 1, & + input_id = 1_iwp, & grid = scalars_north_grid, & intermediate_grid = scalars_north_intermediate, & @@ -2586,5 +2590,5 @@ units = "K", & kind = "south scalar", & - input_id = 1, & + input_id = 1_iwp, & grid = scalars_south_grid, & intermediate_grid = scalars_south_intermediate, & @@ -2598,5 +2602,5 @@ units = "K", & kind = "top scalar", & - input_id = 1, & + input_id = 1_iwp, & grid = scalars_top_grid, & intermediate_grid = scalars_top_intermediate, & @@ -2610,5 +2614,5 @@ units = "kg/kg", & kind = "init scalar", & - input_id = 3, & + input_id = 3_iwp, & output_file = output_file, & grid = palm_grid, & @@ -2626,5 +2630,5 @@ units = "kg/kg", & kind = "left scalar", & - input_id = 3, & + input_id = 3_iwp, & output_file = output_file, & grid = scalars_west_grid, & @@ -2638,5 +2642,5 @@ units = "kg/kg", & kind = "right scalar", & - input_id = 3, & + input_id = 3_iwp, & output_file = output_file, & grid = scalars_east_grid, & @@ -2650,5 +2654,5 @@ units = "kg/kg", & kind = "north scalar", & - input_id = 3, & + input_id = 3_iwp, & output_file = output_file, & grid = scalars_north_grid, & @@ -2662,5 +2666,5 @@ units = "kg/kg", & kind = "south scalar", & - input_id = 3, & + input_id = 3_iwp, & output_file = output_file, & grid = scalars_south_grid, & @@ -2674,5 +2678,5 @@ units = "kg/kg", & kind = "top scalar", & - input_id = 3, & + input_id = 3_iwp, & output_file = output_file, & grid = scalars_top_grid, & @@ -2686,5 +2690,5 @@ units = "m/s", & kind = "init u", & - input_id = 1, & ! first in (U, V) I/O group + input_id = 1_iwp, & ! first in (U, V) I/O group output_file = output_file, & grid = u_initial_grid, & @@ -2702,5 +2706,5 @@ units = "m/s", & kind = "left u", & - input_id = 1, & ! first in (U, V) I/O group + input_id = 1_iwp, & ! first in (U, V) I/O group output_file = output_file, & grid = u_west_grid, & @@ -2714,5 +2718,5 @@ units = "m/s", & kind = "right u", & - input_id = 1, & ! first in (U, V) I/O group + input_id = 1_iwp, & ! first in (U, V) I/O group output_file = output_file, & grid = u_east_grid, & @@ -2726,5 +2730,5 @@ units = "m/s", & kind = "north u", & - input_id = 1, & ! first in (U, V) I/O group + input_id = 1_iwp, & ! first in (U, V) I/O group output_file = output_file, & grid = u_north_grid, & @@ -2738,5 +2742,5 @@ units = "m/s", & kind = "south u", & - input_id = 1, & ! first in (U, V) I/O group + input_id = 1_iwp, & ! first in (U, V) I/O group output_file = output_file, & grid = u_south_grid, & @@ -2750,5 +2754,5 @@ units = "m/s", & kind = "top u", & - input_id = 1, & ! first in (U, V) I/O group + input_id = 1_iwp, & ! first in (U, V) I/O group output_file = output_file, & grid = u_top_grid, & @@ -2762,5 +2766,5 @@ units = "m/s", & kind = "init v", & - input_id = 2, & ! second in (U, V) I/O group + input_id = 2_iwp, & ! second in (U, V) I/O group output_file = output_file, & grid = v_initial_grid, & @@ -2778,5 +2782,5 @@ units = "m/s", & kind = "right v", & - input_id = 2, & ! second in (U, V) I/O group + input_id = 2_iwp, & ! second in (U, V) I/O group output_file = output_file, & grid = v_west_grid, & @@ -2790,5 +2794,5 @@ units = "m/s", & kind = "right v", & - input_id = 2, & ! second in (U, V) I/O group + input_id = 2_iwp, & ! second in (U, V) I/O group output_file = output_file, & grid = v_east_grid, & @@ -2802,5 +2806,5 @@ units = "m/s", & kind = "north v", & - input_id = 2, & ! second in (U, V) I/O group + input_id = 2_iwp, & ! second in (U, V) I/O group output_file = output_file, & grid = v_north_grid, & @@ -2814,5 +2818,5 @@ units = "m/s", & kind = "south v", & - input_id = 2, & ! second in (U, V) I/O group + input_id = 2_iwp, & ! second in (U, V) I/O group output_file = output_file, & grid = v_south_grid, & @@ -2826,5 +2830,5 @@ units = "m/s", & kind = "top v", & - input_id = 2, & ! second in (U, V) I/O group + input_id = 2_iwp, & ! second in (U, V) I/O group output_file = output_file, & grid = v_top_grid, & @@ -2838,5 +2842,5 @@ units = "m/s", & kind = "init w", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = w_initial_grid, & @@ -2854,5 +2858,5 @@ units = "m/s", & kind = "left w", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = w_west_grid, & @@ -2866,5 +2870,5 @@ units = "m/s", & kind = "right w", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = w_east_grid, & @@ -2878,5 +2882,5 @@ units = "m/s", & kind = "north w", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = w_north_grid, & @@ -2890,5 +2894,5 @@ units = "m/s", & kind = "south w", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = w_south_grid, & @@ -2902,5 +2906,5 @@ units = "m/s", & kind = "top w", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = w_top_grid, & @@ -2914,5 +2918,5 @@ units = "kg/m2", & kind = "surface forcing", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = palm_grid, & @@ -2926,5 +2930,5 @@ units = "kg/m2", & kind = "surface forcing", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = palm_grid, & @@ -2938,5 +2942,5 @@ units = "kg/m2", & kind = "surface forcing", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = palm_grid, & @@ -2950,5 +2954,5 @@ units = "kg/m2", & kind = "surface forcing", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = palm_grid, & @@ -2962,5 +2966,5 @@ units = "kg/m2", & kind = "surface forcing", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = palm_grid, & @@ -2974,5 +2978,5 @@ units = "W/m2", & kind = "surface forcing", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = palm_grid, & @@ -2986,5 +2990,5 @@ units = "W/m2", & kind = "surface forcing", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = palm_grid, & @@ -2998,5 +3002,5 @@ units = "W/m2", & kind = "surface forcing", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = palm_grid, & @@ -3010,5 +3014,5 @@ units = "W/m2", & kind = "surface forcing", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = palm_grid, & @@ -3025,5 +3029,5 @@ units = "Pa", & kind = "time series", & - input_id = 2, & ! second in (T, p) I/O group + input_id = 2_iwp, & ! second in (T, p) I/O group output_file = output_file, & grid = palm_grid, & @@ -3038,5 +3042,5 @@ units = "m/s", & kind = "geostrophic", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = averaged_scalar_profile, & @@ -3050,5 +3054,5 @@ units = "m/s", & kind = "geostrophic", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = averaged_scalar_profile, & @@ -3062,5 +3066,5 @@ units = "m/s", & kind = "geostrophic", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = averaged_scalar_profile, & @@ -3075,5 +3079,5 @@ units = "m/s", & kind = "large-scale scalar forcing", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = averaged_scalar_profile, & @@ -3088,5 +3092,5 @@ units = "m/s", & kind = "large-scale w forcing", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = averaged_scalar_profile, & @@ -3101,5 +3105,5 @@ units = "m/s", & kind = "large-scale w forcing", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = averaged_w_profile, & @@ -3115,5 +3119,5 @@ units = "K/s", & kind = "large-scale scalar forcing", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = averaged_scalar_profile, & @@ -3128,5 +3132,5 @@ units = "K/s", & kind = "large-scale scalar forcing", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = averaged_scalar_profile, & @@ -3141,5 +3145,5 @@ units = "K", & kind = "large-scale scalar forcing", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = averaged_scalar_profile, & @@ -3154,5 +3158,5 @@ units = "kg/kg/s", & kind = "large-scale scalar forcing", & - input_id = 3, & + input_id = 3_iwp, & output_file = output_file, & grid = averaged_scalar_profile, & @@ -3168,5 +3172,5 @@ units = "kg/kg/s", & kind = "large-scale scalar forcing", & - input_id = 3, & + input_id = 3_iwp, & output_file = output_file, & grid = averaged_scalar_profile, & @@ -3181,5 +3185,5 @@ units = "kg/kg", & kind = "large-scale scalar forcing", & - input_id = 3, & + input_id = 3_iwp, & output_file = output_file, & grid = averaged_scalar_profile, & @@ -3194,5 +3198,5 @@ units = "s", & kind = "constant scalar profile", & - input_id = 1, & + input_id = 1_iwp, & output_file = output_file, & grid = averaged_scalar_profile, & @@ -3208,5 +3212,5 @@ units = "", & kind = "internal profile", & - input_id = 4, & + input_id = 4_iwp, & output_file = output_file, & grid = averaged_scalar_profile, & @@ -3222,5 +3226,5 @@ units = "", & kind = "internal profile", & - input_id = 4, & + input_id = 4_iwp, & output_file = output_file, & grid = north_averaged_scalar_profile, & @@ -3237,5 +3241,5 @@ units = "", & kind = "internal profile", & - input_id = 4, & + input_id = 4_iwp, & output_file = output_file, & grid = south_averaged_scalar_profile, & @@ -3252,5 +3256,5 @@ units = "", & kind = "internal profile", & - input_id = 4, & + input_id = 4_iwp, & output_file = output_file, & grid = east_averaged_scalar_profile, & @@ -3267,5 +3271,5 @@ units = "", & kind = "internal profile", & - input_id = 4, & + input_id = 4_iwp, & output_file = output_file, & grid = west_averaged_scalar_profile, & @@ -3281,5 +3285,5 @@ units = "", & kind = "internal profile", & - input_id = 2, & + input_id = 2_iwp, & output_file = output_file, & grid = north_averaged_scalar_profile, & @@ -3296,5 +3300,5 @@ units = "", & kind = "internal profile", & - input_id = 2, & + input_id = 2_iwp, & output_file = output_file, & grid = south_averaged_scalar_profile, & @@ -3311,5 +3315,5 @@ units = "", & kind = "internal profile", & - input_id = 2, & + input_id = 2_iwp, & output_file = output_file, & grid = east_averaged_scalar_profile, & @@ -3326,5 +3330,5 @@ units = "", & kind = "internal profile", & - input_id = 2, & + input_id = 2_iwp, & output_file = output_file, & grid = west_averaged_scalar_profile, & @@ -3354,5 +3358,5 @@ CHARACTER(LEN=*), INTENT(IN) :: name, std_name, long_name, units, kind - INTEGER, INTENT(IN) :: input_id + INTEGER(iwp), INTENT(IN) :: input_id TYPE(grid_definition), INTENT(IN), TARGET :: grid, intermediate_grid TYPE(nc_file), INTENT(IN) :: output_file @@ -3733,11 +3737,11 @@ TYPE(container), INTENT(INOUT), ALLOCATABLE :: input_buffer(:) TYPE(grid_definition), INTENT(IN) :: cosmo_grid - INTEGER, INTENT(IN) :: iter + INTEGER(iwp), INTENT(IN) :: iter REAL(wp), ALLOCATABLE :: basic_state_pressure(:) TYPE(container), ALLOCATABLE :: preprocess_buffer(:) - INTEGER :: hour, dt - INTEGER :: i, j, k - INTEGER :: nx, ny, nz + INTEGER(iwp) :: hour, dt + INTEGER(iwp) :: i, j, k + INTEGER(iwp) :: nx, ny, nz input_buffer(:)%is_preprocessed = .FALSE. @@ -3905,5 +3909,5 @@ CALL fill_water_cells(soiltyp, input_buffer(1)%array, & - SIZE(input_buffer(1)%array, 3), & + SIZE(input_buffer(1)%array, 3, kind=iwp), & FILL_ITERATIONS) input_buffer(:)%is_preprocessed = .TRUE. @@ -3912,5 +3916,5 @@ CALL fill_water_cells(soiltyp, input_buffer(1)%array, & - SIZE(input_buffer(1)%array, 3), & + SIZE(input_buffer(1)%array, 3, kind=iwp), & FILL_ITERATIONS) @@ -3941,6 +3945,6 @@ CALL report('preprocess', message) - hour = iter - 1 - dt = MODULO(hour, 3) + 1 ! averaging period + hour = iter - 1_iwp + dt = MODULO(hour, 3_iwp) + 1_iwp ! averaging period SELECT CASE(dt) @@ -3986,8 +3990,8 @@ CALL report('preprocess', message) - hour = iter - 1 + hour = iter - 1_iwp ! !-- averaging period - dt = MODULO(hour, 3) + 1 + dt = MODULO(hour, 3_iwp) + 1_iwp SELECT CASE(dt) ! @@ -4035,94 +4039,4 @@ -!------------------------------------------------------------------------------! -! Description: -! ------------ -!> Computes average soil values in COSMO-DE water cells from neighbouring -!> non-water cells. This is done as a preprocessing step for the COSMO-DE -!> soil input arrays, which contain unphysical values for water cells. -!> -!> This routine computes the average of up to all nine neighbouring cells -!> or keeps the original value, if not at least one non-water neightbour -!> is available. -!> -!> By repeatedly applying this step, soil data can be extrapolated into -!> 'water' regions occupying multiple cells, one cell per iteration. -!> -!> Input parameters: -!> ----------------- -!> soiltyp : 2d map of COSMO-DE soil types -!> nz : number of layers in the COSMO-DE soil -!> niter : number iterations -!> -!> Output parameters: -!> ------------------ -!> array : the soil array (i.e. water content or temperature) -!------------------------------------------------------------------------------! - SUBROUTINE fill_water_cells(soiltyp, array, nz, niter) - INTEGER(iwp), DIMENSION(:,:,:), INTENT(IN) :: soiltyp - REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: array - INTEGER, INTENT(IN) :: nz, niter - - REAL(wp), DIMENSION(nz) :: column - INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: old_soiltyp, new_soiltyp - INTEGER :: l, i, j, nx, ny, n_cells, ii, jj, iter - INTEGER, DIMENSION(8) :: di, dj - - nx = SIZE(array, 1) - ny = SIZE(array, 2) - di = (/ -1, -1, -1, 0, 0, 1, 1, 1 /) - dj = (/ -1, 0, 1, -1, 1, -1, 0, 1 /) - - ALLOCATE(old_soiltyp(SIZE(soiltyp,1), & - SIZE(soiltyp,2) )) - - ALLOCATE(new_soiltyp(SIZE(soiltyp,1), & - SIZE(soiltyp,2) )) - - old_soiltyp(:,:) = soiltyp(:,:,1) - new_soiltyp(:,:) = soiltyp(:,:,1) - - DO iter = 1, niter - - DO j = 1, ny - DO i = 1, nx - - IF (old_soiltyp(i,j) == WATER_ID) THEN - - n_cells = 0 - column(:) = 0.0_wp - DO l = 1, SIZE(di) - - ii = MIN(nx, MAX(1, i + di(l))) - jj = MIN(ny, MAX(1, j + dj(l))) - - IF (old_soiltyp(ii,jj) .NE. WATER_ID) THEN - n_cells = n_cells + 1 - column(:) = column(:) + array(ii,jj,:) - ENDIF - - ENDDO - -! -!-- Overwrite if at least one non-water neighbour cell is available - IF (n_cells > 0) THEN - array(i,j,:) = column(:) / n_cells - new_soiltyp(i,j) = 0 - ENDIF - - ENDIF - - ENDDO - ENDDO - - old_soiltyp(:,:) = new_soiltyp(:,:) - - ENDDO - - DEALLOCATE(old_soiltyp, new_soiltyp) - - END SUBROUTINE fill_water_cells - - END MODULE inifor_grid #endif Index: /palm/trunk/UTIL/inifor/src/inifor_io.f90 =================================================================== --- /palm/trunk/UTIL/inifor/src/inifor_io.f90 (revision 4522) +++ /palm/trunk/UTIL/inifor/src/inifor_io.f90 (revision 4523) @@ -26,4 +26,8 @@ ! ----------------- ! $Id$ +! respect integer working precision (iwp) specified in inifor_defs.f90 +! +! +! 4481 2020-03-31 18:55:54Z maronga ! Pass hhl_file directly instead of entire INIFOR configuration ! @@ -135,5 +139,5 @@ NC_DEPTH_NAME, NC_HHL_NAME, NC_RLAT_NAME, NC_RLON_NAME, & NC_ROTATED_POLE_NAME, NC_POLE_LATITUDE_NAME, & - NC_POLE_LONGITUDE_NAME, RHO_L, wp, iwp + NC_POLE_LONGITUDE_NAME, RHO_L, iwp, wp USE inifor_types USE inifor_util, & @@ -332,5 +336,6 @@ message = "Failed reading NetCDF variable " // & - TRIM(in_var%name) // " with " // TRIM(str(in_var%ndim)) // & + TRIM(in_var%name) // " with " // & + TRIM(str(INT(in_var%ndim, kind=iwp))) // & " dimensions because only two- and and three-dimensional" // & " variables are supported." @@ -579,8 +584,8 @@ CHARACTER (LEN=DATE), INTENT(IN) :: start_date_string CHARACTER (LEN=*), INTENT(IN) :: prefix, suffix, input_path - INTEGER, INTENT(IN) :: start_hour, end_hour, step_hour + INTEGER(iwp), INTENT(IN) :: start_hour, end_hour, step_hour CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: file_list(:) - INTEGER :: number_of_intervals, hour, i + INTEGER(iwp) :: number_of_intervals, hour, i CHARACTER(LEN=DATE) :: date_string @@ -612,10 +617,10 @@ CHARACTER (LEN=DATE), INTENT(IN) :: start_date_string CHARACTER (LEN=*), INTENT(IN) :: prefix, suffix, input_path - INTEGER, INTENT(IN) :: start_hour, end_hour, step_hour + INTEGER(iwp), INTENT(IN) :: start_hour, end_hour, step_hour CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: file_list(:) LOGICAL, OPTIONAL, INTENT(IN) :: nocheck - INTEGER :: i - LOGICAL :: check_files + INTEGER(iwp) :: i + LOGICAL :: check_files CALL get_datetime_file_list( start_date_string, start_hour, end_hour, & @@ -786,8 +791,8 @@ REAL(wp), INTENT(OUT) :: latmin_cosmo !< Minimunm latitude of COSMO-DE's rotated-pole grid [COSMO rotated-pole rad] REAL(wp), INTENT(OUT) :: latmax_cosmo !< Maximum latitude of COSMO-DE's rotated-pole grid [COSMO rotated-pole rad] - INTEGER, INTENt(OUT) :: nlon, nlat, nlev, ndepths + INTEGER(iwp), INTENT(OUT) :: nlon, nlat, nlev, ndepths TYPE(nc_var) :: cosmo_var !< COSMO dummy variable, used for reading HHL, rlon, rlat - INTEGER :: k + INTEGER(iwp) :: k ! @@ -916,5 +921,6 @@ CHARACTER (LEN=5) :: zone_string CHARACTER (LEN=SNAME) :: history_string - INTEGER :: ncid, nx, ny, nz, nt, dimids(3), dimvarids(3) + INTEGER :: nx, ny, nz, nt + INTEGER :: ncid, dimids(3), dimvarids(3) REAL(wp) :: z0 @@ -1101,5 +1107,6 @@ TYPE(nc_var), POINTER :: var - INTEGER :: i, ncid + INTEGER(iwp) :: i + INTEGER :: ncid LOGICAL :: to_be_written @@ -1152,10 +1159,10 @@ SUBROUTINE read_input_variables(group, iter, buffer) TYPE(io_group), INTENT(INOUT), TARGET :: group - INTEGER, INTENT(IN) :: iter + INTEGER(iwp), INTENT(IN) :: iter TYPE(container), ALLOCATABLE, INTENT(INOUT) :: buffer(:) - INTEGER :: hour, buf_id + INTEGER(iwp) :: hour, buf_id TYPE(nc_var), POINTER :: input_var CHARACTER(LEN=PATH), POINTER :: input_file - INTEGER :: ivar, nbuffers + INTEGER(iwp) :: ivar, nbuffers message = "Reading data for I/O group '" // TRIM(group%in_var_list(1)%name) // "'." @@ -1177,5 +1184,5 @@ "accumulated variable. Group '" // TRIM(group%kind) //& "' contains " // & - TRIM( str(SIZE(group%in_var_list)) ) // "." + TRIM( str(SIZE(group%in_var_list, kind=iwp)) ) // "." CALL inifor_abort('read_input_variables | accumulation', message) ENDIF @@ -1250,16 +1257,16 @@ !> depending on the current hour. !------------------------------------------------------------------------------! - INTEGER FUNCTION select_buffer(hour) - INTEGER, INTENT(IN) :: hour - INTEGER :: step - - select_buffer = 0 - step = MODULO(hour, 3) + 1 + INTEGER(iwp) FUNCTION select_buffer(hour) + INTEGER(iwp), INTENT(IN) :: hour + INTEGER(iwp) :: step + + select_buffer = 0_iwp + step = MODULO(hour, 3_iwp) + 1_iwp SELECT CASE(step) CASE(1, 3) - select_buffer = 1 + select_buffer = 1_iwp CASE(2) - select_buffer = 2 + select_buffer = 2_iwp CASE DEFAULT message = "Invalid step '" // TRIM(str(step)) @@ -1369,10 +1376,10 @@ TYPE(nc_var), INTENT(IN) :: var REAL(wp), INTENT(IN) :: array(:,:,:) - INTEGER, INTENT(IN) :: iter + INTEGER(iwp), INTENT(IN) :: iter TYPE(nc_file), INTENT(IN) :: output_file TYPE(inifor_config) :: cfg - INTEGER :: ncid, ndim, start(4), count(4) - LOGICAL :: var_is_time_dependent + INTEGER :: ncid, ndim, start(4), count(4) + LOGICAL :: var_is_time_dependent var_is_time_dependent = ( & Index: /palm/trunk/UTIL/inifor/src/inifor_transform.f90 =================================================================== --- /palm/trunk/UTIL/inifor/src/inifor_transform.f90 (revision 4522) +++ /palm/trunk/UTIL/inifor/src/inifor_transform.f90 (revision 4523) @@ -26,4 +26,11 @@ ! ----------------- ! $Id$ +! bugfix: pressure extrapolation +! respect integer working precision (iwp) specified in inifor_defs.f90 +! moved fill_water_cells() routine here +! remove unused routine, appropriately renamed constand_density_pressure() +! +! +! 4481 2020-03-31 18:55:54Z maronga ! Use PALM's working precision ! Improved coding style @@ -111,5 +118,6 @@ USE inifor_control USE inifor_defs, & - ONLY: BETA, G, P_SL, PI, RD, T_SL, TO_DEGREES, TO_RADIANS, wp + ONLY: BETA, G, P_SL, PI, RD, T_SL, TO_DEGREES, TO_RADIANS, WATER_ID, & + iwp, wp USE inifor_types USE inifor_util, & @@ -126,5 +134,5 @@ REAL(wp), INTENT(OUT) :: out_arr(:) - INTEGER :: k, l, nz + INTEGER(iwp) :: k, l, nz nz = UBOUND(out_arr, 1) @@ -179,5 +187,5 @@ REAL(wp), INTENT(OUT) :: out_arr(0:,0:,:) - INTEGER :: i, j, k, l, nz + INTEGER(iwp) :: i, j, k, l, nz nz = UBOUND(out_arr, 3) @@ -241,5 +249,5 @@ TYPE(nc_var), INTENT(IN), OPTIONAL :: ncvar - INTEGER :: i, j, k, l + INTEGER(iwp) :: i, j, k, l ! @@ -247,6 +255,6 @@ IF ( UBOUND(outvar, 3) .GT. UBOUND(invar, 3) ) THEN message = "Output array for '" // TRIM(ncvar%name) // "' has ' more levels (" // & - TRIM(str(UBOUND(outvar, 3))) // ") than input variable ("//& - TRIM(str(UBOUND(invar, 3))) // ")." + TRIM(str(UBOUND(outvar, 3, kind=iwp))) // ") than input variable ("//& + TRIM(str(UBOUND(invar, 3, kind=iwp))) // ")." CALL inifor_abort('interpolate_2d', message) ENDIF @@ -277,15 +285,15 @@ !------------------------------------------------------------------------------! SUBROUTINE average_2d(in_arr, out_arr, ii, jj) - REAL(wp), INTENT(IN) :: in_arr(0:,0:,0:) - REAL(wp), INTENT(OUT) :: out_arr(0:) - INTEGER, INTENT(IN), DIMENSION(:) :: ii, jj - - INTEGER :: i, j, k, l - REAL(wp) :: ni + REAL(wp), INTENT(IN) :: in_arr(0:,0:,0:) + REAL(wp), INTENT(OUT) :: out_arr(0:) + INTEGER(iwp), INTENT(IN), DIMENSION(:) :: ii, jj + + INTEGER(iwp) :: i, j, k, l + REAL(wp) :: ni IF (SIZE(ii) /= SIZE(jj)) THEN message = "Length of 'ii' and 'jj' index lists do not match." // & - NEW_LINE(' ') // "ii has " // str(SIZE(ii)) // " elements, " // & - NEW_LINE(' ') // "jj has " // str(SIZE(jj)) // "." + NEW_LINE(' ') // "ii has " // str(SIZE(ii, kind=iwp)) // " elements, " // & + NEW_LINE(' ') // "jj has " // str(SIZE(jj, kind=iwp)) // "." CALL inifor_abort('average_2d', message) ENDIF @@ -330,5 +338,5 @@ REAL(wp), DIMENSION(:,:,:), INTENT(OUT) :: palm_array REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: intermediate_array - INTEGER :: nx, ny, nlev + INTEGER(iwp) :: nx, ny, nlev nx = palm_intermediate%nx @@ -365,5 +373,5 @@ REAL(wp), DIMENSION(:), INTENT(OUT) :: profile_array - INTEGER :: i_source, j_source, k_profile, k_source, l, m + INTEGER(iwp) :: i_source, j_source, k_profile, k_source, l, m REAL :: ni_columns @@ -422,5 +430,5 @@ REAL(wp), DIMENSION(:), INTENT(OUT) :: profile_array - INTEGER :: i_source, j_source, l, nz, nlev + INTEGER(iwp) :: i_source, j_source, l, nz, nlev REAL(wp) :: ni_columns @@ -468,5 +476,5 @@ REAL(wp), DIMENSION(:), INTENT(OUT) :: profile_array - INTEGER :: i_source, j_source, l, nz, nlev + INTEGER(iwp) :: i_source, j_source, l, nz, nlev REAL(wp) :: ni_columns @@ -511,41 +519,107 @@ - - -!------------------------------------------------------------------------------! -! Description: -! ------------ -!> Extrapolates density linearly from the level 'k_min' downwards. -!------------------------------------------------------------------------------! - SUBROUTINE extrapolate_density(rho, avg_grid) - REAL(wp), DIMENSION(:), INTENT(INOUT) :: rho - TYPE(grid_definition), INTENT(IN) :: avg_grid - - REAL(wp) :: drhodz, dz, zk, rhok - INTEGER :: k_min - - k_min = avg_grid%k_min - zk = avg_grid%z(k_min) - rhok = rho(k_min) - dz = avg_grid%z(k_min + 1) - avg_grid%z(k_min) - drhodz = (rho(k_min + 1) - rho(k_min)) / dz - - rho(1:k_min-1) = rhok + drhodz * (avg_grid%z(1:k_min-1) - zk) - - END SUBROUTINE extrapolate_density - - -!------------------------------------------------------------------------------! -! Description: -! ------------ -!> Driver for extrapolating pressure from PALM level k_min downwards -!------------------------------------------------------------------------------! - SUBROUTINE extrapolate_pressure(p, rho, avg_grid) +!------------------------------------------------------------------------------! +! Description: +! ------------ +!> Computes average soil values in COSMO-DE water cells from neighbouring +!> non-water cells. This is done as a preprocessing step for the COSMO-DE +!> soil input arrays, which contain unphysical values for water cells. +!> +!> This routine computes the average of up to all nine neighbouring cells +!> or keeps the original value, if not at least one non-water neightbour +!> is available. +!> +!> By repeatedly applying this step, soil data can be extrapolated into +!> 'water' regions occupying multiple cells, one cell per iteration. +!> +!> Input parameters: +!> ----------------- +!> soiltyp : 2d map of COSMO-DE soil types +!> nz : number of layers in the COSMO-DE soil +!> niter : number iterations +!> +!> Output parameters: +!> ------------------ +!> array : the soil array (i.e. water content or temperature) +!------------------------------------------------------------------------------! + SUBROUTINE fill_water_cells(soiltyp, array, nz, niter) + INTEGER(iwp), DIMENSION(:,:,:), INTENT(IN) :: soiltyp + REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: array + INTEGER(iwp), INTENT(IN) :: nz, niter + + REAL(wp), DIMENSION(nz) :: column + INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: old_soiltyp, new_soiltyp + INTEGER(iwp) :: l, i, j, nx, ny, n_cells, ii, jj, iter + INTEGER(iwp), DIMENSION(8) :: di, dj + + nx = SIZE(array, 1) + ny = SIZE(array, 2) + di = (/ -1, -1, -1, 0, 0, 1, 1, 1 /) + dj = (/ -1, 0, 1, -1, 1, -1, 0, 1 /) + + ALLOCATE(old_soiltyp(SIZE(soiltyp,1), & + SIZE(soiltyp,2) )) + + ALLOCATE(new_soiltyp(SIZE(soiltyp,1), & + SIZE(soiltyp,2) )) + + old_soiltyp(:,:) = soiltyp(:,:,1) + new_soiltyp(:,:) = soiltyp(:,:,1) + + DO iter = 1, niter + + DO j = 1, ny + DO i = 1, nx + + IF (old_soiltyp(i,j) == WATER_ID) THEN + + n_cells = 0 + column(:) = 0.0_wp + DO l = 1, SIZE(di) + + ii = MIN(nx, MAX(1_iwp, i + di(l))) + jj = MIN(ny, MAX(1_iwp, j + dj(l))) + + IF (old_soiltyp(ii,jj) .NE. WATER_ID) THEN + n_cells = n_cells + 1 + column(:) = column(:) + array(ii,jj,:) + ENDIF + + ENDDO + +! +!-- Overwrite if at least one non-water neighbour cell is available + IF (n_cells > 0) THEN + array(i,j,:) = column(:) / n_cells + new_soiltyp(i,j) = 0 + ENDIF + + ENDIF + + ENDDO + ENDDO + + old_soiltyp(:,:) = new_soiltyp(:,:) + + ENDDO + + DEALLOCATE(old_soiltyp, new_soiltyp) + + END SUBROUTINE fill_water_cells + + +!------------------------------------------------------------------------------! +! Description: +! ------------ +!> Takes the averaged pressure profile
and sets the lowest entry to the +!> extrapolated pressure at the surface. +!------------------------------------------------------------------------------! + SUBROUTINE get_surface_pressure(p, rho, avg_grid) REAL(wp), DIMENSION(:), INTENT(IN) :: rho REAL(wp), DIMENSION(:), INTENT(INOUT) :: p TYPE(grid_definition), INTENT(IN) :: avg_grid - REAL(wp) :: drhodz, dz, zk, rhok - INTEGER :: k, k_min + REAL(wp) :: drhodz, dz, zk, rhok + INTEGER(iwp) :: k_min k_min = avg_grid%k_min @@ -553,48 +627,20 @@ rhok = rho(k_min) dz = avg_grid%z(k_min + 1) - avg_grid%z(k_min) - drhodz = 0.5_wp * (rho(k_min + 1) - rho(k_min)) / dz - - DO k = 1, k_min-1 - p(k) = constant_density_pressure(p(k_min), zk, rhok, drhodz, & - avg_grid%z(k), G) - ENDDO - - END SUBROUTINE extrapolate_pressure - - -!------------------------------------------------------------------------------! -! Description: -! ------------ -!> Takes the averaged pressure profile
and sets the lowest entry to the -!> extrapolated pressure at the surface. -!------------------------------------------------------------------------------! - SUBROUTINE get_surface_pressure(p, rho, avg_grid) - REAL(wp), DIMENSION(:), INTENT(IN) :: rho - REAL(wp), DIMENSION(:), INTENT(INOUT) :: p - TYPE(grid_definition), INTENT(IN) :: avg_grid - - REAL(wp) :: drhodz, dz, zk, rhok - INTEGER :: k_min - - k_min = avg_grid%k_min - zk = avg_grid%z(k_min) - rhok = rho(k_min) - dz = avg_grid%z(k_min + 1) - avg_grid%z(k_min) - drhodz = 0.5_wp * (rho(k_min + 1) - rho(k_min)) / dz - - p(1) = constant_density_pressure(p(k_min), zk, rhok, drhodz, & - 0.0_wp, G) + drhodz = ( rho(k_min + 1) - rho(k_min) ) / dz + + p(1) = linear_density_pressure( p(k_min), zk, rhok, drhodz, & + z = 0.0_wp, g=G ) END SUBROUTINE get_surface_pressure - FUNCTION constant_density_pressure(pk, zk, rhok, drhodz, z, g) RESULT(p) + FUNCTION linear_density_pressure(pk, zk, rhok, drhodz, z, g) RESULT(p) REAL(wp), INTENT(IN) :: pk, zk, rhok, drhodz, g, z REAL(wp) :: p - p = pk + ( zk - z ) * g * ( rhok + 0.5*drhodz * (zk - z) ) - - END FUNCTION constant_density_pressure + p = pk + ( zk - z ) * g * ( rhok - 0.5_wp * drhodz * (zk - z) ) + + END FUNCTION linear_density_pressure !-----------------------------------------------------------------------------! @@ -769,5 +815,5 @@ REAL(wp), INTENT(OUT) :: phi(0:,0:), lam(0:,0:) - INTEGER :: i, j + INTEGER(iwp) :: i, j IF ( SIZE(phi, 1) .NE. SIZE(lam, 1) .OR. & @@ -816,6 +862,6 @@ REAL(wp), INTENT(IN) :: angle !< rotation angle [deg] - INTEGER :: i - REAL(wp) :: sine, cosine, v_rot(2), rotation(2,2) + INTEGER(iwp) :: i + REAL(wp) :: sine, cosine, v_rot(2), rotation(2,2) sine = SIN(angle * TO_RADIANS) @@ -912,11 +958,11 @@ palm_ii, palm_jj) - REAL(wp), DIMENSION(0:), INTENT(IN) :: cosmo_lat, cosmo_lon - REAL(wp), DIMENSION(0:,0:), INTENT(IN) :: palm_clat, palm_clon - REAL(wp) :: cosmo_dxi, cosmo_dyi - INTEGER, DIMENSION(0:,0:,1:), INTENT(OUT) :: palm_ii, palm_jj - - REAL(wp) :: lonpos, latpos, lon0, lat0 - INTEGER :: i, j + REAL(wp), DIMENSION(0:), INTENT(IN) :: cosmo_lat, cosmo_lon + REAL(wp), DIMENSION(0:,0:), INTENT(IN) :: palm_clat, palm_clon + REAL(wp) :: cosmo_dxi, cosmo_dyi + INTEGER(iwp), DIMENSION(0:,0:,1:), INTENT(OUT) :: palm_ii, palm_jj + + REAL(wp) :: lonpos, latpos, lon0, lat0 + INTEGER(iwp) :: i, j lon0 = cosmo_lon(0) @@ -968,14 +1014,14 @@ !> column of the given palm grid. !------------------------------------------------------------------------------! - SUBROUTINE find_vertical_neighbours_and_weights_interp( palm_grid, & - palm_intermediate ) + SUBROUTINE find_vertical_neighbours_and_weights_interp( palm_grid, & + palm_intermediate ) TYPE(grid_definition), INTENT(INOUT) :: palm_grid TYPE(grid_definition), INTENT(IN) :: palm_intermediate - INTEGER :: i, j, k, nx, ny, nz, nlev, k_intermediate - LOGICAL :: point_is_below_grid, point_is_above_grid, & - point_is_in_current_cell - REAL(wp) :: current_height, column_base, column_top, h_top, h_bottom, & - weight + INTEGER(iwp) :: i, j, k, nx, ny, nz, nlev, k_intermediate + LOGICAL :: point_is_below_grid, point_is_above_grid, & + point_is_in_current_cell + REAL(wp) :: current_height, column_base, column_top, h_top, h_bottom, & + weight nx = palm_grid%nx @@ -1091,5 +1137,5 @@ LOGICAL :: level_based_averaging - INTEGER :: i, j, k_palm, k_intermediate, l, nlev + INTEGER(iwp) :: i, j, k_palm, k_intermediate, l, nlev LOGICAL :: point_is_below_grid, point_is_above_grid, & point_is_in_current_cell @@ -1259,13 +1305,13 @@ palm_clat, palm_clon, palm_ii, palm_jj, palm_w_horiz) - REAL(wp), DIMENSION(0:), INTENT(IN) :: cosmo_lat, cosmo_lon - REAL(wp) :: cosmo_dxi, cosmo_dyi - REAL(wp), DIMENSION(0:,0:), INTENT(IN) :: palm_clat, palm_clon - INTEGER, DIMENSION(0:,0:,1:), INTENT(IN) :: palm_ii, palm_jj + REAL(wp), DIMENSION(0:), INTENT(IN) :: cosmo_lat, cosmo_lon + REAL(wp) :: cosmo_dxi, cosmo_dyi + REAL(wp), DIMENSION(0:,0:), INTENT(IN) :: palm_clat, palm_clon + INTEGER(iwp), DIMENSION(0:,0:,1:), INTENT(IN) :: palm_ii, palm_jj REAL(wp), DIMENSION(0:,0:,1:), INTENT(OUT) :: palm_w_horiz - REAL(wp) :: wlambda, wphi - INTEGER :: i, j + REAL(wp) :: wlambda, wphi + INTEGER(iwp) :: i, j cosmo_dxi = 1.0_wp / (cosmo_lon(1) - cosmo_lon(0)) @@ -1319,5 +1365,5 @@ REAL(wp), DIMENSION(0:,0:,0:), INTENT(IN) :: u_face, v_face REAL(wp), DIMENSION(0:,0:,0:), INTENT(OUT) :: u_centre, v_centre - INTEGER :: nx, ny + INTEGER(iwp) :: nx, ny nx = UBOUND(u_face, 1) Index: /palm/trunk/UTIL/inifor/src/inifor_types.f90 =================================================================== --- /palm/trunk/UTIL/inifor/src/inifor_types.f90 (revision 4522) +++ /palm/trunk/UTIL/inifor/src/inifor_types.f90 (revision 4523) @@ -26,4 +26,8 @@ ! ----------------- ! $Id$ +! respect integer working precision (iwp) specified in inifor_defs.f90 +! +! +! 4481 2020-03-31 18:55:54Z maronga ! Added boolean indicator for --elevation option invocation, sorted varibles ! @@ -79,5 +83,5 @@ USE inifor_defs, & - ONLY: DATE, PATH, SNAME, LNAME, wp + ONLY: DATE, PATH, SNAME, LNAME, iwp, wp #if defined ( __netcdf ) @@ -142,16 +146,16 @@ CHARACTER(LEN=SNAME) :: name(3) !< names of the grid dimensions, e.g. (/'x', 'y', 'z'/) or (/'latitude', 'longitude', 'height'/) CHARACTER(LEN=SNAME) :: kind !< names of the grid dimensions, e.g. (/'x', 'y', 'z'/) or (/'latitude', 'longitude', 'height'/) - INTEGER :: k_min !< Index of lowest PALM grid level that is not cut by local COSMO orography; vertically separates interpolation and extrapolation region. - INTEGER :: nx !< number of gridpoints in the first dimension - INTEGER :: ny !< number of gridpoints in the second dimension - INTEGER :: nz !< number of gridpoints in the third dimension, used for PALM points - INTEGER :: nlev !< number of COSMO grid levels - INTEGER :: n_columns !< number of averaging columns of the source grid - INTEGER, ALLOCATABLE :: ii(:,:,:) !< Given a point (i,j,k) in the PALM-4U grid, ii(i,j,l) gives the x index of the l'th horizontl neighbour on the COSMO-DE grid. - INTEGER, ALLOCATABLE :: jj(:,:,:) !< Given a point (i,j,k) in the PALM-4U grid, jj(i,j,l) gives the y index of the l'th horizontl neighbour on the COSMO-DE grid. - INTEGER, ALLOCATABLE :: kk(:,:,:,:) !< Given a point (i,j,k) in the PALM-4U grid, kk(i,j,k,l) gives the z index of the l'th vertical neighbour in the intermediate grid. - INTEGER, ALLOCATABLE :: iii(:) !< profile averaging neighbour indices - INTEGER, ALLOCATABLE :: jjj(:) !< profile averaging neighbour indices - INTEGER, ALLOCATABLE :: kkk(:,:,:) !< indices of vertical interpolation neightbours, kkk(