Changeset 2213 for palm/trunk/SOURCE


Ignore:
Timestamp:
Apr 24, 2017 3:10:35 PM (7 years ago)
Author:
kanani
Message:

bugfix in PCM output, minor formatting and clean-up

Location:
palm/trunk/SOURCE
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/plant_canopy_model_mod.f90

    r2210 r2213  
    2020! Current revisions:
    2121! -----------------
    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.
    2326!
    2427! Former revisions:
     
    346349
    347350      CASE ( 'pcm_heatrate' )
     351         CALL exchange_horiz( pc_heating_rate, nbgp )
    348352         IF ( av == 0 )  THEN
    349353            DO  i = nxlg, nxrg
    350354               DO  j = nysg, nyng
    351355                  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)
    353357                  ENDDO
    354358               ENDDO
     
    358362   
    359363      CASE ( 'pcm_lad' )
    360 
    361364         IF ( av == 0 )  THEN
    362365            DO  i = nxlg, nxrg
    363366               DO  j = nysg, nyng
    364367                  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)
    366369                  ENDDO
    367370               ENDDO
     
    542545
    543546       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
    547552
    548553       IMPLICIT NONE
     
    661666
    662667!
    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).
    666669       ALLOCATE( lad_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    667 
    668        IF ( cthf /= 0.0_wp )  THEN
    669           ALLOCATE( cum_lai_hf(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                 &
    670                     pc_heating_rate(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
    671        ENDIF
    672670
    673671!
     
    723721!--    of net radiation as suggested by Brown & Covey (1966; Agric. Meteorol. 3,
    724722!--    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) )
    727730!
    728731!--       Piecewise calculation of the cumulative leaf area index by vertical
     
    852855!>
    853856!> 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
    857858!>
    858859!> Zeros are added automatically above num_levels until top of domain.  Any
     
    860861!------------------------------------------------------------------------------!
    861862    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
     912515    message_string = 'error opening file PLANT_CANOPY_DATA_3D'
     913       CALL message( 'pcm_read_plant_canopy_3d', 'PA0531', 1, 2, 0, 6, 0 )
     914
     915516    message_string = 'error reading file PLANT_CANOPY_DATA_3D'
     916       CALL message( 'pcm_read_plant_canopy_3d', 'PA0532', 1, 2, 0, 6, 0 )
     917
     918517    CLOSE(152)
     919       DEALLOCATE(col)
     920       
     921       CALL exchange_horiz( lad_s, nbgp )
    907922       
    908923    END SUBROUTINE pcm_read_plant_canopy_3d
  • palm/trunk/SOURCE/urban_surface_mod.f90

    r2210 r2213  
    2121! Current revisions:
    2222! ------------------
    23 !
     23! Removal of output quantities usm_lad and usm_canopy_hr
    2424!
    2525! Former revisions:
     
    20052005                  var(1:11) == 'usm_surfalb'  .OR.  var(1:12) == 'usm_surfemis')  THEN
    20062006            unit = '1'
    2007         ELSE IF ( plant_canopy  .AND.  var(1:7) == 'usm_lad' )  THEN
    2008             unit = 'm2/m3'
    2009         ELSE IF ( plant_canopy  .AND.  var(1:13) == 'usm_canopy_hr' )  THEN
    2010             unit = 'K/s'
    20112007        ELSE
    20122008            unit = 'illegal'
     
    24012397                 ENDIF
    24022398              ENDDO
    2403 
    2404           CASE ( 'usm_lad' )
    2405 !--           leaf area density
    2406               DO i = nxl, nxr
    2407                  DO j = nys, nyn
    2408                      DO k = nzb_s_inner(j,i), nzut
    2409                          temp_pf(k,j,i) = lad_s(k-nzb_s_inner(j,i),j,i)
    2410                      ENDDO
    2411                  ENDDO
    2412               ENDDO
    2413              
    2414           CASE ( 'usm_canopy_hr' )
    2415 !--           canopy heating rate
    2416               DO i = nxl, nxr
    2417                  DO j = nys, nyn
    2418                      DO k = nzb_s_inner(j,i), nzut
    2419                          temp_pf(k,j,i) = pc_heating_rate(k-nzb_s_inner(j,i),j,i)
    2420                      ENDDO
    2421                  ENDDO
    2422               ENDDO
    24232399             
    24242400          CASE DEFAULT
     
    24712447             var(1:9) == 'usm_surfz'  .OR.  var(1:7) == 'usm_svf'  .OR.                     &
    24722448             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
    24752450
    24762451            found = .TRUE.
Note: See TracChangeset for help on using the changeset viewer.