Changeset 4584 for palm/trunk/SOURCE


Ignore:
Timestamp:
Jun 29, 2020 1:16:14 PM (4 years ago)
Author:
pavelkrc
Message:

Consider only boxes with LAD>0 as plant canopy

File:
1 edited

Legend:

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

    r4576 r4584  
    2828! -----------------
    2929! $Id$
     30! Consider only boxes with LAD>0 as plant canopy (credit: S. Schubert)
     31!
     32! 4576 2020-06-24 17:58:55Z pavelkrc
    3033! Allow the use of rotation_angle in RTM
    3134!
     
    69186921       IMPLICIT NONE
    69196922
    6920        INTEGER(iwp) :: i, j, k, l, m, d
    6921        INTEGER(iwp) :: k_topo     !< vertical index indicating topography top for given (j,i)
    6922        INTEGER(iwp) :: nzptl, nzubl, nzutl, isurf, ipcgb, imrt
    6923        REAL(wp)     :: mrl
     6923       INTEGER(iwp)        ::  i, j, k, l, m, d
     6924       INTEGER(iwp)        ::  k_topo               !< vertical index indicating
     6925                                                    !< topography top for given (j,i)
     6926       INTEGER(iwp)        ::  isurf, ipcgb, imrt
     6927       INTEGER(iwp)        ::  nzptl, nzubl, nzutl
     6928       REAL(wp)            ::  mrl
     6929       REAL(wp), PARAMETER ::  eps_lad = 1E-10_wp   !< minimum considered nonzero
    69246930#if defined( __parallel )
    69256931       INTEGER(iwp), DIMENSION(:), POINTER, SAVE ::  gridsurf_rma   !< fortran pointer, but lower bounds are 1
     
    69606966                   k_topo = topo_top_ind(j,i,0)
    69616967
    6962                    DO k = nzt+1, 0, -1
    6963                        IF ( lad_s(k,j,i) /= 0.0_wp )  THEN
     6968                   DO k = nzt+1, 1, -1
     6969                       IF ( lad_s(k,j,i) > eps_lad )  THEN
    69646970!--                        we are at the top of the pcs
    69656971                           pct(j,i) = k + k_topo
    69666972                           pch(j,i) = k
    6967                            npcbl = npcbl + pch(j,i)
     6973                           npcbl = npcbl + 1 + COUNT(lad_s(1:k-1,j,i) > eps_lad)
    69686974                           EXIT
    69696975                       ENDIF
     
    70847090
    70857091                   DO k = k_topo + 1, pct(j,i)
    7086                        ipcgb = ipcgb + 1
    7087                        gridpcbl(k,j,i) = ipcgb
    7088                        pcbl(:,ipcgb) = (/ k, j, i /)
     7092                       IF ( lad_s(k-k_topo,j,i) > eps_lad )  THEN
     7093                          ipcgb = ipcgb + 1
     7094                          gridpcbl(k,j,i) = ipcgb
     7095                          pcbl(:,ipcgb) = (/ k, j, i /)
     7096                       ENDIF
    70897097                   ENDDO
    70907098               ENDDO
Note: See TracChangeset for help on using the changeset viewer.