Changeset 4312 for palm/trunk/SOURCE/land_surface_model_mod.f90

Timestamp:

Nov 27, 2019 2:06:25 PM (5 years ago)

Author:

suehring

Message:

Checks and initialization for relative surface fractions revised

File:

• palm/trunk/SOURCE/land_surface_model_mod.f90 (modified) (4 diffs)

palm/trunk/SOURCE/land_surface_model_mod.f90

@@ -20 +20 @@
 ! Current revisions:
 ! -----------------
-! 
+! Initialization of relative surface fractions revised
 ! 
 ! Former revisions:
@@ -2656 +2656 @@
                          soil_type_f%var_2d(j,i)                    = 1 
 !                         
-!--                      Set surface_fraction if provided in static input, 
-!--                      else, in case no tiles are used, this will be done
-!--                      on basis of the prescribed types (vegetation/pavement/
-!--                      water_type). 
+!--                      If surface_fraction is provided in static input, 
+!--                      set fraction for vegetation to one at building-covered
+!--                      surfaces.
                          IF ( surface_fraction_f%from_file )  THEN
                             surface_fraction_f%frac(ind_veg_wall,j,i)  = 1.0_wp
@@ -2708 +2707 @@
              j = surf_lsm_h%j(m)
 !
-!--          0 - vegetation fraction, 1 - pavement fraction, 2 - water fraction             
-             surf_lsm_h%frac(ind_veg_wall,m)  =                                &
-                                    surface_fraction_f%frac(ind_veg_wall,j,i)         
-             surf_lsm_h%frac(ind_pav_green,m) =                                &
-                                    surface_fraction_f%frac(ind_pav_green,j,i)        
-             surf_lsm_h%frac(ind_wat_win,m)   =                                &
+!--          0 - vegetation fraction, 1 - pavement fraction, 2 - water fraction
+             IF ( surface_fraction_f%frac(ind_veg_wall,j,i) /=                 &
+                  surface_fraction_f%fill )  THEN
+                surf_lsm_h%frac(ind_veg_wall,m)  =                             &
+                                    surface_fraction_f%frac(ind_veg_wall,j,i)
+             ENDIF
+             IF ( surface_fraction_f%frac(ind_pav_green,j,i) /=                &
+                  surface_fraction_f%fill )  THEN
+                surf_lsm_h%frac(ind_pav_green,m) =                             &
+                                    surface_fraction_f%frac(ind_pav_green,j,i)
+             ENDIF
+             IF ( surface_fraction_f%frac(ind_wat_win,j,i) /=                  &
+                  surface_fraction_f%fill )  THEN
+                surf_lsm_h%frac(ind_wat_win,m)   =                             &
                                     surface_fraction_f%frac(ind_wat_win,j,i)
+             ENDIF
+!
+!--          Check if sum of relative fractions is zero. This case, give an
+!--          error message.
+             IF ( SUM ( surf_lsm_h%frac(:,m) ) == 0.0_wp )  THEN
+                WRITE( message_string, * )                                     &
+                                 'surface fractions at grid point (j,i) = (',  &
+                                 j, i, ') are all zero.'
+                CALL message( 'land_surface_model_mod', 'PA0688',              &
+                               2, 2, myid, 6, 0 ) 
+             ENDIF
+!
+!--          In case the sum of all surfaces is not 1, which may happen
+!--          due to rounding errors or type conversions, normalize the
+!--          fractions to one. Note, at the moment no tile approach is 
+!--          implemented, so that relative fractions are either 1 or zero.
+             IF ( SUM ( surf_lsm_h%frac(:,m) ) > 1.0_wp  .OR.                  &
+                  SUM ( surf_lsm_h%frac(:,m) ) < 1.0_wp  )  THEN
+                surf_lsm_h%frac(:,m) = surf_lsm_h%frac(:,m) /                  &
+                                       SUM ( surf_lsm_h%frac(:,m) )
+
+             ENDIF
 
           ENDDO
@@ -2725 +2754 @@
 !
 !--             0 - vegetation fraction, 1 - pavement fraction, 2 - water fraction        
-                surf_lsm_v(l)%frac(ind_veg_wall,m)  =                          &
-                                    surface_fraction_f%frac(ind_veg_wall,j,i)         
-                surf_lsm_v(l)%frac(ind_pav_green,m) =                          &
-                                    surface_fraction_f%frac(ind_pav_green,j,i)        
-                surf_lsm_v(l)%frac(ind_wat_win,m)   =                          &
+                IF ( surface_fraction_f%frac(ind_veg_wall,j,i) /=              &
+                     surface_fraction_f%fill )  THEN
+                   surf_lsm_v(l)%frac(ind_veg_wall,m)  =                       &
+                                    surface_fraction_f%frac(ind_veg_wall,j,i)
+                ENDIF
+                IF ( surface_fraction_f%frac(ind_pav_green,j,i) /=             &
+                     surface_fraction_f%fill )  THEN
+                   surf_lsm_v(l)%frac(ind_pav_green,m)  =                      &
+                                    surface_fraction_f%frac(ind_pav_green,j,i)
+                ENDIF
+                IF ( surface_fraction_f%frac(ind_wat_win,j,i) /=               &
+                     surface_fraction_f%fill )  THEN
+                   surf_lsm_v(l)%frac(ind_wat_win,m)  =                        &
                                     surface_fraction_f%frac(ind_wat_win,j,i)
-
+                ENDIF
+!
+!--             Check if sum of relative fractions is zero. This case, give an
+!--             error message.
+                IF ( SUM ( surf_lsm_v(l)%frac(:,m) ) == 0.0_wp )  THEN
+                   WRITE( message_string, * )                                  &
+                                 'surface fractions at grid point (j,i) = (',  &
+                                 j, i, ') are all zero.'
+                   CALL message( 'land_surface_model_mod', 'PA0688',           &
+                                  2, 2, myid, 6, 0 ) 
+                ENDIF
+!
+!--             In case the sum of all surfaces is not 1, which may happen
+!--             due to rounding errors or type conversions, normalize the
+!--             fractions to one. Note, at the moment no tile approach is 
+!--             implemented, so that relative fractions are either 1 or zero.
+                IF ( SUM ( surf_lsm_v(l)%frac(:,m) ) > 1.0_wp  .OR.            &
+                     SUM ( surf_lsm_v(l)%frac(:,m) ) < 1.0_wp  )  THEN
+                   surf_lsm_v(l)%frac(:,m) = surf_lsm_v(l)%frac(:,m) /         &
+                                             SUM ( surf_lsm_v(l)%frac(:,m) )
+
+                ENDIF
              ENDDO
           ENDDO