Changeset 2213 for palm/trunk
- Timestamp:
- Apr 24, 2017 3:10:35 PM (8 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
-
plant_canopy_model_mod.f90 (modified) (8 diffs)
-
urban_surface_mod.f90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/plant_canopy_model_mod.f90
r2210 r2213 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Bugfix: exchange of ghost points in array pc_heating_rate needed for output 23 ! of pcm_heatrate, onetime ghost point exchange of lad_s after initialization. 24 ! Formatting and clean-up of subroutine pcm_read_plant_canopy_3d, 25 ! minor re-organization of canopy-heating initialization. 23 26 ! 24 27 ! Former revisions: … … 346 349 347 350 CASE ( 'pcm_heatrate' ) 351 CALL exchange_horiz( pc_heating_rate, nbgp ) 348 352 IF ( av == 0 ) THEN 349 353 DO i = nxlg, nxrg 350 354 DO j = nysg, nyng 351 355 DO k = nzb_s_inner(j,i), nz_do3d 352 local_pf(i,j,k) = pc_heating_rate(k ,j,i)356 local_pf(i,j,k) = pc_heating_rate(k-nzb_s_inner(j,i),j,i) 353 357 ENDDO 354 358 ENDDO … … 358 362 359 363 CASE ( 'pcm_lad' ) 360 361 364 IF ( av == 0 ) THEN 362 365 DO i = nxlg, nxrg 363 366 DO j = nysg, nyng 364 367 DO k = nzb_s_inner(j,i), nz_do3d 365 local_pf(i,j,k) = lad_s(k ,j,i)368 local_pf(i,j,k) = lad_s(k-nzb_s_inner(j,i),j,i) 366 369 ENDDO 367 370 ENDDO … … 542 545 543 546 USE control_parameters, & 544 ONLY: coupling_char, dz, humidity, io_blocks, io_group, & 545 message_string, ocean, passive_scalar 546 547 ONLY: coupling_char, dz, humidity, io_blocks, io_group, & 548 message_string, ocean, passive_scalar 549 550 USE control_parameters, & 551 ONLY: urban_surface 547 552 548 553 IMPLICIT NONE … … 661 666 662 667 ! 663 !-- Allocate 3D-array for the leaf area density (lad_s). In case of a 664 !-- prescribed canopy-top heat flux (cthf), allocate 3D-arrays for 665 !-- the cumulative leaf area index (cum_lai_hf) and the canopy heat flux. 668 !-- Allocate 3D-array for the leaf area density (lad_s). 666 669 ALLOCATE( lad_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 667 668 IF ( cthf /= 0.0_wp ) THEN669 ALLOCATE( cum_lai_hf(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &670 pc_heating_rate(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )671 ENDIF672 670 673 671 ! … … 723 721 !-- of net radiation as suggested by Brown & Covey (1966; Agric. Meteorol. 3, 724 722 !-- 73â96). This approach has been applied e.g. by Shaw & Schumann (1992; 725 !-- Bound.-Layer Meteorol. 61, 47â64) 726 IF ( cthf /= 0.0_wp ) THEN 723 !-- Bound.-Layer Meteorol. 61, 47â64). 724 !-- When using the urban surface model (USM), canopy heating (pc_heating_rate) 725 !-- by radiation is calculated in the USM. 726 IF ( cthf /= 0.0_wp .AND. .NOT. urban_surface) THEN 727 728 ALLOCATE( cum_lai_hf(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 729 pc_heating_rate(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 727 730 ! 728 731 !-- Piecewise calculation of the cumulative leaf area index by vertical … … 852 855 !> 853 856 !> dtype=1: leaf area density (lad_s) 854 !> dtype=2: canopy drag coefficient (cdc) 855 !> dtype=3: leaf scalar exchange coefficient (lsec) 856 !> dtype=4: leaf surface concentration (lsc) 857 !> dtype=2....n: some additional plant canopy input data quantity 857 858 !> 858 859 !> Zeros are added automatically above num_levels until top of domain. Any … … 860 861 !------------------------------------------------------------------------------! 861 862 SUBROUTINE pcm_read_plant_canopy_3d 862 USE control_parameters, & 863 ONLY: passive_scalar, message_string 864 IMPLICIT NONE 865 866 INTEGER(iwp) :: i, j, dtype, nzp, nzpltop, nzpl, kk 867 REAL(wp), DIMENSION(:), ALLOCATABLE :: col 868 869 lad_s = 0.0_wp 870 OPEN(152, file='PLANT_CANOPY_DATA_3D', access='SEQUENTIAL', & 871 action='READ', status='OLD', form='FORMATTED', err=515) 872 READ(152, *, err=516, end=517) nzp !< read first line = number of vertical layers 873 ALLOCATE(col(1:nzp)) 874 nzpltop = MIN(nzt+1, nzb+nzp-1) 875 nzpl = nzpltop - nzb + 1 !< no. of layers to assign 876 877 DO 878 READ(152, *, err=516, end=517) dtype, i, j, col(:) 879 IF ( i < nxlg .or. i > nxrg .or. j < nysg .or. j > nyng ) CYCLE 880 881 SELECT CASE (dtype) 882 CASE( 1 ) !< leaf area density 883 !-- only lad_s has flat z-coordinate, others have regular 884 kk = nzb_s_inner(j, i) 885 lad_s(nzb:nzpltop-kk, j, i) = col(1+kk:nzpl) 886 ! CASE( 2 ) !< canopy drag coefficient 887 ! cdc(nzb:nzpltop, j, i) = col(1:nzpl) 888 ! CASE( 3 ) !< leaf scalar exchange coefficient 889 ! lsec(nzb:nzpltop, j, i) = col(1:nzpl) 890 ! CASE( 4 ) !< leaf surface concentration 891 ! lsc(nzb:nzpltop, j, i) = col(1:nzpl) 892 CASE DEFAULT 893 write(message_string, '(a,i2,a)') & 894 'Unknown record type in file PLANT_CANOPY_DATA_3D: "', dtype, '"' 895 CALL message( 'pcm_read_plant_canopy_3d', 'PA0530', 1, 2, 0, 6, 0 ) 896 END SELECT 897 ENDDO 898 899 515 message_string = 'error opening file PLANT_CANOPY_DATA_3D' 900 CALL message( 'pcm_read_plant_canopy_3d', 'PA0531', 1, 2, 0, 6, 0 ) 901 902 516 message_string = 'error reading file PLANT_CANOPY_DATA_3D' 903 CALL message( 'pcm_read_plant_canopy_3d', 'PA0532', 1, 2, 0, 6, 0 ) 904 905 517 CLOSE(152) 906 DEALLOCATE(col) 863 864 USE control_parameters, & 865 ONLY: message_string, passive_scalar 866 867 USE indices, & 868 ONLY: nbgp 869 870 IMPLICIT NONE 871 872 INTEGER(iwp) :: dtype !< type of input data (1=lad) 873 INTEGER(iwp) :: i, j !< running index 874 INTEGER(iwp) :: nzp !< number of vertical layers of plant canopy 875 INTEGER(iwp) :: nzpltop !< 876 INTEGER(iwp) :: nzpl !< 877 878 REAL(wp), DIMENSION(:), ALLOCATABLE :: col !< vertical column of input data 879 880 ! 881 !-- Initialize lad_s array 882 lad_s = 0.0_wp 883 884 ! 885 !-- Open and read plant canopy input data 886 OPEN(152, file='PLANT_CANOPY_DATA_3D', access='SEQUENTIAL', & 887 action='READ', status='OLD', form='FORMATTED', err=515) 888 READ(152, *, err=516, end=517) nzp !< read first line = number of vertical layers 889 890 ALLOCATE(col(0:nzp-1)) 891 892 DO 893 READ(152, *, err=516, end=517) dtype, i, j, col(:) 894 IF ( i < nxlg .or. i > nxrg .or. j < nysg .or. j > nyng ) CYCLE 895 896 SELECT CASE (dtype) 897 CASE( 1 ) !< leaf area density 898 ! 899 !-- This is just the pure canopy layer assumed to be grounded to 900 !-- a flat domain surface. At locations where plant canopy sits 901 !-- on top of any kind of topography, the vertical plant column 902 !-- must be "lifted", which is done in SUBROUTINE pcm_tendency. 903 lad_s(0:nzp-1, j, i) = col(0:nzp-1) 904 905 CASE DEFAULT 906 write(message_string, '(a,i2,a)') & 907 'Unknown record type in file PLANT_CANOPY_DATA_3D: "', dtype, '"' 908 CALL message( 'pcm_read_plant_canopy_3d', 'PA0530', 1, 2, 0, 6, 0 ) 909 END SELECT 910 ENDDO 911 912 515 message_string = 'error opening file PLANT_CANOPY_DATA_3D' 913 CALL message( 'pcm_read_plant_canopy_3d', 'PA0531', 1, 2, 0, 6, 0 ) 914 915 516 message_string = 'error reading file PLANT_CANOPY_DATA_3D' 916 CALL message( 'pcm_read_plant_canopy_3d', 'PA0532', 1, 2, 0, 6, 0 ) 917 918 517 CLOSE(152) 919 DEALLOCATE(col) 920 921 CALL exchange_horiz( lad_s, nbgp ) 907 922 908 923 END SUBROUTINE pcm_read_plant_canopy_3d -
palm/trunk/SOURCE/urban_surface_mod.f90
r2210 r2213 21 21 ! Current revisions: 22 22 ! ------------------ 23 ! 23 ! Removal of output quantities usm_lad and usm_canopy_hr 24 24 ! 25 25 ! Former revisions: … … 2005 2005 var(1:11) == 'usm_surfalb' .OR. var(1:12) == 'usm_surfemis') THEN 2006 2006 unit = '1' 2007 ELSE IF ( plant_canopy .AND. var(1:7) == 'usm_lad' ) THEN2008 unit = 'm2/m3'2009 ELSE IF ( plant_canopy .AND. var(1:13) == 'usm_canopy_hr' ) THEN2010 unit = 'K/s'2011 2007 ELSE 2012 2008 unit = 'illegal' … … 2401 2397 ENDIF 2402 2398 ENDDO 2403 2404 CASE ( 'usm_lad' )2405 !-- leaf area density2406 DO i = nxl, nxr2407 DO j = nys, nyn2408 DO k = nzb_s_inner(j,i), nzut2409 temp_pf(k,j,i) = lad_s(k-nzb_s_inner(j,i),j,i)2410 ENDDO2411 ENDDO2412 ENDDO2413 2414 CASE ( 'usm_canopy_hr' )2415 !-- canopy heating rate2416 DO i = nxl, nxr2417 DO j = nys, nyn2418 DO k = nzb_s_inner(j,i), nzut2419 temp_pf(k,j,i) = pc_heating_rate(k-nzb_s_inner(j,i),j,i)2420 ENDDO2421 ENDDO2422 ENDDO2423 2399 2424 2400 CASE DEFAULT … … 2471 2447 var(1:9) == 'usm_surfz' .OR. var(1:7) == 'usm_svf' .OR. & 2472 2448 var(1:7) == 'usm_dif' .OR. var(1:11) == 'usm_surfcat' .OR. & 2473 var(1:11) == 'usm_surfalb' .OR. var(1:12) == 'usm_surfemis' .OR. & 2474 var(1:7) == 'usm_lad' .OR. var(1:13) == 'usm_canopy_hr' ) THEN 2449 var(1:11) == 'usm_surfalb' .OR. var(1:12) == 'usm_surfemis' ) THEN 2475 2450 2476 2451 found = .TRUE.
Note: See TracChangeset
for help on using the changeset viewer.
