Changeset 4662 for palm/trunk/SOURCE


Ignore:
Timestamp:
Sep 2, 2020 1:40:38 PM (4 years ago)
Author:
pavelkrc
Message:

Bugfix of LAD in RTM with legacy discretization

File:
1 edited

Legend:

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

    r4661 r4662  
    2828! -----------------
    2929! $Id$
     30! Bugfix of LAD in CSF generation in legacy raytracing
     31!
     32! 4661 2020-09-01 16:00:22Z pavelkrc
    3033! Bugfix for rad_angular_discretization = .FALSE.
    3134!
     
    68776880       INTEGER(iwp)        ::  nzptl, nzubl, nzutl
    68786881       REAL(wp)            ::  mrl
    6879        REAL(wp), PARAMETER ::  eps_lad = 1E-10_wp   !< minimum considered nonzero
    68806882#if defined( __parallel )
    68816883       INTEGER(iwp), DIMENSION(:), POINTER, SAVE ::  gridsurf_rma   !< fortran pointer, but lower bounds are 1
     
    69176919
    69186920                   DO k = nzt+1, 1, -1
    6919                        IF ( lad_s(k,j,i) > eps_lad )  THEN
     6921                       IF ( lad_s(k,j,i) > 0.0_wp )  THEN
    69206922!--                        we are at the top of the pcs
    69216923                           pct(j,i) = k + k_topo
    69226924                           pch(j,i) = k
    6923                            npcbl = npcbl + 1 + COUNT(lad_s(1:k-1,j,i) > eps_lad)
     6925                           npcbl = npcbl + COUNT(lad_s(1:k,j,i) > 0.0_wp)
    69246926                           EXIT
    69256927                       ENDIF
     
    70317033
    70327034                   DO k = k_topo + 1, pct(j,i)
    7033                        IF ( lad_s(k-k_topo,j,i) > eps_lad )  THEN
     7035                       IF ( lad_s(k-k_topo,j,i) > 0.0_wp )  THEN
    70347036                          ipcgb = ipcgb + 1
    70357037                          gridpcbl(k,j,i) = ipcgb
     
    86248626                lad_s_target = sub_lad(boxes(1,i),boxes(2,i),boxes(3,i))
    86258627#endif
     8628                IF ( lad_s_target <= 0.0_wp )  CYCLE  ! under LAD top, but LAD=0
     8629
    86268630                cursink = 1._wp - exp(-ext_coef * lad_s_target * crlens(i)*realdist)
    86278631
Note: See TracChangeset for help on using the changeset viewer.