*IF DEF,A17_1A VGRAV1A.2
C *****************************COPYRIGHT****************************** VGRAV1A.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. VGRAV1A.4
C VGRAV1A.5
C Use, duplication or disclosure of this code is subject to the VGRAV1A.6
C restrictions as set forth in the contract. VGRAV1A.7
C VGRAV1A.8
C Meteorological Office VGRAV1A.9
C London Road VGRAV1A.10
C BRACKNELL VGRAV1A.11
C Berkshire UK VGRAV1A.12
C RG12 2SZ VGRAV1A.13
C VGRAV1A.14
C If no contract has been raised with this copy of the code, the use, VGRAV1A.15
C duplication or disclosure of it is strictly prohibited. Permission VGRAV1A.16
C to do so must first be obtained in writing from the Head of Numerical VGRAV1A.17
C Modelling at the above address. VGRAV1A.18
C ******************************COPYRIGHT****************************** VGRAV1A.19
! Subroutine VGRAV ------------------------------------------------- VGRAV1A.20
! VGRAV1A.21
! Purpose: To calculate the gravitational sedimentation velocity of VGRAV1A.22
! tracer particles according to Stoke's law, including the VGRAV1A.23
! Cunningham correction factor. VGRAV1A.24
! VGRAV1A.25
! Current owners of code: S Woodward, M Woodage VGRAV1A.26
! VGRAV1A.27
! History: VGRAV1A.28
! Version Date Comment VGRAV1A.29
! ------- ---- ------- VGRAV1A.30
! 4.4 03/10/97 Original code S Woodward, M Woodage VGRAV1A.31
! VGRAV1A.32
! Code description: VGRAV1A.33
! Language: FORTRAN77 + extensions VGRAV1A.34
! Programming standard: UMDP 3 Vn 6 VGRAV1A.35
! VGRAV1A.36
! System components covered: VGRAV1A.37
! VGRAV1A.38
! System task: VGRAV1A.39
! VGRAV1A.40
!Documentation: Ref. Pruppacher & Klett VGRAV1A.41
! Microphysics of clouds & ppn 1978,1980 edns. VGRAV1A.42
! VGRAV1A.43
!----------------------------------------------------------------------- VGRAV1A.44
! VGRAV1A.45
SUBROUTINE VGRAV(PFIELD,NLEVS,DIAM,RHOP,PSTAR,AK,BK,T,VSTOKES, 1VGRAV1A.46
& CCF,ETAA,FIRST_POINT,LAST_POINT) VGRAV1A.47
! VGRAV1A.48
implicit none VGRAV1A.49
! VGRAV1A.50
! VGRAV1A.51
INTEGER PFIELD !IN number of grid points VGRAV1A.52
INTEGER NLEVS !IN number of levels VGRAV1A.53
INTEGER FIRST_POINT !IN first pt for caln VGRAV1A.54
INTEGER LAST_POINT !IN last pt for calc VGRAV1A.55
! VGRAV1A.56
REAL DIAM !IN particle diameter VGRAV1A.57
REAL RHOP !IN particles density VGRAV1A.58
REAL PSTAR(PFIELD) !IN surface pressure VGRAV1A.59
REAL AK(NLEVS) !IN A vals VGRAV1A.60
REAL BK(NLEVS) !IN B vals VGRAV1A.61
REAL T(PFIELD,NLEVS) !IN temperature VGRAV1A.62
! VGRAV1A.63
REAL VSTOKES(PFIELD,NLEVS) !OUT sedimentation velocity VGRAV1A.64
REAL ETAA(PFIELD,NLEVS) !OUT viscosity of air VGRAV1A.65
REAL CCF(PFIELD,NLEVS) !OUT cunningham correction factor VGRAV1A.66
! VGRAV1A.67
! Include COMDECKS VGRAV1A.68
! VGRAV1A.69
*IF DEF,MPP VGRAV1A.70
! Parameters and Common blocks VGRAV1A.71
*CALL PARVARS 
VGRAV1A.72
*ENDIF VGRAV1A.73
! VGRAV1A.74
*CALL C_G VGRAV1A.75
*CALL C_0_DG_C VGRAV1A.76
*CALL CDUST_C2 VGRAV1A.77
! VGRAV1A.78
! local variables VGRAV1A.79
! VGRAV1A.80
INTEGER ILEV !LOC loop counter for levels VGRAV1A.81
INTEGER J !LOC loop counter for points VGRAV1A.82
! VGRAV1A.83
REAL TC(PFIELD) !LOC temperature in deg C VGRAV1A.84
REAL LAMDAA(PFIELD) !LOC mean free path of particle VGRAV1A.85
REAL ALPHACCF(PFIELD) !LOC VGRAV1A.86
! VGRAV1A.87
! Calculate viscosity of air (Pruppacher & Klett p.323) VGRAV1A.88
DO ILEV=1,NLEVS VGRAV1A.89
DO J=FIRST_POINT,LAST_POINT VGRAV1A.90
! VGRAV1A.91
TC(J)=T(J,ILEV)-ZERODEGC VGRAV1A.92
IF (TC(J) .GE. 0.) THEN VGRAV1A.93
ETAA(J,ILEV)=(1.718+0.0049*TC(J))*1.E-5 VGRAV1A.94
ELSE VGRAV1A.95
ETAA(J,ILEV)=(1.718+0.0049*TC(J)-1.2E-5*TC(J)*TC(J))*1.E-5 VGRAV1A.96
ENDIF VGRAV1A.97
! VGRAV1A.98
ENDDO VGRAV1A.99
ENDDO VGRAV1A.100
! VGRAV1A.101
DO ILEV=1,NLEVS VGRAV1A.102
DO J = FIRST_POINT,LAST_POINT VGRAV1A.103
! VGRAV1A.104
! Calculate mean free path of particle (Pruppacher & Klett p.323) VGRAV1A.105
LAMDAA(J)=LAMDAA0* VGRAV1A.106
& PREFL*T(J,ILEV)/((AK(ILEV)+BK(ILEV)*PSTAR(J))*TREFL) VGRAV1A.107
! Calculate Cunningham correction factor(Pruppacher & Klett p.361) VGRAV1A.108
ALPHACCF(J)=ACCF+BCCF*EXP(CCCF*DIAM*.5/LAMDAA(J)) VGRAV1A.109
CCF(J,ILEV)=(1.+ALPHACCF(J)*LAMDAA(J)/(.5*DIAM)) VGRAV1A.110
! Calculate sedimentation velocity (Pruppacher & Klett p.362) VGRAV1A.111
VSTOKES(J,ILEV)=CCF(J,ILEV)*(DIAM*DIAM*G*RHOP)/ VGRAV1A.112
& (18.*ETAA(J,ILEV)) VGRAV1A.113
! VGRAV1A.114
ENDDO VGRAV1A.115
ENDDO VGRAV1A.116
! VGRAV1A.117
RETURN VGRAV1A.118
END VGRAV1A.119
*ENDIF VGRAV1A.120