Changeset 1322
- Timestamp:
- Mar 20, 2014 4:38:49 PM (11 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 43 edited
-
Makefile (modified) (1 diff)
-
advec_ws.f90 (modified) (12 diffs)
-
average_3d_data.f90 (modified) (31 diffs)
-
calc_radiation.f90 (modified) (7 diffs)
-
check_parameters.f90 (modified) (30 diffs)
-
cpulog.f90 (modified) (3 diffs)
-
data_output_profiles.f90 (modified) (2 diffs)
-
data_output_spectra.f90 (modified) (2 diffs)
-
diffusion_w.f90 (modified) (10 diffs)
-
diffusivities.f90 (modified) (3 diffs)
-
disturb_field.f90 (modified) (5 diffs)
-
disturb_heatflux.f90 (modified) (2 diffs)
-
fft_xy.f90 (modified) (18 diffs)
-
flow_statistics.f90 (modified) (3 diffs)
-
header.f90 (modified) (14 diffs)
-
init_1d_model.f90 (modified) (2 diffs)
-
init_3d_model.f90 (modified) (7 diffs)
-
init_advec.f90 (modified) (2 diffs)
-
init_cloud_physics.f90 (modified) (3 diffs)
-
init_dvrp.f90 (modified) (2 diffs)
-
init_grid.f90 (modified) (10 diffs)
-
init_ocean.f90 (modified) (2 diffs)
-
init_pegrid.f90 (modified) (2 diffs)
-
init_pt_anomaly.f90 (modified) (2 diffs)
-
init_rankine.f90 (modified) (7 diffs)
-
init_slope.f90 (modified) (3 diffs)
-
local_tremain.f90 (modified) (3 diffs)
-
local_tremain_ini.f90 (modified) (2 diffs)
-
lpm_advec.f90 (modified) (10 diffs)
-
lpm_collision_kernels.f90 (modified) (16 diffs)
-
lpm_droplet_collision.f90 (modified) (11 diffs)
-
lpm_droplet_condensation.f90 (modified) (2 diffs)
-
lpm_init.f90 (modified) (2 diffs)
-
microphysics.f90 (modified) (11 diffs)
-
netcdf.f90 (modified) (3 diffs)
-
poismg.f90 (modified) (4 diffs)
-
read_var_list.f90 (modified) (2 diffs)
-
surface_coupler.f90 (modified) (3 diffs)
-
temperton_fft.f90 (modified) (3 diffs)
-
timestep.f90 (modified) (3 diffs)
-
timestep_scheme_steering.f90 (modified) (4 diffs)
-
tridia_solver.f90 (modified) (3 diffs)
-
user_3d_data_averaging.f90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/Makefile
r1321 r1322 269 269 diffusivities.o: modules.o mod_kinds.o 270 270 disturb_field.o: modules.o cpulog.o mod_kinds.o random_function.o 271 disturb_heatflux.o: modules.o mod_kinds.o271 disturb_heatflux.o: modules.o cpulog.o mod_kinds.o 272 272 eqn_state_seawater.o: modules.o mod_kinds.o 273 273 exchange_horiz.o: modules.o cpulog.o mod_kinds.o -
palm/trunk/SOURCE/advec_ws.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! REAL constants defined as wp-kind 23 23 ! 24 24 ! Former revisions: … … 195 195 ! 196 196 !-- Set the appropriate factors for scalar and momentum advection. 197 adv_sca_5 = 1. /60.198 adv_sca_3 = 1. /12.199 adv_sca_1 = 1. /2.200 adv_mom_5 = 1. /120.201 adv_mom_3 = 1. /24.202 adv_mom_1 = 1. /4.197 adv_sca_5 = 1.0_wp / 60.0_wp 198 adv_sca_3 = 1.0_wp / 12.0_wp 199 adv_sca_1 = 1.0_wp / 2.0_wp 200 adv_mom_5 = 1.0_wp / 120.0_wp 201 adv_mom_3 = 1.0_wp / 24.0_wp 202 adv_mom_1 = 1.0_wp / 4.0_wp 203 203 ! 204 204 !-- Arrays needed for statical evaluation of fluxes. … … 1174 1174 + ( flux_r(k) * & 1175 1175 ( u_comp(k) - 2.0 * hom(k,1,1,0) ) & 1176 / ( u_comp(k) - gu + 1.0E-20 1176 / ( u_comp(k) - gu + 1.0E-20_wp ) & 1177 1177 + diss_r(k) * & 1178 1178 ABS( u_comp(k) - 2.0 * hom(k,1,1,0) ) & 1179 / ( ABS( u_comp(k) - gu ) + 1.0E-20 ) )&1179 / ( ABS( u_comp(k) - gu ) + 1.0E-20_wp ) ) & 1180 1180 * weight_substep(intermediate_timestep_count) 1181 1181 ! … … 1278 1278 + ( flux_r(k) * & 1279 1279 ( u_comp(k) - 2.0 * hom(k,1,1,0) ) & 1280 / ( u_comp(k) - gu + 1.0E-20 1280 / ( u_comp(k) - gu + 1.0E-20_wp ) & 1281 1281 + diss_r(k) * & 1282 1282 ABS( u_comp(k) - 2.0 * hom(k,1,1,0) ) & 1283 / ( ABS( u_comp(k) - gu ) + 1.0E-20 ) )&1283 / ( ABS( u_comp(k) - gu ) + 1.0E-20_wp ) ) & 1284 1284 * weight_substep(intermediate_timestep_count) 1285 1285 ! … … 1631 1631 + ( flux_n(k) & 1632 1632 * ( v_comp(k) - 2.0 * hom(k,1,2,0) ) & 1633 / ( v_comp(k) - gv + 1.0E-20 )&1633 / ( v_comp(k) - gv + 1.0E-20_wp ) & 1634 1634 + diss_n(k) & 1635 1635 * ABS( v_comp(k) - 2.0 * hom(k,1,2,0) ) & 1636 / ( ABS( v_comp(k) - gv ) +1.0E-20 ) )&1636 / ( ABS( v_comp(k) - gv ) +1.0E-20_wp ) ) & 1637 1637 * weight_substep(intermediate_timestep_count) 1638 1638 ! … … 1740 1740 + ( flux_n(k) & 1741 1741 * ( v_comp(k) - 2.0 * hom(k,1,2,0) ) & 1742 / ( v_comp(k) - gv + 1.0E-20 )&1742 / ( v_comp(k) - gv + 1.0E-20_wp ) & 1743 1743 + diss_n(k) & 1744 1744 * ABS( v_comp(k) - 2.0 * hom(k,1,2,0) ) & 1745 / ( ABS( v_comp(k) - gv ) +1.0E-20 ) )&1745 / ( ABS( v_comp(k) - gv ) +1.0E-20_wp ) ) & 1746 1746 * weight_substep(intermediate_timestep_count) 1747 1747 ! … … 3312 3312 + ( flux_r(k) * & 3313 3313 ( u_comp(k) - 2.0 * hom(k,1,1,0) ) & 3314 / ( u_comp(k) - gu + 1.0E-20 )&3314 / ( u_comp(k) - gu + 1.0E-20_wp ) & 3315 3315 + diss_r(k) * & 3316 3316 ABS( u_comp(k) - 2.0 * hom(k,1,1,0) ) & 3317 / ( ABS( u_comp(k) - gu ) + 1.0E-20 ) )&3317 / ( ABS( u_comp(k) - gu ) + 1.0E-20_wp ) ) & 3318 3318 * weight_substep(intermediate_timestep_count) 3319 3319 ! … … 3418 3418 + ( flux_r(k) * & 3419 3419 ( u_comp(k) - 2.0 * hom(k,1,1,0) ) & 3420 / ( u_comp(k) - gu + 1.0E-20 3420 / ( u_comp(k) - gu + 1.0E-20_wp ) & 3421 3421 + diss_r(k) * & 3422 3422 ABS( u_comp(k) - 2.0 * hom(k,1,1,0) ) & 3423 / ( ABS( u_comp(k) - gu ) + 1.0E-20 ) )&3423 / ( ABS( u_comp(k) - gu ) + 1.0E-20_wp ) ) & 3424 3424 * weight_substep(intermediate_timestep_count) 3425 3425 ! … … 3749 3749 ! + ( flux_r * & 3750 3750 ! ( u_comp - 2.0 * hom(k,1,1,0) ) & 3751 ! / ( u_comp - gu + 1.0E-20 3751 ! / ( u_comp - gu + 1.0E-20_wp ) & 3752 3752 ! + diss_r * & 3753 3753 ! ABS( u_comp - 2.0 * hom(k,1,1,0) ) & 3754 ! / ( ABS( u_comp - gu ) + 1.0E-20 ) )&3754 ! / ( ABS( u_comp - gu ) + 1.0E-20_wp ) ) & 3755 3755 ! * weight_substep(intermediate_timestep_count) 3756 3756 ! … … 4108 4108 + ( flux_n(k) & 4109 4109 * ( v_comp(k) - 2.0 * hom(k,1,2,0) ) & 4110 / ( v_comp(k) - gv + 1.0E-20 )&4110 / ( v_comp(k) - gv + 1.0E-20_wp ) & 4111 4111 + diss_n(k) & 4112 4112 * ABS( v_comp(k) - 2.0 * hom(k,1,2,0) ) & 4113 / ( ABS( v_comp(k) - gv ) +1.0E-20 ) )&4113 / ( ABS( v_comp(k) - gv ) +1.0E-20_wp ) ) & 4114 4114 * weight_substep(intermediate_timestep_count) 4115 4115 ! … … 4221 4221 + ( flux_n(k) & 4222 4222 * ( v_comp(k) - 2.0 * hom(k,1,2,0) ) & 4223 / ( v_comp(k) - gv + 1.0E-20 )&4223 / ( v_comp(k) - gv + 1.0E-20_wp ) & 4224 4224 + diss_n(k) & 4225 4225 * ABS( v_comp(k) - 2.0 * hom(k,1,2,0) ) & 4226 / ( ABS( v_comp(k) - gv ) +1.0E-20 ) )&4226 / ( ABS( v_comp(k) - gv ) +1.0E-20_wp ) ) & 4227 4227 * weight_substep(intermediate_timestep_count) 4228 4228 ! … … 4554 4554 ! + ( flux_n & 4555 4555 ! * ( v_comp - 2.0 * hom(k,1,2,0) ) & 4556 ! / ( v_comp - gv + 1.0E-20 )&4556 ! / ( v_comp - gv + 1.0E-20_wp ) & 4557 4557 ! + diss_n & 4558 4558 ! * ABS( v_comp - 2.0 * hom(k,1,2,0) ) & 4559 ! / ( ABS( v_comp - gv ) +1.0E-20 ) )&4559 ! / ( ABS( v_comp - gv ) +1.0E-20_wp ) ) & 4560 4560 ! * weight_substep(intermediate_timestep_count) 4561 4561 ! -
palm/trunk/SOURCE/average_3d_data.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! REAL functions provided with KIND-attribute 23 23 ! 24 24 ! Former revisions: … … 99 99 DO j = nysg, nyng 100 100 DO k = nzb, nzt+1 101 e_av(k,j,i) = e_av(k,j,i) / REAL( average_count_3d )101 e_av(k,j,i) = e_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 102 102 ENDDO 103 103 ENDDO … … 107 107 DO i = nxlg, nxrg 108 108 DO j = nysg, nyng 109 qsws_av(j,i) = qsws_av(j,i) / REAL( average_count_3d )109 qsws_av(j,i) = qsws_av(j,i) / REAL( average_count_3d, KIND=wp ) 110 110 ENDDO 111 111 ENDDO … … 115 115 DO j = nysg, nyng 116 116 DO k = nzb, nzt+1 117 lpt_av(k,j,i) = lpt_av(k,j,i) / REAL( average_count_3d )117 lpt_av(k,j,i) = lpt_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 118 118 ENDDO 119 119 ENDDO … … 123 123 DO i = nxlg, nxrg 124 124 DO j = nysg, nyng 125 lwp_av(j,i) = lwp_av(j,i) / REAL( average_count_3d )125 lwp_av(j,i) = lwp_av(j,i) / REAL( average_count_3d, KIND=wp ) 126 126 ENDDO 127 127 ENDDO … … 131 131 DO j = nysg, nyng 132 132 DO k = nzb, nzt+1 133 nr_av(k,j,i) = nr_av(k,j,i) / REAL( average_count_3d )133 nr_av(k,j,i) = nr_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 134 134 ENDDO 135 135 ENDDO … … 140 140 DO j = nysg, nyng 141 141 DO k = nzb, nzt+1 142 p_av(k,j,i) = p_av(k,j,i) / REAL( average_count_3d )142 p_av(k,j,i) = p_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 143 143 ENDDO 144 144 ENDDO … … 149 149 DO j = nys, nyn 150 150 DO k = nzb, nzt+1 151 pc_av(k,j,i) = pc_av(k,j,i) / REAL( average_count_3d )151 pc_av(k,j,i) = pc_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 152 152 ENDDO 153 153 ENDDO … … 158 158 DO j = nys, nyn 159 159 DO k = nzb, nzt+1 160 pr_av(k,j,i) = pr_av(k,j,i) / REAL( average_count_3d )160 pr_av(k,j,i) = pr_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 161 161 ENDDO 162 162 ENDDO … … 167 167 DO j = nysg, nyng 168 168 precipitation_rate_av(j,i) = precipitation_rate_av(j,i) / & 169 REAL( average_count_3d )169 REAL( average_count_3d, KIND=wp ) 170 170 ENDDO 171 171 ENDDO … … 175 175 DO j = nysg, nyng 176 176 DO k = nzb, nzt+1 177 pt_av(k,j,i) = pt_av(k,j,i) / REAL( average_count_3d )177 pt_av(k,j,i) = pt_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 178 178 ENDDO 179 179 ENDDO … … 184 184 DO j = nysg, nyng 185 185 DO k = nzb, nzt+1 186 q_av(k,j,i) = q_av(k,j,i) / REAL( average_count_3d )186 q_av(k,j,i) = q_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 187 187 ENDDO 188 188 ENDDO … … 193 193 DO j = nysg, nyng 194 194 DO k = nzb, nzt+1 195 qc_av(k,j,i) = qc_av(k,j,i) / REAL( average_count_3d )195 qc_av(k,j,i) = qc_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 196 196 ENDDO 197 197 ENDDO … … 202 202 DO j = nysg, nyng 203 203 DO k = nzb, nzt+1 204 ql_av(k,j,i) = ql_av(k,j,i) / REAL( average_count_3d )204 ql_av(k,j,i) = ql_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 205 205 ENDDO 206 206 ENDDO … … 211 211 DO j = nysg, nyng 212 212 DO k = nzb, nzt+1 213 ql_c_av(k,j,i) = ql_c_av(k,j,i) / REAL( average_count_3d )213 ql_c_av(k,j,i) = ql_c_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 214 214 ENDDO 215 215 ENDDO … … 220 220 DO j = nysg, nyng 221 221 DO k = nzb, nzt+1 222 ql_v_av(k,j,i) = ql_v_av(k,j,i) / REAL( average_count_3d )222 ql_v_av(k,j,i) = ql_v_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 223 223 ENDDO 224 224 ENDDO … … 230 230 DO k = nzb, nzt+1 231 231 ql_vp_av(k,j,i) = ql_vp_av(k,j,i) / & 232 REAL( average_count_3d )232 REAL( average_count_3d, KIND=wp ) 233 233 ENDDO 234 234 ENDDO … … 239 239 DO j = nysg, nyng 240 240 DO k = nzb, nzt+1 241 qr_av(k,j,i) = qr_av(k,j,i) / REAL( average_count_3d )241 qr_av(k,j,i) = qr_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 242 242 ENDDO 243 243 ENDDO … … 248 248 DO j = nysg, nyng 249 249 DO k = nzb, nzt+1 250 qv_av(k,j,i) = qv_av(k,j,i) / REAL( average_count_3d )250 qv_av(k,j,i) = qv_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 251 251 ENDDO 252 252 ENDDO … … 257 257 DO j = nysg, nyng 258 258 DO k = nzb, nzt+1 259 rho_av(k,j,i) = rho_av(k,j,i) / REAL( average_count_3d )259 rho_av(k,j,i) = rho_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 260 260 ENDDO 261 261 ENDDO … … 266 266 DO j = nysg, nyng 267 267 DO k = nzb, nzt+1 268 s_av(k,j,i) = s_av(k,j,i) / REAL( average_count_3d )268 s_av(k,j,i) = s_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 269 269 ENDDO 270 270 ENDDO … … 275 275 DO j = nysg, nyng 276 276 DO k = nzb, nzt+1 277 sa_av(k,j,i) = sa_av(k,j,i) / REAL( average_count_3d )277 sa_av(k,j,i) = sa_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 278 278 ENDDO 279 279 ENDDO … … 283 283 DO i = nxlg, nxrg 284 284 DO j = nysg, nyng 285 shf_av(j,i) = shf_av(j,i) / REAL( average_count_3d )285 shf_av(j,i) = shf_av(j,i) / REAL( average_count_3d, KIND=wp ) 286 286 ENDDO 287 287 ENDDO … … 290 290 DO i = nxlg, nxrg 291 291 DO j = nysg, nyng 292 ts_av(j,i) = ts_av(j,i) / REAL( average_count_3d )292 ts_av(j,i) = ts_av(j,i) / REAL( average_count_3d, KIND=wp ) 293 293 ENDDO 294 294 ENDDO … … 298 298 DO j = nysg, nyng 299 299 DO k = nzb, nzt+1 300 u_av(k,j,i) = u_av(k,j,i) / REAL( average_count_3d )300 u_av(k,j,i) = u_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 301 301 ENDDO 302 302 ENDDO … … 306 306 DO i = nxlg, nxrg 307 307 DO j = nysg, nyng 308 us_av(j,i) = us_av(j,i) / REAL( average_count_3d )308 us_av(j,i) = us_av(j,i) / REAL( average_count_3d, KIND=wp ) 309 309 ENDDO 310 310 ENDDO … … 314 314 DO j = nysg, nyng 315 315 DO k = nzb, nzt+1 316 v_av(k,j,i) = v_av(k,j,i) / REAL( average_count_3d )316 v_av(k,j,i) = v_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 317 317 ENDDO 318 318 ENDDO … … 323 323 DO j = nysg, nyng 324 324 DO k = nzb, nzt+1 325 vpt_av(k,j,i) = vpt_av(k,j,i) / REAL( average_count_3d )325 vpt_av(k,j,i) = vpt_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 326 326 ENDDO 327 327 ENDDO … … 332 332 DO j = nysg, nyng 333 333 DO k = nzb, nzt+1 334 w_av(k,j,i) = w_av(k,j,i) / REAL( average_count_3d )334 w_av(k,j,i) = w_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 335 335 ENDDO 336 336 ENDDO … … 340 340 DO i = nxlg, nxrg 341 341 DO j = nysg, nyng 342 z0_av(j,i) = z0_av(j,i) / REAL( average_count_3d )342 z0_av(j,i) = z0_av(j,i) / REAL( average_count_3d, KIND=wp ) 343 343 ENDDO 344 344 ENDDO … … 347 347 DO i = nxlg, nxrg 348 348 DO j = nysg, nyng 349 z0h_av(j,i) = z0h_av(j,i) / REAL( average_count_3d )349 z0h_av(j,i) = z0h_av(j,i) / REAL( average_count_3d, KIND=wp ) 350 350 ENDDO 351 351 ENDDO -
palm/trunk/SOURCE/calc_radiation.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! exponent 4.0 changed to integer 23 23 ! 24 24 ! Former revisions: … … 127 127 128 128 temperature = pt(nzb,j,i) * t_d_pt(nzb) + l_d_cp * ql(nzb,j,i) 129 blackbody_emission(nzb) = sigma * temperature**4 .0129 blackbody_emission(nzb) = sigma * temperature**4 130 130 131 131 DO k = nzb_2d(j,i)+1, nzt … … 139 139 140 140 temperature = pt(k,j,i) * t_d_pt(k) + l_d_cp * ql(k,j,i) 141 blackbody_emission(k) = sigma * temperature**4 .0141 blackbody_emission(k) = sigma * temperature**4 142 142 143 143 ENDDO … … 149 149 temperature = pt(nzt+1,j,i) * t_d_pt(nzt+1) + l_d_cp * & 150 150 ql(nzt+1,j,i) 151 blackbody_emission(nzt+1) = sigma * temperature**4 .0151 blackbody_emission(nzt+1) = sigma * temperature**4 152 152 153 153 ! … … 267 267 268 268 temperature = pt(nzb,j,i) * t_d_pt(nzb) + l_d_cp * ql(nzb,j,i) 269 blackbody_emission(nzb) = sigma * temperature**4 .0269 blackbody_emission(nzb) = sigma * temperature**4 270 270 271 271 DO k = nzb_2d(j,i)+1, nzt … … 277 277 278 278 temperature = pt(k,j,i) * t_d_pt(k) + l_d_cp * ql(k,j,i) 279 blackbody_emission(k) = sigma * temperature**4 .0279 blackbody_emission(k) = sigma * temperature**4 280 280 281 281 ENDDO … … 286 286 temperature = pt(nzt+1,j,i) * t_d_pt(nzt+1) + l_d_cp * & 287 287 ql(nzt+1,j,i) 288 blackbody_emission(nzt+1) = sigma * temperature**4 .0288 blackbody_emission(nzt+1) = sigma * temperature**4 289 289 290 290 ! -
palm/trunk/SOURCE/check_parameters.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! some REAL constants defined as wp-kind 23 23 ! 24 24 ! Former revisions: … … 259 259 IF ( coupling_mode /= 'uncoupled') THEN 260 260 261 IF ( dt_coupling == 9999999.9 ) THEN261 IF ( dt_coupling == 9999999.9_wp ) THEN 262 262 message_string = 'dt_coupling is not set but required for coup' // & 263 263 'ling mode "' // TRIM( coupling_mode ) // '"' … … 920 920 ! 921 921 !-- In case of no given gradients for ug, choose a zero gradient 922 IF ( ug_vertical_gradient_level(1) == -9999999.9 ) THEN922 IF ( ug_vertical_gradient_level(1) == -9999999.9_wp ) THEN 923 923 ug_vertical_gradient_level(1) = 0.0 924 924 ENDIF … … 984 984 ! 985 985 !-- In case of no given gradients for vg, choose a zero gradient 986 IF ( vg_vertical_gradient_level(1) == -9999999.9 ) THEN986 IF ( vg_vertical_gradient_level(1) == -9999999.9_wp ) THEN 987 987 vg_vertical_gradient_level(1) = 0.0 988 988 ENDIF … … 991 991 !-- Let the initial wind profiles be the calculated ug/vg profiles or 992 992 !-- interpolate them from wind profile data (if given) 993 IF ( u_profile(1) == 9999999.9 .AND. v_profile(1) == 9999999.9) THEN993 IF ( u_profile(1) == 9999999.9_wp .AND. v_profile(1) == 9999999.9_wp ) THEN 994 994 995 995 u_init = ug … … 1018 1018 ENDIF 1019 1019 1020 IF ( kk < 100 .AND. uv_heights(kk+1) /= 9999999.9 ) THEN1020 IF ( kk < 100 .AND. uv_heights(kk+1) /= 9999999.9_wp ) THEN 1021 1021 u_init(k) = u_profile(kk) + ( zu(k) - uv_heights(kk) ) / & 1022 1022 ( uv_heights(kk+1) - uv_heights(kk) ) * & … … 1100 1100 !-- In case of no given temperature gradients, choose gradient of neutral 1101 1101 !-- stratification 1102 IF ( pt_vertical_gradient_level(1) == -9999999.9 ) THEN1102 IF ( pt_vertical_gradient_level(1) == -9999999.9_wp ) THEN 1103 1103 pt_vertical_gradient_level(1) = 0.0 1104 1104 ENDIF … … 1236 1236 !-- In case of no given leaf area density gradients, choose a vanishing 1237 1237 !-- gradient 1238 IF ( lad_vertical_gradient_level(1) == -9999999.9 ) THEN1238 IF ( lad_vertical_gradient_level(1) == -9999999.9_wp ) THEN 1239 1239 lad_vertical_gradient_level(1) = 0.0 1240 1240 ENDIF … … 1247 1247 !-- Initialize large scale subsidence if required 1248 1248 If ( large_scale_subsidence ) THEN 1249 IF ( subs_vertical_gradient_level(1) /= -9999999.9 .AND. &1249 IF ( subs_vertical_gradient_level(1) /= -9999999.9_wp .AND. & 1250 1250 .NOT. large_scale_forcing ) THEN 1251 1251 CALL init_w_subsidence … … 1255 1255 !-- are read in from file LSF_DATA 1256 1256 1257 IF ( subs_vertical_gradient_level(1) == -9999999.9 .AND. &1257 IF ( subs_vertical_gradient_level(1) == -9999999.9_wp .AND. & 1258 1258 .NOT. large_scale_forcing ) THEN 1259 1259 message_string = 'There is no default large scale vertical ' // & … … 1264 1264 ENDIF 1265 1265 ELSE 1266 IF ( subs_vertical_gradient_level(1) /= -9999999.9 ) THEN1266 IF ( subs_vertical_gradient_level(1) /= -9999999.9_wp ) THEN 1267 1267 message_string = 'Enable usage of large scale subsidence by ' // & 1268 1268 'setting large_scale_subsidence = .T..' … … 1284 1284 ELSEIF ( reference_state == 'single_value' ) THEN 1285 1285 use_single_reference_value = .TRUE. 1286 IF ( pt_reference == 9999999.9 ) pt_reference = pt_surface1286 IF ( pt_reference == 9999999.9_wp ) pt_reference = pt_surface 1287 1287 vpt_reference = pt_reference * ( 1.0 + 0.61 * q_surface ) 1288 1288 ELSE … … 1528 1528 ENDIF 1529 1529 1530 IF ( surface_heatflux == 9999999.9 ) THEN1530 IF ( surface_heatflux == 9999999.9_wp ) THEN 1531 1531 constant_heatflux = .FALSE. 1532 1532 IF ( large_scale_forcing ) THEN … … 1548 1548 ENDIF 1549 1549 1550 IF ( top_heatflux == 9999999.9 ) constant_top_heatflux = .FALSE.1550 IF ( top_heatflux == 9999999.9_wp ) constant_top_heatflux = .FALSE. 1551 1551 1552 1552 IF ( neutral ) THEN 1553 1553 1554 IF ( surface_heatflux /= 0.0 .AND. surface_heatflux /= 9999999.9 ) &1554 IF ( surface_heatflux /= 0.0 .AND. surface_heatflux /= 9999999.9_wp ) & 1555 1555 THEN 1556 1556 message_string = 'heatflux must not be set for pure neutral flow' … … 1558 1558 ENDIF 1559 1559 1560 IF ( top_heatflux /= 0.0 .AND. top_heatflux /= 9999999.9 ) &1560 IF ( top_heatflux /= 0.0 .AND. top_heatflux /= 9999999.9_wp ) & 1561 1561 THEN 1562 1562 message_string = 'heatflux must not be set for pure neutral flow' … … 1566 1566 ENDIF 1567 1567 1568 IF ( top_momentumflux_u /= 9999999.9 .AND. &1569 top_momentumflux_v /= 9999999.9 ) THEN1568 IF ( top_momentumflux_u /= 9999999.9_wp .AND. & 1569 top_momentumflux_v /= 9999999.9_wp ) THEN 1570 1570 constant_top_momentumflux = .TRUE. 1571 ELSEIF ( .NOT. ( top_momentumflux_u == 9999999.9 .AND. &1572 top_momentumflux_v == 9999999.9 ) ) THEN1571 ELSEIF ( .NOT. ( top_momentumflux_u == 9999999.9_wp .AND. & 1572 top_momentumflux_v == 9999999.9_wp ) ) THEN 1573 1573 message_string = 'both, top_momentumflux_u AND top_momentumflux_v ' // & 1574 1574 'must be set' … … 1617 1617 ENDIF 1618 1618 1619 IF ( top_salinityflux == 9999999.9 ) constant_top_salinityflux = .FALSE.1620 IF ( ibc_sa_t == 1 .AND. top_salinityflux == 9999999.9 ) THEN1619 IF ( top_salinityflux == 9999999.9_wp ) constant_top_salinityflux = .FALSE. 1620 IF ( ibc_sa_t == 1 .AND. top_salinityflux == 9999999.9_wp ) THEN 1621 1621 message_string = 'boundary condition: bc_sa_t = "' // & 1622 1622 TRIM( bc_sa_t ) // '" requires to set ' // & … … 1667 1667 ENDIF 1668 1668 1669 IF ( surface_waterflux == 9999999.9 ) THEN1669 IF ( surface_waterflux == 9999999.9_wp ) THEN 1670 1670 constant_waterflux = .FALSE. 1671 1671 IF ( large_scale_forcing ) THEN … … 1817 1817 !-- Set the default intervals for data output, if necessary 1818 1818 !-- NOTE: dt_dosp has already been set in package_parin 1819 IF ( dt_data_output /= 9999999.9 ) THEN1820 IF ( dt_dopr == 9999999.9 ) dt_dopr = dt_data_output1821 IF ( dt_dopts == 9999999.9 ) dt_dopts = dt_data_output1822 IF ( dt_do2d_xy == 9999999.9 ) dt_do2d_xy = dt_data_output1823 IF ( dt_do2d_xz == 9999999.9 ) dt_do2d_xz = dt_data_output1824 IF ( dt_do2d_yz == 9999999.9 ) dt_do2d_yz = dt_data_output1825 IF ( dt_do3d == 9999999.9 ) dt_do3d = dt_data_output1826 IF ( dt_data_output_av == 9999999.9 ) dt_data_output_av = dt_data_output1819 IF ( dt_data_output /= 9999999.9_wp ) THEN 1820 IF ( dt_dopr == 9999999.9_wp ) dt_dopr = dt_data_output 1821 IF ( dt_dopts == 9999999.9_wp ) dt_dopts = dt_data_output 1822 IF ( dt_do2d_xy == 9999999.9_wp ) dt_do2d_xy = dt_data_output 1823 IF ( dt_do2d_xz == 9999999.9_wp ) dt_do2d_xz = dt_data_output 1824 IF ( dt_do2d_yz == 9999999.9_wp ) dt_do2d_yz = dt_data_output 1825 IF ( dt_do3d == 9999999.9_wp ) dt_do3d = dt_data_output 1826 IF ( dt_data_output_av == 9999999.9_wp ) dt_data_output_av = dt_data_output 1827 1827 DO mid = 1, max_masks 1828 IF ( dt_domask(mid) == 9999999.9 ) dt_domask(mid) = dt_data_output1828 IF ( dt_domask(mid) == 9999999.9_wp ) dt_domask(mid) = dt_data_output 1829 1829 ENDDO 1830 1830 ENDIF … … 1832 1832 ! 1833 1833 !-- Set the default skip time intervals for data output, if necessary 1834 IF ( skip_time_dopr == 9999999.9 ) &1834 IF ( skip_time_dopr == 9999999.9_wp ) & 1835 1835 skip_time_dopr = skip_time_data_output 1836 IF ( skip_time_dosp == 9999999.9 ) &1836 IF ( skip_time_dosp == 9999999.9_wp ) & 1837 1837 skip_time_dosp = skip_time_data_output 1838 IF ( skip_time_do2d_xy == 9999999.9 ) &1838 IF ( skip_time_do2d_xy == 9999999.9_wp ) & 1839 1839 skip_time_do2d_xy = skip_time_data_output 1840 IF ( skip_time_do2d_xz == 9999999.9 ) &1840 IF ( skip_time_do2d_xz == 9999999.9_wp ) & 1841 1841 skip_time_do2d_xz = skip_time_data_output 1842 IF ( skip_time_do2d_yz == 9999999.9 ) &1842 IF ( skip_time_do2d_yz == 9999999.9_wp ) & 1843 1843 skip_time_do2d_yz = skip_time_data_output 1844 IF ( skip_time_do3d == 9999999.9 ) &1844 IF ( skip_time_do3d == 9999999.9_wp ) & 1845 1845 skip_time_do3d = skip_time_data_output 1846 IF ( skip_time_data_output_av == 9999999.9 ) &1846 IF ( skip_time_data_output_av == 9999999.9_wp ) & 1847 1847 skip_time_data_output_av = skip_time_data_output 1848 1848 DO mid = 1, max_masks 1849 IF ( skip_time_domask(mid) == 9999999.9 ) &1849 IF ( skip_time_domask(mid) == 9999999.9_wp ) & 1850 1850 skip_time_domask(mid) = skip_time_data_output 1851 1851 ENDDO … … 1860 1860 ENDIF 1861 1861 1862 IF ( averaging_interval_pr == 9999999.9 ) THEN1862 IF ( averaging_interval_pr == 9999999.9_wp ) THEN 1863 1863 averaging_interval_pr = averaging_interval 1864 1864 ENDIF … … 1870 1870 ENDIF 1871 1871 1872 IF ( averaging_interval_sp == 9999999.9 ) THEN1872 IF ( averaging_interval_sp == 9999999.9_wp ) THEN 1873 1873 averaging_interval_sp = averaging_interval 1874 1874 ENDIF … … 1882 1882 ! 1883 1883 !-- Set the default interval for profiles entering the temporal average 1884 IF ( dt_averaging_input_pr == 9999999.9 ) THEN1884 IF ( dt_averaging_input_pr == 9999999.9_wp ) THEN 1885 1885 dt_averaging_input_pr = dt_averaging_input 1886 1886 ENDIF … … 1889 1889 !-- Set the default interval for the output of timeseries to a reasonable 1890 1890 !-- value (tries to minimize the number of calls of flow_statistics) 1891 IF ( dt_dots == 9999999.9 ) THEN1891 IF ( dt_dots == 9999999.9_wp ) THEN 1892 1892 IF ( averaging_interval_pr == 0.0 ) THEN 1893 1893 dt_dots = MIN( dt_run_control, dt_dopr ) … … 1916 1916 !-- Set the default value for the integration interval of precipitation amount 1917 1917 IF ( precipitation ) THEN 1918 IF ( precipitation_amount_interval == 9999999.9 ) THEN1918 IF ( precipitation_amount_interval == 9999999.9_wp ) THEN 1919 1919 precipitation_amount_interval = dt_do2d_xy 1920 1920 ELSE … … 3277 3277 ! 3278 3278 !-- Determine upper and lower hight level indices for random perturbations 3279 IF ( disturbance_level_b == -9999999.9 ) THEN3279 IF ( disturbance_level_b == -9999999.9_wp ) THEN 3280 3280 IF ( ocean ) THEN 3281 3281 disturbance_level_b = zu((nzt*2)/3) … … 3302 3302 ENDIF 3303 3303 3304 IF ( disturbance_level_t == -9999999.9 ) THEN3304 IF ( disturbance_level_t == -9999999.9_wp ) THEN 3305 3305 IF ( ocean ) THEN 3306 3306 disturbance_level_t = zu(nzt-3) … … 3419 3419 !-- In case of turbulent inflow calculate the index of the recycling plane 3420 3420 IF ( turbulent_inflow ) THEN 3421 IF ( recycling_width == 9999999.9 ) THEN3421 IF ( recycling_width == 9999999.9_wp ) THEN 3422 3422 ! 3423 3423 !-- Set the default value for the width of the recycling domain … … 3482 3482 !-- Set time for the next user defined restart (time_restart is the 3483 3483 !-- internal parameter for steering restart events) 3484 IF ( restart_time /= 9999999.9 ) THEN3484 IF ( restart_time /= 9999999.9_wp ) THEN 3485 3485 IF ( restart_time > time_since_reference_point ) THEN 3486 3486 time_restart = restart_time … … 3490 3490 !-- In case of a restart run, set internal parameter to default (no restart) 3491 3491 !-- if the NAMELIST-parameter restart_time is omitted 3492 time_restart = 9999999.9 3492 time_restart = 9999999.9_wp 3493 3493 ENDIF 3494 3494 -
palm/trunk/SOURCE/cpulog.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! REAL functions provided with KIND-attribute 23 23 ! 24 24 ! Former revisions: … … 165 165 #if defined( __lc ) || defined( __decalpha ) || defined( __nec ) 166 166 CALL SYSTEM_CLOCK( count, count_rate ) 167 mtime = REAL( count ) / REAL( count_rate)167 mtime = REAL( count, KIND=wp ) / REAL( count_rate, KIND=wp ) 168 168 #elif defined( __ibm ) 169 mtime = IRTC( ) * 1E-9 169 mtime = IRTC( ) * 1E-9_wp 170 170 #else 171 171 message_string = 'no time measurement defined on this host' … … 322 322 !-- Get total time in order to calculate CPU-time per gridpoint and timestep 323 323 IF ( nr_timesteps_this_run /= 0 ) THEN 324 average_cputime = log_point(1)%sum / REAL( (nx+1) * (ny+1) * nz ) / &325 REAL( nr_timesteps_this_run ) * 1E6! in micro-sec324 average_cputime = log_point(1)%sum / REAL( (nx+1) * (ny+1) * nz, KIND=wp ) / & 325 REAL( nr_timesteps_this_run, KIND=wp ) * 1E6_wp ! in micro-sec 326 326 ELSE 327 327 average_cputime = -1.0 -
palm/trunk/SOURCE/data_output_profiles.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! REAL functions provided with KIND-attribute 23 23 ! 24 24 ! Former revisions: … … 102 102 ELSE 103 103 IF ( average_count_pr > 0 ) THEN 104 hom_sum = hom_sum / REAL( average_count_pr )104 hom_sum = hom_sum / REAL( average_count_pr, KIND=wp ) 105 105 ELSE 106 106 ! -
palm/trunk/SOURCE/data_output_spectra.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! REAL functions provided with KIND-attribute 23 23 ! 24 24 ! Former revisions: … … 113 113 ENDIF 114 114 IF ( average_count_sp /= 1 ) THEN 115 spectrum_x = spectrum_x / REAL( average_count_sp )116 spectrum_y = spectrum_y / REAL( average_count_sp )115 spectrum_x = spectrum_x / REAL( average_count_sp, KIND=wp ) 116 spectrum_y = spectrum_y / REAL( average_count_sp, KIND=wp ) 117 117 average_count_sp = 0 118 118 ENDIF -
palm/trunk/SOURCE/diffusion_w.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! REAL constants defined as wp-kind 23 23 ! 24 24 ! Former revisions: … … 132 132 ! 133 133 !-- Interpolate eddy diffusivities on staggered gridpoints 134 kmxp = 0.25 *&134 kmxp = 0.25_wp * & 135 135 ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) ) 136 kmxm = 0.25 *&136 kmxm = 0.25_wp * & 137 137 ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) ) 138 kmyp = 0.25 *&138 kmyp = 0.25_wp * & 139 139 ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) ) 140 kmym = 0.25 *&140 kmym = 0.25_wp * & 141 141 ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) ) 142 142 … … 152 152 & - kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) & 153 153 & ) * ddy & 154 & + 2.0 * (&154 & + 2.0_wp * ( & 155 155 & km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) & 156 156 & - km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) & … … 165 165 ! 166 166 !-- Interpolate eddy diffusivities on staggered gridpoints 167 kmxp = 0.25 *&167 kmxp = 0.25_wp * & 168 168 ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) ) 169 kmxm = 0.25 *&169 kmxm = 0.25_wp * & 170 170 ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) ) 171 kmyp = 0.25 *&171 kmyp = 0.25_wp * & 172 172 ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) ) 173 kmym = 0.25 *&173 kmym = 0.25_wp * & 174 174 ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) ) 175 175 … … 262 262 ! 263 263 !-- Interpolate eddy diffusivities on staggered gridpoints 264 kmxp = 0.25 *&264 kmxp = 0.25_wp * & 265 265 ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) ) 266 kmxm = 0.25 *&266 kmxm = 0.25_wp * & 267 267 ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) ) 268 kmyp = 0.25 *&268 kmyp = 0.25_wp * & 269 269 ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) ) 270 kmym = 0.25 *&270 kmym = 0.25_wp * & 271 271 ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) ) 272 272 … … 282 282 & - kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) & 283 283 & ) * ddy & 284 & + 2.0 * (&284 & + 2.0_wp * ( & 285 285 & km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) & 286 286 & - km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) & … … 297 297 ! 298 298 !-- Interpolate eddy diffusivities on staggered gridpoints 299 kmxp = 0.25 *&299 kmxp = 0.25_wp * & 300 300 ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) ) 301 kmxm = 0.25 *&301 kmxm = 0.25_wp * & 302 302 ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) ) 303 kmyp = 0.25 *&303 kmyp = 0.25_wp * & 304 304 ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) ) 305 kmym = 0.25 *&305 kmym = 0.25_wp * & 306 306 ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) ) 307 307 … … 378 378 ! 379 379 !-- Interpolate eddy diffusivities on staggered gridpoints 380 kmxp = 0.25 * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )381 kmxm = 0.25 * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )382 kmyp = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )383 kmym = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )380 kmxp = 0.25_wp * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) ) 381 kmxm = 0.25_wp * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) ) 382 kmyp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) ) 383 kmym = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) ) 384 384 385 385 tend(k,j,i) = tend(k,j,i) & … … 394 394 & - kmym * ( v(k+1,j,i) - v(k,j,i) ) * ddzu(k+1) & 395 395 & ) * ddy & 396 & + 2.0 * (&396 & + 2.0_wp * ( & 397 397 & km(k+1,j,i) * ( w(k+1,j,i) - w(k,j,i) ) * ddzw(k+1) & 398 398 & - km(k,j,i) * ( w(k,j,i) - w(k-1,j,i) ) * ddzw(k) & … … 423 423 ! 424 424 !-- Interpolate eddy diffusivities on staggered gridpoints 425 kmxp = 0.25 * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) )426 kmxm = 0.25 * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) )427 kmyp = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) )428 kmym = 0.25 * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) )425 kmxp = 0.25_wp * ( km(k,j,i)+km(k,j,i+1)+km(k+1,j,i)+km(k+1,j,i+1) ) 426 kmxm = 0.25_wp * ( km(k,j,i)+km(k,j,i-1)+km(k+1,j,i)+km(k+1,j,i-1) ) 427 kmyp = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j+1,i)+km(k+1,j+1,i) ) 428 kmym = 0.25_wp * ( km(k,j,i)+km(k+1,j,i)+km(k,j-1,i)+km(k+1,j-1,i) ) 429 429 430 430 tend(k,j,i) = tend(k,j,i) & -
palm/trunk/SOURCE/diffusivities.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! REAL constants defined as wp-kind 23 23 ! 24 24 ! Former revisions: … … 141 141 IF ( dvar_dz > 0.0 ) THEN 142 142 IF ( use_single_reference_value ) THEN 143 l_stable = 0.76 * sqrt_e /&144 SQRT( g / var_reference * dvar_dz ) + 1E-5 143 l_stable = 0.76_wp * sqrt_e / & 144 SQRT( g / var_reference * dvar_dz ) + 1E-5_wp 145 145 ELSE 146 l_stable = 0.76 * sqrt_e /&147 SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5 146 l_stable = 0.76_wp * sqrt_e / & 147 SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp 148 148 ENDIF 149 149 ELSE … … 162 162 ! 163 163 !-- Compute diffusion coefficients for momentum and heat 164 km(k,j,i) = 0.1 * l * sqrt_e165 kh(k,j,i) = ( 1.0 + 2.0* l / ll ) * km(k,j,i)164 km(k,j,i) = 0.1_wp * l * sqrt_e 165 kh(k,j,i) = ( 1.0_wp + 2.0_wp * l / ll ) * km(k,j,i) 166 166 167 167 ENDIF -
palm/trunk/SOURCE/disturb_field.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! REAL constants defined as wp-kind 23 23 ! 24 24 ! Former revisions: … … 98 98 DO j = dist_nys(dist_range), dist_nyn(dist_range) 99 99 DO k = disturbance_level_ind_b, disturbance_level_ind_t 100 randomnumber = 3.0 * disturbance_amplitude *&101 ( random_function( iran ) - 0.5 )100 randomnumber = 3.0_wp * disturbance_amplitude * & 101 ( random_function( iran ) - 0.5_wp ) 102 102 IF ( nxl <= i .AND. nxr >= i .AND. nys <= j .AND. & 103 103 nyn >= j ) & … … 113 113 DO k = disturbance_level_ind_b, disturbance_level_ind_t 114 114 #if defined( __nec ) 115 randomnumber = 3.0 * disturbance_amplitude *&116 ( RANDOM( 0 ) - 0.5 )115 randomnumber = 3.0_wp * disturbance_amplitude * & 116 ( RANDOM( 0 ) - 0.5_wp ) 117 117 #else 118 118 CALL RANDOM_NUMBER( randomnumber ) 119 randomnumber = 3.0 * disturbance_amplitude *&120 ( randomnumber - 0.5 )119 randomnumber = 3.0_wp * disturbance_amplitude * & 120 ( randomnumber - 0.5_wp ) 121 121 #endif 122 122 IF ( nxl <= i .AND. nxr >= i .AND. nys <= j .AND. nyn >= j ) & … … 145 145 dist2(k,j,i) = ( dist1(k,j,i-1) + dist1(k,j,i+1) & 146 146 + dist1(k,j+1,i) + dist1(k+1,j,i) & 147 ) / 12.0 147 ) / 12.0_wp 148 148 ENDDO 149 149 DO k = disturbance_level_ind_b-1, disturbance_level_ind_t+1 150 150 dist2(k,j,i) = dist2(k,j,i) + ( dist1(k,j-1,i) + dist1(k-1,j,i) & 151 + 6.0 * dist1(k,j,i)&152 ) / 12.0 151 + 6.0_wp * dist1(k,j,i) & 152 ) / 12.0_wp 153 153 ENDDO 154 154 ENDDO … … 165 165 dist1(k,j,i) = ( dist2(k,j,i-1) + dist2(k,j,i+1) + dist2(k,j-1,i) & 166 166 + dist2(k,j+1,i) + dist2(k+1,j,i) + dist2(k-1,j,i) & 167 + 6.0 * dist2(k,j,i)&168 ) / 12.0 167 + 6.0_wp * dist2(k,j,i) & 168 ) / 12.0_wp 169 169 ENDDO 170 170 ENDDO -
palm/trunk/SOURCE/disturb_heatflux.f90
r1321 r1322 19 19 ! 20 20 ! Current revisions: 21 ! ----------------- 22 ! 21 ! ------------------ 22 ! REAL constants defined as wp-kind 23 23 ! 24 24 ! Former revisions: … … 79 79 DO i = 0, nx 80 80 DO j = 0, ny 81 randomnumber = random_gauss( iran, 5.0 )81 randomnumber = random_gauss( iran, 5.0_wp ) 82 82 IF ( nxl <= i .AND. nxr >= i .AND. nys <= j .AND. nyn >= j ) & 83 83 THEN -
palm/trunk/SOURCE/fft_xy.f90
r1321 r1322 16 16 ! 17 17 ! Copyright 1997-2014 Leibniz Universitaet Hannover 18 !------------------------------------------------------------------------------ --!18 !------------------------------------------------------------------------------! 19 19 ! 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! REAL functions provided with KIND-attribute 23 23 ! 24 24 ! Former revisions: … … 413 413 414 414 DO i = 0, (nx+1)/2 415 ar(i,j,k) = REAL( cwork(i) )415 ar(i,j,k) = REAL( cwork(i), KIND=wp ) 416 416 ENDDO 417 417 DO i = 1, (nx+1)/2 - 1 … … 441 441 442 442 DO i = 0, nx 443 ar(i,j,k) = REAL( cwork(i) )443 ar(i,j,k) = REAL( cwork(i), KIND=wp ) 444 444 ENDDO 445 445 … … 519 519 520 520 DO i = 0, (nx+1)/2 521 ar_2d(i,j) = REAL( x_out(i) ) / ( nx+1 )521 ar_2d(i,j) = REAL( x_out(i), KIND=wp ) / ( nx+1 ) 522 522 ENDDO 523 523 DO i = 1, (nx+1)/2 - 1 … … 528 528 529 529 DO i = 0, (nx+1)/2 530 ar(i,j,k) = REAL( x_out(i) ) / ( nx+1 )530 ar(i,j,k) = REAL( x_out(i), KIND=wp ) / ( nx+1 ) 531 531 ENDDO 532 532 DO i = 1, (nx+1)/2 - 1 … … 689 689 690 690 DO i = 0, (nx+1)/2 691 ar(i,j,k) = REAL( ar_tmp(i,j,k) ) * dnx691 ar(i,j,k) = REAL( ar_tmp(i,j,k), KIND=wp ) * dnx 692 692 ENDDO 693 693 … … 794 794 CALL FFTN( cwork, ishape ) 795 795 DO i = 0, (nx+1)/2 796 ar(i) = REAL( cwork(i) )796 ar(i) = REAL( cwork(i), KIND=wp ) 797 797 ENDDO 798 798 DO i = 1, (nx+1)/2 - 1 … … 813 813 814 814 DO i = 0, nx 815 ar(i) = REAL( cwork(i) )815 ar(i) = REAL( cwork(i), KIND=wp ) 816 816 ENDDO 817 817 … … 862 862 863 863 DO i = 0, (nx+1)/2 864 ar(i) = REAL( x_out(i) ) / ( nx+1 )864 ar(i) = REAL( x_out(i), KIND=wp ) / ( nx+1 ) 865 865 ENDDO 866 866 DO i = 1, (nx+1)/2 - 1 … … 1056 1056 1057 1057 DO j = 0, (ny+1)/2 1058 ar_tr(j,i,k) = REAL( cwork(j) )1058 ar_tr(j,i,k) = REAL( cwork(j), KIND=wp ) 1059 1059 ENDDO 1060 1060 DO j = 1, (ny+1)/2 - 1 … … 1084 1084 1085 1085 DO j = 0, ny 1086 ar(j,i,k) = REAL( cwork(j) )1086 ar(j,i,k) = REAL( cwork(j), KIND=wp ) 1087 1087 ENDDO 1088 1088 … … 1160 1160 1161 1161 DO j = 0, (ny+1)/2 1162 ar_tr(j,i,k) = REAL( y_out(j) ) / (ny+1)1162 ar_tr(j,i,k) = REAL( y_out(j), KIND=wp ) / (ny+1) 1163 1163 ENDDO 1164 1164 DO j = 1, (ny+1)/2 - 1 … … 1305 1305 1306 1306 DO j = 0, (ny+1)/2 1307 ar(j,i,k) = REAL( ar_tmp(j,i,k) ) * dny1307 ar(j,i,k) = REAL( ar_tmp(j,i,k), KIND=wp ) * dny 1308 1308 ENDDO 1309 1309 … … 1412 1412 1413 1413 DO j = 0, (ny+1)/2 1414 ar(j) = REAL( cwork(j) )1414 ar(j) = REAL( cwork(j), KIND=wp ) 1415 1415 ENDDO 1416 1416 DO j = 1, (ny+1)/2 - 1 … … 1431 1431 1432 1432 DO j = 0, ny 1433 ar(j) = REAL( cwork(j) )1433 ar(j) = REAL( cwork(j), KIND=wp ) 1434 1434 ENDDO 1435 1435 … … 1480 1480 1481 1481 DO j = 0, (ny+1)/2 1482 ar(j) = REAL( y_out(j) ) / (ny+1)1482 ar(j) = REAL( y_out(j), KIND=wp ) / (ny+1) 1483 1483 ENDDO 1484 1484 DO j = 1, (ny+1)/2 - 1 … … 1674 1674 DO k = 1, nz 1675 1675 DO i = 0, (nx+1)/2 1676 ar(i,k) = REAL( work(i+1,k) )1676 ar(i,k) = REAL( work(i+1,k), KIND=wp ) 1677 1677 ENDDO 1678 1678 DO i = 1, (nx+1)/2 - 1 … … 1817 1817 DO k = 1, nz 1818 1818 DO j = 0, (ny+1)/2 1819 ar(j,k) = REAL( work(j+1,k) )1819 ar(j,k) = REAL( work(j+1,k), KIND=wp ) 1820 1820 ENDDO 1821 1821 DO j = 1, (ny+1)/2 - 1 -
palm/trunk/SOURCE/flow_statistics.f90
r1321 r1322 21 21 ! Current revisions: 22 22 ! ----------------- 23 ! 23 ! REAL constants defined as wp-kind 24 24 ! 25 25 ! Former revisions: … … 1193 1193 dptdz(k) = ( hom(k,1,4,sr) - hom(k-1,1,4,sr) ) * ddzu(k) 1194 1194 ENDDO 1195 dptdz_threshold = 0.2 / 100.01195 dptdz_threshold = 0.2_wp / 100.0_wp 1196 1196 1197 1197 IF ( ocean ) THEN … … 2859 2859 dptdz(k) = ( hom(k,1,4,sr) - hom(k-1,1,4,sr) ) * ddzu(k) 2860 2860 ENDDO 2861 dptdz_threshold = 0.2 / 100.02861 dptdz_threshold = 0.2_wp / 100.0_wp 2862 2862 2863 2863 IF ( ocean ) THEN -
palm/trunk/SOURCE/header.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! REAL functions provided with KIND-attribute, 23 ! some REAL constants defined as wp-kind 23 24 ! 24 25 ! Former revisions: … … 454 455 WRITE ( io, 203 ) simulated_time_at_begin, end_time 455 456 456 IF ( time_restart /= 9999999.9 .AND. &457 IF ( time_restart /= 9999999.9_wp .AND. & 457 458 simulated_time_at_begin == simulated_time ) THEN 458 IF ( dt_restart == 9999999.9 ) THEN459 IF ( dt_restart == 9999999.9_wp ) THEN 459 460 WRITE ( io, 204 ) ' Restart at: ',time_restart 460 461 ELSE … … 472 473 simulated_time_at_begin ) 473 474 ENDIF 474 WRITE ( io, 206 ) simulated_time, log_point_s(10)%sum, &475 log_point_s(10)%sum / REAL( i ),&475 WRITE ( io, 206 ) simulated_time, log_point_s(10)%sum, & 476 log_point_s(10)%sum / REAL( i, KIND=wp ), & 476 477 cpuseconds_per_simulated_second 477 IF ( time_restart /= 9999999.9 .AND. time_restart < end_time ) THEN478 IF ( dt_restart == 9999999.9 ) THEN478 IF ( time_restart /= 9999999.9_wp .AND. time_restart < end_time ) THEN 479 IF ( dt_restart == 9999999.9_wp ) THEN 479 480 WRITE ( io, 204 ) ' Next restart at: ',time_restart 480 481 ELSE … … 524 525 bh = INT( building_height / dz ) 525 526 526 IF ( building_wall_left == 9999999.9 ) THEN527 IF ( building_wall_left == 9999999.9_wp ) THEN 527 528 building_wall_left = ( nx + 1 - blx ) / 2 * dx 528 529 ENDIF … … 530 531 bxr = bxl + blx 531 532 532 IF ( building_wall_south == 9999999.9 ) THEN533 IF ( building_wall_south == 9999999.9_wp ) THEN 533 534 building_wall_south = ( ny + 1 - bly ) / 2 * dy 534 535 ENDIF … … 541 542 CASE ( 'single_street_canyon' ) 542 543 ch = NINT( canyon_height / dz ) 543 IF ( canyon_width_x /= 9999999.9 ) THEN544 IF ( canyon_width_x /= 9999999.9_wp ) THEN 544 545 ! 545 546 !-- Street canyon in y direction 546 547 cwx = NINT( canyon_width_x / dx ) 547 IF ( canyon_wall_left == 9999999.9 ) THEN548 IF ( canyon_wall_left == 9999999.9_wp ) THEN 548 549 canyon_wall_left = ( nx + 1 - cwx ) / 2 * dx 549 550 ENDIF … … 552 553 WRITE ( io, 272 ) 'y', canyon_height, ch, 'u', cxl, cxr 553 554 554 ELSEIF ( canyon_width_y /= 9999999.9 ) THEN555 ELSEIF ( canyon_width_y /= 9999999.9_wp ) THEN 555 556 ! 556 557 !-- Street canyon in x direction 557 558 cwy = NINT( canyon_width_y / dy ) 558 IF ( canyon_wall_south == 9999999.9 ) THEN559 IF ( canyon_wall_south == 9999999.9_wp ) THEN 559 560 canyon_wall_south = ( ny + 1 - cwy ) / 2 * dy 560 561 ENDIF … … 1188 1189 ! 1189 1190 !-- Timeseries 1190 IF ( dt_dots /= 9999999.9 ) THEN1191 IF ( dt_dots /= 9999999.9_wp ) THEN 1191 1192 WRITE ( io, 340 ) 1192 1193 … … 1202 1203 ! 1203 1204 !-- Dvrp-output 1204 IF ( dt_dvrp /= 9999999.9 ) THEN1205 IF ( dt_dvrp /= 9999999.9_wp ) THEN 1205 1206 WRITE ( io, 360 ) dt_dvrp, TRIM( dvrp_output ), TRIM( dvrp_host ), & 1206 1207 TRIM( dvrp_username ), TRIM( dvrp_directory ) … … 1254 1255 ! 1255 1256 !-- Spectra output 1256 IF ( dt_dosp /= 9999999.9 ) THEN1257 IF ( dt_dosp /= 9999999.9_wp ) THEN 1257 1258 WRITE ( io, 370 ) 1258 1259 … … 1377 1378 ! 1378 1379 !-- Initial wind profiles 1379 IF ( u_profile(1) /= 9999999.9 ) WRITE ( io, 427 )1380 IF ( u_profile(1) /= 9999999.9_wp ) WRITE ( io, 427 ) 1380 1381 1381 1382 ! … … 1627 1628 ENDIF 1628 1629 ENDIF 1629 IF ( dt_write_particle_data /= 9999999.9 ) THEN1630 IF ( dt_write_particle_data /= 9999999.9_wp ) THEN 1630 1631 WRITE ( io, 485 ) dt_write_particle_data 1631 1632 output_format = ' ' … … 1641 1642 WRITE ( io, 344 ) output_format 1642 1643 ENDIF 1643 IF ( dt_dopts /= 9999999.9 ) WRITE ( io, 494 ) dt_dopts1644 IF ( dt_dopts /= 9999999.9_wp ) WRITE ( io, 494 ) dt_dopts 1644 1645 IF ( write_particle_statistics ) WRITE ( io, 486 ) 1645 1646 … … 1647 1648 1648 1649 DO i = 1, number_of_particle_groups 1649 IF ( i == 1 .AND. density_ratio(i) == 9999999.9 ) THEN1650 IF ( i == 1 .AND. density_ratio(i) == 9999999.9_wp ) THEN 1650 1651 WRITE ( io, 490 ) i, 0.0 1651 1652 WRITE ( io, 492 ) -
palm/trunk/SOURCE/init_1d_model.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! REAL functions provided with KIND-attribute 23 23 ! 24 24 ! Former revisions: … … 777 777 energy = energy + 0.5 * ( u1d(k)**2 + v1d(k)**2 ) 778 778 ENDDO 779 energy = energy / REAL( nzt - nzb + 1 )779 energy = energy / REAL( nzt - nzb + 1, KIND=wp ) 780 780 781 781 uv_total = SQRT( u1d(nzb+1)**2 + v1d(nzb+1)**2 ) -
palm/trunk/SOURCE/init_3d_model.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 23 ! 22 ! REAL constants defined as wp-kind 24 23 ! module interfaces removed 25 24 ! … … 1604 1603 IF ( TRIM(timestep_scheme) == 'runge-kutta-3' ) THEN ! for RK3-method 1605 1604 1606 weight_substep(1) = 1. /6.1607 weight_substep(2) = 3. /10.1608 weight_substep(3) = 8. /15.1609 1610 weight_pres(1) = 1. /3.1611 weight_pres(2) = 5. /12.1612 weight_pres(3) = 1. /4.1605 weight_substep(1) = 1._wp/6._wp 1606 weight_substep(2) = 3._wp/10._wp 1607 weight_substep(3) = 8._wp/15._wp 1608 1609 weight_pres(1) = 1._wp/3._wp 1610 weight_pres(2) = 5._wp/12._wp 1611 weight_pres(3) = 1._wp/4._wp 1613 1612 1614 1613 ELSEIF ( TRIM(timestep_scheme) == 'runge-kutta-2' ) THEN ! for RK2-method 1615 1614 1616 weight_substep(1) = 1. /2.1617 weight_substep(2) = 1. /2.1615 weight_substep(1) = 1._wp/2._wp 1616 weight_substep(2) = 1._wp/2._wp 1618 1617 1619 weight_pres(1) = 1. /2.1620 weight_pres(2) = 1. /2.1618 weight_pres(1) = 1._wp/2._wp 1619 weight_pres(2) = 1._wp/2._wp 1621 1620 1622 1621 ELSE ! for Euler-method … … 1671 1670 DO k = dp_level_ind_b+1, nzt 1672 1671 dp_smooth_factor(k) = 0.5 * ( 1.0 + SIN( pi * & 1673 ( REAL( k - dp_level_ind_b ) / &1674 REAL( nzt - dp_level_ind_b ) - 0.5 ) ) )1672 ( REAL( k - dp_level_ind_b, KIND=wp ) / & 1673 REAL( nzt - dp_level_ind_b, KIND=wp ) - 0.5 ) ) ) 1675 1674 ENDDO 1676 1675 ENDIF … … 1686 1685 DO i = nxl, nxr 1687 1686 IF ( ( i * dx ) < pt_damping_width ) THEN 1688 ptdf_x(i) = pt_damping_factor * ( SIN( pi * 0.5 * &1689 REAL( pt_damping_width - i * dx ) / (&1690 REAL( pt_damping_width ) ) ) )**21687 ptdf_x(i) = pt_damping_factor * ( SIN( pi * 0.5 * & 1688 REAL( pt_damping_width - i * dx, KIND=wp ) / ( & 1689 REAL( pt_damping_width, KIND=wp ) ) ) )**2 1691 1690 ENDIF 1692 1691 ENDDO … … 1694 1693 DO i = nxl, nxr 1695 1694 IF ( ( i * dx ) > ( nx * dx - pt_damping_width ) ) THEN 1696 ptdf_x(i) = pt_damping_factor * & 1697 SIN( pi * 0.5 * ( ( i - nx ) * dx + pt_damping_width ) / & 1698 REAL( pt_damping_width ) )**2 1695 ptdf_x(i) = pt_damping_factor * & 1696 SIN( pi * 0.5 * & 1697 ( ( i - nx ) * dx + pt_damping_width ) / & 1698 REAL( pt_damping_width, KIND=wp ) )**2 1699 1699 ENDIF 1700 1700 ENDDO … … 1702 1702 DO j = nys, nyn 1703 1703 IF ( ( j * dy ) > ( ny * dy - pt_damping_width ) ) THEN 1704 ptdf_y(j) = pt_damping_factor * & 1705 SIN( pi * 0.5 * ( ( j - ny ) * dy + pt_damping_width ) / & 1706 REAL( pt_damping_width ) )**2 1704 ptdf_y(j) = pt_damping_factor * & 1705 SIN( pi * 0.5 * & 1706 ( ( j - ny ) * dy + pt_damping_width ) / & 1707 REAL( pt_damping_width, KIND=wp ) )**2 1707 1708 ENDIF 1708 1709 ENDDO … … 1710 1711 DO j = nys, nyn 1711 1712 IF ( ( j * dy ) < pt_damping_width ) THEN 1712 ptdf_y(j) = pt_damping_factor * & 1713 SIN( pi * 0.5 * ( pt_damping_width - j * dy ) / & 1714 REAL( pt_damping_width ) )**2 1713 ptdf_y(j) = pt_damping_factor * & 1714 SIN( pi * 0.5 * & 1715 ( pt_damping_width - j * dy ) / & 1716 REAL( pt_damping_width, KIND=wp ) )**2 1715 1717 ENDIF 1716 1718 ENDDO -
palm/trunk/SOURCE/init_advec.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! REAL constants defined as wp-kind 23 23 ! 24 24 ! Former revisions: … … 85 85 ALLOCATE( aex(intervals), bex(intervals), dex(intervals), eex(intervals) ) 86 86 87 delt = 1.0 / REAL( intervals)87 delt = 1.0_wp / REAL( intervals, KIND=wp ) 88 88 sterm = delt * 0.5 89 89 -
palm/trunk/SOURCE/init_cloud_physics.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! REAL constants defined as wp-kind 23 23 ! 24 24 ! Former revisions: … … 96 96 l_d_rv = l_v / r_v 97 97 98 schmidt_p_1d3 = schmidt**( 1.0 / 3.0)98 schmidt_p_1d3 = schmidt**( 1.0_wp / 3.0_wp ) 99 99 100 100 pirho_l = pi * rho_l / 6.0 … … 125 125 ENDIF 126 126 hyp(k) = surface_pressure * 100.0 * & 127 ( (t_surface - g/cp * zu(k)) / t_surface )**(1.0 /0.286)127 ( (t_surface - g/cp * zu(k)) / t_surface )**(1.0_wp/0.286_wp) 128 128 pt_d_t(k) = ( 100000.0 / hyp(k) )**0.286 129 129 t_d_pt(k) = 1.0 / pt_d_t(k) -
palm/trunk/SOURCE/init_dvrp.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! REAL constants defined as wp-kind 23 23 ! 24 24 ! Former revisions: … … 710 710 !-- Define a default colourtable for particles 711 711 DO i = 1, 11 712 interval_values_dvrp_prt(1,i) = i - 1.0 713 interval_values_dvrp_prt(2,i) = REAL( i )714 interval_h_dvrp_prt(:,i) = 270.0 - ( i - 1.0 ) * 9.0712 interval_values_dvrp_prt(1,i) = i - 1.0_wp 713 interval_values_dvrp_prt(2,i) = REAL( i, KIND=wp ) 714 interval_h_dvrp_prt(:,i) = 270.0_wp - ( i - 1.0_wp ) * 9.0_wp 715 715 ENDDO 716 716 717 717 DO i = 12, 22 718 interval_values_dvrp_prt(1,i) = i - 1.0 719 interval_values_dvrp_prt(2,i) = REAL( i )720 interval_h_dvrp_prt(:,i) = 70.0 - ( i - 12.0 ) * 9.5718 interval_values_dvrp_prt(1,i) = i - 1.0_wp 719 interval_values_dvrp_prt(2,i) = REAL( i, KIND=wp ) 720 interval_h_dvrp_prt(:,i) = 70.0_wp - ( i - 12.0_wp ) * 9.5_wp 721 721 ENDDO 722 722 -
palm/trunk/SOURCE/init_grid.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! REAL constants defined as wp-kind 23 23 ! 24 24 ! Former revisions: … … 377 377 !-- Compute the grid-dependent mixing length. 378 378 DO k = 1, nzt 379 l_grid(k) = ( dx * dy * dzw(k) )**0.33333333333333 379 l_grid(k) = ( dx * dy * dzw(k) )**0.33333333333333_wp 380 380 ENDDO 381 381 … … 516 516 bh = NINT( building_height / dz ) 517 517 518 IF ( building_wall_left == 9999999.9 ) THEN518 IF ( building_wall_left == 9999999.9_wp ) THEN 519 519 building_wall_left = ( nx + 1 - blx ) / 2 * dx 520 520 ENDIF … … 522 522 bxr = bxl + blx 523 523 524 IF ( building_wall_south == 9999999.9 ) THEN524 IF ( building_wall_south == 9999999.9_wp ) THEN 525 525 building_wall_south = ( ny + 1 - bly ) / 2 * dy 526 526 ENDIF … … 547 547 !-- Single quasi-2D street canyon of infinite length in x or y direction. 548 548 !-- The canyon is centered in the other direction by default. 549 IF ( canyon_width_x /= 9999999.9 ) THEN549 IF ( canyon_width_x /= 9999999.9_wp ) THEN 550 550 ! 551 551 !-- Street canyon in y direction 552 552 cwx = NINT( canyon_width_x / dx ) 553 IF ( canyon_wall_left == 9999999.9 ) THEN553 IF ( canyon_wall_left == 9999999.9_wp ) THEN 554 554 canyon_wall_left = ( nx + 1 - cwx ) / 2 * dx 555 555 ENDIF … … 557 557 cxr = cxl + cwx 558 558 559 ELSEIF ( canyon_width_y /= 9999999.9 ) THEN559 ELSEIF ( canyon_width_y /= 9999999.9_wp ) THEN 560 560 ! 561 561 !-- Street canyon in x direction 562 562 cwy = NINT( canyon_width_y / dy ) 563 IF ( canyon_wall_south == 9999999.9 ) THEN563 IF ( canyon_wall_south == 9999999.9_wp ) THEN 564 564 canyon_wall_south = ( ny + 1 - cwy ) / 2 * dy 565 565 ENDIF … … 578 578 ! 579 579 !-- Street canyon size has to meet some requirements 580 IF ( canyon_width_x /= 9999999.9 ) THEN580 IF ( canyon_width_x /= 9999999.9_wp ) THEN 581 581 IF ( ( cxl < 1 ) .OR. ( cxr > nx-1 ) .OR. ( cwx < 3 ) .OR. & 582 582 ( ch < 3 ) ) THEN … … 587 587 CALL message( 'init_grid', 'PA0205', 1, 2, 0, 6, 0 ) 588 588 ENDIF 589 ELSEIF ( canyon_width_y /= 9999999.9 ) THEN589 ELSEIF ( canyon_width_y /= 9999999.9_wp ) THEN 590 590 IF ( ( cys < 1 ) .OR. ( cyn > ny-1 ) .OR. ( cwy < 3 ) .OR. & 591 591 ( ch < 3 ) ) THEN … … 597 597 ENDIF 598 598 ENDIF 599 IF ( canyon_width_x /= 9999999.9 .AND. canyon_width_y /= 9999999.9) &599 IF ( canyon_width_x /= 9999999.9_wp .AND. canyon_width_y /= 9999999.9_wp ) & 600 600 THEN 601 601 message_string = 'inconsistent canyon parameters:' // & … … 606 606 607 607 nzb_local = ch 608 IF ( canyon_width_x /= 9999999.9 ) THEN608 IF ( canyon_width_x /= 9999999.9_wp ) THEN 609 609 nzb_local(:,cxl+1:cxr-1) = 0 610 ELSEIF ( canyon_width_y /= 9999999.9 ) THEN610 ELSEIF ( canyon_width_y /= 9999999.9_wp ) THEN 611 611 nzb_local(cys+1:cyn-1,:) = 0 612 612 ENDIF -
palm/trunk/SOURCE/init_ocean.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! REAL constants defined as wp_kind 22 23 ! 23 24 ! Former revisions: … … 87 88 !-- and the reference density (used later in buoyancy term) 88 89 !-- First step: Calculate pressure using reference density 89 hyp(nzt+1) = surface_pressure * 100.0 90 hyp(nzt+1) = surface_pressure * 100.0_wp 90 91 91 92 hyp(nzt) = hyp(nzt+1) + rho_surface * g * 0.5 * dzu(nzt+1) -
palm/trunk/SOURCE/init_pegrid.f90
r1321 r1322 19 19 ! 20 20 ! Current revisions: 21 ! ----------------- 21 ! ------------------ 22 ! REAL functions provided with KIND-attribute 22 23 ! 23 24 ! Former revisions: … … 174 175 ! 175 176 !-- Automatic determination of the topology 176 numproc_sqr = SQRT( REAL( numprocs ) )177 numproc_sqr = SQRT( REAL( numprocs, KIND=wp ) ) 177 178 pdims(1) = MAX( numproc_sqr , 1 ) 178 179 DO WHILE ( MOD( numprocs , pdims(1) ) /= 0 ) -
palm/trunk/SOURCE/init_pt_anomaly.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! REAL constants defined as wp_kind 22 23 ! 23 24 ! Former revisions: … … 93 94 radius = SQRT( x**2 + y**2 + z**2 ) 94 95 IF ( radius <= rc ) THEN 95 betrag = 5.0 * EXP( -( radius * 0.001 / 2.0)**2 )96 betrag = 5.0 * EXP( -( radius * 0.001_wp / 2.0_wp )**2 ) 96 97 ELSE 97 98 betrag = 0.0 -
palm/trunk/SOURCE/init_rankine.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! REAL constants defined as wp_kind 22 23 ! 23 24 ! Former revisions: … … 111 112 radius = SQRT( x**2 + y**2 ) 112 113 IF ( radius <= 2.0 * rc ) THEN 113 betrag = radius / ( 2.0 * rc ) * 0.08 114 betrag = radius / ( 2.0 * rc ) * 0.08_wp 114 115 ELSEIF ( radius > 2.0 * rc .AND. radius < 8.0 * rc ) THEN 115 betrag = 0.08 * EXP( -( radius - 2.0 * rc ) / 2.0)116 betrag = 0.08 * EXP( -( radius - 2.0_wp * rc ) / 2.0_wp ) 116 117 ELSE 117 118 betrag = 0.0 … … 120 121 IF ( x == 0.0 ) THEN 121 122 IF ( y > 0.0 ) THEN 122 alpha = pi / 2.0 123 alpha = pi / 2.0_wp 123 124 ELSEIF ( y < 0.0 ) THEN 124 alpha = 3.0 * pi / 2.0 125 alpha = 3.0 * pi / 2.0_wp 125 126 ENDIF 126 127 ELSE … … 129 130 ELSE 130 131 IF ( y < 0.0 ) THEN 131 alpha = ATAN( y / x ) + 2.0 * pi132 alpha = ATAN( y / x ) + 2.0_wp * pi 132 133 ELSE 133 134 alpha = ATAN( y / x ) … … 152 153 radius = SQRT( x**2 + y**2 ) 153 154 IF ( radius <= 2.0 * rc ) THEN 154 betrag = radius / ( 2.0 * rc ) * 0.08155 betrag = radius / ( 2.0_wp * rc ) * 0.08_wp 155 156 ELSEIF ( radius > 2.0 * rc .AND. radius < 8.0 * rc ) THEN 156 betrag = 0.08 * EXP( -( radius - 2.0 * rc ) / 2.0)157 betrag = 0.08 * EXP( -( radius - 2.0_wp * rc ) / 2.0_wp ) 157 158 ELSE 158 159 betrag = 0.0 … … 161 162 IF ( x == 0.0 ) THEN 162 163 IF ( y > 0.0 ) THEN 163 alpha = pi / 2.0 164 alpha = pi / 2.0_wp 164 165 ELSEIF ( y < 0.0 ) THEN 165 alpha = 3.0 * pi / 2.0 166 alpha = 3.0 * pi / 2.0_wp 166 167 ENDIF 167 168 ELSE … … 170 171 ELSE 171 172 IF ( y < 0.0 ) THEN 172 alpha = ATAN( y / x ) + 2.0 * pi173 alpha = ATAN( y / x ) + 2.0_wp * pi 173 174 ELSE 174 175 alpha = ATAN( y / x ) -
palm/trunk/SOURCE/init_slope.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! REAL constants defined as wp_kind 22 23 ! 23 24 ! Former revisions: … … 109 110 ! 110 111 !-- Compute temperatures in the rotated coordinate system 111 alpha = alpha + alpha_surface / 180.0 * pi112 alpha = alpha + alpha_surface / 180.0_wp * pi 112 113 pt_value = pt_surface + radius * SIN( alpha ) * & 113 pt_vertical_gradient(1) / 100.0 114 pt_vertical_gradient(1) / 100.0_wp 114 115 pt_slope_ref(k,i) = pt_value 115 116 ENDDO … … 120 121 !-- used for the cyclic boundary in x-direction 121 122 pt_slope_offset = (nx+1) * dx * sin_alpha_surface * & 122 pt_vertical_gradient(1) / 100.0 123 pt_vertical_gradient(1) / 100.0_wp 123 124 124 125 -
palm/trunk/SOURCE/local_tremain.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! REAL constants defined as wp_kind 22 23 ! 23 24 ! Former revisions: … … 69 70 #if defined( __ibm ) 70 71 71 actual_wallclock_time = IRTC( ) * 1E-9 72 actual_wallclock_time = IRTC( ) * 1E-9_wp 72 73 remaining_time = maximum_cpu_time_allowed - & 73 74 ( actual_wallclock_time - initial_wallclock_time ) … … 76 77 77 78 CALL SYSTEM_CLOCK( count, count_rate ) 78 actual_wallclock_time = REAL( count ) / REAL( count_rate)79 actual_wallclock_time = REAL( count, KIND=wp ) / REAL( count_rate, KIND=wp ) 79 80 remaining_time = maximum_cpu_time_allowed - & 80 81 ( actual_wallclock_time - initial_wallclock_time ) -
palm/trunk/SOURCE/local_tremain_ini.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! REAL constants defined as wp_kind 22 23 ! 23 24 ! Former revisions: … … 67 68 #if defined( __ibm ) 68 69 69 initial_wallclock_time = IRTC( ) * 1E-9 70 initial_wallclock_time = IRTC( ) * 1E-9_wp 70 71 71 72 #elif defined( __lc ) 72 73 73 74 CALL SYSTEM_CLOCK( count, count_rate ) 74 initial_wallclock_time = REAL( count ) / REAL( count_rate)75 initial_wallclock_time = REAL( count, KIND=wp ) / REAL( count_rate, KIND=wp ) 75 76 76 77 #else -
palm/trunk/SOURCE/lpm_advec.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! REAL constants defined as wp_kind 22 23 ! 23 24 ! Former revisions: … … 186 187 ! 187 188 !-- Determine the sublayer. Further used as index. 188 height_p = ( particles(n)%z - z0_av_global ) &189 * REAL( number_of_sublayers )&189 height_p = ( particles(n)%z - z0_av_global ) & 190 * REAL( number_of_sublayers, KIND=wp ) & 190 191 * d_z_p_z0 191 192 ! … … 210 211 us_int = 0.5 * ( us(j,i) + us(j,i-1) ) 211 212 212 u_int = -usws(j,i) / ( us_int * kappa + 1E-10 ) &213 u_int = -usws(j,i) / ( us_int * kappa + 1E-10_wp ) & 213 214 * log_z_z0_int 214 215 … … 277 278 us_int = 0.5 * ( us(j,i) + us(j-1,i) ) 278 279 279 v_int = -vsws(j,i) / ( us_int * kappa + 1E-10 ) &280 v_int = -vsws(j,i) / ( us_int * kappa + 1E-10_wp ) & 280 281 * log_z_z0_int 281 282 … … 1093 1094 ENDIF 1094 1095 1095 vv_int = ( 1.0 / 3.0) * ( aa + bb + cc )1096 1097 fs_int = ( 2.0 / 3.0) * e_mean_int / &1098 ( vv_int + ( 2.0 / 3.0) * e_mean_int )1096 vv_int = ( 1.0_wp / 3.0_wp ) * ( aa + bb + cc ) 1097 1098 fs_int = ( 2.0_wp / 3.0_wp ) * e_mean_int / & 1099 ( vv_int + ( 2.0_wp / 3.0_wp ) * e_mean_int ) 1099 1100 1100 1101 ! … … 1126 1127 !-- from becoming unrealistically large. 1127 1128 particles(n)%rvar1 = SQRT( 2.0 * sgs_wfu_part * e_int ) * & 1128 ( random_gauss( iran_part, 5.0 ) - 1.0)1129 ( random_gauss( iran_part, 5.0_wp ) - 1.0_wp ) 1129 1130 particles(n)%rvar2 = SQRT( 2.0 * sgs_wfv_part * e_int ) * & 1130 ( random_gauss( iran_part, 5.0 ) - 1.0)1131 ( random_gauss( iran_part, 5.0_wp ) - 1.0_wp ) 1131 1132 particles(n)%rvar3 = SQRT( 2.0 * sgs_wfw_part * e_int ) * & 1132 ( random_gauss( iran_part, 5.0 ) - 1.0)1133 ( random_gauss( iran_part, 5.0_wp ) - 1.0_wp ) 1133 1134 1134 1135 ELSE … … 1168 1169 ) * dt_particle / 2.0 + & 1169 1170 SQRT( fs_int * c_0 * diss_int ) * & 1170 ( random_gauss( iran_part, 5.0 ) - 1.0) * &1171 ( random_gauss( iran_part, 5.0_wp ) - 1.0_wp ) * & 1171 1172 SQRT( dt_particle ) 1172 1173 … … 1177 1178 particles(n)%rvar2 / & 1178 1179 ( 2.0 * sgs_wfv_part * e_int ) + de_dy_int & 1179 ) * dt_particle / 2.0 + &1180 ) * dt_particle / 2.0_wp + & 1180 1181 SQRT( fs_int * c_0 * diss_int ) * & 1181 ( random_gauss( iran_part, 5.0 ) - 1.0) * &1182 ( random_gauss( iran_part, 5.0_wp ) - 1.0_wp ) * & 1182 1183 SQRT( dt_particle ) 1183 1184 … … 1188 1189 particles(n)%rvar3 / & 1189 1190 ( 2.0 * sgs_wfw_part * e_int ) + de_dz_int & 1190 ) * dt_particle / 2.0 1191 ) * dt_particle / 2.0_wp + & 1191 1192 SQRT( fs_int * c_0 * diss_int ) * & 1192 ( random_gauss( iran_part, 5.0 ) - 1.0) * &1193 ( random_gauss( iran_part, 5.0_wp ) - 1.0_wp ) * & 1193 1194 SQRT( dt_particle ) 1194 1195 … … 1252 1253 ( v_int - particles(n)%speed_y )**2 + & 1253 1254 ( w_int - particles(n)%speed_z )**2 ) / & 1254 molecular_viscosity )**0.687 &1255 molecular_viscosity )**0.687_wp & 1255 1256 ) 1256 1257 exp_term = EXP( -exp_arg * dt_particle ) -
palm/trunk/SOURCE/lpm_collision_kernels.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! REAL constants defined as wp_kind 22 23 ! 23 24 ! Former revisions: … … 167 168 !-- Calculate the radius class bounds with logarithmic distances 168 169 !-- in the interval [1.0E-6, 2.0E-4] m 169 rclass_lbound = LOG( 1.0E-6 )170 rclass_ubound = LOG( 2.0E-4 )170 rclass_lbound = LOG( 1.0E-6_wp ) 171 rclass_ubound = LOG( 2.0E-4_wp ) 171 172 radclass(1) = 1.0E-6 172 173 DO i = 2, radius_classes … … 182 183 !-- Set the class bounds for dissipation in interval [0.0, 0.1] m**2/s**3 183 184 DO i = 1, dissipation_classes 184 epsclass(i) = 0.1 * REAL( i ) / dissipation_classes185 epsclass(i) = 0.1 * REAL( i, KIND=wp ) / dissipation_classes 185 186 ! IF ( myid == 0 ) THEN 186 187 ! PRINT*, 'i=', i, ' eps = ', epsclass(i) … … 197 198 198 199 epsilon = epsclass(k) 199 urms = 2.02 * ( epsilon / 0.04 )**( 1.0 / 3.0)200 urms = 2.02 * ( epsilon / 0.04_wp )**( 1.0_wp / 3.0_wp ) 200 201 201 202 CALL turbsd … … 313 314 epsilon = 0.0 314 315 ENDIF 315 urms = 2.02 * ( epsilon / 0.04 )**( 0.33333333333)316 urms = 2.02 * ( epsilon / 0.04_wp )**( 0.33333333333_wp ) 316 317 317 318 IF ( wang_kernel .AND. epsilon > 1.0E-7 ) THEN … … 431 432 ENDIF 432 433 433 lambda = urms * SQRT( 15.0 * molecular_viscosity / epsilon )! in m434 lambda_re = urms**2 * SQRT( 15.0 / epsilon / molecular_viscosity )434 lambda = urms * SQRT( 15.0_wp * molecular_viscosity / epsilon ) ! in m 435 lambda_re = urms**2 * SQRT( 15.0_wp / epsilon / molecular_viscosity ) 435 436 tl = urms**2 / epsilon ! in s 436 437 lf = 0.5 * urms**3 / epsilon ! in m 437 438 tauk = SQRT( molecular_viscosity / epsilon ) ! in s 438 eta = ( molecular_viscosity**3 / epsilon )**0.25 439 eta = ( molecular_viscosity**3 / epsilon )**0.25_wp ! in m 439 440 vk = eta / tauk 440 441 441 442 ao = ( 11.0 + 7.0 * lambda_re ) / ( 205.0 + lambda_re ) 442 tt = SQRT( 2.0 * lambda_re / ( SQRT( 15.0 ) * ao ) ) * tauk ! in s443 tt = SQRT( 2.0 * lambda_re / ( SQRT( 15.0_wp ) * ao ) ) * tauk ! in s 443 444 444 445 CALL fallg ! gives winf in m/s … … 452 453 !-- Calculate wr (from Aayala 2008b, page 38f) 453 454 z = tt / tl 454 be = SQRT( 2.0 ) * lambda / lf455 be = SQRT( 2.0_wp ) * lambda / lf 455 456 bbb = SQRT( 1.0 - 2.0 * be**2 ) 456 457 d1 = ( 1.0 + bbb ) / ( 2.0 * bbb ) … … 504 505 wrtur2xy = vrms1xy**2 + vrms2xy**2 - 2.0 * v1v2xy ! in m**2/s**2 505 506 IF ( wrtur2xy < 0.0 ) wrtur2xy = 0.0 506 wrgrav2 = pi / 8.0 * ( winf(j) - winf(i) )**2507 wrfin = SQRT( ( 2.0 / pi ) * ( wrtur2xy + wrgrav2) )! in m/s507 wrgrav2 = pi / 8.0_wp * ( winf(j) - winf(i) )**2 508 wrfin = SQRT( ( 2.0_wp / pi ) * ( wrtur2xy + wrgrav2) ) ! in m/s 508 509 509 510 ! … … 518 519 5.3406 * sst 519 520 IF ( xx < 0.0 ) xx = 0.0 520 yy = 0.1886 * EXP( 20.306 / lambda_re )521 yy = 0.1886 * EXP( 20.306_wp / lambda_re ) 521 522 522 523 c1_gr = xx / ( g / vk * tauk )**yy 523 524 524 ao_gr = ao + ( pi / 8.0 ) * ( g / vk * tauk )**2525 ao_gr = ao + ( pi / 8.0_wp) * ( g / vk * tauk )**2 525 526 fao_gr = 20.115 * SQRT( ao_gr / lambda_re ) 526 527 rc = SQRT( fao_gr * ABS( st(j) - st(i) ) ) * eta ! in cm … … 652 653 stb = 32.0 * rho_a * ( rho_l - rho_a) * g / (3.0 * eta * eta) 653 654 phy = sigma**3 * rho_a**2 / ( eta**4 * g * ( rho_l - rho_a ) ) 654 py = phy**( 1.0 / 6.0)655 py = phy**( 1.0_wp / 6.0_wp ) 655 656 656 657 ENDIF … … 685 686 ENDIF 686 687 687 x = LOG( 16.0 * bond * py / 3.0 )688 x = LOG( 16.0 * bond * py / 3.0_wp ) 688 689 y = 0.0 689 690 … … 695 696 696 697 IF ( radclass(j) > 0.0035 ) THEN 697 winf(j) = xrey * eta / ( 2.0 * rho_a * 0.0035 )698 winf(j) = xrey * eta / ( 2.0 * rho_a * 0.0035_wp ) 698 699 ELSE 699 700 winf(j) = xrey * eta / ( 2.0 * rho_a * radclass(j) ) … … 799 800 ALLOCATE( ira(1:radius_classes) ) 800 801 DO j = 1, radius_classes 801 particle_radius = radclass(j) * 1.0E6 802 particle_radius = radclass(j) * 1.0E6_wp 802 803 DO k = 1, 15 803 804 IF ( particle_radius < r0(k) ) THEN … … 822 823 IF ( ir < 16 ) THEN 823 824 IF ( ir >= 2 ) THEN 824 pp = ( ( radclass(j) * 1.0E06 ) - r0(ir-1) ) / &825 pp = ( ( radclass(j) * 1.0E06_wp ) - r0(ir-1) ) / & 825 826 ( r0(ir) - r0(ir-1) ) 826 827 qq = ( rq- rat(iq-1) ) / ( rat(iq) - rat(iq-1) ) … … 930 931 931 932 DO j = 1, radius_classes 932 particle_radius = radclass(j) * 1.0E6 933 particle_radius = radclass(j) * 1.0E6_wp 933 934 DO k = 1, 7 934 935 IF ( particle_radius < r0(k) ) THEN … … 1039 1040 REAL(wp), DIMENSION(1:9,1:19), SAVE :: ef = 0.0 !: 1040 1041 1041 mean_rm = mean_r * 1.0E06 1042 rm = r * 1.0E06 1042 mean_rm = mean_r * 1.0E06_wp 1043 rm = r * 1.0E06_wp 1043 1044 1044 1045 IF ( first ) THEN -
palm/trunk/SOURCE/lpm_droplet_collision.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! REAL constants defined as wp_kind 23 23 ! 24 24 ! Former revisions: … … 207 207 !-- Determine dissipation class index of this gridbox 208 208 IF ( wang_kernel ) THEN 209 eclass = INT( diss(k,j,i) * 1.0E4 / 1000.0* &209 eclass = INT( diss(k,j,i) * 1.0E4_wp / 1000.0_wp * & 210 210 dissipation_classes ) + 1 211 211 epsilon = diss(k,j,i) … … 213 213 epsilon = 0.0 214 214 ENDIF 215 IF ( hall_kernel .OR. epsilon * 1.0E4 < 0.001 ) THEN215 IF ( hall_kernel .OR. epsilon * 1.0E4_wp < 0.001 ) THEN 216 216 eclass = 0 ! Hall kernel is used 217 217 ELSE … … 270 270 !-- Change of the current droplet radius 271 271 rad(n-is+1) = ( (r3 + dt_3d * ddV * (sum1 - sum2 * r3) )/& 272 sum3 )**0.33333333333333 272 sum3 )**0.33333333333333_wp 273 273 274 274 IF ( weight(n-is+1) < 0.0 ) THEN … … 347 347 !-- Change of the current droplet radius 348 348 rad(n-is+1) = ( (r3 + dt_3d * ddV * (sum1 - sum2 * r3) )/& 349 sum3 )**0.33333333333333 349 sum3 )**0.33333333333333_wp 350 350 351 351 IF ( weight(n-is+1) < 0.0 ) THEN … … 534 534 ! 535 535 !-- Change in radius due to collision 536 delta_r = effective_coll_efficiency / 3.0 536 delta_r = effective_coll_efficiency / 3.0_wp & 537 537 * pi * sl_r3 * ddx * ddy / dz & 538 538 * SQRT( ( u_int - particles(n)%speed_x )**2 & … … 551 551 IF ( delta_v >= sl_r3 .AND. sl_r3 > 0.0 ) THEN 552 552 553 delta_r = ( ( sl_r3/particles(n)%weight_factor ) &554 + particles(n)%radius**3 )**( 1. /3.) &553 delta_r = ( ( sl_r3/particles(n)%weight_factor ) & 554 + particles(n)%radius**3 )**( 1.0_wp/3.0_wp ) & 555 555 - particles(n)%radius 556 556 … … 612 612 613 613 IF ( wang_kernel ) THEN 614 eclass = INT( diss(k,j,i) * 1.0E4 / 1000.0* &614 eclass = INT( diss(k,j,i) * 1.0E4_wp / 1000.0_wp * & 615 615 dissipation_classes ) + 1 616 616 epsilon = diss(k,j,i) … … 618 618 epsilon = 0.0 619 619 ENDIF 620 IF ( hall_kernel .OR. epsilon * 1.0E4 < 0.001 ) THEN620 IF ( hall_kernel .OR. epsilon * 1.0E4_wp < 0.001 ) THEN 621 621 eclass = 0 ! Hall kernel is used 622 622 ELSE … … 631 631 632 632 particles(psi)%radius = ( particles(psi)%radius**3 / & 633 sum3 )**0.33333333333333 633 sum3 )**0.33333333333333_wp 634 634 particles(psi)%weight_factor = particles(psi)%weight_factor & 635 635 * sum3 … … 652 652 653 653 particles(psi)%radius = ( particles(psi)%radius**3 / & 654 sum3 )**0.33333333333333 654 sum3 )**0.33333333333333_wp 655 655 particles(psi)%weight_factor = particles(psi)%weight_factor & 656 656 * sum3 -
palm/trunk/SOURCE/lpm_droplet_condensation.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! REAL constants defined as wp-kind 23 23 ! 24 24 ! Former revisions: … … 153 153 154 154 !-- Parameters for Rosenbrock method 155 REAL(wp), PARAMETER :: a21 = 2.0 !:156 REAL(wp), PARAMETER :: a31 = 48.0/25.0 !:157 REAL(wp), PARAMETER :: a32 = 6.0/25.0 !:158 REAL(wp), PARAMETER :: b1 = 19.0/9.0 !:159 REAL(wp), PARAMETER :: b2 = 0.5 !:160 REAL(wp), PARAMETER :: b3 = 25.0/108.0 !:161 REAL(wp), PARAMETER :: b4 = 125.0/108.0 !:162 REAL(wp), PARAMETER :: c21 = -8.0 !:163 REAL(wp), PARAMETER :: c31 = 372.0/25.0 !:164 REAL(wp), PARAMETER :: c32 = 12.0/5.0 !:165 REAL(wp), PARAMETER :: c41 = -112.0/125.0 !:166 REAL(wp), PARAMETER :: c42 = -54.0/125.0 !:167 REAL(wp), PARAMETER :: c43 = -2.0/5.0 !:168 REAL(wp), PARAMETER :: errcon = 0.1296 !:169 REAL(wp), PARAMETER :: e1 = 17.0/54.0 !:170 REAL(wp), PARAMETER :: e2 = 7.0/36.0 !:171 REAL(wp), PARAMETER :: e3 = 0.0 !:172 REAL(wp), PARAMETER :: e4 = 125.0/108.0 !:173 REAL(wp), PARAMETER :: gam = 0.5 !:174 REAL(wp), PARAMETER :: grow = 1.5 !:175 REAL(wp), PARAMETER :: pgrow = -0.25 !:176 REAL(wp), PARAMETER :: pshrnk = -1.0/3.0 !:177 REAL(wp), PARAMETER :: shrnk = 0.5 !:155 REAL(wp), PARAMETER :: a21 = 2.0 !: 156 REAL(wp), PARAMETER :: a31 = 48.0/25.0_wp !: 157 REAL(wp), PARAMETER :: a32 = 6.0/25.0_wp !: 158 REAL(wp), PARAMETER :: b1 = 19.0/9.0_wp !: 159 REAL(wp), PARAMETER :: b2 = 0.5 !: 160 REAL(wp), PARAMETER :: b3 = 25.0/108.0_wp !: 161 REAL(wp), PARAMETER :: b4 = 125.0/108.0_wp !: 162 REAL(wp), PARAMETER :: c21 = -8.0 !: 163 REAL(wp), PARAMETER :: c31 = 372.0/25.0_wp !: 164 REAL(wp), PARAMETER :: c32 = 12.0/5.0_wp !: 165 REAL(wp), PARAMETER :: c41 = -112.0/125.0_wp !: 166 REAL(wp), PARAMETER :: c42 = -54.0/125.0_wp !: 167 REAL(wp), PARAMETER :: c43 = -2.0/5.0_wp !: 168 REAL(wp), PARAMETER :: errcon = 0.1296 !: 169 REAL(wp), PARAMETER :: e1 = 17.0/54.0_wp !: 170 REAL(wp), PARAMETER :: e2 = 7.0/36.0_wp !: 171 REAL(wp), PARAMETER :: e3 = 0.0 !: 172 REAL(wp), PARAMETER :: e4 = 125.0/108.0_wp !: 173 REAL(wp), PARAMETER :: gam = 0.5 !: 174 REAL(wp), PARAMETER :: grow = 1.5 !: 175 REAL(wp), PARAMETER :: pgrow = -0.25 !: 176 REAL(wp), PARAMETER :: pshrnk = -1.0/3.0_wp !: 177 REAL(wp), PARAMETER :: shrnk = 0.5 !: 178 178 179 179 -
palm/trunk/SOURCE/lpm_init.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! REAL functions provided with KIND-attribute 23 23 ! 24 24 ! Former revisions: … … 252 252 ! 253 253 !-- Calculate vertical depth of the sublayers 254 height_int = ( z_p - z0_av_global ) / REAL( number_of_sublayers )254 height_int = ( z_p - z0_av_global ) / REAL( number_of_sublayers, KIND=wp ) 255 255 ! 256 256 !-- Precalculate LOG(z/z0) -
palm/trunk/SOURCE/microphysics.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! REAL constants defined as wp-kind 23 23 ! 24 24 ! Former revisions: … … 522 522 ! 523 523 !-- Weight averaged radius of cloud droplets: 524 rc = 0.5 * ( xc * dpirho_l )**( 1.0 / 3.0 )524 rc = 0.5 * ( xc * dpirho_l )**( 1.0 / 3.0_wp ) 525 525 526 526 alpha_cc = ( a_1 + a_2 * nu_c ) / ( 1.0 + a_3 * nu_c ) … … 529 529 ! 530 530 !-- Mixing length (neglecting distance to ground and stratification) 531 l_mix = ( dx * dy * dzu(k) )**( 1.0 / 3.0 )531 l_mix = ( dx * dy * dzu(k) )**( 1.0 / 3.0_wp ) 532 532 ! 533 533 !-- Limit dissipation rate according to Seifert, Nuijens and … … 536 536 ! 537 537 !-- Compute Taylor-microscale Reynolds number: 538 re_lambda = 6.0 / 11.0 * ( l_mix / c_const )**( 2.0 / 3.0 ) * &539 SQRT( 15.0 / kin_vis_air ) * epsilon**( 1.0 / 6.0 )538 re_lambda = 6.0 / 11.0 * ( l_mix / c_const )**( 2.0 / 3.0_wp ) * & 539 SQRT( 15.0 / kin_vis_air ) * epsilon**( 1.0 / 6.0_wp ) 540 540 ! 541 541 !-- The factor of 1.0E4 is needed to convert the dissipation rate … … 664 664 ! 665 665 !-- Weight averaged diameter of rain drops: 666 dr = ( hyrho(k) * qr_1d(k) / nr_1d(k) * dpirho_l )**( 1.0 / 3.0 )666 dr = ( hyrho(k) * qr_1d(k) / nr_1d(k) * dpirho_l )**( 1.0 / 3.0_wp ) 667 667 ! 668 668 !-- Collisional breakup rate (Seifert, 2008): … … 760 760 ! 761 761 !-- Weight averaged diameter of rain drops: 762 dr = ( xr * dpirho_l )**( 1.0 / 3.0 )762 dr = ( xr * dpirho_l )**( 1.0 / 3.0_wp ) 763 763 ! 764 764 !-- Compute ventilation factor and intercept parameter … … 772 772 !-- Slope parameter of gamma distribution (Seifert, 2008): 773 773 lambda_r = ( ( mu_r + 3.0 ) * ( mu_r + 2.0 ) * & 774 ( mu_r + 1.0 ) )**( 1.0 / 3.0 ) / dr774 ( mu_r + 1.0 ) )**( 1.0 / 3.0_wp ) / dr 775 775 776 776 mu_r_2 = mu_r + 2.0 … … 849 849 ! 850 850 !-- Sedimentation of cloud droplets (Heus et al., 2010): 851 sed_qc_const = k_st * ( 3.0 / ( 4.0 * pi * rho_l ))**( 2.0 / 3.0 ) * &851 sed_qc_const = k_st * ( 3.0 / ( 4.0 * pi * rho_l ))**( 2.0 / 3.0_wp ) * & 852 852 EXP( 5.0 * LOG( sigma_gc )**2 ) 853 853 … … 856 856 DO k = nzt, nzb_s_inner(j,i)+1, -1 857 857 IF ( qc_1d(k) > eps_sb ) THEN 858 sed_qc(k) = sed_qc_const * nc_1d(k)**( -2.0 / 3.0 ) * &859 ( qc_1d(k) * hyrho(k) )**( 5.0 / 3.0 )858 sed_qc(k) = sed_qc_const * nc_1d(k)**( -2.0 / 3.0_wp ) * & 859 ( qc_1d(k) * hyrho(k) )**( 5.0 / 3.0_wp ) 860 860 ELSE 861 861 sed_qc(k) = 0.0 … … 940 940 ! 941 941 !-- Weight averaged diameter of rain drops: 942 dr = ( hyrho(k) * qr_1d(k) / nr_1d(k) * dpirho_l )**( 1.0 / 3.0 )942 dr = ( hyrho(k) * qr_1d(k) / nr_1d(k) * dpirho_l )**( 1.0 / 3.0_wp ) 943 943 ! 944 944 !-- Shape parameter of gamma distribution (Milbrandt and Yau, 2005; … … 948 948 !-- Slope parameter of gamma distribution (Seifert, 2008): 949 949 lambda_r = ( ( mu_r + 3.0 ) * ( mu_r + 2.0 ) * & 950 ( mu_r + 1.0 ) )**( 1.0 / 3.0 ) / dr950 ( mu_r + 1.0 ) )**( 1.0 / 3.0_wp ) / dr 951 951 952 952 w_nr(k) = MAX( 0.1, MIN( 20.0, a_term - b_term * ( 1.0 + & -
palm/trunk/SOURCE/netcdf.f90
r1321 r1322 23 23 ! Current revisions: 24 24 ! ------------------ 25 ! 25 ! Forgotten ONLY-attribute added to USE-statements 26 26 ! 27 27 ! Former revisions: … … 4924 4924 !------------------------------------------------------------------------------! 4925 4925 4926 USE control_parameters 4926 USE control_parameters, & 4927 ONLY: netcdf_data_format 4928 4927 4929 USE netcdf 4930 4928 4931 USE netcdf_control 4932 4929 4933 USE pegrid 4930 4934 … … 4962 4966 !------------------------------------------------------------------------------! 4963 4967 4964 USE control_parameters 4968 USE control_parameters, & 4969 ONLY: message_string 4970 4965 4971 USE netcdf 4972 4966 4973 USE netcdf_control 4974 4967 4975 USE pegrid 4968 4976 -
palm/trunk/SOURCE/poismg.f90
r1321 r1322 23 23 ! Current revisions: 24 24 ! ----------------- 25 ! 25 ! REAL constants defined as wp-kind 26 26 ! 27 27 ! Former revisions: … … 505 505 ( r(k,j,i) - r(k-1,j+1,i+1) ) 506 506 507 f_mg(kc,jc,ic) = 1.0 / 64.0 * (&507 f_mg(kc,jc,ic) = 1.0 / 64.0_wp * ( & 508 508 8.0 * r(k,j,i) & 509 509 + 4.0 * ( rkjim + rkjip + & … … 521 521 + ( r(k+1,j-1,i-1) + r(k+1,j+1,i-1) + & 522 522 r(k+1,j-1,i+1) + r(k+1,j+1,i+1) ) & 523 )524 525 ! f_mg(kc,jc,ic) = 1.0 / 64.0 * (&523 ) 524 525 ! f_mg(kc,jc,ic) = 1.0 / 64.0_wp * ( & 526 526 ! 8.0 * r(k,j,i) & 527 527 ! + 4.0 * ( r(k,j,i-1) + r(k,j,i+1) + & … … 539 539 ! + ( r(k+1,j-1,i-1) + r(k+1,j+1,i-1) + & 540 540 ! r(k+1,j-1,i+1) + r(k+1,j+1,i+1) ) & 541 ! )541 ! ) 542 542 ENDDO 543 543 ENDDO -
palm/trunk/SOURCE/read_var_list.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! REAL functions provided with KIND-attribute 23 23 ! 24 24 ! Former revisions: … … 906 906 !-- Calculate the temporal average of vertical profiles, if neccessary 907 907 IF ( average_count_pr /= 0 ) THEN 908 hom_sum = hom_sum / REAL( average_count_pr )908 hom_sum = hom_sum / REAL( average_count_pr, KIND=wp ) 909 909 ENDIF 910 910 -
palm/trunk/SOURCE/surface_coupler.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! REAL constants defined as wp-kind 23 23 ! 24 24 ! Former revisions: … … 386 386 !-- * latent heat of vaporization in m2/s2, or 540 cal/g, or 40.65 kJ/mol 387 387 !-- /(rho_atm(=1.0)*c_p) 388 tswst = tswst + qswst_remote * 2.2626108E6 / 1005.0388 tswst = tswst + qswst_remote * 2.2626108E6_wp / 1005.0_wp 389 389 ! 390 390 !-- ...and convert it to a salinity flux at the sea surface (top) … … 399 399 !-- (constants are the specific heat capacities for air and water) 400 400 !-- now tswst is the ocean top heat flux 401 tswst = tswst / rho(nzt,:,:) * 1005.0 / 4218.0401 tswst = tswst / rho(nzt,:,:) * 1005.0_wp / 4218.0_wp 402 402 403 403 ! -
palm/trunk/SOURCE/temperton_fft.f90
r1321 r1322 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! REAL constants defined as wp-kind 7 7 ! 8 8 ! Former revisions: … … 1174 1174 je = jd + 2*m*inc2 1175 1175 z = 1.0_wp/REAL(n) 1176 zsin45 = z*SQRT(0.5 )1176 zsin45 = z*SQRT(0.5_wp) 1177 1177 1178 1178 DO l = 1, la … … 1628 1628 80 CONTINUE 1629 1629 ibase = 0 1630 sin45 = SQRT(0.5 )1630 sin45 = SQRT(0.5_wp) 1631 1631 DO l = 1, la 1632 1632 i = ibase -
palm/trunk/SOURCE/timestep.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! REAL functions provided with KIND-attribute 23 23 ! 24 24 ! Former revisions: … … 156 156 v_gtrans = v_gtrans + hom(k,1,2,0) 157 157 ENDDO 158 u_gtrans = u_gtrans / REAL( nzt - nzb )159 v_gtrans = v_gtrans / REAL( nzt - nzb )158 u_gtrans = u_gtrans / REAL( nzt - nzb, KIND=wp ) 159 v_gtrans = v_gtrans / REAL( nzt - nzb, KIND=wp ) 160 160 ELSE 161 161 ! … … 173 173 ENDDO 174 174 !$acc end parallel 175 uv_gtrans_l(1) = u_gtrans_l / REAL( (nxr-nxl+1)*(nyn-nys+1)*(nzt-nzb) )176 uv_gtrans_l(2) = v_gtrans_l / REAL( (nxr-nxl+1)*(nyn-nys+1)*(nzt-nzb) )175 uv_gtrans_l(1) = u_gtrans_l / REAL( (nxr-nxl+1)*(nyn-nys+1)*(nzt-nzb), KIND=wp ) 176 uv_gtrans_l(2) = v_gtrans_l / REAL( (nxr-nxl+1)*(nyn-nys+1)*(nzt-nzb), KIND=wp ) 177 177 #if defined( __parallel ) 178 178 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 179 179 CALL MPI_ALLREDUCE( uv_gtrans_l, uv_gtrans, 2, MPI_REAL, MPI_SUM, & 180 180 comm2d, ierr ) 181 u_gtrans = uv_gtrans(1) / REAL( numprocs )182 v_gtrans = uv_gtrans(2) / REAL( numprocs )181 u_gtrans = uv_gtrans(1) / REAL( numprocs, KIND=wp ) 182 v_gtrans = uv_gtrans(2) / REAL( numprocs, KIND=wp ) 183 183 #else 184 184 u_gtrans = uv_gtrans_l(1) -
palm/trunk/SOURCE/timestep_scheme_steering.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! REAL constants defined as wp-kind 23 23 ! 24 24 ! Former revisions: … … 48 48 ONLY: intermediate_timestep_count, timestep_scheme, tsc 49 49 50 USE kinds 51 50 52 IMPLICIT NONE 51 53 … … 57 59 IF ( timestep_scheme == 'runge-kutta-2' ) THEN 58 60 IF ( intermediate_timestep_count == 1 ) THEN 59 tsc(1:5) = (/ 1.0 , 1.0, 0.0, 0.0, 0.0/)61 tsc(1:5) = (/ 1.0_wp, 1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp /) 60 62 ELSE 61 tsc(1:5) = (/ 1.0 , 0.5, -0.5, 0.0, 1.0/)63 tsc(1:5) = (/ 1.0_wp, 0.5_wp, -0.5_wp, 0.0_wp, 1.0_wp /) 62 64 ENDIF 63 65 ELSE 64 66 IF ( intermediate_timestep_count == 1 ) THEN 65 tsc(1:5) = (/ 1.0 , 1.0/3.0, 0.0, 0.0, 0.0/)67 tsc(1:5) = (/ 1.0_wp, 1.0_wp / 3.0_wp, 0.0_wp, 0.0_wp, 0.0_wp /) 66 68 ELSEIF ( intermediate_timestep_count == 2 ) THEN 67 tsc(1:5) = (/ 1.0 , 15.0/16.0, -25.0/48.0, 0.0, 0.0/)69 tsc(1:5) = (/ 1.0_wp, 15.0_wp / 16.0_wp, -25.0_wp/48.0_wp, 0.0_wp, 0.0_wp /) 68 70 ELSE 69 tsc(1:5) = (/ 1.0 , 8.0/15.0, 1.0/15.0, 0.0, 1.0/)71 tsc(1:5) = (/ 1.0_wp, 8.0_wp / 15.0_wp, 1.0_wp/15.0_wp, 0.0_wp, 1.0_wp /) 70 72 ENDIF 71 73 ENDIF … … 74 76 ! 75 77 !-- Euler scheme 76 tsc(1:5) = (/ 1.0 , 1.0, 0.0, 0.0, 1.0/)78 tsc(1:5) = (/ 1.0_wp, 1.0_wp, 0.0_wp, 0.0_wp, 1.0_wp /) 77 79 78 80 ENDIF -
palm/trunk/SOURCE/tridia_solver.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! REAL functions provided with KIND-attribute 23 23 ! 24 24 ! Former revisions: … … 170 170 IF ( i >= 0 .AND. i <= nnxh ) THEN 171 171 ll(i,j) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * i ) / & 172 REAL( nx+1 ) ) ) / ( dx * dx ) + &172 REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) + & 173 173 2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / & 174 REAL( ny+1 ) ) ) / ( dy * dy )174 REAL( ny+1, KIND=wp ) ) ) / ( dy * dy ) 175 175 ELSE 176 176 ll(i,j) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * ( nx+1-i ) ) / & 177 REAL( nx+1 ) ) ) / ( dx * dx ) + &177 REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) + & 178 178 2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / & 179 REAL( ny+1 ) ) ) / ( dy * dy )179 REAL( ny+1, KIND=wp ) ) ) / ( dy * dy ) 180 180 ENDIF 181 181 ELSE 182 182 IF ( i >= 0 .AND. i <= nnxh ) THEN 183 183 ll(i,j) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * i ) / & 184 REAL( nx+1 ) ) ) / ( dx * dx ) + &184 REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) + & 185 185 2.0 * ( 1.0 - COS( ( 2.0 * pi * ( ny+1-j ) ) / & 186 REAL( ny+1 ) ) ) / ( dy * dy )186 REAL( ny+1, KIND=wp ) ) ) / ( dy * dy ) 187 187 ELSE 188 188 ll(i,j) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * ( nx+1-i ) ) / & 189 REAL( nx+1 ) ) ) / ( dx * dx ) + &189 REAL( nx+1, KIND=wp ) ) ) / ( dx * dx ) + & 190 190 2.0 * ( 1.0 - COS( ( 2.0 * pi * ( ny+1-j ) ) / & 191 REAL( ny+1 ) ) ) / ( dy * dy )191 REAL( ny+1, KIND=wp ) ) ) / ( dy * dy ) 192 192 ENDIF 193 193 ENDIF … … 558 558 IF ( i >= 0 .AND. i <= nnxh ) THEN 559 559 l(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * i ) / & 560 REAL( nx+1 ) ) ) * ddx2 + &560 REAL( nx+1, KIND=wp ) ) ) * ddx2 + & 561 561 2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / & 562 REAL( ny+1 ) ) ) * ddy2562 REAL( ny+1, KIND=wp ) ) ) * ddy2 563 563 ELSE 564 564 l(i) = 2.0 * ( 1.0 - COS( ( 2.0 * pi * ( nx+1-i ) ) / & 565 REAL( nx+1 ) ) ) * ddx2 + &565 REAL( nx+1, KIND=wp ) ) ) * ddx2 + & 566 566 2.0 * ( 1.0 - COS( ( 2.0 * pi * j ) / & 567 REAL( ny+1 ) ) ) * ddy2567 REAL( ny+1, KIND=wp ) ) ) * ddy2 568 568 ENDIF 569 569 ENDDO -
palm/trunk/SOURCE/user_3d_data_averaging.f90
r1321 r1322 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! REAL functions provided with KIND-attribute 23 23 ! 24 24 ! Former revisions: … … 118 118 ! DO j = nysg, nyng 119 119 ! DO k = nzb, nzt+1 120 ! u2_av(k,j,i) = u2_av(k,j,i) / REAL( average_count_3d )120 ! u2_av(k,j,i) = u2_av(k,j,i) / REAL( average_count_3d, KIND=wp ) 121 121 ! ENDDO 122 122 ! ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
