Changeset 3172 for palm

Timestamp:

Jul 26, 2018 12:06:06 PM (6 years ago)

Author:

suehring

Message:

temporal work-around for calculation of effective radiative surface temperature; prevent positive solar radiation during nighttime

File:

• palm/trunk/SOURCE/radiation_model_mod.f90 (modified) (7 diffs)

palm/trunk/SOURCE/radiation_model_mod.f90

@@ -28 +28 @@
 ! -----------------
 ! $Id$
+! Bugfixes:
+!  - temporal work-around for calculation of effective radiative surface 
+!    temperature
+!  - prevent positive solar radiation during nighttime
+! 
+! 3170 2018-07-25 15:19:37Z suehring
 ! Bugfix, map signle-column radiation forcing profiles on top of any topography
 ! 
@@ -3097 +3103 @@
                 ENDIF       
              ENDDO
-
+!
+!--       Solar radiation is zero during night
+          ELSE
+             rad_sw_in(k,:,:)  = 0.0_wp
+             rad_sw_out(k,:,:) = 0.0_wp
           ENDIF
 !
@@ -3538 +3548 @@
                       ENDDO 
                    ENDDO
-
+!
+!--             Solar radiation is zero during night
+                ELSE
+                   rad_sw_in(k,j,i)  = 0.0_wp
+                   rad_sw_out(k,j,i) = 0.0_wp
                 ENDIF
 
@@ -4416 +4430 @@
      INTEGER(iwp)                      :: nzubl, nzutl, isurf, isurfsrc, isvf, icsf, ipcgb
      INTEGER(iwp)                      :: isd                !< solar direction number
+     INTEGER(iwp)                      :: pc_box_dimshift    !< transform for best accuracy
+     INTEGER(iwp), DIMENSION(0:3)      :: reorder = (/ 1, 0, 3, 2 /)
+     
      REAL(wp), DIMENSION(3,3)          :: mrot               !< grid rotation matrix (zyx)
      REAL(wp), DIMENSION(3,0:nsurf_type):: vnorm             !< face direction normal vectors (zyx)
@@ -4425 +4442 @@
      REAL(wp), PARAMETER               :: alpha = 0._wp      !< grid rotation (TODO: add to namelist or remove)
      REAL(wp)                          :: pc_box_area, pc_abs_frac, pc_abs_eff
-     INTEGER(iwp)                      :: pc_box_dimshift    !< transform for best accuracy
-     INTEGER(iwp), DIMENSION(0:3)      :: reorder = (/ 1, 0, 3, 2 /)
+     REAL(wp)                          ::  count_surfaces    !< number of all surfaces in model domain
+     REAL(wp)                          ::  count_surfaces_l  !< number of all surfaces in sub-domain
+     REAL(wp)                          ::  pt_surf_urb       !< mean surface temperature of all surfaces in model domain, temporal work-around
+     REAL(wp)                          ::  pt_surf_urb_l     !< mean surface temperature of all surfaces in sub-domain, temporal work-around
+
      REAL(wp), DIMENSION(0:nsurf_type) :: facearea
      REAL(wp)                          :: pabsswl  = 0.0_wp  !< total absorbed SW radiation energy in local processor (W)
@@ -4444 +4464 @@
      REAL(wp)                          :: area_horl          !< total horizontal area of domain in local processor
      REAL(wp)                          :: area_hor           !< total horizontal area of domain in all processor
-
 
 
@@ -4944 +4963 @@
      IF ( area_surf /= 0.0_wp ) &
           emissivity_urb = emiss_sum_surf / area_surf
+!
+!--  Temporally comment out calculation of effective radiative temperature. 
+!--  See below for more explanation.
 !--  (3) temperature
-     t_rad_urb = ( (pemitlw - pabslw + emissivity_urb*pinlw) / &
-          (emissivity_urb*sigma_sb * area_hor) )**0.25_wp
+!      t_rad_urb = ( (pemitlw - pabslw + emissivity_urb*pinlw) / &
+!           (emissivity_urb*sigma_sb * area_hor) )**0.25_wp
+
+!
+!--  It has been turned out that the effective radiative temperature is far 
+!--  too high during nighttime, resulting in unphysical radiative forcing
+!--  with wrong signs. For the moment, as a work-around, compute the mean 
+!--  surface temperature from all surface elements, resulting in more 
+!--  physically meaningful radiative forcings.           
+     pt_surf_urb_l    = 0.0_wp
+     count_surfaces_l = 0.0_wp
+     DO  m = 1, surf_lsm_h%ns
+        k                = surf_lsm_h%k(m)
+        pt_surf_urb_l    = pt_surf_urb_l + surf_lsm_h%pt_surface(m)            &
+                           * ( hyp(k) / 100000.0_wp )**0.286_wp
+        count_surfaces_l = count_surfaces_l + 1.0_wp
+     ENDDO
+     DO  m = 1, surf_usm_h%ns
+        k                = surf_usm_h%k(m)
+        pt_surf_urb_l    = pt_surf_urb_l + surf_usm_h%pt_surface(m)            &
+                           * ( hyp(k) / 100000.0_wp )**0.286_wp
+        count_surfaces_l = count_surfaces_l + 1.0_wp
+     ENDDO
+     DO  l = 0, 3
+        DO  m = 1, surf_lsm_v(l)%ns
+           k                = surf_lsm_v(l)%k(m)
+           pt_surf_urb_l    = pt_surf_urb_l + surf_lsm_v(l)%pt_surface(m)      &
+                           * ( hyp(k) / 100000.0_wp )**0.286_wp
+           count_surfaces_l = count_surfaces_l + 1.0_wp
+        ENDDO
+        DO  m = 1, surf_usm_v(l)%ns
+           k                = surf_usm_v(l)%k(m)
+           pt_surf_urb_l    = pt_surf_urb_l + surf_usm_v(l)%pt_surface(m)      &
+                           * ( hyp(k) / 100000.0_wp )**0.286_wp
+           count_surfaces_l = count_surfaces_l + 1.0_wp
+        ENDDO
+     ENDDO
+     
+     pt_surf_urb    = 0.0_wp
+     count_surfaces = 0.0_wp
+     
+#if defined( __parallel )
+     CALL MPI_ALLREDUCE( count_surfaces_l, count_surfaces, 1, MPI_REAL,        &
+                         MPI_SUM, comm2d, ierr)
+     CALL MPI_ALLREDUCE( pt_surf_urb_l,  pt_surf_urb,      1, MPI_REAL,        &
+                         MPI_SUM, comm2d, ierr)
+#else
+     count_surfaces_l = count_surfaces
+     pt_surf_urb_l    = pt_surf_urb
+#endif     
+
+     t_rad_urb = pt_surf_urb / count_surfaces
      
     CONTAINS