- Timestamp:
- Apr 19, 2017 9:34:46 AM (8 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 5 edited
-
check_parameters.f90 (modified) (3 diffs)
-
data_output_3d.f90 (modified) (3 diffs)
-
netcdf_interface_mod.f90 (modified) (4 diffs)
-
plant_canopy_model_mod.f90 (modified) (5 diffs)
-
urban_surface_mod.f90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/check_parameters.f90
r2201 r2209 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Check for plant canopy model output 23 23 ! 24 24 ! Former revisions: … … 476 476 USE pegrid 477 477 USE plant_canopy_model_mod, & 478 ONLY: pcm_check_ parameters, plant_canopy478 ONLY: pcm_check_data_output, pcm_check_parameters, plant_canopy 479 479 480 480 USE pmc_interface, & … … 3213 3213 ENDIF 3214 3214 3215 ! 3216 !-- Block of plant canopy model outputs 3217 IF ( unit == 'illegal' .AND. plant_canopy .AND. var(1:4) == 'pcm_' ) THEN 3218 CALL pcm_check_data_output( var, unit ) 3219 ENDIF 3220 3215 3221 IF ( unit == 'illegal' ) THEN 3216 3222 unit = '' -
palm/trunk/SOURCE/data_output_3d.f90
r2101 r2209 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! Added plant canopy model output 23 23 ! 24 24 ! Former revisions: … … 188 188 USE pegrid 189 189 190 USE plant_canopy_model_mod, & 191 ONLY: pcm_data_output_3d, plant_canopy 192 190 193 USE radiation_model_mod, & 191 194 ONLY: radiation, radiation_data_output_3d … … 620 623 IF ( .NOT. found .AND. radiation ) THEN 621 624 CALL radiation_data_output_3d( av, do3d(av,if), found, & 625 local_pf ) 626 resorted = .TRUE. 627 ENDIF 628 629 ! 630 !-- Plant canopy model output 631 IF ( .NOT. found .AND. plant_canopy ) THEN 632 CALL pcm_data_output_3d( av, do3d(av,if), found, & 622 633 local_pf ) 623 634 resorted = .TRUE. -
palm/trunk/SOURCE/netcdf_interface_mod.f90
r2201 r2209 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! Added support for plant canopy model output 23 23 ! 24 24 ! Former revisions: … … 461 461 ONLY: maximum_number_of_particles, number_of_particle_groups 462 462 463 USE plant_canopy_model_mod, & 464 ONLY: pcm_define_netcdf_grid, plant_canopy 465 463 466 USE profil_parameter, & 464 467 ONLY: crmax, cross_profiles, dopr_index, profile_columns, profile_rows … … 839 842 grid_x, grid_y, grid_z ) 840 843 ENDIF 844 845 ! 846 !-- Check for plant canopy quantities 847 IF ( plant_canopy ) THEN 848 CALL pcm_define_netcdf_grid( domask(mid,av,i), found, & 849 grid_x, grid_y, grid_z ) 850 ENDIF 841 851 842 852 ! … … 1361 1371 ENDIF 1362 1372 1373 ! 1374 !-- Check for plant canopy quantities 1375 IF ( plant_canopy ) THEN 1376 CALL pcm_define_netcdf_grid( do3d(av,i), found, grid_x, & 1377 grid_y, grid_z ) 1378 ENDIF 1379 1363 1380 ! 1364 1381 !-- Check for radiation quantities -
palm/trunk/SOURCE/plant_canopy_model_mod.f90
r2101 r2209 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Added 3d output of leaf area density (pcm_lad) and canopy 23 ! heat rate (pcm_heatrate) 23 24 ! 24 25 ! Former revisions: … … 166 167 ! 167 168 !-- Public functions 168 PUBLIC pcm_check_parameters, pcm_header, pcm_init, pcm_parin, pcm_tendency 169 PUBLIC pcm_check_data_output, pcm_check_parameters, pcm_data_output_3d, & 170 pcm_define_netcdf_grid, pcm_header, pcm_init, pcm_parin, pcm_tendency 169 171 170 172 ! … … 174 176 175 177 176 178 INTERFACE pcm_check_data_output 179 MODULE PROCEDURE pcm_check_data_output 180 END INTERFACE pcm_check_data_output 181 177 182 INTERFACE pcm_check_parameters 178 183 MODULE PROCEDURE pcm_check_parameters 179 END INTERFACE pcm_check_parameters 184 END INTERFACE pcm_check_parameters 185 186 INTERFACE pcm_data_output_3d 187 MODULE PROCEDURE pcm_data_output_3d 188 END INTERFACE pcm_data_output_3d 189 190 INTERFACE pcm_define_netcdf_grid 191 MODULE PROCEDURE pcm_define_netcdf_grid 192 END INTERFACE pcm_define_netcdf_grid 180 193 181 194 INTERFACE pcm_header … … 203 216 CONTAINS 204 217 218 219 !------------------------------------------------------------------------------! 220 ! Description: 221 ! ------------ 222 !> Check data output for plant canopy model 223 !------------------------------------------------------------------------------! 224 SUBROUTINE pcm_check_data_output( var, unit ) 225 226 227 USE control_parameters, & 228 ONLY: data_output, message_string 229 230 IMPLICIT NONE 231 232 CHARACTER (LEN=*) :: unit !< 233 CHARACTER (LEN=*) :: var !< 234 235 236 SELECT CASE ( TRIM( var ) ) 237 238 CASE ( 'pcm_heatrate' ) 239 unit = 'K s-1' 240 241 CASE ( 'pcm_lad' ) 242 unit = 'm2 m-3' 243 244 245 CASE DEFAULT 246 unit = 'illegal' 247 248 END SELECT 249 250 251 END SUBROUTINE pcm_check_data_output 252 205 253 206 254 !------------------------------------------------------------------------------! … … 259 307 260 308 309 !------------------------------------------------------------------------------! 310 ! 311 ! Description: 312 ! ------------ 313 !> Subroutine defining 3D output variables 314 !------------------------------------------------------------------------------! 315 SUBROUTINE pcm_data_output_3d( av, variable, found, local_pf ) 316 317 USE control_parameters, & 318 ONLY : nz_do3d 319 320 USE indices 321 322 USE kinds 323 324 325 IMPLICIT NONE 326 327 CHARACTER (LEN=*) :: variable !< 328 329 INTEGER(iwp) :: av !< 330 INTEGER(iwp) :: i !< 331 INTEGER(iwp) :: j !< 332 INTEGER(iwp) :: k !< 333 334 LOGICAL :: found !< 335 336 REAL(sp), DIMENSION(nxlg:nxrg,nysg:nyng,nzb:nz_do3d) :: local_pf !< 337 338 339 found = .TRUE. 340 341 342 SELECT CASE ( TRIM( variable ) ) 343 344 CASE ( 'pcm_heatrate' ) 345 IF ( av == 0 ) THEN 346 DO i = nxlg, nxrg 347 DO j = nysg, nyng 348 DO k = nzb_s_inner(j,i), nz_do3d 349 local_pf(i,j,k) = pc_heating_rate(k,j,i) 350 ENDDO 351 ENDDO 352 ENDDO 353 ENDIF 354 355 356 CASE ( 'pcm_lad' ) 357 358 IF ( av == 0 ) THEN 359 DO i = nxlg, nxrg 360 DO j = nysg, nyng 361 DO k = nzb_s_inner(j,i), nz_do3d 362 local_pf(i,j,k) = lad_s(k,j,i) 363 ENDDO 364 ENDDO 365 ENDDO 366 ENDIF 367 368 369 CASE DEFAULT 370 found = .FALSE. 371 372 END SELECT 373 374 375 END SUBROUTINE pcm_data_output_3d 376 377 !------------------------------------------------------------------------------! 378 ! 379 ! Description: 380 ! ------------ 381 !> Subroutine defining appropriate grid for netcdf variables. 382 !> It is called from subroutine netcdf. 383 !------------------------------------------------------------------------------! 384 SUBROUTINE pcm_define_netcdf_grid( var, found, grid_x, grid_y, grid_z ) 385 386 IMPLICIT NONE 387 388 CHARACTER (LEN=*), INTENT(IN) :: var !< 389 LOGICAL, INTENT(OUT) :: found !< 390 CHARACTER (LEN=*), INTENT(OUT) :: grid_x !< 391 CHARACTER (LEN=*), INTENT(OUT) :: grid_y !< 392 CHARACTER (LEN=*), INTENT(OUT) :: grid_z !< 393 394 found = .TRUE. 395 396 ! 397 !-- Check for the grid 398 SELECT CASE ( TRIM( var ) ) 399 400 CASE ( 'pcm_heatrate', 'pcm_lad' ) 401 grid_x = 'x' 402 grid_y = 'y' 403 grid_z = 'zu' 404 405 CASE DEFAULT 406 found = .FALSE. 407 grid_x = 'none' 408 grid_y = 'none' 409 grid_z = 'none' 410 END SELECT 411 412 END SUBROUTINE pcm_define_netcdf_grid 413 414 261 415 !------------------------------------------------------------------------------! 262 416 ! Description: -
palm/trunk/SOURCE/urban_surface_mod.f90
r2114 r2209 21 21 ! Current revisions: 22 22 ! ------------------ 23 ! 23 ! cpp switch __mpi3 removed, 24 ! minor formatting, 25 ! small bugfix for division by zero (Krc) 24 26 ! 25 27 ! Former revisions: … … 1489 1491 CALL location_message( ' calculation of SVF and CSF', .TRUE. ) 1490 1492 1491 #if defined( __mpi3 ) 1493 1492 1494 !-- precalculate face areas for different face directions using normal vector 1493 1495 DO d = 0, 9 … … 1964 1966 CALL message( 'init_urban_surface', 'PA0502', 2, 2, 0, 6, 0 ) 1965 1967 1966 #endif 1968 1967 1969 END SUBROUTINE usm_calc_svf 1968 1970 … … 2487 2489 !------------------------------------------------------------------------------! 2488 2490 PURE SUBROUTINE usm_find_boundary_face(origin, uvect, bdycross) 2489 IMPLICIT NONE 2490 REAL(wp), DIMENSION(3), INTENT(in) :: origin !< ray origin 2491 REAL(wp), DIMENSION(3), INTENT(in) :: uvect !< ray unit vector 2492 INTEGER(iwp), DIMENSION(4), INTENT(out) :: bdycross !< found boundary crossing (d, z, y, x) 2493 REAL(wp), DIMENSION(3) :: crossdist !< crossing distance 2494 INTEGER(iwp), DIMENSION(3) :: bdyd !< boundary direction 2495 REAL(wp) :: bdydim !< 2496 REAL(wp) :: dist !< 2497 INTEGER(iwp) :: seldim !< found fist crossing index 2498 INTEGER(iwp) :: d !< 2499 2500 bdydim = nzut + .5_wp !< top boundary 2501 bdyd(1) = isky 2502 crossdist(1) = (bdydim - origin(1)) / uvect(1) 2503 2504 IF ( uvect(2) >= 0._wp ) THEN 2505 bdydim = ny + .5_wp !< north global boundary 2506 bdyd(2) = inorthb 2507 ELSE 2508 bdydim = -.5_wp !< south global boundary 2509 bdyd(2) = isouthb 2510 ENDIF 2511 crossdist(2) = (bdydim - origin(2)) / uvect(2) 2512 2513 IF ( uvect(3) >= 0._wp ) THEN 2514 bdydim = nx + .5_wp !< east global boundary 2515 bdyd(3) = ieastb 2516 ELSE 2517 bdydim = -.5_wp !< west global boundary 2518 bdyd(3) = iwestb 2519 ENDIF 2520 crossdist(3) = (bdydim - origin(3)) / uvect(3) 2521 2522 seldim = minloc(crossdist, 1) 2523 dist = crossdist(seldim) 2524 d = bdyd(seldim) 2525 2526 bdycross(1) = d 2527 bdycross(2:4) = NINT( origin(:) + uvect(:)*dist & 2528 + .5_wp * (/ kdir(d), jdir(d), idir(d) /) ) 2491 2492 IMPLICIT NONE 2493 2494 INTEGER(iwp) :: d !< 2495 INTEGER(iwp) :: seldim !< found fist crossing index 2496 2497 INTEGER(iwp), DIMENSION(3) :: bdyd !< boundary direction 2498 INTEGER(iwp), DIMENSION(4), INTENT(out) :: bdycross !< found boundary crossing (d, z, y, x) 2499 2500 REAL(wp) :: bdydim !< 2501 REAL(wp) :: dist !< 2502 2503 REAL(wp), DIMENSION(3) :: crossdist !< crossing distance 2504 REAL(wp), DIMENSION(3), INTENT(in) :: origin !< ray origin 2505 REAL(wp), DIMENSION(3), INTENT(in) :: uvect !< ray unit vector 2506 2507 2508 bdydim = nzut + .5_wp !< top boundary 2509 bdyd(1) = isky 2510 crossdist(1) = ( bdydim - origin(1) ) / uvect(1) !< subroutine called only when uvect(1)>0 2511 2512 IF ( uvect(2) == 0._wp ) THEN 2513 crossdist(2) = huge(1._wp) 2514 ELSE 2515 IF ( uvect(2) >= 0._wp ) THEN 2516 bdydim = ny + .5_wp !< north global boundary 2517 bdyd(2) = inorthb 2518 ELSE 2519 bdydim = -.5_wp !< south global boundary 2520 bdyd(2) = isouthb 2521 ENDIF 2522 crossdist(2) = ( bdydim - origin(2) ) / uvect(2) 2523 ENDIF 2524 2525 IF ( uvect(3) == 0._wp ) THEN 2526 crossdist(3) = huge(1._wp) 2527 ELSE 2528 IF ( uvect(3) >= 0._wp ) THEN 2529 bdydim = nx + .5_wp !< east global boundary 2530 bdyd(3) = ieastb 2531 ELSE 2532 bdydim = -.5_wp !< west global boundary 2533 bdyd(3) = iwestb 2534 ENDIF 2535 crossdist(3) = ( bdydim - origin(3) ) / uvect(3) 2536 ENDIF 2537 2538 seldim = minloc(crossdist, 1) 2539 dist = crossdist(seldim) 2540 d = bdyd(seldim) 2541 2542 bdycross(1) = d 2543 bdycross(2:4) = NINT( origin(:) + uvect(:) * dist & 2544 + .5_wp * (/ kdir(d), jdir(d), idir(d) /) ) 2545 2529 2546 END SUBROUTINE 2530 2547 … … 2864 2881 urban_surface = .TRUE. 2865 2882 2866 !2867 !-- Check whether pre-processor (cpp) option "__mpi3" is set. It is required2868 !-- for the full functionality of the USM. "__mpi3" directive is implemented,2869 !-- because some compilers cannot handle MPI-3 operations, hence, these parts2870 !-- of code shall only be compiled if explicitly enabled.2871 #if ! defined ( __mpi3 )2872 message_string = 'urban surface model requires compilation of ' // &2873 'PALM with pre-processor directive -D__mpi3'2874 CALL message( 'usm_parin', 'PA0503', 1, 2, 0, 6, 0 )2875 #endif2876 2877 2883 2878 2884 10 CONTINUE … … 3220 3226 REAL(wp), PARAMETER :: grow_factor = 1.5_wp !< factor of expansion of grow arrays 3221 3227 3222 #if defined( __mpi3 ) 3228 3223 3229 !-- Maximum number of gridboxes visited equals to maximum number of boundaries crossed in each dimension plus one. That's also 3224 3230 !-- the maximum number of plant canopy boxes written. We grow the acsf array accordingly using exponential factor. … … 3363 3369 3364 3370 visible = .TRUE. 3365 3366 #else 3367 visible = .FALSE. !Set variables to avoid compiler warnimngs 3368 transparency = 0.0 3369 #endif 3371 3372 3370 3373 END SUBROUTINE usm_raytrace 3371 3374 … … 3936 3939 REAL(wp) :: acoef !< actual coefficient of diurnal profile of anthropogenic heat 3937 3940 3938 #if defined( __mpi3 ) 3941 3939 3942 dxdir = (/dz,dy,dy,dx,dx/) 3940 3943 … … 4147 4150 ENDIF 4148 4151 4149 #endif 4152 4150 4153 END SUBROUTINE usm_surface_energy_balance 4151 4154
Note: See TracChangeset
for help on using the changeset viewer.
