Changeset 1353 for palm/trunk/SOURCE/check_parameters.f90
- Timestamp:
- Apr 8, 2014 3:21:23 PM (10 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/check_parameters.f90 (modified) (81 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/check_parameters.f90
r1331 r1353 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! REAL constants provided with KIND-attribute 23 23 ! 24 24 ! Former revisions: … … 238 238 239 239 REAL(wp) :: gradient !: 240 REAL(wp) :: remote = 0.0 240 REAL(wp) :: remote = 0.0_wp !: 241 241 REAL(wp) :: simulation_time_since_reference !: 242 242 … … 307 307 CALL message( 'check_parameters', 'PA0004', 1, 2, 0, 6, 0 ) 308 308 ENDIF 309 IF ( dt_coupling <= 0.0 ) THEN309 IF ( dt_coupling <= 0.0_wp ) THEN 310 310 #if ! defined( __check ) 311 311 IF ( myid == 0 ) THEN … … 505 505 ! 506 506 !-- Check if vertical grid stretching is used together with particles 507 IF ( dz_stretch_level < 100000.0 .AND. particle_advection ) THEN507 IF ( dz_stretch_level < 100000.0_wp .AND. particle_advection ) THEN 508 508 message_string = 'Vertical grid stretching is not allowed together ' // & 509 509 'with particle advection.' … … 677 677 CALL message( 'check_parameters', 'PA0024', 1, 2, 0, 6, 0 ) 678 678 ENDIF 679 IF ( scalar_advec == 'bc-scheme' .AND. loop_optimization == 'cache' ) &679 IF ( scalar_advec == 'bc-scheme' .AND. loop_optimization == 'cache' ) & 680 680 THEN 681 681 message_string = 'advection_scheme scalar_advec = "' & … … 685 685 ENDIF 686 686 687 IF ( use_sgs_for_particles .AND. .NOT. use_upstream_for_tke .AND. &687 IF ( use_sgs_for_particles .AND. .NOT. use_upstream_for_tke .AND. & 688 688 scalar_advec /= 'ws-scheme' ) THEN 689 689 use_upstream_for_tke = .TRUE. 690 message_string = 'use_upstream_for_tke set .TRUE. because ' // &691 'use_sgs_for_particles = .TRUE. ' // &690 message_string = 'use_upstream_for_tke set .TRUE. because ' // & 691 'use_sgs_for_particles = .TRUE. ' // & 692 692 'and scalar_advec /= ws-scheme' 693 693 CALL message( 'check_parameters', 'PA0025', 0, 1, 0, 6, 0 ) … … 695 695 696 696 IF ( use_sgs_for_particles .AND. curvature_solution_effects ) THEN 697 message_string = 'use_sgs_for_particles = .TRUE. not allowed with ' // &697 message_string = 'use_sgs_for_particles = .TRUE. not allowed with ' // & 698 698 'curvature_solution_effects = .TRUE.' 699 699 CALL message( 'check_parameters', 'PA0349', 1, 2, 0, 6, 0 ) … … 719 719 720 720 CASE DEFAULT 721 message_string = 'unknown timestep scheme: timestep_scheme = "' // &721 message_string = 'unknown timestep scheme: timestep_scheme = "' // & 722 722 TRIM( timestep_scheme ) // '"' 723 723 CALL message( 'check_parameters', 'PA0027', 1, 2, 0, 6, 0 ) … … 725 725 END SELECT 726 726 727 IF ( (momentum_advec /= 'pw-scheme' .AND. momentum_advec /= 'ws-scheme') &727 IF ( (momentum_advec /= 'pw-scheme' .AND. momentum_advec /= 'ws-scheme') & 728 728 .AND. timestep_scheme(1:5) == 'runge' ) THEN 729 729 message_string = 'momentum advection scheme "' // & … … 833 833 ENDIF 834 834 835 IF ( plant_canopy .AND. ( drag_coefficient == 0.0 ) ) THEN835 IF ( plant_canopy .AND. ( drag_coefficient == 0.0_wp ) ) THEN 836 836 message_string = 'plant_canopy = .TRUE. requires a non-zero drag ' // & 837 837 'coefficient & given value is drag_coefficient = 0.0' … … 872 872 IF ( ocean ) sa_init = sa_surface 873 873 IF ( passive_scalar ) q_init = s_surface 874 IF ( plant_canopy ) lad = 0.0 874 IF ( plant_canopy ) lad = 0.0_wp 875 875 876 876 ! … … 879 879 !-- (component ug) 880 880 i = 1 881 gradient = 0.0 881 gradient = 0.0_wp 882 882 883 883 IF ( .NOT. ocean ) THEN … … 888 888 IF ( i < 11 ) THEN 889 889 IF ( ug_vertical_gradient_level(i) < zu(k) .AND. & 890 ug_vertical_gradient_level(i) >= 0.0 ) THEN891 gradient = ug_vertical_gradient(i) / 100.0 890 ug_vertical_gradient_level(i) >= 0.0_wp ) THEN 891 gradient = ug_vertical_gradient(i) / 100.0_wp 892 892 ug_vertical_gradient_level_ind(i) = k - 1 893 893 i = i + 1 894 894 ENDIF 895 895 ENDIF 896 IF ( gradient /= 0.0 ) THEN896 IF ( gradient /= 0.0_wp ) THEN 897 897 IF ( k /= 1 ) THEN 898 898 ug(k) = ug(k-1) + dzu(k) * gradient … … 912 912 IF ( i < 11 ) THEN 913 913 IF ( ug_vertical_gradient_level(i) > zu(k) .AND. & 914 ug_vertical_gradient_level(i) <= 0.0 ) THEN915 gradient = ug_vertical_gradient(i) / 100.0 914 ug_vertical_gradient_level(i) <= 0.0_wp ) THEN 915 gradient = ug_vertical_gradient(i) / 100.0_wp 916 916 ug_vertical_gradient_level_ind(i) = k + 1 917 917 i = i + 1 918 918 ENDIF 919 919 ENDIF 920 IF ( gradient /= 0.0 ) THEN920 IF ( gradient /= 0.0_wp ) THEN 921 921 IF ( k /= nzt ) THEN 922 922 ug(k) = ug(k+1) - dzu(k+1) * gradient 923 923 ELSE 924 ug(k) = ug_surface - 0.5 * dzu(k+1) * gradient925 ug(k+1) = ug_surface + 0.5 * dzu(k+1) * gradient924 ug(k) = ug_surface - 0.5_wp * dzu(k+1) * gradient 925 ug(k+1) = ug_surface + 0.5_wp * dzu(k+1) * gradient 926 926 ENDIF 927 927 ELSE … … 935 935 !-- In case of no given gradients for ug, choose a zero gradient 936 936 IF ( ug_vertical_gradient_level(1) == -9999999.9_wp ) THEN 937 ug_vertical_gradient_level(1) = 0.0 937 ug_vertical_gradient_level(1) = 0.0_wp 938 938 ENDIF 939 939 … … 943 943 !-- (component vg) 944 944 i = 1 945 gradient = 0.0 945 gradient = 0.0_wp 946 946 947 947 IF ( .NOT. ocean ) THEN … … 952 952 IF ( i < 11 ) THEN 953 953 IF ( vg_vertical_gradient_level(i) < zu(k) .AND. & 954 vg_vertical_gradient_level(i) >= 0.0 ) THEN955 gradient = vg_vertical_gradient(i) / 100.0 954 vg_vertical_gradient_level(i) >= 0.0_wp ) THEN 955 gradient = vg_vertical_gradient(i) / 100.0_wp 956 956 vg_vertical_gradient_level_ind(i) = k - 1 957 957 i = i + 1 958 958 ENDIF 959 959 ENDIF 960 IF ( gradient /= 0.0 ) THEN960 IF ( gradient /= 0.0_wp ) THEN 961 961 IF ( k /= 1 ) THEN 962 962 vg(k) = vg(k-1) + dzu(k) * gradient … … 976 976 IF ( i < 11 ) THEN 977 977 IF ( vg_vertical_gradient_level(i) > zu(k) .AND. & 978 vg_vertical_gradient_level(i) <= 0.0 ) THEN979 gradient = vg_vertical_gradient(i) / 100.0 978 vg_vertical_gradient_level(i) <= 0.0_wp ) THEN 979 gradient = vg_vertical_gradient(i) / 100.0_wp 980 980 vg_vertical_gradient_level_ind(i) = k + 1 981 981 i = i + 1 982 982 ENDIF 983 983 ENDIF 984 IF ( gradient /= 0.0 ) THEN984 IF ( gradient /= 0.0_wp ) THEN 985 985 IF ( k /= nzt ) THEN 986 986 vg(k) = vg(k+1) - dzu(k+1) * gradient 987 987 ELSE 988 vg(k) = vg_surface - 0.5 * dzu(k+1) * gradient989 vg(k+1) = vg_surface + 0.5 * dzu(k+1) * gradient988 vg(k) = vg_surface - 0.5_wp * dzu(k+1) * gradient 989 vg(k+1) = vg_surface + 0.5_wp * dzu(k+1) * gradient 990 990 ENDIF 991 991 ELSE … … 999 999 !-- In case of no given gradients for vg, choose a zero gradient 1000 1000 IF ( vg_vertical_gradient_level(1) == -9999999.9_wp ) THEN 1001 vg_vertical_gradient_level(1) = 0.0 1001 vg_vertical_gradient_level(1) = 0.0_wp 1002 1002 ENDIF 1003 1003 … … 1010 1010 v_init = vg 1011 1011 1012 ELSEIF ( u_profile(1) == 0.0 .AND. v_profile(1) == 0.0) THEN1013 1014 IF ( uv_heights(1) /= 0.0 ) THEN1012 ELSEIF ( u_profile(1) == 0.0_wp .AND. v_profile(1) == 0.0_wp ) THEN 1013 1014 IF ( uv_heights(1) /= 0.0_wp ) THEN 1015 1015 message_string = 'uv_heights(1) must be 0.0' 1016 1016 CALL message( 'check_parameters', 'PA0345', 1, 2, 0, 6, 0 ) … … 1020 1020 1021 1021 kk = 1 1022 u_init(0) = 0.0 1023 v_init(0) = 0.0 1022 u_init(0) = 0.0_wp 1023 v_init(0) = 0.0_wp 1024 1024 1025 1025 DO k = 1, nz+1 … … 1058 1058 1059 1059 i = 1 1060 gradient = 0.0 1060 gradient = 0.0_wp 1061 1061 1062 1062 IF ( .NOT. ocean ) THEN … … 1066 1066 IF ( i < 11 ) THEN 1067 1067 IF ( pt_vertical_gradient_level(i) < zu(k) .AND. & 1068 pt_vertical_gradient_level(i) >= 0.0 ) THEN1069 gradient = pt_vertical_gradient(i) / 100.0 1068 pt_vertical_gradient_level(i) >= 0.0_wp ) THEN 1069 gradient = pt_vertical_gradient(i) / 100.0_wp 1070 1070 pt_vertical_gradient_level_ind(i) = k - 1 1071 1071 i = i + 1 1072 1072 ENDIF 1073 1073 ENDIF 1074 IF ( gradient /= 0.0 ) THEN1074 IF ( gradient /= 0.0_wp ) THEN 1075 1075 IF ( k /= 1 ) THEN 1076 1076 pt_init(k) = pt_init(k-1) + dzu(k) * gradient … … 1089 1089 IF ( i < 11 ) THEN 1090 1090 IF ( pt_vertical_gradient_level(i) > zu(k) .AND. & 1091 pt_vertical_gradient_level(i) <= 0.0 ) THEN1092 gradient = pt_vertical_gradient(i) / 100.0 1091 pt_vertical_gradient_level(i) <= 0.0_wp ) THEN 1092 gradient = pt_vertical_gradient(i) / 100.0_wp 1093 1093 pt_vertical_gradient_level_ind(i) = k + 1 1094 1094 i = i + 1 1095 1095 ENDIF 1096 1096 ENDIF 1097 IF ( gradient /= 0.0 ) THEN1097 IF ( gradient /= 0.0_wp ) THEN 1098 1098 IF ( k /= nzt ) THEN 1099 1099 pt_init(k) = pt_init(k+1) - dzu(k+1) * gradient 1100 1100 ELSE 1101 pt_init(k) = pt_surface - 0.5 * dzu(k+1) * gradient1102 pt_init(k+1) = pt_surface + 0.5 * dzu(k+1) * gradient1101 pt_init(k) = pt_surface - 0.5_wp * dzu(k+1) * gradient 1102 pt_init(k+1) = pt_surface + 0.5_wp * dzu(k+1) * gradient 1103 1103 ENDIF 1104 1104 ELSE … … 1115 1115 !-- stratification 1116 1116 IF ( pt_vertical_gradient_level(1) == -9999999.9_wp ) THEN 1117 pt_vertical_gradient_level(1) = 0.0 1117 pt_vertical_gradient_level(1) = 0.0_wp 1118 1118 ENDIF 1119 1119 … … 1141 1141 1142 1142 i = 1 1143 gradient = 0.0 1143 gradient = 0.0_wp 1144 1144 q_vertical_gradient_level_ind(1) = 0 1145 1145 DO k = 1, nzt+1 1146 1146 IF ( i < 11 ) THEN 1147 1147 IF ( q_vertical_gradient_level(i) < zu(k) .AND. & 1148 q_vertical_gradient_level(i) >= 0.0 ) THEN1149 gradient = q_vertical_gradient(i) / 100.0 1148 q_vertical_gradient_level(i) >= 0.0_wp ) THEN 1149 gradient = q_vertical_gradient(i) / 100.0_wp 1150 1150 q_vertical_gradient_level_ind(i) = k - 1 1151 1151 i = i + 1 1152 1152 ENDIF 1153 1153 ENDIF 1154 IF ( gradient /= 0.0 ) THEN1154 IF ( gradient /= 0.0_wp ) THEN 1155 1155 IF ( k /= 1 ) THEN 1156 1156 q_init(k) = q_init(k-1) + dzu(k) * gradient … … 1163 1163 ! 1164 1164 !-- Avoid negative humidities 1165 IF ( q_init(k) < 0.0 ) THEN1166 q_init(k) = 0.0 1165 IF ( q_init(k) < 0.0_wp ) THEN 1166 q_init(k) = 0.0_wp 1167 1167 ENDIF 1168 1168 ENDDO … … 1171 1171 !-- In case of no given humidity gradients, choose zero gradient 1172 1172 !-- conditions 1173 IF ( q_vertical_gradient_level(1) == -1.0 ) THEN1174 q_vertical_gradient_level(1) = 0.0 1173 IF ( q_vertical_gradient_level(1) == -1.0_wp ) THEN 1174 q_vertical_gradient_level(1) = 0.0_wp 1175 1175 ENDIF 1176 1176 ! … … 1186 1186 1187 1187 i = 1 1188 gradient = 0.0 1188 gradient = 0.0_wp 1189 1189 1190 1190 sa_vertical_gradient_level_ind(1) = nzt+1 … … 1192 1192 IF ( i < 11 ) THEN 1193 1193 IF ( sa_vertical_gradient_level(i) > zu(k) .AND. & 1194 sa_vertical_gradient_level(i) <= 0.0 ) THEN1195 gradient = sa_vertical_gradient(i) / 100.0 1194 sa_vertical_gradient_level(i) <= 0.0_wp ) THEN 1195 gradient = sa_vertical_gradient(i) / 100.0_wp 1196 1196 sa_vertical_gradient_level_ind(i) = k + 1 1197 1197 i = i + 1 1198 1198 ENDIF 1199 1199 ENDIF 1200 IF ( gradient /= 0.0 ) THEN1200 IF ( gradient /= 0.0_wp ) THEN 1201 1201 IF ( k /= nzt ) THEN 1202 1202 sa_init(k) = sa_init(k+1) - dzu(k+1) * gradient 1203 1203 ELSE 1204 sa_init(k) = sa_surface - 0.5 * dzu(k+1) * gradient1205 sa_init(k+1) = sa_surface + 0.5 * dzu(k+1) * gradient1204 sa_init(k) = sa_surface - 0.5_wp * dzu(k+1) * gradient 1205 sa_init(k+1) = sa_surface + 0.5_wp * dzu(k+1) * gradient 1206 1206 ENDIF 1207 1207 ELSE … … 1218 1218 1219 1219 i = 1 1220 gradient = 0.0 1220 gradient = 0.0_wp 1221 1221 1222 1222 IF ( .NOT. ocean ) THEN … … 1228 1228 IF ( i < 11 ) THEN 1229 1229 IF ( lad_vertical_gradient_level(i) < zu(k) .AND. & 1230 lad_vertical_gradient_level(i) >= 0.0 ) THEN1230 lad_vertical_gradient_level(i) >= 0.0_wp ) THEN 1231 1231 gradient = lad_vertical_gradient(i) 1232 1232 lad_vertical_gradient_level_ind(i) = k - 1 … … 1234 1234 ENDIF 1235 1235 ENDIF 1236 IF ( gradient /= 0.0 ) THEN1236 IF ( gradient /= 0.0_wp ) THEN 1237 1237 IF ( k /= 1 ) THEN 1238 1238 lad(k) = lad(k-1) + dzu(k) * gradient … … 1251 1251 !-- gradient 1252 1252 IF ( lad_vertical_gradient_level(1) == -9999999.9_wp ) THEN 1253 lad_vertical_gradient_level(1) = 0.0 1253 lad_vertical_gradient_level(1) = 0.0_wp 1254 1254 ENDIF 1255 1255 … … 1287 1287 ! 1288 1288 !-- Compute Coriolis parameter 1289 f = 2.0 * omega * SIN( phi / 180.0* pi )1290 fs = 2.0 * omega * COS( phi / 180.0* pi )1289 f = 2.0_wp * omega * SIN( phi / 180.0_wp * pi ) 1290 fs = 2.0_wp * omega * COS( phi / 180.0_wp * pi ) 1291 1291 1292 1292 ! … … 1299 1299 use_single_reference_value = .TRUE. 1300 1300 IF ( pt_reference == 9999999.9_wp ) pt_reference = pt_surface 1301 vpt_reference = pt_reference * ( 1.0 + 0.61* q_surface )1301 vpt_reference = pt_reference * ( 1.0_wp + 0.61_wp * q_surface ) 1302 1302 ELSE 1303 1303 message_string = 'illegal value for reference_state: "' // & … … 1315 1315 ! 1316 1316 !-- Sign of buoyancy/stability terms 1317 IF ( ocean ) atmos_ocean_sign = -1.0 1317 IF ( ocean ) atmos_ocean_sign = -1.0_wp 1318 1318 1319 1319 ! … … 1326 1326 ! 1327 1327 !-- In case of a given slope, compute the relevant quantities 1328 IF ( alpha_surface /= 0.0 ) THEN1329 IF ( ABS( alpha_surface ) > 90.0 ) THEN1328 IF ( alpha_surface /= 0.0_wp ) THEN 1329 IF ( ABS( alpha_surface ) > 90.0_wp ) THEN 1330 1330 WRITE( message_string, * ) 'ABS( alpha_surface = ', alpha_surface, & 1331 1331 ' ) must be < 90.0' … … 1333 1333 ENDIF 1334 1334 sloping_surface = .TRUE. 1335 cos_alpha_surface = COS( alpha_surface / 180.0 * pi )1336 sin_alpha_surface = SIN( alpha_surface / 180.0 * pi )1335 cos_alpha_surface = COS( alpha_surface / 180.0_wp * pi ) 1336 sin_alpha_surface = SIN( alpha_surface / 180.0_wp * pi ) 1337 1337 ENDIF 1338 1338 1339 1339 ! 1340 1340 !-- Check time step and cfl_factor 1341 IF ( dt /= -1.0 ) THEN1342 IF ( dt <= 0.0 .AND. dt /= -1.0) THEN1341 IF ( dt /= -1.0_wp ) THEN 1342 IF ( dt <= 0.0_wp .AND. dt /= -1.0_wp ) THEN 1343 1343 WRITE( message_string, * ) 'dt = ', dt , ' <= 0.0' 1344 1344 CALL message( 'check_parameters', 'PA0044', 1, 2, 0, 6, 0 ) … … 1348 1348 ENDIF 1349 1349 1350 IF ( cfl_factor <= 0.0 .OR. cfl_factor > 1.0) THEN1351 IF ( cfl_factor == -1.0 ) THEN1350 IF ( cfl_factor <= 0.0_wp .OR. cfl_factor > 1.0_wp ) THEN 1351 IF ( cfl_factor == -1.0_wp ) THEN 1352 1352 IF ( timestep_scheme == 'runge-kutta-2' ) THEN 1353 cfl_factor = 0.8 1353 cfl_factor = 0.8_wp 1354 1354 ELSEIF ( timestep_scheme == 'runge-kutta-3' ) THEN 1355 cfl_factor = 0.9 1355 cfl_factor = 0.9_wp 1356 1356 ELSE 1357 cfl_factor = 0.9 1357 cfl_factor = 0.9_wp 1358 1358 ENDIF 1359 1359 ELSE … … 1371 1371 !-- Store reference time for coupled runs and change the coupling flag, 1372 1372 !-- if ... 1373 IF ( simulated_time == 0.0 ) THEN1374 IF ( coupling_start_time == 0.0 ) THEN1375 time_since_reference_point = 0.0 1376 ELSEIF ( time_since_reference_point < 0.0 ) THEN1373 IF ( simulated_time == 0.0_wp ) THEN 1374 IF ( coupling_start_time == 0.0_wp ) THEN 1375 time_since_reference_point = 0.0_wp 1376 ELSEIF ( time_since_reference_point < 0.0_wp ) THEN 1377 1377 run_coupled = .FALSE. 1378 1378 ENDIF … … 1382 1382 !-- Set wind speed in the Galilei-transformed system 1383 1383 IF ( galilei_transformation ) THEN 1384 IF ( use_ug_for_galilei_tr .AND. &1385 ug_vertical_gradient_level(1) == 0.0 .AND. &1386 ug_vertical_gradient(1) == 0.0 .AND. &1387 vg_vertical_gradient_level(1) == 0.0 .AND. &1388 vg_vertical_gradient(1) == 0.0 ) THEN1389 u_gtrans = ug_surface * 0.6 1390 v_gtrans = vg_surface * 0.6 1391 ELSEIF ( use_ug_for_galilei_tr .AND. &1392 ( ug_vertical_gradient_level(1) /= 0.0 .OR. &1393 ug_vertical_gradient(1) /= 0.0 ) ) THEN1384 IF ( use_ug_for_galilei_tr .AND. & 1385 ug_vertical_gradient_level(1) == 0.0_wp .AND. & 1386 ug_vertical_gradient(1) == 0.0_wp .AND. & 1387 vg_vertical_gradient_level(1) == 0.0_wp .AND. & 1388 vg_vertical_gradient(1) == 0.0_wp ) THEN 1389 u_gtrans = ug_surface * 0.6_wp 1390 v_gtrans = vg_surface * 0.6_wp 1391 ELSEIF ( use_ug_for_galilei_tr .AND. & 1392 ( ug_vertical_gradient_level(1) /= 0.0_wp .OR. & 1393 ug_vertical_gradient(1) /= 0.0_wp ) ) THEN 1394 1394 message_string = 'baroclinity (ug) not allowed simultaneously' // & 1395 1395 ' with galilei transformation' 1396 1396 CALL message( 'check_parameters', 'PA0046', 1, 2, 0, 6, 0 ) 1397 ELSEIF ( use_ug_for_galilei_tr .AND. &1398 ( vg_vertical_gradient_level(1) /= 0.0 .OR. &1399 vg_vertical_gradient(1) /= 0.0 ) ) THEN1397 ELSEIF ( use_ug_for_galilei_tr .AND. & 1398 ( vg_vertical_gradient_level(1) /= 0.0_wp .OR. & 1399 vg_vertical_gradient(1) /= 0.0_wp ) ) THEN 1400 1400 message_string = 'baroclinity (vg) not allowed simultaneously' // & 1401 1401 ' with galilei transformation' … … 1561 1561 IF ( neutral ) THEN 1562 1562 1563 IF ( surface_heatflux /= 0.0 .AND. surface_heatflux /= 9999999.9_wp ) &1563 IF ( surface_heatflux /= 0.0_wp .AND. surface_heatflux /= 9999999.9_wp ) & 1564 1564 THEN 1565 1565 message_string = 'heatflux must not be set for pure neutral flow' … … 1590 1590 !-- forbidden. 1591 1591 IF ( ibc_pt_b == 0 .AND. constant_heatflux .AND. & 1592 surface_heatflux /= 0.0 ) THEN1592 surface_heatflux /= 0.0_wp ) THEN 1593 1593 message_string = 'boundary_condition: bc_pt_b = "' // TRIM( bc_pt_b ) //& 1594 1594 '& is not allowed with constant_heatflux = .TRUE.' 1595 1595 CALL message( 'check_parameters', 'PA0065', 1, 2, 0, 6, 0 ) 1596 1596 ENDIF 1597 IF ( constant_heatflux .AND. pt_surface_initial_change /= 0.0 ) THEN1597 IF ( constant_heatflux .AND. pt_surface_initial_change /= 0.0_wp ) THEN 1598 1598 WRITE ( message_string, * ) 'constant_heatflux = .TRUE. is not allo', & 1599 1599 'wed with pt_surface_initial_change (/=0) = ', & … … 1607 1607 !-- forbidden. 1608 1608 IF ( ibc_pt_t == 0 .AND. constant_top_heatflux .AND. & 1609 top_heatflux /= 0.0 ) THEN1609 top_heatflux /= 0.0_wp ) THEN 1610 1610 message_string = 'boundary_condition: bc_pt_t = "' // TRIM( bc_pt_t ) //& 1611 1611 '" is not allowed with constant_top_heatflux = .TRUE.' … … 1639 1639 !-- forbidden. 1640 1640 IF ( ibc_sa_t == 0 .AND. constant_top_salinityflux .AND. & 1641 top_salinityflux /= 0.0 ) THEN1641 top_salinityflux /= 0.0_wp ) THEN 1642 1642 message_string = 'boundary condition: bc_sa_t = "' // & 1643 1643 TRIM( bc_sa_t ) // '" is not allowed with ' // & … … 1706 1706 CALL message( 'check_parameters', 'PA0073', 1, 2, 0, 6, 0 ) 1707 1707 ENDIF 1708 IF ( constant_waterflux .AND. q_surface_initial_change /= 0.0 ) THEN1708 IF ( constant_waterflux .AND. q_surface_initial_change /= 0.0_wp ) THEN 1709 1709 WRITE( message_string, * ) 'a prescribed surface flux is not allo', & 1710 1710 'wed with ', sq, '_surface_initial_change (/=0) = ', & … … 1747 1747 !-- Velocities for the initial u,v-profiles are set zero at the top 1748 1748 !-- in case of dirichlet_0 conditions 1749 u_init(nzt+1) = 0.0 1750 v_init(nzt+1) = 0.0 1749 u_init(nzt+1) = 0.0_wp 1750 v_init(nzt+1) = 0.0_wp 1751 1751 ENDIF 1752 1752 ELSEIF ( bc_uv_t == 'neumann' ) THEN … … 1761 1761 ! 1762 1762 !-- Compute and check, respectively, the Rayleigh Damping parameter 1763 IF ( rayleigh_damping_factor == -1.0 ) THEN1764 rayleigh_damping_factor = 0.0 1763 IF ( rayleigh_damping_factor == -1.0_wp ) THEN 1764 rayleigh_damping_factor = 0.0_wp 1765 1765 ELSE 1766 IF ( rayleigh_damping_factor < 0.0 .OR. rayleigh_damping_factor > 1.0 ) &1766 IF ( rayleigh_damping_factor < 0.0 .OR. rayleigh_damping_factor > 1.0_wp ) & 1767 1767 THEN 1768 1768 WRITE( message_string, * ) 'rayleigh_damping_factor = ', & … … 1772 1772 ENDIF 1773 1773 1774 IF ( rayleigh_damping_height == -1.0 ) THEN1774 IF ( rayleigh_damping_height == -1.0_wp ) THEN 1775 1775 IF ( .NOT. ocean ) THEN 1776 rayleigh_damping_height = 0.66666666666 * zu(nzt)1776 rayleigh_damping_height = 0.66666666666_wp * zu(nzt) 1777 1777 ELSE 1778 rayleigh_damping_height = 0.66666666666 * zu(nzb)1778 rayleigh_damping_height = 0.66666666666_wp * zu(nzb) 1779 1779 ENDIF 1780 1780 ELSE 1781 1781 IF ( .NOT. ocean ) THEN 1782 IF ( rayleigh_damping_height < 0.0 .OR. &1782 IF ( rayleigh_damping_height < 0.0_wp .OR. & 1783 1783 rayleigh_damping_height > zu(nzt) ) THEN 1784 1784 WRITE( message_string, * ) 'rayleigh_damping_height = ', & … … 1787 1787 ENDIF 1788 1788 ELSE 1789 IF ( rayleigh_damping_height > 0.0 .OR. &1789 IF ( rayleigh_damping_height > 0.0_wp .OR. & 1790 1790 rayleigh_damping_height < zu(nzb) ) THEN 1791 1791 WRITE( message_string, * ) 'rayleigh_damping_height = ', & … … 1816 1816 !-- Check the interval for sorting particles. 1817 1817 !-- Using particles as cloud droplets requires sorting after each timestep. 1818 IF ( dt_sort_particles /= 0.0 .AND. cloud_droplets ) THEN1819 dt_sort_particles = 0.0 1818 IF ( dt_sort_particles /= 0.0_wp .AND. cloud_droplets ) THEN 1819 dt_sort_particles = 0.0_wp 1820 1820 message_string = 'dt_sort_particles is reset to 0.0 because of cloud' //& 1821 1821 '_droplets = .TRUE.' … … 1899 1899 !-- value (tries to minimize the number of calls of flow_statistics) 1900 1900 IF ( dt_dots == 9999999.9_wp ) THEN 1901 IF ( averaging_interval_pr == 0.0 ) THEN1901 IF ( averaging_interval_pr == 0.0_wp ) THEN 1902 1902 dt_dots = MIN( dt_run_control, dt_dopr ) 1903 1903 ELSE … … 1983 1983 dopr_initial_index(i) = 7 1984 1984 hom(:,2,7,:) = SPREAD( zu, 2, statistic_regions+1 ) 1985 hom(nzb,2,7,:) = 0.0 ! because zu(nzb) is negative1985 hom(nzb,2,7,:) = 0.0_wp ! because zu(nzb) is negative 1986 1986 data_output_pr(i) = data_output_pr(i)(2:) 1987 1987 ENDIF … … 1993 1993 dopr_initial_index(i) = 28 1994 1994 hom(:,2,28,:) = SPREAD( zu, 2, statistic_regions+1 ) 1995 hom(nzb,2,28,:) = 0.0 ! because zu(nzb) is negative1995 hom(nzb,2,28,:) = 0.0_wp ! because zu(nzb) is negative 1996 1996 data_output_pr(i) = data_output_pr(i)(2:) 1997 1997 ENDIF … … 2002 2002 dopr_unit(i) = 'm2/s2' 2003 2003 hom(:,2,8,:) = SPREAD( zu, 2, statistic_regions+1 ) 2004 hom(nzb,2,8,:) = 0.0 2004 hom(nzb,2,8,:) = 0.0_wp 2005 2005 2006 2006 CASE ( 'km', '#km' ) … … 2008 2008 dopr_unit(i) = 'm2/s' 2009 2009 hom(:,2,9,:) = SPREAD( zu, 2, statistic_regions+1 ) 2010 hom(nzb,2,9,:) = 0.0 2010 hom(nzb,2,9,:) = 0.0_wp 2011 2011 IF ( data_output_pr(i)(1:1) == '#' ) THEN 2012 2012 dopr_initial_index(i) = 23 … … 2019 2019 dopr_unit(i) = 'm2/s' 2020 2020 hom(:,2,10,:) = SPREAD( zu, 2, statistic_regions+1 ) 2021 hom(nzb,2,10,:) = 0.0 2021 hom(nzb,2,10,:) = 0.0_wp 2022 2022 IF ( data_output_pr(i)(1:1) == '#' ) THEN 2023 2023 dopr_initial_index(i) = 24 … … 2030 2030 dopr_unit(i) = 'm' 2031 2031 hom(:,2,11,:) = SPREAD( zu, 2, statistic_regions+1 ) 2032 hom(nzb,2,11,:) = 0.0 2032 hom(nzb,2,11,:) = 0.0_wp 2033 2033 IF ( data_output_pr(i)(1:1) == '#' ) THEN 2034 2034 dopr_initial_index(i) = 25 … … 2109 2109 dopr_initial_index(i) = 26 2110 2110 hom(:,2,26,:) = SPREAD( zu, 2, statistic_regions+1 ) 2111 hom(nzb,2,26,:) = 0.0 ! weil zu(nzb) negativ ist2111 hom(nzb,2,26,:) = 0.0_wp ! because zu(nzb) is negative 2112 2112 data_output_pr(i) = data_output_pr(i)(2:) 2113 2113 ENDIF … … 2182 2182 dopr_initial_index(i) = 26 2183 2183 hom(:,2,26,:) = SPREAD( zu, 2, statistic_regions+1 ) 2184 hom(nzb,2,26,:) = 0.0 ! weil zu(nzb) negativ ist2184 hom(nzb,2,26,:) = 0.0_wp ! because zu(nzb) is negative 2185 2185 data_output_pr(i) = data_output_pr(i)(2:) 2186 2186 ENDIF … … 2200 2200 dopr_initial_index(i) = 26 2201 2201 hom(:,2,26,:) = SPREAD( zu, 2, statistic_regions+1 ) 2202 hom(nzb,2,26,:) = 0.0 ! weil zu(nzb) negativ ist2202 hom(nzb,2,26,:) = 0.0_wp ! because zu(nzb) is negative 2203 2203 data_output_pr(i) = data_output_pr(i)(2:) 2204 2204 ENDIF … … 2213 2213 dopr_initial_index(i) = 26 2214 2214 hom(:,2,26,:) = SPREAD( zu, 2, statistic_regions+1 ) 2215 hom(nzb,2,26,:) = 0.0 ! weil zu(nzb) negativ ist2215 hom(nzb,2,26,:) = 0.0_wp ! because zu(nzb) is negative 2216 2216 data_output_pr(i) = data_output_pr(i)(2:) 2217 2217 ENDIF … … 2223 2223 dopr_initial_index(i) = 27 2224 2224 hom(:,2,27,:) = SPREAD( zu, 2, statistic_regions+1 ) 2225 hom(nzb,2,27,:) = 0.0 ! weil zu(nzb) negativ ist2225 hom(nzb,2,27,:) = 0.0_wp ! because zu(nzb) is negative 2226 2226 data_output_pr(i) = data_output_pr(i)(2:) 2227 2227 ENDIF … … 2241 2241 dopr_initial_index(i) = 7 2242 2242 hom(:,2,7,:) = SPREAD( zu, 2, statistic_regions+1 ) 2243 hom(nzb,2,7,:) = 0.0 ! weil zu(nzb) negativ ist2243 hom(nzb,2,7,:) = 0.0_wp ! because zu(nzb) is negative 2244 2244 data_output_pr(i) = data_output_pr(i)(2:) 2245 2245 ENDIF … … 2253 2253 dopr_initial_index(i) = 29 2254 2254 hom(:,2,29,:) = SPREAD( zu, 2, statistic_regions+1 ) 2255 hom(nzb,2,29,:) = 0.0 ! weil zu(nzb) negativ ist2255 hom(nzb,2,29,:) = 0.0_wp ! because zu(nzb) is negative 2256 2256 data_output_pr(i) = data_output_pr(i)(2:) 2257 2257 ENDIF … … 2470 2470 dopr_initial_index(i) = 77 2471 2471 hom(:,2,77,:) = SPREAD( zu, 2, statistic_regions+1 ) 2472 hom(nzb,2,77,:) = 0.0 ! because zu(nzb) is negative2472 hom(nzb,2,77,:) = 0.0_wp ! because zu(nzb) is negative 2473 2473 data_output_pr(i) = data_output_pr(i)(2:) 2474 2474 ENDIF … … 2977 2977 ! 2978 2978 !-- Averaged 2d or 3d output requires that an averaging interval has been set 2979 IF ( doav_n > 0 .AND. averaging_interval == 0.0 ) THEN2979 IF ( doav_n > 0 .AND. averaging_interval == 0.0_wp ) THEN 2980 2980 WRITE( message_string, * ) 'output of averaged quantity "', & 2981 2981 TRIM( doav(1) ), '_av" requires to set a ', & … … 3004 3004 ! 3005 3005 !-- Upper plot limit for 2D vertical sections 3006 IF ( z_max_do2d == -1.0 ) z_max_do2d = zu(nzt)3006 IF ( z_max_do2d == -1.0_wp ) z_max_do2d = zu(nzt) 3007 3007 IF ( z_max_do2d < zu(nzb+1) .OR. z_max_do2d > zu(nzt) ) THEN 3008 3008 WRITE( message_string, * ) 'z_max_do2d = ', z_max_do2d, & … … 3066 3066 mask_scale(2) = mask_scale_y 3067 3067 mask_scale(3) = mask_scale_z 3068 IF ( ANY( mask_scale <= 0.0 ) ) THEN3068 IF ( ANY( mask_scale <= 0.0_wp ) ) THEN 3069 3069 WRITE( message_string, * ) & 3070 3070 'illegal value: mask_scale_x, mask_scale_y and mask_scale_z', & … … 3151 3151 ! 3152 3152 !-- Check, whether a constant diffusion coefficient shall be used 3153 IF ( km_constant /= -1.0 ) THEN3154 IF ( km_constant < 0.0 ) THEN3153 IF ( km_constant /= -1.0_wp ) THEN 3154 IF ( km_constant < 0.0_wp ) THEN 3155 3155 WRITE( message_string, * ) 'km_constant = ', km_constant, ' < 0.0' 3156 3156 CALL message( 'check_parameters', 'PA0121', 1, 2, 0, 6, 0 ) 3157 3157 ELSE 3158 IF ( prandtl_number < 0.0 ) THEN3158 IF ( prandtl_number < 0.0_wp ) THEN 3159 3159 WRITE( message_string, * ) 'prandtl_number = ', prandtl_number, & 3160 3160 ' < 0.0' … … 3175 3175 !-- potential temperature, check the width of the damping layer 3176 3176 IF ( bc_lr /= 'cyclic' ) THEN 3177 IF ( pt_damping_width < 0.0 .OR. pt_damping_width > REAL( nx * dx ) ) THEN3177 IF ( pt_damping_width < 0.0_wp .OR. pt_damping_width > REAL( nx * dx ) ) THEN 3178 3178 message_string = 'pt_damping_width out of range' 3179 3179 CALL message( 'check_parameters', 'PA0124', 1, 2, 0, 6, 0 ) … … 3182 3182 3183 3183 IF ( bc_ns /= 'cyclic' ) THEN 3184 IF ( pt_damping_width < 0.0 .OR. pt_damping_width > REAL( ny * dy ) ) THEN3184 IF ( pt_damping_width < 0.0_wp .OR. pt_damping_width > REAL( ny * dy ) ) THEN 3185 3185 message_string = 'pt_damping_width out of range' 3186 3186 CALL message( 'check_parameters', 'PA0124', 1, 2, 0, 6, 0 ) … … 3343 3343 ! 3344 3344 !-- Set the default value for the width of the recycling domain 3345 recycling_width = 0.1 * nx * dx3345 recycling_width = 0.1_wp * nx * dx 3346 3346 ELSE 3347 3347 IF ( recycling_width < dx .OR. recycling_width > nx * dx ) THEN … … 3368 3368 !-- Determine damping level index for 1D model 3369 3369 IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 ) THEN 3370 IF ( damp_level_1d == -1.0 ) THEN3370 IF ( damp_level_1d == -1.0_wp ) THEN 3371 3371 damp_level_1d = zu(nzt+1) 3372 3372 damp_level_ind_1d = nzt + 1 3373 ELSEIF ( damp_level_1d < 0.0 .OR. damp_level_1d > zu(nzt+1) ) THEN3373 ELSEIF ( damp_level_1d < 0.0_wp .OR. damp_level_1d > zu(nzt+1) ) THEN 3374 3374 WRITE( message_string, * ) 'damp_level_1d = ', damp_level_1d, & 3375 3375 ' must be > 0.0 and < ', zu(nzt+1), '(zu(nzt+1))' … … 3416 3416 ! 3417 3417 !-- Set default value of the time needed to terminate a model run 3418 IF ( termination_time_needed == -1.0 ) THEN3418 IF ( termination_time_needed == -1.0_wp ) THEN 3419 3419 IF ( host(1:3) == 'ibm' ) THEN 3420 termination_time_needed = 300.0 3420 termination_time_needed = 300.0_wp 3421 3421 ELSE 3422 termination_time_needed = 35.0 3422 termination_time_needed = 35.0_wp 3423 3423 ENDIF 3424 3424 ENDIF … … 3430 3430 !-- Time needed must be at least 30 seconds on all CRAY machines, because 3431 3431 !-- MPP_TREMAIN gives the remaining CPU time only in steps of 30 seconds 3432 IF ( termination_time_needed <= 30.0 ) THEN3432 IF ( termination_time_needed <= 30.0_wp ) THEN 3433 3433 WRITE( message_string, * ) 'termination_time_needed = ', & 3434 3434 termination_time_needed, ' must be > 30.0 on host "', & … … 3441 3441 !-- because the job time consumed before executing palm (for compiling, 3442 3442 !-- copying of files, etc.) has to be regarded 3443 IF ( termination_time_needed < 300.0 ) THEN3443 IF ( termination_time_needed < 300.0_wp ) THEN 3444 3444 WRITE( message_string, * ) 'termination_time_needed = ', & 3445 3445 termination_time_needed, ' should be >= 300.0 on host "', & … … 3462 3462 CALL message( 'check_parameters', 'PA0151', 1, 2, 0, 6, 0 ) 3463 3463 ENDIF 3464 IF ( .NOT. ANY( dpdxy /= 0.0 ) ) THEN3464 IF ( .NOT. ANY( dpdxy /= 0.0_wp ) ) THEN 3465 3465 WRITE( message_string, * ) 'dp_external is .TRUE. but dpdxy is ze', & 3466 3466 'ro, i.e. the external pressure gradient & will not be applied' … … 3468 3468 ENDIF 3469 3469 ENDIF 3470 IF ( ANY( dpdxy /= 0.0 ) .AND. .NOT. dp_external ) THEN3470 IF ( ANY( dpdxy /= 0.0_wp ) .AND. .NOT. dp_external ) THEN 3471 3471 WRITE( message_string, * ) 'dpdxy is nonzero but dp_external is ', & 3472 3472 '.FALSE., i.e. the external pressure gradient & will not be applied' … … 3499 3499 ENDIF 3500 3500 ENDIF 3501 IF ( ( u_bulk /= 0.0 .OR. v_bulk /= 0.0) .AND. &3501 IF ( ( u_bulk /= 0.0_wp .OR. v_bulk /= 0.0_wp ) .AND. & 3502 3502 ( .NOT. conserve_volume_flow .OR. & 3503 3503 TRIM( conserve_volume_flow_mode ) /= 'bulk_velocity' ) ) THEN
Note: See TracChangeset
for help on using the changeset viewer.
