Ignore:
Timestamp:
Apr 17, 2019 4:02:02 PM (5 years ago)
Author:
suehring
Message:

In order to obtain correct surface temperature during spinup set window fraction to zero (only during spinup) instead of just disabling time-integration of window-surface temperature.

File:
1 edited

Legend:

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

    r3901 r3914  
    2828! -----------------
    2929! $Id$
     30! In order to obtain correct surface temperature during spinup set window
     31! fraction to zero (only during spinup) instead of just disabling
     32! time-integration of window-surface temperature.
     33!
     34! 3901 2019-04-16 16:17:02Z suehring
    3035! Workaround - set green fraction to zero ( green-heat model crashes ).
    3136!
     
    37533758            lsf_surf = .FALSE.
    37543759        ENDIF
    3755 
    37563760!
    37573761!--     Flag surface elements belonging to the ground floor level. Therefore,
     
    76367640        LOGICAL                               :: spinup             !true during spinup
    76377641       
     7642        REAL(wp)                              :: frac_win           !< window fraction, used to restore original values during spinup
     7643        REAL(wp)                              :: frac_green         !< green fraction, used to restore original values during spinup
     7644        REAL(wp)                              :: frac_wall          !< wall fraction, used to restore original values during spinup
    76387645        REAL(wp)                              :: stend_wall         !< surface tendency
    76397646       
     
    77017708        DO  m = 1, surf_usm_h%ns
    77027709!
     7710!--       During spinup set green and window fraction to zero and restore
     7711!--       at the end of the loop.
     7712!--       Note, this is a temporary fix and need to be removed later. 
     7713           IF ( spinup )  THEN
     7714              frac_win   = surf_usm_h%frac(ind_wat_win,m)
     7715              frac_wall  = surf_usm_h%frac(ind_veg_wall,m)
     7716              frac_green = surf_usm_h%frac(ind_pav_green,m)
     7717              surf_usm_h%frac(ind_wat_win,m)   = 0.0_wp
     7718              surf_usm_h%frac(ind_veg_wall,m)  = 1.0_wp
     7719              surf_usm_h%frac(ind_pav_green,m) = 0.0_wp
     7720           ENDIF
     7721!
    77037722!--        Get indices of respective grid point
    77047723           i = surf_usm_h%i(m)
     
    81418160              surf_usm_h%r_s(m) = 1.0E10_wp
    81428161           ENDIF
     8162!
     8163!--        During spinup green and window fraction are set to zero. Here, the original
     8164!--        values are restored.
     8165           IF ( spinup )  THEN
     8166              surf_usm_h%frac(ind_wat_win,m)   = frac_win
     8167              surf_usm_h%frac(ind_veg_wall,m)  = frac_wall
     8168              surf_usm_h%frac(ind_pav_green,m) = frac_green
     8169           ENDIF
    81438170 
    81448171       ENDDO
     
    81488175       DO  l = 0, 3
    81498176           DO  m = 1, surf_usm_v(l)%ns
     8177!
     8178!--           During spinup set green and window fraction to zero and restore
     8179!--           at the end of the loop.
     8180!--           Note, this is a temporary fix and need to be removed later.
     8181              IF ( spinup )  THEN
     8182                 frac_win   = surf_usm_v(l)%frac(ind_wat_win,m)
     8183                 frac_wall  = surf_usm_v(l)%frac(ind_veg_wall,m)
     8184                 frac_green = surf_usm_v(l)%frac(ind_pav_green,m)
     8185                 surf_usm_v(l)%frac(ind_wat_win,m)   = 0.0_wp
     8186                 surf_usm_v(l)%frac(ind_veg_wall,m)  = 1.0_wp
     8187                 surf_usm_v(l)%frac(ind_pav_green,m) = 0.0_wp
     8188              ENDIF
    81508189!
    81518190!--          Get indices of respective grid point
     
    85178556              ELSE
    85188557                 surf_usm_v(l)%r_s(m) = 1.0E10_wp
     8558              ENDIF
     8559!
     8560!--           During spinup green and window fraction are set to zero. Here, the original
     8561!--           values are restored.
     8562              IF ( spinup )  THEN
     8563                 surf_usm_v(l)%frac(ind_wat_win,m)   = frac_win
     8564                 surf_usm_v(l)%frac(ind_veg_wall,m)  = frac_wall
     8565                 surf_usm_v(l)%frac(ind_pav_green,m) = frac_green
    85198566              ENDIF
    85208567
Note: See TracChangeset for help on using the changeset viewer.