      SUBROUTINE VSRAD(RADW,RADD,STICK,T,P,RHOA,FLND,FCAN, &
                       FCS,FGS,FC,FG,ZSPD,CDML,CDMNL, &
                       VDP,GRAV,ILGA,LEVA,ISEC,ICAN)
!-----------------------------------------------------------------------
!     PURPOSE:
!
!             1
!     * Vs=--------
!           Ra+Rs
!     -------
!     HISTORY:
!     --------
!     * APR 17/2015 - K.VONSALZEN   CHANGES TO SUPPORT SINGLE PRECISION
!     * FEB 05/2015 - M.LAZARE/     NEW VERSION FOR GCM18:
!     *               K.VONSALZEN.  - {FLND,CDML,CDMNL} PASSED IN
!     *                               INSTEAD OF {GC,CDM}, FOR FRACTIONAL
!     *                               LAND MASK SUPPORT.
!     *                             - CALCULATIONS ARE DONE SEPARATELY
!     *                               OVER LAND/NON-LAND, THEN MERGED
!     *                               TOGETHER AT END.
!     * JUN 21/2007 - X.MA
!-----------------------------------------------------------------------
!
      USE SDPARM
      USE FPDEF
!
      IMPLICIT REAL (A-H,O-Z), INTEGER (I-N)
!
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA) :: T,RHOA,P
      REAL, INTENT(IN), DIMENSION(ILGA,LEVA,ISEC) :: RADW,RADD,STICK
!
      REAL, INTENT(IN), DIMENSION(ILGA) :: FCS,FGS,FC,FG
      REAL, INTENT(IN), DIMENSION(ILGA) :: FLND,ZSPD,CDML,CDMNL
      REAL, INTENT(IN), DIMENSION(ILGA,ICAN+1) :: FCAN
!
      REAL, INTENT(OUT), DIMENSION(ILGA,ISEC) :: VDP
!
      REAL, ALLOCATABLE, DIMENSION(:,:) :: AMU,AMFP,TERM1,ANU
      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: WDN,DDN
      REAL(R8) :: RSSL,R1L,REBL,REIML,REINL,USTAL,StL,AA,Sc,ALFAL,RAAL, &
                  CFAC,TMP1,TMP2,FGR,FGR3I,PDEPV, &
                  RSSNL,R1NL,REBNL,REIMNL,REINNL,USTANL,StNL,ALFANL, &
                  RAANL
!
!-----------------------------------------------------------------------
!     * ALLOCATE WORK ARRAYS.
!
      ALLOCATE(AMU  (ILGA,LEVA))
      ALLOCATE(AMFP (ILGA,LEVA))
      ALLOCATE(TERM1(ILGA,LEVA))
      ALLOCATE(ANU  (ILGA,LEVA))
!
      ALLOCATE(WDN  (ILGA,LEVA,ISEC))
      ALLOCATE(DDN  (ILGA,LEVA,ISEC))
!
!-----------------------------------------------------------------------
!     * SURFACE RESISTENCE (RSS)
!
!     * DYNAMIC VISCOSITY OF AIR.
!
      TERM1=SQRT(T)
      TERM1=TERM1*T
      AMU=145.8*1.E-8*TERM1/(T+110.4)
!
!     * KINEMATIS VISCOSITY OF AIR
!
      ANU=AMU/RHOA
!
!     * MEAN FREE PATH (K.V. BEARD, 1976) AND CUNNINGHAM SLIP
!     * CORRECTION FACTOR.
!
      TERM1=SQRT(T/293.15)
      AMFP=6.54E-8*(AMU/1.818E-5)*(1.013E5/P)*TERM1
!
      DO IS=1,ISEC
      DO L=1,LEVA
      DO IL=1,ILGA
        DDN(IL,L,IS)=DRYDN0
        FGR=RADW(IL,L,IS)/RADD(IL,L,IS)
        FGR3I=1./FGR**3
        WDN(IL,L,IS)=DNH2O*(1.-FGR3I)+DDN(IL,L,IS)*FGR3I
      ENDDO
      ENDDO
      ENDDO
!
      VDP=0.
!------------------------------------------------------------------
      A1 = 2.0*1E-3                    !! canopy over snow
      A2 = 0.6*1E-3                    !! snow covered ground
      A3 = 5.0*1E-3                    !! canopy
      A4 = 8.0*1E-3                    !! ground
!
!     ANOPY 1: TALL CONIFEROUS. &
!     ANOPY 2: TALL BROADLEAF. &
!     ANOPY 3: ARABLE AND CROPS. &
!     ANOPY 4: GRASS, SWAMP AND TUNDRA (I.E. OTHER).
!
      C1 = 2.6*1E-3                    !! TALL CONIFEROUS
      C2 = 6.0*1E-3                    !! TALL BROADLEAF
      C3 = 3.2*1E-3                    !! ARABLE AND CROPS
      C4 = 6.6*1E-3                    !! GRASS, SWAMP AND TUNDRA (I.E. OTHER)
!
      AL1 = 0.5                    !! canopy over snow
      AL2 = 0.5                    !! snow covered ground
      AL3 = 999.9                  !! canopy
      AL4 = 15.0                   !! ground
!
      CL1 = 1.1                    !! TALL CONIFEROUS
      CL2 = 0.7                    !! TALL BROADLEAF
      CL3 = 1.2                    !! ARABLE AND CROPS
      CL4 = 10.0                   !! GRASS, SWAMP AND TUNDRA (I.E. OTHER)
!
      L=LEVA
      DO IS=1,ISEC
      DO IL=1,ILGA
!
!       * CUNNINGHAN FACTOR
!
        TMP1=AMFP(IL,L)/RADW(IL,L,IS)
        TMP2=RADW(IL,L,IS)/AMFP(IL,L)
        TMP2=EXP(-1.1_R8*TMP2)
        CFAC=1._R8+TMP1*(1.257_R8+0.4_R8*TMP2)
!
!       * STOKES FRICTION AND DIFFUSION COEFFICIENTS.
!
        AMOB=6.*YPI*AMU(IL,L)*RADW(IL,L,IS)/CFAC
        PDIFF=AKB*T(IL,L)/AMOB
        Sc   =ANU(IL,L)/PDIFF
!
!       * SURFACE RESISTANCE (ZHANG ET AL., 2001,ATMOSPHERIC ENVIRONEMENT)
!
!       * PDEPV: GRAVATATIONAL SETTLING VELOCITIES
!       * EB   : COLLECTION EFFICIENCY FROM BROWNIAN DIFFUTION
!       * EIM  : COLLECTION EFFICIENCY FROM IMPACTION
!       * EIN  : COLLECTION EFFICIENCY FROM INTERCEPTION
!
        TMP1=RADW(IL,L,IS)
        PDEPV=2.0_R8*WDN(IL,L,IS)*TMP1**2*GRAV*CFAC/(9.0_R8*AMU(IL,L))
        VDPL=0.
        VDPNL=0.
        IF(FLND(IL).GT.0.) THEN
          USTAL  = SQRT(CDML(IL))*ZSPD(IL)
          RAAL   = 1.0_R8/(CDML(IL)*ZSPD(IL))
          A3     = FCAN(IL,1)*C1+FCAN(IL,2)*C2+FCAN(IL,3)*C3 &
                                              +FCAN(IL,4)*C4
          AL3    = FCAN(IL,1)*CL1+FCAN(IL,2)*CL2+FCAN(IL,3)*CL3 &
                                                +FCAN(IL,4)*CL4
          AA     = FCS(IL)*A1 +FGS(IL)*A2 +FC(IL)*A3 +FG(IL)*A4
          ALFAL  = FCS(IL)*AL1+FGS(IL)*AL2+FC(IL)*AL3+FG(IL)*AL4
          StL    = PDEPV*USTAL/(GRAV*AA)
!         ALFAL  = 0.8
          REBL   = Sc**(-2.0_R8/3.0_R8)
          REIML  = ( StL/(StL+ALFAL))**2
          REIML  = MIN(REIML,0.8_R8)
          REINL  = 0.5_R8*(2.0_R8*RADW(IL,L,IS)/AA)**2
          REINL  = MIN(REINL,0.6_R8)
          R1L    = MAX(STICK(IL,L,IS)*MAX(0.5_R8,EXP(-SQRT(StL))) &
                                     ,0.001_R8)
          RSSL   = 1.0_R8/(3._R8*USTAL*(REBL+REIML+REINL)*R1L)
          VDPL   = 1.0/(RAAL+RSSL)
        ENDIF
        IF(FLND(IL).LT.1.) THEN
          USTANL = SQRT(CDMNL(IL))*ZSPD(IL)
          RAANL  = 1.0_R8/(CDMNL(IL)*ZSPD(IL))
          StNL   = PDEPV*USTANL**2/(GRAV*ANU(IL,L))
          ALFANL = 100.0_R8
          REBNL  = 1._R8/SQRT(Sc)
          REIMNL = ( StNL/(StNL+ALFANL))**2
          REIMNL = MIN(REIMNL,0.8_R8)
          REINNL = 0._R8
          R1NL   = MAX(STICK(IL,L,IS)*MAX(0.5_R8,EXP(-SQRT(StNL))) &
                                     ,0.001_R8)
          RSSNL  = 1.0_R8/(3._R8*USTANL*(REBNL+REIMNL+REINNL)*R1NL)
          VDPNL  = 1.0/(RAANL+RSSNL)
        END IF
!
        VDP(IL,IS) = FLND(IL)*VDPL + (1.-FLND(IL))*VDPNL
      ENDDO
      ENDDO
!------------------------------------------------------------------
!     * DEALLOCATE WORK ARRAYS.
!
      DEALLOCATE(AMU  )
      DEALLOCATE(AMFP )
      DEALLOCATE(TERM1)
      DEALLOCATE(ANU  )
!
      DEALLOCATE(WDN )
      DEALLOCATE(DDN )
!
      END SUBROUTINE VSRAD
