[38] | 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 | |
---|