1 | SUBROUTINE dustlift(ngrid,nlay,nq,rho,pcdh_true,pcdh,co2ice, |
---|
2 | $ dqslift) |
---|
3 | IMPLICIT NONE |
---|
4 | |
---|
5 | c======================================================================= |
---|
6 | c |
---|
7 | c Dust lifting by surface winds |
---|
8 | c Computing flux to the middle of the first layer |
---|
9 | c (Called by vdifc) |
---|
10 | c |
---|
11 | c======================================================================= |
---|
12 | |
---|
13 | c----------------------------------------------------------------------- |
---|
14 | c declarations: |
---|
15 | c ------------- |
---|
16 | |
---|
17 | #include "dimensions.h" |
---|
18 | #include "dimphys.h" |
---|
19 | #include "comcstfi.h" |
---|
20 | #include "tracer.h" |
---|
21 | |
---|
22 | c |
---|
23 | c arguments: |
---|
24 | c ---------- |
---|
25 | |
---|
26 | c INPUT |
---|
27 | integer ngrid, nlay, nq |
---|
28 | real rho(ngrid) ! density (kg.m-3) at surface |
---|
29 | real pcdh_true(ngrid) ! Cd |
---|
30 | real pcdh(ngrid) ! Cd * |V| |
---|
31 | real co2ice(ngrid) |
---|
32 | |
---|
33 | c OUTPUT |
---|
34 | real dqslift(ngrid,nq) !surface dust flux to mid-layer (<0 when lifing) |
---|
35 | c real pb(ngrid,nlay) ! diffusion to surface coeff. |
---|
36 | |
---|
37 | c local: |
---|
38 | c ------ |
---|
39 | INTEGER ig,iq |
---|
40 | REAL fhoriz(ngridmx) ! Horizontal dust flux |
---|
41 | REAL ust,us |
---|
42 | REAL stress_seuil |
---|
43 | SAVE stress_seuil |
---|
44 | DATA stress_seuil/0.0225/ ! stress seuil soulevement (N.m2) |
---|
45 | |
---|
46 | |
---|
47 | c --------------------------------- |
---|
48 | c Computing horizontal flux: fhoriz |
---|
49 | c --------------------------------- |
---|
50 | |
---|
51 | do ig=1,ngrid |
---|
52 | fhoriz(ig) = 0. ! initialisation |
---|
53 | |
---|
54 | c Selection of points where surface dust is available |
---|
55 | c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
56 | c if (latid(ig).ge.80.) goto 99 ! N permanent polar caps |
---|
57 | c if (latid(ig).le.-80.) goto 99 ! S polar deposits |
---|
58 | c if ((longd(ig).ge.-141. .and. longd(ig).le.-127.) |
---|
59 | c & .and.(latid(ig).ge.12. .and. latid(ig).le.23.))goto 99 ! olympus |
---|
60 | c if ((longd(ig).ge.-125. .and. longd(ig).le.-118.) |
---|
61 | c & .and.(latid(ig).ge.-12. .and. latid(ig).le.-6.))goto 99 ! Arsia |
---|
62 | c if ((longd(ig).ge.-116. .and. longd(ig).le.-109.) |
---|
63 | c & .and.(latid(ig).ge.-5. .and. latid(ig).le. 5.))goto 99 ! pavonis |
---|
64 | c if ((longd(ig).ge.-109. .and. longd(ig).le.-100.) |
---|
65 | c & .and.(latid(ig).ge. 7. .and. latid(ig).le. 16.))goto 99 ! ascraeus |
---|
66 | c if ((longd(ig).ge. 61. .and. longd(ig).le. 63.) |
---|
67 | c & .and.(latid(ig).ge. 63. .and. latid(ig).le. 64.))goto 99 !weird point |
---|
68 | if (co2ice(ig).gt.0.) goto 99 |
---|
69 | |
---|
70 | |
---|
71 | c Is the wind strong enough ? |
---|
72 | c ~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
73 | ust = sqrt(stress_seuil/rho(ig)) |
---|
74 | us = pcdh(ig) / sqrt(pcdh_true(ig)) ! ustar=cd*v /sqrt(cd) |
---|
75 | if (us.gt.ust) then |
---|
76 | c If lifting ? |
---|
77 | c Calcul du flux suivant Marticorena ( en fait white (1979)) |
---|
78 | |
---|
79 | fhoriz(ig) = 2.61*(rho(ig)/g) * |
---|
80 | & (us -ust) * (us + ust)**2 |
---|
81 | end if |
---|
82 | 99 continue |
---|
83 | end do |
---|
84 | |
---|
85 | c ------------------------------------- |
---|
86 | c Computing vertical flux and diffusion |
---|
87 | c ------------------------------------- |
---|
88 | |
---|
89 | do iq=1,nq |
---|
90 | do ig=1,ngrid |
---|
91 | dqslift(ig,iq)= -alpha_lift(iq)* fhoriz(ig) |
---|
92 | |
---|
93 | |
---|
94 | cc le flux vertical remplace le terme de diffusion turb. qui est mis a zero |
---|
95 | c zb(ig,1) = 0. |
---|
96 | cc If surface deposition by turbulence diffusion (impaction...) |
---|
97 | cc if(fhoriz(ig).ne.0) then |
---|
98 | cc zb(ig,1) = zcdh(ig)*zb0(ig,1) |
---|
99 | cc AMount of Surface deposition ! |
---|
100 | cc pdqs_dif(ig,iq)=pdqs_dif(ig,iq) + |
---|
101 | cc & zb(ig,1)*zq(ig,1,iq)/ptimestep |
---|
102 | cc write(*,*) 'zb(1) = ' , zb(ig,1),zcdh(ig),zb0(ig,1) |
---|
103 | cc |
---|
104 | |
---|
105 | enddo |
---|
106 | enddo |
---|
107 | |
---|
108 | RETURN |
---|
109 | END |
---|
110 | |
---|