1 | subroutine stokes(p,t,rd,w,rho_aer) |
---|
2 | |
---|
3 | !================================================================== |
---|
4 | ! Purpose |
---|
5 | ! ------- |
---|
6 | ! Compute the sedimentation velocity in a low pressure |
---|
7 | ! atmosphere. |
---|
8 | ! |
---|
9 | ! Authors |
---|
10 | ! ------- |
---|
11 | ! Francois Forget (1997) |
---|
12 | ! |
---|
13 | !================================================================== |
---|
14 | |
---|
15 | ! use radcommon_h, only : Rgas |
---|
16 | use comcstfi_mod, only: g, pi, avocado |
---|
17 | |
---|
18 | implicit none |
---|
19 | |
---|
20 | ! input |
---|
21 | ! ----- |
---|
22 | ! pressure (Pa), Temperature (K), particle radius (m), density |
---|
23 | real p, t, rd, rho_aer |
---|
24 | |
---|
25 | ! output |
---|
26 | ! ------ |
---|
27 | ! sedimentation velocity (m/s, >0) |
---|
28 | real w |
---|
29 | |
---|
30 | ! locally saved variables |
---|
31 | ! --------------------- |
---|
32 | real a,b,molrad,visc |
---|
33 | save a,b |
---|
34 | !$OMP THREADPRIVATE(a,b) |
---|
35 | |
---|
36 | LOGICAL firstcall |
---|
37 | SAVE firstcall |
---|
38 | DATA firstcall/.true./ |
---|
39 | !$OMP THREADPRIVATE(firstcall) |
---|
40 | |
---|
41 | if (firstcall) then |
---|
42 | |
---|
43 | !print*,'Routine not working: replace Rgas with r' |
---|
44 | !stop |
---|
45 | !a = 0.707*Rgas/(4*pi*molrad**2 * avocado) |
---|
46 | |
---|
47 | molrad=2.2e-10 ! CO2 (only used in condense_co2cloud at the moment) |
---|
48 | visc=1.e-5 ! CO2 |
---|
49 | |
---|
50 | |
---|
51 | a = 0.707*8.31/(4*pi*molrad**2 * avocado) |
---|
52 | b = (2./9.) * rho_aer * g / visc |
---|
53 | !print*,'molrad=',molrad |
---|
54 | !print*,'visc=',visc |
---|
55 | !print*,'a=',a |
---|
56 | !print*,'b=',b |
---|
57 | !print*,'rho_aer=',rho_aer |
---|
58 | !stop |
---|
59 | |
---|
60 | firstcall=.false. |
---|
61 | end if |
---|
62 | |
---|
63 | ! Sedimentation velocity = |
---|
64 | ! Stokes' Law corrected for low pressures by the Cunningham |
---|
65 | ! slip-flow correction according to Rossow (Icarus 36, 1-50, 1978) |
---|
66 | w = b * rd*rd * (1 + 1.333* (a*T/P)/rd ) |
---|
67 | return |
---|
68 | end subroutine stokes |
---|