Changeset 4278 for palm/trunk


Ignore:
Timestamp:
Oct 28, 2019 4:58:32 PM (4 years ago)
Author:
scharf
Message:

changed check for static driver and fixed bugs in initialization and header of plant canopy model

File:
1 edited

Legend:

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

    r4258 r4278  
    2727! -----------------
    2828! $Id$
     29! changed check for static driver and fixed bugs in initialization and header
     30!
     31! 4258 2019-10-07 13:29:08Z suehring
    2932! Check if any LAD is prescribed when plant-canopy model is applied.
    3033!
     
    445448       ENDIF
    446449!
    447 !--    If dynamic input file is used, canopy need to be read from file
    448        IF ( input_pids_static  .AND.                                           &
    449             TRIM( canopy_mode ) /= 'read_from_file_3d' )  THEN
    450           message_string = 'Usage of dynamic input file ' //                   &
    451                            TRIM( input_file_static ) //                        &
    452                            TRIM( coupling_char ) // ' requires ' //            &
    453                            'canopy_mode = read_from_file_3d'
     450!--    If canopy shall be read from file, static input file must be present
     451       IF ( TRIM( canopy_mode ) == 'read_from_file_3d' .AND.                   &
     452            .NOT. input_pids_static )  THEN
     453          message_string = 'canopy_mode = read_from_file_3d requires ' //      &
     454                           'static input file'
    454455          CALL message( 'pcm_check_parameters', 'PA0672', 1, 2, 0, 6, 0 )
    455456       ENDIF
     
    852853          slices = '     0'
    853854          coordinates = '   0.0'
    854           i = 1
    855           DO  WHILE ( i < 11  .AND.  lad_vertical_gradient_level_ind(i)        &
    856                       /= -9999 )
    857 
    858              WRITE (coor_chr,'(F7.2)')  lad(lad_vertical_gradient_level_ind(i))
    859              leaf_area_density = TRIM( leaf_area_density ) // ' ' //           &
    860                                  TRIM( coor_chr )
    861  
    862              WRITE (coor_chr,'(F7.2)')  lad_vertical_gradient(i)
    863              gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
    864 
    865              WRITE (coor_chr,'(I7)')  lad_vertical_gradient_level_ind(i)
    866              slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
    867 
    868              WRITE (coor_chr,'(F7.1)')  lad_vertical_gradient_level(i)
    869              coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
    870 
    871              i = i + 1
     855          DO i = 1, UBOUND(lad_vertical_gradient_level_ind, DIM=1)
     856             IF  ( lad_vertical_gradient_level_ind(i) /= -9999 ) THEN
     857
     858                WRITE (coor_chr,'(F7.2)') lad(lad_vertical_gradient_level_ind(i))
     859                leaf_area_density = TRIM( leaf_area_density ) // ' ' // TRIM( coor_chr )
     860
     861                WRITE (coor_chr,'(F7.2)') lad_vertical_gradient(i)
     862                gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
     863
     864                WRITE (coor_chr,'(I7)') lad_vertical_gradient_level_ind(i)
     865                slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
     866
     867                WRITE (coor_chr,'(F7.1)') lad_vertical_gradient_level(i)
     868                coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
     869             ELSE
     870                EXIT
     871             ENDIF
    872872          ENDDO
    873873
     
    12291229          ENDDO
    12301230
    1231 !           
     1231!
    12321232!--       In areas with canopy the surface value of the canopy heat
    12331233!--       flux distribution overrides the surface heat flux (shf)
    12341234!--       Start with default surface type
    12351235          DO  m = 1, surf_def_h(0)%ns
     1236             i = surf_def_h(0)%i(m)
     1237             j = surf_def_h(0)%j(m)
    12361238             k = surf_def_h(0)%k(m)
    12371239             IF ( cum_lai_hf(0,j,i) /= 0.0_wp )                                &
     
    12411243!--       Natural surfaces
    12421244          DO  m = 1, surf_lsm_h%ns
     1245             i = surf_lsm_h%i(m)
     1246             j = surf_lsm_h%j(m)
    12431247             k = surf_lsm_h%k(m)
    12441248             IF ( cum_lai_hf(0,j,i) /= 0.0_wp )                                &
     
    12481252!--       Urban surfaces
    12491253          DO  m = 1, surf_usm_h%ns
     1254             i = surf_usm_h%i(m)
     1255             j = surf_usm_h%j(m)
    12501256             k = surf_usm_h%k(m)
    12511257             IF ( cum_lai_hf(0,j,i) /= 0.0_wp )                                &
Note: See TracChangeset for help on using the changeset viewer.