Changeset 4523 for palm/trunk/UTIL/inifor/src
- Timestamp:
- May 7, 2020 3:58:16 PM (5 years ago)
- Location:
- palm/trunk/UTIL/inifor/src
- Files:
-
- 8 edited
-
inifor.f90 (modified) (3 diffs)
-
inifor_control.f90 (modified) (3 diffs)
-
inifor_defs.f90 (modified) (2 diffs)
-
inifor_grid.f90 (modified) (120 diffs)
-
inifor_io.f90 (modified) (12 diffs)
-
inifor_transform.f90 (modified) (20 diffs)
-
inifor_types.f90 (modified) (5 diffs)
-
inifor_util.f90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/UTIL/inifor/src/inifor.f90
r4481 r4523 26 26 ! ----------------- 27 27 ! $Id$ 28 ! respect integer working precision (iwp) specified in inifor_defs.f90 29 ! 30 ! 31 ! 4481 2020-03-31 18:55:54Z maronga 28 32 ! Alert user to warnings if any 29 33 ! … … 128 132 ONLY: average_pressure_perturbation, & 129 133 average_profile, & 130 extrapolate_density, &131 extrapolate_pressure, &132 134 geostrophic_winds, & 133 135 get_surface_pressure, & … … 141 143 IMPLICIT NONE 142 144 143 INTEGER :: igroup !< loop index for IO groups144 INTEGER :: ivar !< loop index for output variables145 INTEGER :: iter !< loop index for time steps145 INTEGER(iwp) :: igroup !< loop index for IO groups 146 INTEGER(iwp) :: ivar !< loop index for output variables 147 INTEGER(iwp) :: iter !< loop index for time steps 146 148 147 149 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: output_arr !< array buffer for interpolated quantities -
palm/trunk/UTIL/inifor/src/inifor_control.f90
r4481 r4523 26 26 ! ----------------- 27 27 ! $Id$ 28 ! respect integer working precision (iwp) specified in inifor_defs.f90 29 ! 30 ! 31 ! 4481 2020-03-31 18:55:54Z maronga 28 32 ! Change output format in routine report to allow for better message formatting 29 33 ! … … 83 87 84 88 USE inifor_defs, & 85 ONLY: COPYRIGHT, LNAME, LOG_FILE_NAME, VERSION, wp89 ONLY: COPYRIGHT, LNAME, LOG_FILE_NAME, VERSION, iwp, wp 86 90 USE inifor_util, & 87 91 ONLY: real_to_str, real_to_str_f … … 91 95 CHARACTER (LEN=5000) :: message = '' !< log message buffer 92 96 CHARACTER (LEN=5000) :: tip = '' !< optional log message buffer for tips on how to rectify encountered errors 93 INTEGER , SAVE :: u !< Fortran file unit for the log file94 INTEGER , SAVE :: n_wrngs = 0 !< Fortran file unit for the log file97 INTEGER(iwp), SAVE :: u !< Fortran file unit for the log file 98 INTEGER(iwp), SAVE :: n_wrngs = 0 !< Fortran file unit for the log file 95 99 96 100 CONTAINS -
palm/trunk/UTIL/inifor/src/inifor_defs.f90
r4499 r4523 141 141 ! 142 142 !-- COSMO parameters 143 INTEGER , PARAMETER :: WATER_ID = 9 !< Integer corresponding to the water soil type in COSMO-DE [-]143 INTEGER(iwp), PARAMETER :: WATER_ID = 9 !< Integer corresponding to the water soil type in COSMO-DE [-] 144 144 REAL(wp), PARAMETER :: EARTH_RADIUS = 6371229.0_wp !< Earth radius used in COSMO-DE [m] 145 145 REAL(wp), PARAMETER :: P_SL = 1e5_wp !< Reference pressure for computation of COSMO-DE's basic state pressure [Pa] … … 181 181 ! 182 182 !-- INIFOR parameters 183 INTEGER , PARAMETER:: FILL_ITERATIONS = 5 !< Number of iterations for extrapolating soil data into COSMO-DE183 INTEGER(iwp), PARAMETER :: FILL_ITERATIONS = 5 !< Number of iterations for extrapolating soil data into COSMO-DE 184 184 !< water cells [-] 185 INTEGER , PARAMETER:: FORCING_STEP = 1 !< Number of hours between forcing time steps [h]185 INTEGER(iwp), PARAMETER :: FORCING_STEP = 1 !< Number of hours between forcing time steps [h] 186 186 REAL(wp), PARAMETER :: NUDGING_TAU = 21600.0_wp !< Nudging relaxation time scale [s] 187 187 CHARACTER(LEN=*), PARAMETER :: COPYRIGHT = 'Copyright 2017-2020 Leibniz Universitaet Hannover' // & 188 188 ACHAR( 10 ) // ' Copyright 2017-2020 Deutscher Wetterdienst Offenbach' !< Copyright notice 189 189 CHARACTER(LEN=*), PARAMETER :: LOG_FILE_NAME = 'inifor.log' !< Name of INIFOR's log file 190 CHARACTER(LEN=*), PARAMETER :: VERSION = '1.4.1 2' !< INIFOR version number190 CHARACTER(LEN=*), PARAMETER :: VERSION = '1.4.13' !< INIFOR version number 191 191 192 192 END MODULE inifor_defs -
palm/trunk/UTIL/inifor/src/inifor_grid.f90
r4481 r4523 26 26 ! ----------------- 27 27 ! $Id$ 28 ! respect integer working precision (iwp) specified in inifor_defs.f90 29 ! 30 ! 31 ! 4481 2020-03-31 18:55:54Z maronga 28 32 ! Bugfix: check if namelist file could be opened without error 29 33 ! … … 155 159 USE inifor_defs, & 156 160 ONLY: DATE, EARTH_RADIUS, TO_RADIANS, TO_DEGREES, PI, & 157 SNAME, LNAME, PATH, FORCING_STEP, WATER_ID, FILL_ITERATIONS,&161 SNAME, LNAME, PATH, FORCING_STEP, FILL_ITERATIONS, & 158 162 BETA, P_SL, T_SL, BETA, RD, RV, G, P_REF, RD_PALM, CP_PALM, & 159 163 RHO_L, OMEGA, HECTO, wp, iwp, & … … 167 171 USE inifor_transform, & 168 172 ONLY: average_2d, rotate_to_cosmo, find_horizontal_neighbours, & 169 compute_horizontal_interp_weights, 173 compute_horizontal_interp_weights, fill_water_cells, & 170 174 find_vertical_neighbours_and_weights_interp, & 171 175 find_vertical_neighbours_and_weights_average, interpolate_2d, & … … 257 261 258 262 INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: soiltyp !< COSMO-DE soil type map 259 INTEGER :: dz_stretch_level_end_index(9) !< vertical grid level index until which the vertical grid spacing is stretched260 INTEGER :: dz_stretch_level_start_index(9) !< vertical grid level index above which the vertical grid spacing is stretched261 INTEGER :: iostat !< return status of READ statement262 INTEGER :: nt !< number of output time steps263 INTEGER :: nx !< number of PALM-4U grid points in x direction264 INTEGER :: ny !< number of PALM-4U grid points in y direction265 INTEGER :: nz !< number of PALM-4U grid points in z direction266 INTEGER :: nlon !< number of longitudal points in target grid (COSMO-DE)267 INTEGER :: nlat !< number of latitudal points in target grid (COSMO-DE)268 INTEGER :: nlev !< number of levels in target grid (COSMO-DE)269 INTEGER :: ndepths !< number of COSMO-DE soil layers270 INTEGER :: start_hour_flow !< start of flow forcing in number of hours relative to start_date271 INTEGER :: start_hour_soil !< start of soil forcing in number of hours relative to start_date, typically equals start_hour_flow272 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 data273 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)274 INTEGER :: end_hour !< simulation time in hours275 INTEGER :: end_hour_soilmoisture !< end of soil moisture spin-up in hours relative to start_hour_flow276 INTEGER :: step_hour !< number of hours between forcing time steps263 INTEGER(iwp) :: dz_stretch_level_end_index(9) !< vertical grid level index until which the vertical grid spacing is stretched 264 INTEGER(iwp) :: dz_stretch_level_start_index(9) !< vertical grid level index above which the vertical grid spacing is stretched 265 INTEGER(iwp) :: iostat !< return status of READ statement 266 INTEGER(iwp) :: nt !< number of output time steps 267 INTEGER(iwp) :: nx !< number of PALM-4U grid points in x direction 268 INTEGER(iwp) :: ny !< number of PALM-4U grid points in y direction 269 INTEGER(iwp) :: nz !< number of PALM-4U grid points in z direction 270 INTEGER(iwp) :: nlon !< number of longitudal points in target grid (COSMO-DE) 271 INTEGER(iwp) :: nlat !< number of latitudal points in target grid (COSMO-DE) 272 INTEGER(iwp) :: nlev !< number of levels in target grid (COSMO-DE) 273 INTEGER(iwp) :: ndepths !< number of COSMO-DE soil layers 274 INTEGER(iwp) :: start_hour_flow !< start of flow forcing in number of hours relative to start_date 275 INTEGER(iwp) :: start_hour_soil !< start of soil forcing in number of hours relative to start_date, typically equals start_hour_flow 276 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 277 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) 278 INTEGER(iwp) :: end_hour !< simulation time in hours 279 INTEGER(iwp) :: end_hour_soilmoisture !< end of soil moisture spin-up in hours relative to start_hour_flow 280 INTEGER(iwp) :: step_hour !< number of hours between forcing time steps 277 281 278 282 LOGICAL :: init_variables_required !< flag controlling whether init variables are to be processed … … 858 862 ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & 859 863 x0=x0, y0=y0, z0 = z0, & 860 nx = 0 , ny = ny, nz = nz, z=z)864 nx = 0_iwp, ny = ny, nz = nz, z=z) 861 865 862 866 CALL init_grid_definition('boundary', grid=scalars_west_grid, & … … 864 868 ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & 865 869 x0=x0, y0=y0, z0 = z0, & 866 nx = 0 , ny = ny, nz = nz, z=z)870 nx = 0_iwp, ny = ny, nz = nz, z=z) 867 871 868 872 CALL init_grid_definition('boundary', grid=scalars_north_grid, & … … 870 874 ymin = ly + 0.5_wp * dy, ymax = ly + 0.5_wp * dy, & 871 875 x0=x0, y0=y0, z0 = z0, & 872 nx = nx, ny = 0 , nz = nz, z=z)876 nx = nx, ny = 0_iwp, nz = nz, z=z) 873 877 874 878 CALL init_grid_definition('boundary', grid=scalars_south_grid, & … … 876 880 ymin = -0.5_wp * dy, ymax = -0.5_wp * dy, & 877 881 x0=x0, y0=y0, z0 = z0, & 878 nx = nx, ny = 0 , nz = nz, z=z)882 nx = nx, ny = 0_iwp, nz = nz, z=z) 879 883 880 884 CALL init_grid_definition('boundary', grid=scalars_top_grid, & … … 882 886 ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & 883 887 x0=x0, y0=y0, z0 = z0, & 884 nx = nx, ny = ny, nz = 1 , z=z_top)888 nx = nx, ny = ny, nz = 1_iwp, z=z_top) 885 889 886 890 CALL init_grid_definition('boundary', grid=u_east_grid, & … … 888 892 ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & 889 893 x0=x0, y0=y0, z0 = z0, & 890 nx = 0 , ny = ny, nz = nz, z=z)894 nx = 0_iwp, ny = ny, nz = nz, z=z) 891 895 892 896 CALL init_grid_definition('boundary', grid=u_west_grid, & … … 894 898 ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & 895 899 x0=x0, y0=y0, z0 = z0, & 896 nx = 0 , ny = ny, nz = nz, z=z)900 nx = 0_iwp, ny = ny, nz = nz, z=z) 897 901 898 902 CALL init_grid_definition('boundary', grid=u_north_grid, & … … 900 904 ymin = ly + 0.5_wp * dy, ymax = ly + 0.5_wp * dy, & 901 905 x0=x0, y0=y0, z0 = z0, & 902 nx = nx-1, ny = 0 , nz = nz, z=z)906 nx = nx-1, ny = 0_iwp, nz = nz, z=z) 903 907 904 908 CALL init_grid_definition('boundary', grid=u_south_grid, & … … 906 910 ymin = -0.5_wp * dy, ymax = -0.5_wp * dy, & 907 911 x0=x0, y0=y0, z0 = z0, & 908 nx = nx-1, ny = 0 , nz = nz, z=z)912 nx = nx-1, ny = 0_iwp, nz = nz, z=z) 909 913 910 914 CALL init_grid_definition('boundary', grid=u_top_grid, & … … 912 916 ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & 913 917 x0=x0, y0=y0, z0 = z0, & 914 nx = nx-1, ny = ny, nz = 1 , z=z_top)918 nx = nx-1, ny = ny, nz = 1_iwp, z=z_top) 915 919 916 920 CALL init_grid_definition('boundary', grid=v_east_grid, & … … 918 922 ymin = dy, ymax = ly - dy, & 919 923 x0=x0, y0=y0, z0 = z0, & 920 nx = 0 , ny = ny-1, nz = nz, z=z)924 nx = 0_iwp, ny = ny-1, nz = nz, z=z) 921 925 922 926 CALL init_grid_definition('boundary', grid=v_west_grid, & … … 924 928 ymin = dy, ymax = ly - dy, & 925 929 x0=x0, y0=y0, z0 = z0, & 926 nx = 0 , ny = ny-1, nz = nz, z=z)930 nx = 0_iwp, ny = ny-1, nz = nz, z=z) 927 931 928 932 CALL init_grid_definition('boundary', grid=v_north_grid, & … … 930 934 ymin = ly, ymax = ly, & 931 935 x0=x0, y0=y0, z0 = z0, & 932 nx = nx, ny = 0 , nz = nz, z=z)936 nx = nx, ny = 0_iwp, nz = nz, z=z) 933 937 934 938 CALL init_grid_definition('boundary', grid=v_south_grid, & … … 936 940 ymin = 0.0_wp, ymax = 0.0_wp, & 937 941 x0=x0, y0=y0, z0 = z0, & 938 nx = nx, ny = 0 , nz = nz, z=z)942 nx = nx, ny = 0_iwp, nz = nz, z=z) 939 943 940 944 CALL init_grid_definition('boundary', grid=v_top_grid, & … … 942 946 ymin = dy, ymax = ly - dy, & 943 947 x0=x0, y0=y0, z0 = z0, & 944 nx = nx, ny = ny-1, nz = 1 , z=(/z_top/))948 nx = nx, ny = ny-1, nz = 1_iwp, z=(/z_top/)) 945 949 946 950 CALL init_grid_definition('boundary', grid=w_east_grid, & … … 948 952 ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & 949 953 x0=x0, y0=y0, z0 = z0, & 950 nx = 0 , ny = ny, nz = nz - 1, z=zw)954 nx = 0_iwp, ny = ny, nz = nz - 1, z=zw) 951 955 952 956 CALL init_grid_definition('boundary', grid=w_west_grid, & … … 954 958 ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & 955 959 x0=x0, y0=y0, z0 = z0, & 956 nx = 0 , ny = ny, nz = nz - 1, z=zw)960 nx = 0_iwp, ny = ny, nz = nz - 1, z=zw) 957 961 958 962 CALL init_grid_definition('boundary', grid=w_north_grid, & … … 960 964 ymin = ly + 0.5_wp * dy, ymax = ly + 0.5_wp * dy, & 961 965 x0=x0, y0=y0, z0 = z0, & 962 nx = nx, ny = 0 , nz = nz - 1, z=zw)966 nx = nx, ny = 0_iwp, nz = nz - 1, z=zw) 963 967 964 968 CALL init_grid_definition('boundary', grid=w_south_grid, & … … 966 970 ymin = -0.5_wp * dy, ymax = -0.5_wp * dy, & 967 971 x0=x0, y0=y0, z0 = z0, & 968 nx = nx, ny = 0 , nz = nz - 1, z=zw)972 nx = nx, ny = 0_iwp, nz = nz - 1, z=zw) 969 973 970 974 CALL init_grid_definition('boundary', grid=w_top_grid, & … … 972 976 ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & 973 977 x0=x0, y0=y0, z0 = z0, & 974 nx = nx, ny = ny, nz = 1 , z=zw_top)978 nx = nx, ny = ny, nz = 1_iwp, z=zw_top) 975 979 976 980 CALL init_grid_definition('boundary intermediate', grid=scalars_east_intermediate, & … … 978 982 ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & 979 983 x0=x0, y0=y0, z0 = z0, & 980 nx = 0 , ny = ny, nz = nlev - 2)984 nx = 0_iwp, ny = ny, nz = nlev - 2) 981 985 982 986 CALL init_grid_definition('boundary intermediate', grid=scalars_west_intermediate, & … … 984 988 ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & 985 989 x0=x0, y0=y0, z0 = z0, & 986 nx = 0 , ny = ny, nz = nlev - 2)990 nx = 0_iwp, ny = ny, nz = nlev - 2) 987 991 988 992 CALL init_grid_definition('boundary intermediate', grid=scalars_north_intermediate, & … … 990 994 ymin = ly + 0.5_wp * dy, ymax = ly + 0.5_wp * dy, & 991 995 x0=x0, y0=y0, z0 = z0, & 992 nx = nx, ny = 0 , nz = nlev - 2)996 nx = nx, ny = 0_iwp, nz = nlev - 2) 993 997 994 998 CALL init_grid_definition('boundary intermediate', grid=scalars_south_intermediate, & … … 996 1000 ymin = -0.5_wp * dy, ymax = -0.5_wp * dy, & 997 1001 x0=x0, y0=y0, z0 = z0, & 998 nx = nx, ny = 0 , nz = nlev - 2)1002 nx = nx, ny = 0_iwp, nz = nlev - 2) 999 1003 1000 1004 CALL init_grid_definition('boundary intermediate', grid=scalars_top_intermediate, & … … 1008 1012 ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & 1009 1013 x0=x0, y0=y0, z0 = z0, & 1010 nx = 0 , ny = ny, nz = nlev - 2)1014 nx = 0_iwp, ny = ny, nz = nlev - 2) 1011 1015 1012 1016 CALL init_grid_definition('boundary intermediate', grid=u_west_intermediate, & … … 1014 1018 ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & 1015 1019 x0=x0, y0=y0, z0 = z0, & 1016 nx = 0 , ny = ny, nz = nlev - 2)1020 nx = 0_iwp, ny = ny, nz = nlev - 2) 1017 1021 1018 1022 CALL init_grid_definition('boundary intermediate', grid=u_north_intermediate, & … … 1020 1024 ymin = ly + 0.5_wp * dy, ymax = ly + 0.5_wp * dy, & 1021 1025 x0=x0, y0=y0, z0 = z0, & 1022 nx = nx-1, ny = 0 , nz = nlev - 2)1026 nx = nx-1, ny = 0_iwp, nz = nlev - 2) 1023 1027 1024 1028 CALL init_grid_definition('boundary intermediate', grid=u_south_intermediate, & … … 1026 1030 ymin = -0.5_wp * dy, ymax = -0.5_wp * dy, & 1027 1031 x0=x0, y0=y0, z0 = z0, & 1028 nx = nx-1, ny = 0 , nz = nlev - 2)1032 nx = nx-1, ny = 0_iwp, nz = nlev - 2) 1029 1033 1030 1034 CALL init_grid_definition('boundary intermediate', grid=u_top_intermediate, & … … 1038 1042 ymin = dy, ymax = ly - dy, & 1039 1043 x0=x0, y0=y0, z0 = z0, & 1040 nx = 0 , ny = ny-1, nz = nlev - 2)1044 nx = 0_iwp, ny = ny-1, nz = nlev - 2) 1041 1045 1042 1046 CALL init_grid_definition('boundary intermediate', grid=v_west_intermediate, & … … 1044 1048 ymin = dy, ymax = ly - dy, & 1045 1049 x0=x0, y0=y0, z0 = z0, & 1046 nx = 0 , ny = ny-1, nz = nlev - 2)1050 nx = 0_iwp, ny = ny-1, nz = nlev - 2) 1047 1051 1048 1052 CALL init_grid_definition('boundary intermediate', grid=v_north_intermediate, & … … 1050 1054 ymin = ly, ymax = ly, & 1051 1055 x0=x0, y0=y0, z0 = z0, & 1052 nx = nx, ny = 0 , nz = nlev - 2)1056 nx = nx, ny = 0_iwp, nz = nlev - 2) 1053 1057 1054 1058 CALL init_grid_definition('boundary intermediate', grid=v_south_intermediate, & … … 1056 1060 ymin = 0.0_wp, ymax = 0.0_wp, & 1057 1061 x0=x0, y0=y0, z0 = z0, & 1058 nx = nx, ny = 0 , nz = nlev - 2)1062 nx = nx, ny = 0_iwp, nz = nlev - 2) 1059 1063 1060 1064 CALL init_grid_definition('boundary intermediate', grid=v_top_intermediate, & … … 1068 1072 ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & 1069 1073 x0=x0, y0=y0, z0 = z0, & 1070 nx = 0 , ny = ny, nz = nlev - 1)1074 nx = 0_iwp, ny = ny, nz = nlev - 1) 1071 1075 1072 1076 CALL init_grid_definition('boundary intermediate', grid=w_west_intermediate, & … … 1074 1078 ymin = 0.5_wp * dy, ymax = ly - 0.5_wp * dy, & 1075 1079 x0=x0, y0=y0, z0 = z0, & 1076 nx = 0 , ny = ny, nz = nlev - 1)1080 nx = 0_iwp, ny = ny, nz = nlev - 1) 1077 1081 1078 1082 CALL init_grid_definition('boundary intermediate', grid=w_north_intermediate, & … … 1080 1084 ymin = ly + 0.5_wp * dy, ymax = ly + 0.5_wp * dy, & 1081 1085 x0=x0, y0=y0, z0 = z0, & 1082 nx = nx, ny = 0 , nz = nlev - 1)1086 nx = nx, ny = 0_iwp, nz = nlev - 1) 1083 1087 1084 1088 CALL init_grid_definition('boundary intermediate', grid=w_south_intermediate, & … … 1086 1090 ymin = -0.5_wp * dy, ymax = -0.5_wp * dy, & 1087 1091 x0=x0, y0=y0, z0 = z0, & 1088 nx = nx, ny = 0 , nz = nlev - 1)1092 nx = nx, ny = 0_iwp, nz = nlev - 1) 1089 1093 1090 1094 CALL init_grid_definition('boundary intermediate', grid=w_top_intermediate, & … … 1344 1348 CHARACTER(LEN=*), INTENT(IN) :: kind 1345 1349 CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: ic_mode 1346 INTEGER , INTENT(IN):: nx, ny, nz1350 INTEGER(iwp), INTENT(IN) :: nx, ny, nz 1347 1351 REAL(wp), INTENT(IN) :: xmin, xmax, ymin, ymax 1348 1352 REAL(wp), INTENT(IN) :: x0, y0, z0 … … 1671 1675 REAL(wp) :: dlon, dlat 1672 1676 1673 INTEGER :: i, j, imin, imax, jmin, jmax, l, nx, ny1677 INTEGER(iwp) :: i, j, imin, imax, jmin, jmax, l, nx, ny 1674 1678 1675 1679 … … 1749 1753 REAL(wp), INTENT(IN) :: dz_max, dz_stretch_factor, dz_stretch_level 1750 1754 1751 INTEGER :: number_stretch_level_start !< number of user-specified start levels for stretching1752 INTEGER :: number_stretch_level_end !< number of user-specified end levels for stretching1755 INTEGER(iwp) :: number_stretch_level_start !< number of user-specified start levels for stretching 1756 INTEGER(iwp) :: number_stretch_level_end !< number of user-specified end levels for stretching 1753 1757 1754 1758 REAL(wp), DIMENSION(:), ALLOCATABLE :: min_dz_stretch_level_end 1755 1759 REAL(wp) :: dz_level_end, dz_stretched 1756 1760 1757 INTEGER :: dz_stretch_level_end_index(9) !< vertical grid level index until which the vertical grid spacing is stretched1758 INTEGER :: dz_stretch_level_start_index(9) !< vertical grid level index above which the vertical grid spacing is stretched1759 INTEGER :: dz_stretch_level_index = 01760 INTEGER :: k, n, number_dz1761 INTEGER(iwp) :: dz_stretch_level_end_index(9) !< vertical grid level index until which the vertical grid spacing is stretched 1762 INTEGER(iwp) :: dz_stretch_level_start_index(9) !< vertical grid level index above which the vertical grid spacing is stretched 1763 INTEGER(iwp) :: dz_stretch_level_index = 0 1764 INTEGER(iwp) :: k, n, number_dz 1761 1765 1762 1766 ! … … 1990 1994 REAL(wp), DIMENSION(:), INTENT(IN) :: dz_stretch_level_end, dz_stretch_level_start 1991 1995 1992 INTEGER :: iterations !< number of iterations until stretch_factor_lower/upper_limit is reached1993 INTEGER :: l_rounded !< after l_rounded grid levels dz(n) is strechted to dz(n+1) with stretch_factor_21994 INTEGER :: n !< loop variable for stretching1996 INTEGER(iwp) :: iterations !< number of iterations until stretch_factor_lower/upper_limit is reached 1997 INTEGER(iwp) :: l_rounded !< after l_rounded grid levels dz(n) is strechted to dz(n+1) with stretch_factor_2 1998 INTEGER(iwp) :: n !< loop variable for stretching 1995 1999 1996 INTEGER , INTENT(IN) :: number_end !< number of user-specified end levels for stretching2000 INTEGER(iwp), INTENT(IN) :: number_end !< number of user-specified end levels for stretching 1997 2001 1998 2002 REAL(wp) :: delta_l !< absolute difference between l and l_rounded … … 2130 2134 REAL(wp), INTENT(OUT) :: zw(1:) 2131 2135 2132 INTEGER :: k2136 INTEGER(iwp) :: k 2133 2137 2134 2138 DO k = 1, UBOUND(zw, 1) … … 2145 2149 SUBROUTINE setup_io_groups() 2146 2150 2147 INTEGER :: ngroups2151 INTEGER(iwp) :: ngroups 2148 2152 2149 2153 ngroups = 16 … … 2180 2184 input_var_table(4) /), & 2181 2185 kind = 'thermodynamics', & 2182 n_output_quantities = 4 2186 n_output_quantities = 4_iwp & ! P, Theta, Rho, qv 2183 2187 ) 2184 2188 … … 2323 2327 TYPE(nc_var), INTENT(IN) :: out_vars(:) 2324 2328 TYPE(nc_var), INTENT(IN) :: in_var_list(:) 2325 INTEGER , OPTIONAL:: n_output_quantities2329 INTEGER(iwp), OPTIONAL :: n_output_quantities 2326 2330 2327 2331 TYPE(io_group) :: group … … 2391 2395 SUBROUTINE setup_variable_tables(ic_mode) 2392 2396 CHARACTER(LEN=*), INTENT(IN) :: ic_mode 2393 INTEGER 2394 INTEGER 2397 INTEGER(iwp) :: n_invar = 0 !< number of variables in the input variable table 2398 INTEGER(iwp) :: n_outvar = 0 !< number of variables in the output variable table 2395 2399 TYPE(nc_var), POINTER :: var 2396 2400 … … 2510 2514 units = "K", & 2511 2515 kind = "init soil", & 2512 input_id = 1 ,&2516 input_id = 1_iwp, & 2513 2517 output_file = output_file, & 2514 2518 grid = palm_grid, & … … 2522 2526 units = "m^3/m^3", & 2523 2527 kind = "init soil", & 2524 input_id = 1 ,&2528 input_id = 1_iwp, & 2525 2529 output_file = output_file, & 2526 2530 grid = palm_grid, & … … 2534 2538 units = "K", & 2535 2539 kind = "init scalar", & 2536 input_id = 1 ,& ! first in (T, p) IO group2540 input_id = 1_iwp, & ! first in (T, p) IO group 2537 2541 output_file = output_file, & 2538 2542 grid = palm_grid, & … … 2550 2554 units = "K", & 2551 2555 kind = "left scalar", & 2552 input_id = 1 ,&2556 input_id = 1_iwp, & 2553 2557 grid = scalars_west_grid, & 2554 2558 intermediate_grid = scalars_west_intermediate, & … … 2562 2566 units = "K", & 2563 2567 kind = "right scalar", & 2564 input_id = 1 ,&2568 input_id = 1_iwp, & 2565 2569 grid = scalars_east_grid, & 2566 2570 intermediate_grid = scalars_east_intermediate, & … … 2574 2578 units = "K", & 2575 2579 kind = "north scalar", & 2576 input_id = 1 ,&2580 input_id = 1_iwp, & 2577 2581 grid = scalars_north_grid, & 2578 2582 intermediate_grid = scalars_north_intermediate, & … … 2586 2590 units = "K", & 2587 2591 kind = "south scalar", & 2588 input_id = 1 ,&2592 input_id = 1_iwp, & 2589 2593 grid = scalars_south_grid, & 2590 2594 intermediate_grid = scalars_south_intermediate, & … … 2598 2602 units = "K", & 2599 2603 kind = "top scalar", & 2600 input_id = 1 ,&2604 input_id = 1_iwp, & 2601 2605 grid = scalars_top_grid, & 2602 2606 intermediate_grid = scalars_top_intermediate, & … … 2610 2614 units = "kg/kg", & 2611 2615 kind = "init scalar", & 2612 input_id = 3 ,&2616 input_id = 3_iwp, & 2613 2617 output_file = output_file, & 2614 2618 grid = palm_grid, & … … 2626 2630 units = "kg/kg", & 2627 2631 kind = "left scalar", & 2628 input_id = 3 ,&2632 input_id = 3_iwp, & 2629 2633 output_file = output_file, & 2630 2634 grid = scalars_west_grid, & … … 2638 2642 units = "kg/kg", & 2639 2643 kind = "right scalar", & 2640 input_id = 3 ,&2644 input_id = 3_iwp, & 2641 2645 output_file = output_file, & 2642 2646 grid = scalars_east_grid, & … … 2650 2654 units = "kg/kg", & 2651 2655 kind = "north scalar", & 2652 input_id = 3 ,&2656 input_id = 3_iwp, & 2653 2657 output_file = output_file, & 2654 2658 grid = scalars_north_grid, & … … 2662 2666 units = "kg/kg", & 2663 2667 kind = "south scalar", & 2664 input_id = 3 ,&2668 input_id = 3_iwp, & 2665 2669 output_file = output_file, & 2666 2670 grid = scalars_south_grid, & … … 2674 2678 units = "kg/kg", & 2675 2679 kind = "top scalar", & 2676 input_id = 3 ,&2680 input_id = 3_iwp, & 2677 2681 output_file = output_file, & 2678 2682 grid = scalars_top_grid, & … … 2686 2690 units = "m/s", & 2687 2691 kind = "init u", & 2688 input_id = 1 ,& ! first in (U, V) I/O group2692 input_id = 1_iwp, & ! first in (U, V) I/O group 2689 2693 output_file = output_file, & 2690 2694 grid = u_initial_grid, & … … 2702 2706 units = "m/s", & 2703 2707 kind = "left u", & 2704 input_id = 1 ,& ! first in (U, V) I/O group2708 input_id = 1_iwp, & ! first in (U, V) I/O group 2705 2709 output_file = output_file, & 2706 2710 grid = u_west_grid, & … … 2714 2718 units = "m/s", & 2715 2719 kind = "right u", & 2716 input_id = 1 ,& ! first in (U, V) I/O group2720 input_id = 1_iwp, & ! first in (U, V) I/O group 2717 2721 output_file = output_file, & 2718 2722 grid = u_east_grid, & … … 2726 2730 units = "m/s", & 2727 2731 kind = "north u", & 2728 input_id = 1 ,& ! first in (U, V) I/O group2732 input_id = 1_iwp, & ! first in (U, V) I/O group 2729 2733 output_file = output_file, & 2730 2734 grid = u_north_grid, & … … 2738 2742 units = "m/s", & 2739 2743 kind = "south u", & 2740 input_id = 1 ,& ! first in (U, V) I/O group2744 input_id = 1_iwp, & ! first in (U, V) I/O group 2741 2745 output_file = output_file, & 2742 2746 grid = u_south_grid, & … … 2750 2754 units = "m/s", & 2751 2755 kind = "top u", & 2752 input_id = 1 ,& ! first in (U, V) I/O group2756 input_id = 1_iwp, & ! first in (U, V) I/O group 2753 2757 output_file = output_file, & 2754 2758 grid = u_top_grid, & … … 2762 2766 units = "m/s", & 2763 2767 kind = "init v", & 2764 input_id = 2 ,& ! second in (U, V) I/O group2768 input_id = 2_iwp, & ! second in (U, V) I/O group 2765 2769 output_file = output_file, & 2766 2770 grid = v_initial_grid, & … … 2778 2782 units = "m/s", & 2779 2783 kind = "right v", & 2780 input_id = 2 ,& ! second in (U, V) I/O group2784 input_id = 2_iwp, & ! second in (U, V) I/O group 2781 2785 output_file = output_file, & 2782 2786 grid = v_west_grid, & … … 2790 2794 units = "m/s", & 2791 2795 kind = "right v", & 2792 input_id = 2 ,& ! second in (U, V) I/O group2796 input_id = 2_iwp, & ! second in (U, V) I/O group 2793 2797 output_file = output_file, & 2794 2798 grid = v_east_grid, & … … 2802 2806 units = "m/s", & 2803 2807 kind = "north v", & 2804 input_id = 2 ,& ! second in (U, V) I/O group2808 input_id = 2_iwp, & ! second in (U, V) I/O group 2805 2809 output_file = output_file, & 2806 2810 grid = v_north_grid, & … … 2814 2818 units = "m/s", & 2815 2819 kind = "south v", & 2816 input_id = 2 ,& ! second in (U, V) I/O group2820 input_id = 2_iwp, & ! second in (U, V) I/O group 2817 2821 output_file = output_file, & 2818 2822 grid = v_south_grid, & … … 2826 2830 units = "m/s", & 2827 2831 kind = "top v", & 2828 input_id = 2 ,& ! second in (U, V) I/O group2832 input_id = 2_iwp, & ! second in (U, V) I/O group 2829 2833 output_file = output_file, & 2830 2834 grid = v_top_grid, & … … 2838 2842 units = "m/s", & 2839 2843 kind = "init w", & 2840 input_id = 1 ,&2844 input_id = 1_iwp, & 2841 2845 output_file = output_file, & 2842 2846 grid = w_initial_grid, & … … 2854 2858 units = "m/s", & 2855 2859 kind = "left w", & 2856 input_id = 1 ,&2860 input_id = 1_iwp, & 2857 2861 output_file = output_file, & 2858 2862 grid = w_west_grid, & … … 2866 2870 units = "m/s", & 2867 2871 kind = "right w", & 2868 input_id = 1 ,&2872 input_id = 1_iwp, & 2869 2873 output_file = output_file, & 2870 2874 grid = w_east_grid, & … … 2878 2882 units = "m/s", & 2879 2883 kind = "north w", & 2880 input_id = 1 ,&2884 input_id = 1_iwp, & 2881 2885 output_file = output_file, & 2882 2886 grid = w_north_grid, & … … 2890 2894 units = "m/s", & 2891 2895 kind = "south w", & 2892 input_id = 1 ,&2896 input_id = 1_iwp, & 2893 2897 output_file = output_file, & 2894 2898 grid = w_south_grid, & … … 2902 2906 units = "m/s", & 2903 2907 kind = "top w", & 2904 input_id = 1 ,&2908 input_id = 1_iwp, & 2905 2909 output_file = output_file, & 2906 2910 grid = w_top_grid, & … … 2914 2918 units = "kg/m2", & 2915 2919 kind = "surface forcing", & 2916 input_id = 1 ,&2920 input_id = 1_iwp, & 2917 2921 output_file = output_file, & 2918 2922 grid = palm_grid, & … … 2926 2930 units = "kg/m2", & 2927 2931 kind = "surface forcing", & 2928 input_id = 1 ,&2932 input_id = 1_iwp, & 2929 2933 output_file = output_file, & 2930 2934 grid = palm_grid, & … … 2938 2942 units = "kg/m2", & 2939 2943 kind = "surface forcing", & 2940 input_id = 1 ,&2944 input_id = 1_iwp, & 2941 2945 output_file = output_file, & 2942 2946 grid = palm_grid, & … … 2950 2954 units = "kg/m2", & 2951 2955 kind = "surface forcing", & 2952 input_id = 1 ,&2956 input_id = 1_iwp, & 2953 2957 output_file = output_file, & 2954 2958 grid = palm_grid, & … … 2962 2966 units = "kg/m2", & 2963 2967 kind = "surface forcing", & 2964 input_id = 1 ,&2968 input_id = 1_iwp, & 2965 2969 output_file = output_file, & 2966 2970 grid = palm_grid, & … … 2974 2978 units = "W/m2", & 2975 2979 kind = "surface forcing", & 2976 input_id = 1 ,&2980 input_id = 1_iwp, & 2977 2981 output_file = output_file, & 2978 2982 grid = palm_grid, & … … 2986 2990 units = "W/m2", & 2987 2991 kind = "surface forcing", & 2988 input_id = 1 ,&2992 input_id = 1_iwp, & 2989 2993 output_file = output_file, & 2990 2994 grid = palm_grid, & … … 2998 3002 units = "W/m2", & 2999 3003 kind = "surface forcing", & 3000 input_id = 1 ,&3004 input_id = 1_iwp, & 3001 3005 output_file = output_file, & 3002 3006 grid = palm_grid, & … … 3010 3014 units = "W/m2", & 3011 3015 kind = "surface forcing", & 3012 input_id = 1 ,&3016 input_id = 1_iwp, & 3013 3017 output_file = output_file, & 3014 3018 grid = palm_grid, & … … 3025 3029 units = "Pa", & 3026 3030 kind = "time series", & 3027 input_id = 2 ,& ! second in (T, p) I/O group3031 input_id = 2_iwp, & ! second in (T, p) I/O group 3028 3032 output_file = output_file, & 3029 3033 grid = palm_grid, & … … 3038 3042 units = "m/s", & 3039 3043 kind = "geostrophic", & 3040 input_id = 1 ,&3044 input_id = 1_iwp, & 3041 3045 output_file = output_file, & 3042 3046 grid = averaged_scalar_profile, & … … 3050 3054 units = "m/s", & 3051 3055 kind = "geostrophic", & 3052 input_id = 1 ,&3056 input_id = 1_iwp, & 3053 3057 output_file = output_file, & 3054 3058 grid = averaged_scalar_profile, & … … 3062 3066 units = "m/s", & 3063 3067 kind = "geostrophic", & 3064 input_id = 1 ,&3068 input_id = 1_iwp, & 3065 3069 output_file = output_file, & 3066 3070 grid = averaged_scalar_profile, & … … 3075 3079 units = "m/s", & 3076 3080 kind = "large-scale scalar forcing", & 3077 input_id = 1 ,&3081 input_id = 1_iwp, & 3078 3082 output_file = output_file, & 3079 3083 grid = averaged_scalar_profile, & … … 3088 3092 units = "m/s", & 3089 3093 kind = "large-scale w forcing", & 3090 input_id = 1 ,&3094 input_id = 1_iwp, & 3091 3095 output_file = output_file, & 3092 3096 grid = averaged_scalar_profile, & … … 3101 3105 units = "m/s", & 3102 3106 kind = "large-scale w forcing", & 3103 input_id = 1 ,&3107 input_id = 1_iwp, & 3104 3108 output_file = output_file, & 3105 3109 grid = averaged_w_profile, & … … 3115 3119 units = "K/s", & 3116 3120 kind = "large-scale scalar forcing", & 3117 input_id = 1 ,&3121 input_id = 1_iwp, & 3118 3122 output_file = output_file, & 3119 3123 grid = averaged_scalar_profile, & … … 3128 3132 units = "K/s", & 3129 3133 kind = "large-scale scalar forcing", & 3130 input_id = 1 ,&3134 input_id = 1_iwp, & 3131 3135 output_file = output_file, & 3132 3136 grid = averaged_scalar_profile, & … … 3141 3145 units = "K", & 3142 3146 kind = "large-scale scalar forcing", & 3143 input_id = 1 ,&3147 input_id = 1_iwp, & 3144 3148 output_file = output_file, & 3145 3149 grid = averaged_scalar_profile, & … … 3154 3158 units = "kg/kg/s", & 3155 3159 kind = "large-scale scalar forcing", & 3156 input_id = 3 ,&3160 input_id = 3_iwp, & 3157 3161 output_file = output_file, & 3158 3162 grid = averaged_scalar_profile, & … … 3168 3172 units = "kg/kg/s", & 3169 3173 kind = "large-scale scalar forcing", & 3170 input_id = 3 ,&3174 input_id = 3_iwp, & 3171 3175 output_file = output_file, & 3172 3176 grid = averaged_scalar_profile, & … … 3181 3185 units = "kg/kg", & 3182 3186 kind = "large-scale scalar forcing", & 3183 input_id = 3 ,&3187 input_id = 3_iwp, & 3184 3188 output_file = output_file, & 3185 3189 grid = averaged_scalar_profile, & … … 3194 3198 units = "s", & 3195 3199 kind = "constant scalar profile", & 3196 input_id = 1 ,&3200 input_id = 1_iwp, & 3197 3201 output_file = output_file, & 3198 3202 grid = averaged_scalar_profile, & … … 3208 3212 units = "", & 3209 3213 kind = "internal profile", & 3210 input_id = 4 ,&3214 input_id = 4_iwp, & 3211 3215 output_file = output_file, & 3212 3216 grid = averaged_scalar_profile, & … … 3222 3226 units = "", & 3223 3227 kind = "internal profile", & 3224 input_id = 4 ,&3228 input_id = 4_iwp, & 3225 3229 output_file = output_file, & 3226 3230 grid = north_averaged_scalar_profile, & … … 3237 3241 units = "", & 3238 3242 kind = "internal profile", & 3239 input_id = 4 ,&3243 input_id = 4_iwp, & 3240 3244 output_file = output_file, & 3241 3245 grid = south_averaged_scalar_profile, & … … 3252 3256 units = "", & 3253 3257 kind = "internal profile", & 3254 input_id = 4 ,&3258 input_id = 4_iwp, & 3255 3259 output_file = output_file, & 3256 3260 grid = east_averaged_scalar_profile, & … … 3267 3271 units = "", & 3268 3272 kind = "internal profile", & 3269 input_id = 4 ,&3273 input_id = 4_iwp, & 3270 3274 output_file = output_file, & 3271 3275 grid = west_averaged_scalar_profile, & … … 3281 3285 units = "", & 3282 3286 kind = "internal profile", & 3283 input_id = 2 ,&3287 input_id = 2_iwp, & 3284 3288 output_file = output_file, & 3285 3289 grid = north_averaged_scalar_profile, & … … 3296 3300 units = "", & 3297 3301 kind = "internal profile", & 3298 input_id = 2 ,&3302 input_id = 2_iwp, & 3299 3303 output_file = output_file, & 3300 3304 grid = south_averaged_scalar_profile, & … … 3311 3315 units = "", & 3312 3316 kind = "internal profile", & 3313 input_id = 2 ,&3317 input_id = 2_iwp, & 3314 3318 output_file = output_file, & 3315 3319 grid = east_averaged_scalar_profile, & … … 3326 3330 units = "", & 3327 3331 kind = "internal profile", & 3328 input_id = 2 ,&3332 input_id = 2_iwp, & 3329 3333 output_file = output_file, & 3330 3334 grid = west_averaged_scalar_profile, & … … 3354 3358 3355 3359 CHARACTER(LEN=*), INTENT(IN) :: name, std_name, long_name, units, kind 3356 INTEGER , INTENT(IN):: input_id3360 INTEGER(iwp), INTENT(IN) :: input_id 3357 3361 TYPE(grid_definition), INTENT(IN), TARGET :: grid, intermediate_grid 3358 3362 TYPE(nc_file), INTENT(IN) :: output_file … … 3733 3737 TYPE(container), INTENT(INOUT), ALLOCATABLE :: input_buffer(:) 3734 3738 TYPE(grid_definition), INTENT(IN) :: cosmo_grid 3735 INTEGER , INTENT(IN):: iter3739 INTEGER(iwp), INTENT(IN) :: iter 3736 3740 3737 3741 REAL(wp), ALLOCATABLE :: basic_state_pressure(:) 3738 3742 TYPE(container), ALLOCATABLE :: preprocess_buffer(:) 3739 INTEGER 3740 INTEGER 3741 INTEGER 3743 INTEGER(iwp) :: hour, dt 3744 INTEGER(iwp) :: i, j, k 3745 INTEGER(iwp) :: nx, ny, nz 3742 3746 3743 3747 input_buffer(:)%is_preprocessed = .FALSE. … … 3905 3909 3906 3910 CALL fill_water_cells(soiltyp, input_buffer(1)%array, & 3907 SIZE(input_buffer(1)%array, 3 ), &3911 SIZE(input_buffer(1)%array, 3, kind=iwp), & 3908 3912 FILL_ITERATIONS) 3909 3913 input_buffer(:)%is_preprocessed = .TRUE. … … 3912 3916 3913 3917 CALL fill_water_cells(soiltyp, input_buffer(1)%array, & 3914 SIZE(input_buffer(1)%array, 3 ), &3918 SIZE(input_buffer(1)%array, 3, kind=iwp), & 3915 3919 FILL_ITERATIONS) 3916 3920 … … 3941 3945 CALL report('preprocess', message) 3942 3946 3943 hour = iter - 1 3944 dt = MODULO(hour, 3 ) + 1! averaging period3947 hour = iter - 1_iwp 3948 dt = MODULO(hour, 3_iwp) + 1_iwp ! averaging period 3945 3949 SELECT CASE(dt) 3946 3950 … … 3986 3990 CALL report('preprocess', message) 3987 3991 3988 hour = iter - 1 3992 hour = iter - 1_iwp 3989 3993 ! 3990 3994 !-- averaging period 3991 dt = MODULO(hour, 3 ) + 13995 dt = MODULO(hour, 3_iwp) + 1_iwp 3992 3996 SELECT CASE(dt) 3993 3997 ! … … 4035 4039 4036 4040 4037 !------------------------------------------------------------------------------!4038 ! Description:4039 ! ------------4040 !> Computes average soil values in COSMO-DE water cells from neighbouring4041 !> non-water cells. This is done as a preprocessing step for the COSMO-DE4042 !> soil input arrays, which contain unphysical values for water cells.4043 !>4044 !> This routine computes the average of up to all nine neighbouring cells4045 !> or keeps the original value, if not at least one non-water neightbour4046 !> is available.4047 !>4048 !> By repeatedly applying this step, soil data can be extrapolated into4049 !> 'water' regions occupying multiple cells, one cell per iteration.4050 !>4051 !> Input parameters:4052 !> -----------------4053 !> soiltyp : 2d map of COSMO-DE soil types4054 !> nz : number of layers in the COSMO-DE soil4055 !> niter : number iterations4056 !>4057 !> Output parameters:4058 !> ------------------4059 !> array : the soil array (i.e. water content or temperature)4060 !------------------------------------------------------------------------------!4061 SUBROUTINE fill_water_cells(soiltyp, array, nz, niter)4062 INTEGER(iwp), DIMENSION(:,:,:), INTENT(IN) :: soiltyp4063 REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: array4064 INTEGER, INTENT(IN) :: nz, niter4065 4066 REAL(wp), DIMENSION(nz) :: column4067 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: old_soiltyp, new_soiltyp4068 INTEGER :: l, i, j, nx, ny, n_cells, ii, jj, iter4069 INTEGER, DIMENSION(8) :: di, dj4070 4071 nx = SIZE(array, 1)4072 ny = SIZE(array, 2)4073 di = (/ -1, -1, -1, 0, 0, 1, 1, 1 /)4074 dj = (/ -1, 0, 1, -1, 1, -1, 0, 1 /)4075 4076 ALLOCATE(old_soiltyp(SIZE(soiltyp,1), &4077 SIZE(soiltyp,2) ))4078 4079 ALLOCATE(new_soiltyp(SIZE(soiltyp,1), &4080 SIZE(soiltyp,2) ))4081 4082 old_soiltyp(:,:) = soiltyp(:,:,1)4083 new_soiltyp(:,:) = soiltyp(:,:,1)4084 4085 DO iter = 1, niter4086 4087 DO j = 1, ny4088 DO i = 1, nx4089 4090 IF (old_soiltyp(i,j) == WATER_ID) THEN4091 4092 n_cells = 04093 column(:) = 0.0_wp4094 DO l = 1, SIZE(di)4095 4096 ii = MIN(nx, MAX(1, i + di(l)))4097 jj = MIN(ny, MAX(1, j + dj(l)))4098 4099 IF (old_soiltyp(ii,jj) .NE. WATER_ID) THEN4100 n_cells = n_cells + 14101 column(:) = column(:) + array(ii,jj,:)4102 ENDIF4103 4104 ENDDO4105 4106 !4107 !-- Overwrite if at least one non-water neighbour cell is available4108 IF (n_cells > 0) THEN4109 array(i,j,:) = column(:) / n_cells4110 new_soiltyp(i,j) = 04111 ENDIF4112 4113 ENDIF4114 4115 ENDDO4116 ENDDO4117 4118 old_soiltyp(:,:) = new_soiltyp(:,:)4119 4120 ENDDO4121 4122 DEALLOCATE(old_soiltyp, new_soiltyp)4123 4124 END SUBROUTINE fill_water_cells4125 4126 4127 4041 END MODULE inifor_grid 4128 4042 #endif -
palm/trunk/UTIL/inifor/src/inifor_io.f90
r4481 r4523 26 26 ! ----------------- 27 27 ! $Id$ 28 ! respect integer working precision (iwp) specified in inifor_defs.f90 29 ! 30 ! 31 ! 4481 2020-03-31 18:55:54Z maronga 28 32 ! Pass hhl_file directly instead of entire INIFOR configuration 29 33 ! … … 135 139 NC_DEPTH_NAME, NC_HHL_NAME, NC_RLAT_NAME, NC_RLON_NAME, & 136 140 NC_ROTATED_POLE_NAME, NC_POLE_LATITUDE_NAME, & 137 NC_POLE_LONGITUDE_NAME, RHO_L, wp, iwp141 NC_POLE_LONGITUDE_NAME, RHO_L, iwp, wp 138 142 USE inifor_types 139 143 USE inifor_util, & … … 332 336 333 337 message = "Failed reading NetCDF variable " // & 334 TRIM(in_var%name) // " with " // TRIM(str(in_var%ndim)) // & 338 TRIM(in_var%name) // " with " // & 339 TRIM(str(INT(in_var%ndim, kind=iwp))) // & 335 340 " dimensions because only two- and and three-dimensional" // & 336 341 " variables are supported." … … 579 584 CHARACTER (LEN=DATE), INTENT(IN) :: start_date_string 580 585 CHARACTER (LEN=*), INTENT(IN) :: prefix, suffix, input_path 581 INTEGER ,INTENT(IN) :: start_hour, end_hour, step_hour586 INTEGER(iwp), INTENT(IN) :: start_hour, end_hour, step_hour 582 587 CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: file_list(:) 583 588 584 INTEGER 589 INTEGER(iwp) :: number_of_intervals, hour, i 585 590 CHARACTER(LEN=DATE) :: date_string 586 591 … … 612 617 CHARACTER (LEN=DATE), INTENT(IN) :: start_date_string 613 618 CHARACTER (LEN=*), INTENT(IN) :: prefix, suffix, input_path 614 INTEGER ,INTENT(IN) :: start_hour, end_hour, step_hour619 INTEGER(iwp), INTENT(IN) :: start_hour, end_hour, step_hour 615 620 CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: file_list(:) 616 621 LOGICAL, OPTIONAL, INTENT(IN) :: nocheck 617 622 618 INTEGER :: i619 LOGICAL :: check_files623 INTEGER(iwp) :: i 624 LOGICAL :: check_files 620 625 621 626 CALL get_datetime_file_list( start_date_string, start_hour, end_hour, & … … 786 791 REAL(wp), INTENT(OUT) :: latmin_cosmo !< Minimunm latitude of COSMO-DE's rotated-pole grid [COSMO rotated-pole rad] 787 792 REAL(wp), INTENT(OUT) :: latmax_cosmo !< Maximum latitude of COSMO-DE's rotated-pole grid [COSMO rotated-pole rad] 788 INTEGER , INTENt(OUT):: nlon, nlat, nlev, ndepths793 INTEGER(iwp), INTENT(OUT) :: nlon, nlat, nlev, ndepths 789 794 790 795 TYPE(nc_var) :: cosmo_var !< COSMO dummy variable, used for reading HHL, rlon, rlat 791 INTEGER 796 INTEGER(iwp) :: k 792 797 793 798 ! … … 916 921 CHARACTER (LEN=5) :: zone_string 917 922 CHARACTER (LEN=SNAME) :: history_string 918 INTEGER :: ncid, nx, ny, nz, nt, dimids(3), dimvarids(3) 923 INTEGER :: nx, ny, nz, nt 924 INTEGER :: ncid, dimids(3), dimvarids(3) 919 925 REAL(wp) :: z0 920 926 … … 1101 1107 1102 1108 TYPE(nc_var), POINTER :: var 1103 INTEGER :: i, ncid 1109 INTEGER(iwp) :: i 1110 INTEGER :: ncid 1104 1111 LOGICAL :: to_be_written 1105 1112 … … 1152 1159 SUBROUTINE read_input_variables(group, iter, buffer) 1153 1160 TYPE(io_group), INTENT(INOUT), TARGET :: group 1154 INTEGER , INTENT(IN):: iter1161 INTEGER(iwp), INTENT(IN) :: iter 1155 1162 TYPE(container), ALLOCATABLE, INTENT(INOUT) :: buffer(:) 1156 INTEGER 1163 INTEGER(iwp) :: hour, buf_id 1157 1164 TYPE(nc_var), POINTER :: input_var 1158 1165 CHARACTER(LEN=PATH), POINTER :: input_file 1159 INTEGER 1166 INTEGER(iwp) :: ivar, nbuffers 1160 1167 1161 1168 message = "Reading data for I/O group '" // TRIM(group%in_var_list(1)%name) // "'." … … 1177 1184 "accumulated variable. Group '" // TRIM(group%kind) //& 1178 1185 "' contains " // & 1179 TRIM( str(SIZE(group%in_var_list )) ) // "."1186 TRIM( str(SIZE(group%in_var_list, kind=iwp)) ) // "." 1180 1187 CALL inifor_abort('read_input_variables | accumulation', message) 1181 1188 ENDIF … … 1250 1257 !> depending on the current hour. 1251 1258 !------------------------------------------------------------------------------! 1252 INTEGER FUNCTION select_buffer(hour)1253 INTEGER , INTENT(IN) :: hour1254 INTEGER :: step1255 1256 select_buffer = 0 1257 step = MODULO(hour, 3 ) + 11259 INTEGER(iwp) FUNCTION select_buffer(hour) 1260 INTEGER(iwp), INTENT(IN) :: hour 1261 INTEGER(iwp) :: step 1262 1263 select_buffer = 0_iwp 1264 step = MODULO(hour, 3_iwp) + 1_iwp 1258 1265 1259 1266 SELECT CASE(step) 1260 1267 CASE(1, 3) 1261 select_buffer = 1 1268 select_buffer = 1_iwp 1262 1269 CASE(2) 1263 select_buffer = 2 1270 select_buffer = 2_iwp 1264 1271 CASE DEFAULT 1265 1272 message = "Invalid step '" // TRIM(str(step)) … … 1369 1376 TYPE(nc_var), INTENT(IN) :: var 1370 1377 REAL(wp), INTENT(IN) :: array(:,:,:) 1371 INTEGER , INTENT(IN):: iter1378 INTEGER(iwp), INTENT(IN) :: iter 1372 1379 TYPE(nc_file), INTENT(IN) :: output_file 1373 1380 TYPE(inifor_config) :: cfg 1374 1381 1375 INTEGER :: ncid, ndim, start(4), count(4)1376 LOGICAL :: var_is_time_dependent1382 INTEGER :: ncid, ndim, start(4), count(4) 1383 LOGICAL :: var_is_time_dependent 1377 1384 1378 1385 var_is_time_dependent = ( & -
palm/trunk/UTIL/inifor/src/inifor_transform.f90
r4481 r4523 26 26 ! ----------------- 27 27 ! $Id$ 28 ! bugfix: pressure extrapolation 29 ! respect integer working precision (iwp) specified in inifor_defs.f90 30 ! moved fill_water_cells() routine here 31 ! remove unused routine, appropriately renamed constand_density_pressure() 32 ! 33 ! 34 ! 4481 2020-03-31 18:55:54Z maronga 28 35 ! Use PALM's working precision 29 36 ! Improved coding style … … 111 118 USE inifor_control 112 119 USE inifor_defs, & 113 ONLY: BETA, G, P_SL, PI, RD, T_SL, TO_DEGREES, TO_RADIANS, wp 120 ONLY: BETA, G, P_SL, PI, RD, T_SL, TO_DEGREES, TO_RADIANS, WATER_ID, & 121 iwp, wp 114 122 USE inifor_types 115 123 USE inifor_util, & … … 126 134 REAL(wp), INTENT(OUT) :: out_arr(:) 127 135 128 INTEGER :: k, l, nz136 INTEGER(iwp) :: k, l, nz 129 137 130 138 nz = UBOUND(out_arr, 1) … … 179 187 REAL(wp), INTENT(OUT) :: out_arr(0:,0:,:) 180 188 181 INTEGER :: i, j, k, l, nz189 INTEGER(iwp) :: i, j, k, l, nz 182 190 183 191 nz = UBOUND(out_arr, 3) … … 241 249 TYPE(nc_var), INTENT(IN), OPTIONAL :: ncvar 242 250 243 INTEGER :: i, j, k, l251 INTEGER(iwp) :: i, j, k, l 244 252 245 253 ! … … 247 255 IF ( UBOUND(outvar, 3) .GT. UBOUND(invar, 3) ) THEN 248 256 message = "Output array for '" // TRIM(ncvar%name) // "' has ' more levels (" // & 249 TRIM(str(UBOUND(outvar, 3 ))) // ") than input variable ("//&250 TRIM(str(UBOUND(invar, 3 ))) // ")."257 TRIM(str(UBOUND(outvar, 3, kind=iwp))) // ") than input variable ("//& 258 TRIM(str(UBOUND(invar, 3, kind=iwp))) // ")." 251 259 CALL inifor_abort('interpolate_2d', message) 252 260 ENDIF … … 277 285 !------------------------------------------------------------------------------! 278 286 SUBROUTINE average_2d(in_arr, out_arr, ii, jj) 279 REAL(wp), INTENT(IN) :: in_arr(0:,0:,0:)280 REAL(wp), INTENT(OUT) :: out_arr(0:)281 INTEGER , INTENT(IN), DIMENSION(:) :: ii, jj282 283 INTEGER 284 REAL(wp) :: ni287 REAL(wp), INTENT(IN) :: in_arr(0:,0:,0:) 288 REAL(wp), INTENT(OUT) :: out_arr(0:) 289 INTEGER(iwp), INTENT(IN), DIMENSION(:) :: ii, jj 290 291 INTEGER(iwp) :: i, j, k, l 292 REAL(wp) :: ni 285 293 286 294 IF (SIZE(ii) /= SIZE(jj)) THEN 287 295 message = "Length of 'ii' and 'jj' index lists do not match." // & 288 NEW_LINE(' ') // "ii has " // str(SIZE(ii )) // " elements, " // &289 NEW_LINE(' ') // "jj has " // str(SIZE(jj )) // "."296 NEW_LINE(' ') // "ii has " // str(SIZE(ii, kind=iwp)) // " elements, " // & 297 NEW_LINE(' ') // "jj has " // str(SIZE(jj, kind=iwp)) // "." 290 298 CALL inifor_abort('average_2d', message) 291 299 ENDIF … … 330 338 REAL(wp), DIMENSION(:,:,:), INTENT(OUT) :: palm_array 331 339 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: intermediate_array 332 INTEGER :: nx, ny, nlev340 INTEGER(iwp) :: nx, ny, nlev 333 341 334 342 nx = palm_intermediate%nx … … 365 373 REAL(wp), DIMENSION(:), INTENT(OUT) :: profile_array 366 374 367 INTEGER :: i_source, j_source, k_profile, k_source, l, m375 INTEGER(iwp) :: i_source, j_source, k_profile, k_source, l, m 368 376 369 377 REAL :: ni_columns … … 422 430 REAL(wp), DIMENSION(:), INTENT(OUT) :: profile_array 423 431 424 INTEGER :: i_source, j_source, l, nz, nlev432 INTEGER(iwp) :: i_source, j_source, l, nz, nlev 425 433 426 434 REAL(wp) :: ni_columns … … 468 476 REAL(wp), DIMENSION(:), INTENT(OUT) :: profile_array 469 477 470 INTEGER :: i_source, j_source, l, nz, nlev478 INTEGER(iwp) :: i_source, j_source, l, nz, nlev 471 479 472 480 REAL(wp) :: ni_columns … … 511 519 512 520 513 514 515 !------------------------------------------------------------------------------! 516 ! Description: 517 ! ------------ 518 !> Extrapolates density linearly from the level 'k_min' downwards. 519 !------------------------------------------------------------------------------! 520 SUBROUTINE extrapolate_density(rho, avg_grid) 521 REAL(wp), DIMENSION(:), INTENT(INOUT) :: rho 522 TYPE(grid_definition), INTENT(IN) :: avg_grid 523 524 REAL(wp) :: drhodz, dz, zk, rhok 525 INTEGER :: k_min 526 527 k_min = avg_grid%k_min 528 zk = avg_grid%z(k_min) 529 rhok = rho(k_min) 530 dz = avg_grid%z(k_min + 1) - avg_grid%z(k_min) 531 drhodz = (rho(k_min + 1) - rho(k_min)) / dz 532 533 rho(1:k_min-1) = rhok + drhodz * (avg_grid%z(1:k_min-1) - zk) 534 535 END SUBROUTINE extrapolate_density 536 537 538 !------------------------------------------------------------------------------! 539 ! Description: 540 ! ------------ 541 !> Driver for extrapolating pressure from PALM level k_min downwards 542 !------------------------------------------------------------------------------! 543 SUBROUTINE extrapolate_pressure(p, rho, avg_grid) 521 !------------------------------------------------------------------------------! 522 ! Description: 523 ! ------------ 524 !> Computes average soil values in COSMO-DE water cells from neighbouring 525 !> non-water cells. This is done as a preprocessing step for the COSMO-DE 526 !> soil input arrays, which contain unphysical values for water cells. 527 !> 528 !> This routine computes the average of up to all nine neighbouring cells 529 !> or keeps the original value, if not at least one non-water neightbour 530 !> is available. 531 !> 532 !> By repeatedly applying this step, soil data can be extrapolated into 533 !> 'water' regions occupying multiple cells, one cell per iteration. 534 !> 535 !> Input parameters: 536 !> ----------------- 537 !> soiltyp : 2d map of COSMO-DE soil types 538 !> nz : number of layers in the COSMO-DE soil 539 !> niter : number iterations 540 !> 541 !> Output parameters: 542 !> ------------------ 543 !> array : the soil array (i.e. water content or temperature) 544 !------------------------------------------------------------------------------! 545 SUBROUTINE fill_water_cells(soiltyp, array, nz, niter) 546 INTEGER(iwp), DIMENSION(:,:,:), INTENT(IN) :: soiltyp 547 REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: array 548 INTEGER(iwp), INTENT(IN) :: nz, niter 549 550 REAL(wp), DIMENSION(nz) :: column 551 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: old_soiltyp, new_soiltyp 552 INTEGER(iwp) :: l, i, j, nx, ny, n_cells, ii, jj, iter 553 INTEGER(iwp), DIMENSION(8) :: di, dj 554 555 nx = SIZE(array, 1) 556 ny = SIZE(array, 2) 557 di = (/ -1, -1, -1, 0, 0, 1, 1, 1 /) 558 dj = (/ -1, 0, 1, -1, 1, -1, 0, 1 /) 559 560 ALLOCATE(old_soiltyp(SIZE(soiltyp,1), & 561 SIZE(soiltyp,2) )) 562 563 ALLOCATE(new_soiltyp(SIZE(soiltyp,1), & 564 SIZE(soiltyp,2) )) 565 566 old_soiltyp(:,:) = soiltyp(:,:,1) 567 new_soiltyp(:,:) = soiltyp(:,:,1) 568 569 DO iter = 1, niter 570 571 DO j = 1, ny 572 DO i = 1, nx 573 574 IF (old_soiltyp(i,j) == WATER_ID) THEN 575 576 n_cells = 0 577 column(:) = 0.0_wp 578 DO l = 1, SIZE(di) 579 580 ii = MIN(nx, MAX(1_iwp, i + di(l))) 581 jj = MIN(ny, MAX(1_iwp, j + dj(l))) 582 583 IF (old_soiltyp(ii,jj) .NE. WATER_ID) THEN 584 n_cells = n_cells + 1 585 column(:) = column(:) + array(ii,jj,:) 586 ENDIF 587 588 ENDDO 589 590 ! 591 !-- Overwrite if at least one non-water neighbour cell is available 592 IF (n_cells > 0) THEN 593 array(i,j,:) = column(:) / n_cells 594 new_soiltyp(i,j) = 0 595 ENDIF 596 597 ENDIF 598 599 ENDDO 600 ENDDO 601 602 old_soiltyp(:,:) = new_soiltyp(:,:) 603 604 ENDDO 605 606 DEALLOCATE(old_soiltyp, new_soiltyp) 607 608 END SUBROUTINE fill_water_cells 609 610 611 !------------------------------------------------------------------------------! 612 ! Description: 613 ! ------------ 614 !> Takes the averaged pressure profile <p> and sets the lowest entry to the 615 !> extrapolated pressure at the surface. 616 !------------------------------------------------------------------------------! 617 SUBROUTINE get_surface_pressure(p, rho, avg_grid) 544 618 REAL(wp), DIMENSION(:), INTENT(IN) :: rho 545 619 REAL(wp), DIMENSION(:), INTENT(INOUT) :: p 546 620 TYPE(grid_definition), INTENT(IN) :: avg_grid 547 621 548 REAL(wp) :: drhodz, dz, zk, rhok549 INTEGER :: k,k_min622 REAL(wp) :: drhodz, dz, zk, rhok 623 INTEGER(iwp) :: k_min 550 624 551 625 k_min = avg_grid%k_min … … 553 627 rhok = rho(k_min) 554 628 dz = avg_grid%z(k_min + 1) - avg_grid%z(k_min) 555 drhodz = 0.5_wp * (rho(k_min + 1) - rho(k_min)) / dz 556 557 DO k = 1, k_min-1 558 p(k) = constant_density_pressure(p(k_min), zk, rhok, drhodz, & 559 avg_grid%z(k), G) 560 ENDDO 561 562 END SUBROUTINE extrapolate_pressure 563 564 565 !------------------------------------------------------------------------------! 566 ! Description: 567 ! ------------ 568 !> Takes the averaged pressure profile <p> and sets the lowest entry to the 569 !> extrapolated pressure at the surface. 570 !------------------------------------------------------------------------------! 571 SUBROUTINE get_surface_pressure(p, rho, avg_grid) 572 REAL(wp), DIMENSION(:), INTENT(IN) :: rho 573 REAL(wp), DIMENSION(:), INTENT(INOUT) :: p 574 TYPE(grid_definition), INTENT(IN) :: avg_grid 575 576 REAL(wp) :: drhodz, dz, zk, rhok 577 INTEGER :: k_min 578 579 k_min = avg_grid%k_min 580 zk = avg_grid%z(k_min) 581 rhok = rho(k_min) 582 dz = avg_grid%z(k_min + 1) - avg_grid%z(k_min) 583 drhodz = 0.5_wp * (rho(k_min + 1) - rho(k_min)) / dz 584 585 p(1) = constant_density_pressure(p(k_min), zk, rhok, drhodz, & 586 0.0_wp, G) 629 drhodz = ( rho(k_min + 1) - rho(k_min) ) / dz 630 631 p(1) = linear_density_pressure( p(k_min), zk, rhok, drhodz, & 632 z = 0.0_wp, g=G ) 587 633 588 634 END SUBROUTINE get_surface_pressure 589 635 590 636 591 FUNCTION constant_density_pressure(pk, zk, rhok, drhodz, z, g) RESULT(p)637 FUNCTION linear_density_pressure(pk, zk, rhok, drhodz, z, g) RESULT(p) 592 638 593 639 REAL(wp), INTENT(IN) :: pk, zk, rhok, drhodz, g, z 594 640 REAL(wp) :: p 595 641 596 p = pk + ( zk - z ) * g * ( rhok + 0.5*drhodz * (zk - z) )597 598 END FUNCTION constant_density_pressure642 p = pk + ( zk - z ) * g * ( rhok - 0.5_wp * drhodz * (zk - z) ) 643 644 END FUNCTION linear_density_pressure 599 645 600 646 !-----------------------------------------------------------------------------! … … 769 815 REAL(wp), INTENT(OUT) :: phi(0:,0:), lam(0:,0:) 770 816 771 INTEGER :: i, j817 INTEGER(iwp) :: i, j 772 818 773 819 IF ( SIZE(phi, 1) .NE. SIZE(lam, 1) .OR. & … … 816 862 REAL(wp), INTENT(IN) :: angle !< rotation angle [deg] 817 863 818 INTEGER 819 REAL(wp) :: sine, cosine, v_rot(2), rotation(2,2)864 INTEGER(iwp) :: i 865 REAL(wp) :: sine, cosine, v_rot(2), rotation(2,2) 820 866 821 867 sine = SIN(angle * TO_RADIANS) … … 912 958 palm_ii, palm_jj) 913 959 914 REAL(wp), DIMENSION(0:), INTENT(IN) :: cosmo_lat, cosmo_lon915 REAL(wp), DIMENSION(0:,0:), INTENT(IN) :: palm_clat, palm_clon916 REAL(wp) :: cosmo_dxi, cosmo_dyi917 INTEGER , DIMENSION(0:,0:,1:), INTENT(OUT):: palm_ii, palm_jj918 919 REAL(wp) :: lonpos, latpos, lon0, lat0920 INTEGER 960 REAL(wp), DIMENSION(0:), INTENT(IN) :: cosmo_lat, cosmo_lon 961 REAL(wp), DIMENSION(0:,0:), INTENT(IN) :: palm_clat, palm_clon 962 REAL(wp) :: cosmo_dxi, cosmo_dyi 963 INTEGER(iwp), DIMENSION(0:,0:,1:), INTENT(OUT) :: palm_ii, palm_jj 964 965 REAL(wp) :: lonpos, latpos, lon0, lat0 966 INTEGER(iwp) :: i, j 921 967 922 968 lon0 = cosmo_lon(0) … … 968 1014 !> column of the given palm grid. 969 1015 !------------------------------------------------------------------------------! 970 SUBROUTINE find_vertical_neighbours_and_weights_interp( palm_grid, &971 1016 SUBROUTINE find_vertical_neighbours_and_weights_interp( palm_grid, & 1017 palm_intermediate ) 972 1018 TYPE(grid_definition), INTENT(INOUT) :: palm_grid 973 1019 TYPE(grid_definition), INTENT(IN) :: palm_intermediate 974 1020 975 INTEGER 976 LOGICAL :: point_is_below_grid, point_is_above_grid,&977 point_is_in_current_cell978 REAL(wp) :: current_height, column_base, column_top, h_top, h_bottom,&979 weight1021 INTEGER(iwp) :: i, j, k, nx, ny, nz, nlev, k_intermediate 1022 LOGICAL :: point_is_below_grid, point_is_above_grid, & 1023 point_is_in_current_cell 1024 REAL(wp) :: current_height, column_base, column_top, h_top, h_bottom, & 1025 weight 980 1026 981 1027 nx = palm_grid%nx … … 1091 1137 LOGICAL :: level_based_averaging 1092 1138 1093 INTEGER 1139 INTEGER(iwp) :: i, j, k_palm, k_intermediate, l, nlev 1094 1140 LOGICAL :: point_is_below_grid, point_is_above_grid, & 1095 1141 point_is_in_current_cell … … 1259 1305 palm_clat, palm_clon, palm_ii, palm_jj, palm_w_horiz) 1260 1306 1261 REAL(wp), DIMENSION(0:), INTENT(IN) :: cosmo_lat, cosmo_lon1262 REAL(wp) :: cosmo_dxi, cosmo_dyi1263 REAL(wp), DIMENSION(0:,0:), INTENT(IN) :: palm_clat, palm_clon1264 INTEGER , DIMENSION(0:,0:,1:), INTENT(IN):: palm_ii, palm_jj1307 REAL(wp), DIMENSION(0:), INTENT(IN) :: cosmo_lat, cosmo_lon 1308 REAL(wp) :: cosmo_dxi, cosmo_dyi 1309 REAL(wp), DIMENSION(0:,0:), INTENT(IN) :: palm_clat, palm_clon 1310 INTEGER(iwp), DIMENSION(0:,0:,1:), INTENT(IN) :: palm_ii, palm_jj 1265 1311 1266 1312 REAL(wp), DIMENSION(0:,0:,1:), INTENT(OUT) :: palm_w_horiz 1267 1313 1268 REAL(wp) :: wlambda, wphi1269 INTEGER 1314 REAL(wp) :: wlambda, wphi 1315 INTEGER(iwp) :: i, j 1270 1316 1271 1317 cosmo_dxi = 1.0_wp / (cosmo_lon(1) - cosmo_lon(0)) … … 1319 1365 REAL(wp), DIMENSION(0:,0:,0:), INTENT(IN) :: u_face, v_face 1320 1366 REAL(wp), DIMENSION(0:,0:,0:), INTENT(OUT) :: u_centre, v_centre 1321 INTEGER :: nx, ny1367 INTEGER(iwp) :: nx, ny 1322 1368 1323 1369 nx = UBOUND(u_face, 1) -
palm/trunk/UTIL/inifor/src/inifor_types.f90
r4481 r4523 26 26 ! ----------------- 27 27 ! $Id$ 28 ! respect integer working precision (iwp) specified in inifor_defs.f90 29 ! 30 ! 31 ! 4481 2020-03-31 18:55:54Z maronga 28 32 ! Added boolean indicator for --elevation option invocation, sorted varibles 29 33 ! … … 79 83 80 84 USE inifor_defs, & 81 ONLY: DATE, PATH, SNAME, LNAME, wp85 ONLY: DATE, PATH, SNAME, LNAME, iwp, wp 82 86 83 87 #if defined ( __netcdf ) … … 142 146 CHARACTER(LEN=SNAME) :: name(3) !< names of the grid dimensions, e.g. (/'x', 'y', 'z'/) or (/'latitude', 'longitude', 'height'/) 143 147 CHARACTER(LEN=SNAME) :: kind !< names of the grid dimensions, e.g. (/'x', 'y', 'z'/) or (/'latitude', 'longitude', 'height'/) 144 INTEGER :: k_min !< Index of lowest PALM grid level that is not cut by local COSMO orography; vertically separates interpolation and extrapolation region.145 INTEGER :: nx !< number of gridpoints in the first dimension146 INTEGER :: ny !< number of gridpoints in the second dimension147 INTEGER :: nz !< number of gridpoints in the third dimension, used for PALM points148 INTEGER :: nlev !< number of COSMO grid levels149 INTEGER :: n_columns !< number of averaging columns of the source grid150 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.151 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.152 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.153 INTEGER , ALLOCATABLE :: iii(:) !< profile averaging neighbour indices154 INTEGER , ALLOCATABLE :: jjj(:) !< profile averaging neighbour indices155 INTEGER , ALLOCATABLE :: kkk(:,:,:) !< indices of vertical interpolation neightbours, kkk(<source column>, <PALM k level>, <neighbour index>)148 INTEGER(iwp) :: k_min !< Index of lowest PALM grid level that is not cut by local COSMO orography; vertically separates interpolation and extrapolation region. 149 INTEGER(iwp) :: nx !< number of gridpoints in the first dimension 150 INTEGER(iwp) :: ny !< number of gridpoints in the second dimension 151 INTEGER(iwp) :: nz !< number of gridpoints in the third dimension, used for PALM points 152 INTEGER(iwp) :: nlev !< number of COSMO grid levels 153 INTEGER(iwp) :: n_columns !< number of averaging columns of the source grid 154 INTEGER(iwp), 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. 155 INTEGER(iwp), 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. 156 INTEGER(iwp), 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. 157 INTEGER(iwp), ALLOCATABLE :: iii(:) !< profile averaging neighbour indices 158 INTEGER(iwp), ALLOCATABLE :: jjj(:) !< profile averaging neighbour indices 159 INTEGER(iwp), ALLOCATABLE :: kkk(:,:,:) !< indices of vertical interpolation neightbours, kkk(<source column>, <PALM k level>, <neighbour index>) 156 160 REAL(wp) :: lx !< domain length in the first dimension [m] 157 161 REAL(wp) :: ly !< domain length in the second dimension [m] … … 215 219 INTEGER :: input_id !< ID of the correpsonding input variables, only valid for output variables 216 220 INTEGER :: ndim !< number of NetCDF dimensions 217 INTEGER 221 INTEGER(iwp) :: nt !< number of output time steps 218 222 INTEGER :: lod !< NetCDF attribute indicating the PALM-4U level of detail 219 223 INTEGER, DIMENSION(NF90_MAX_VAR_DIMS) :: dimids !< NetCDF IDs of the dimensions … … 247 251 !------------------------------------------------------------------------------! 248 252 TYPE io_group 249 INTEGER :: nt !< maximum number of output time steps across all output variables250 INTEGER :: nv !< number of netCDF output variables251 INTEGER :: n_inputs !< number of input variables252 INTEGER :: n_output_quantities !< number of physical quantities required for computing netCDF output variables253 INTEGER(iwp) :: nt !< maximum number of output time steps across all output variables 254 INTEGER(iwp) :: nv !< number of netCDF output variables 255 INTEGER(iwp) :: n_inputs !< number of input variables 256 INTEGER(iwp) :: n_output_quantities !< number of physical quantities required for computing netCDF output variables 253 257 CHARACTER(LEN=SNAME) :: kind !< kind of I/O group 254 258 CHARACTER(LEN=PATH), ALLOCATABLE :: in_files(:) !< list of nt input files -
palm/trunk/UTIL/inifor/src/inifor_util.f90
r4499 r4523 26 26 ! ----------------- 27 27 ! $Id$ 28 ! respect integer working precision (iwp) specified in inifor_defs.f90 29 ! 30 ! 31 ! 4499 2020-04-16 15:51:56Z eckhard 28 32 ! Bugfix: avoid using already overwritten elements in 'reverse' subroutine 29 33 ! … … 73 77 74 78 USE inifor_defs, & 75 ONLY : PI, DATE, SNAME, wp79 ONLY : PI, DATE, SNAME, iwp, wp 76 80 USE inifor_types, & 77 81 ONLY : grid_definition … … 169 173 CHARACTER(LEN=DATE) FUNCTION add_hours_to(date_string, hours) 170 174 CHARACTER(LEN=DATE), INTENT(IN) :: date_string 171 INTEGER , INTENT(IN):: hours175 INTEGER(iwp), INTENT(IN) :: hours 172 176 173 177 CHARACTER(KIND=C_CHAR, LEN=*), PARAMETER :: format_string = "%Y%m%d%H" … … 175 179 TYPE(C_PTR) :: c_pointer 176 180 TYPE(tm_struct) :: time_info 177 INTEGER 181 INTEGER(iwp) :: err 178 182 179 183 c_date_string = date_string … … 249 253 REAL(wp), INTENT(IN) :: start, stop 250 254 REAL(wp), INTENT(INOUT) :: array(0:) 251 INTEGER 255 INTEGER(iwp) :: i, n 252 256 253 257 n = UBOUND(array, 1) … … 276 280 SUBROUTINE reverse(input_arr) 277 281 278 INTEGER :: idx, opposite_idx, half_idx279 INTEGER :: size_1st_dimension280 INTEGER :: size_2nd_dimension281 INTEGER :: size_3rd_dimension282 INTEGER :: lbound_3rd_dimension283 INTEGER :: ubound_3rd_dimension282 INTEGER(iwp) :: idx, opposite_idx, half_idx 283 INTEGER(iwp) :: size_1st_dimension 284 INTEGER(iwp) :: size_2nd_dimension 285 INTEGER(iwp) :: size_3rd_dimension 286 INTEGER(iwp) :: lbound_3rd_dimension 287 INTEGER(iwp) :: ubound_3rd_dimension 284 288 285 289 REAL(wp), INTENT(INOUT) :: input_arr(:,:,:) … … 432 436 CHARACTER(LEN=10) FUNCTION str(val) 433 437 434 INTEGER , INTENT(IN) :: val438 INTEGER(iwp), INTENT(IN) :: val 435 439 436 440 WRITE(str, '(i10)') val … … 448 452 449 453 CHARACTER(LEN=*), INTENT(INOUT) :: path 450 INTEGER :: n454 INTEGER(iwp) :: n 451 455 452 456 n = LEN_TRIM(path)
Note: See TracChangeset
for help on using the changeset viewer.
