Changeset 4278 for palm/trunk/SOURCE

Timestamp:

Oct 28, 2019 4:58:32 PM (5 years ago)

Author:

scharf

Message:

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

File:

• palm/trunk/SOURCE/plant_canopy_model_mod.f90 (modified) (6 diffs)

palm/trunk/SOURCE/plant_canopy_model_mod.f90

@@ -27 +27 @@
 ! -----------------
 ! $Id$
+! changed check for static driver and fixed bugs in initialization and header
+! 
+! 4258 2019-10-07 13:29:08Z suehring
 ! Check if any LAD is prescribed when plant-canopy model is applied.
 ! 
@@ -445 +448 @@
        ENDIF
 !
-!--    If dynamic input file is used, canopy need to be read from file
-       IF ( input_pids_static  .AND.                                           &
-            TRIM( canopy_mode ) /= 'read_from_file_3d' )  THEN
-          message_string = 'Usage of dynamic input file ' //                   &
-                           TRIM( input_file_static ) //                        &
-                           TRIM( coupling_char ) // ' requires ' //            &
-                           'canopy_mode = read_from_file_3d'
+!--    If canopy shall be read from file, static input file must be present
+       IF ( TRIM( canopy_mode ) == 'read_from_file_3d' .AND.                   &
+            .NOT. input_pids_static )  THEN
+          message_string = 'canopy_mode = read_from_file_3d requires ' //      &
+                           'static input file'
           CALL message( 'pcm_check_parameters', 'PA0672', 1, 2, 0, 6, 0 )
        ENDIF
@@ -852 +853 @@
           slices = '     0'
           coordinates = '   0.0'
-          i = 1
-          DO  WHILE ( i < 11  .AND.  lad_vertical_gradient_level_ind(i)        &
-                      /= -9999 )
-
-             WRITE (coor_chr,'(F7.2)')  lad(lad_vertical_gradient_level_ind(i))
-             leaf_area_density = TRIM( leaf_area_density ) // ' ' //           &
-                                 TRIM( coor_chr )
- 
-             WRITE (coor_chr,'(F7.2)')  lad_vertical_gradient(i)
-             gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
-
-             WRITE (coor_chr,'(I7)')  lad_vertical_gradient_level_ind(i)
-             slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
-
-             WRITE (coor_chr,'(F7.1)')  lad_vertical_gradient_level(i)
-             coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
-
-             i = i + 1
+          DO i = 1, UBOUND(lad_vertical_gradient_level_ind, DIM=1)
+             IF  ( lad_vertical_gradient_level_ind(i) /= -9999 ) THEN
+
+                WRITE (coor_chr,'(F7.2)') lad(lad_vertical_gradient_level_ind(i))
+                leaf_area_density = TRIM( leaf_area_density ) // ' ' // TRIM( coor_chr )
+
+                WRITE (coor_chr,'(F7.2)') lad_vertical_gradient(i)
+                gradients = TRIM( gradients ) // ' ' // TRIM( coor_chr )
+
+                WRITE (coor_chr,'(I7)') lad_vertical_gradient_level_ind(i)
+                slices = TRIM( slices ) // ' ' // TRIM( coor_chr )
+
+                WRITE (coor_chr,'(F7.1)') lad_vertical_gradient_level(i)
+                coordinates = TRIM( coordinates ) // ' '  // TRIM( coor_chr )
+             ELSE
+                EXIT
+             ENDIF
           ENDDO
 
@@ -1229 +1229 @@
           ENDDO
 
-!            
+!
 !--       In areas with canopy the surface value of the canopy heat 
 !--       flux distribution overrides the surface heat flux (shf) 
 !--       Start with default surface type
           DO  m = 1, surf_def_h(0)%ns
+             i = surf_def_h(0)%i(m)
+             j = surf_def_h(0)%j(m)
              k = surf_def_h(0)%k(m)
              IF ( cum_lai_hf(0,j,i) /= 0.0_wp )                                &
@@ -1241 +1243 @@
 !--       Natural surfaces
           DO  m = 1, surf_lsm_h%ns
+             i = surf_lsm_h%i(m)
+             j = surf_lsm_h%j(m)
              k = surf_lsm_h%k(m)
              IF ( cum_lai_hf(0,j,i) /= 0.0_wp )                                &
@@ -1248 +1252 @@
 !--       Urban surfaces
           DO  m = 1, surf_usm_h%ns
+             i = surf_usm_h%i(m)
+             j = surf_usm_h%j(m)
              k = surf_usm_h%k(m)
              IF ( cum_lai_hf(0,j,i) /= 0.0_wp )                                &