[482] | 1 | SUBROUTINE coefkzmin(ngrid,ypaprs,ypplay,yu,yv,yt,yq,ycoefm |
---|
| 2 | . ,km,kn) |
---|
| 3 | c SUBROUTINE coefkzmin(ngrid,zlev,teta,ustar,km,kn) |
---|
| 4 | IMPLICIT NONE |
---|
| 5 | |
---|
| 6 | #include "dimensions.h" |
---|
| 7 | #include "dimphy.h" |
---|
| 8 | #include "YOMCST.h" |
---|
| 9 | |
---|
| 10 | c....................................................................... |
---|
| 11 | c Entrees modifies en attendant une version ou les zlev, et zlay soient |
---|
| 12 | c disponibles. |
---|
| 13 | |
---|
| 14 | REAL ycoefm(klon,klev) |
---|
| 15 | |
---|
| 16 | REAL yu(klon,klev), yv(klon,klev) |
---|
| 17 | REAL yt(klon,klev), yq(klon,klev) |
---|
| 18 | REAL ypaprs(klon,klev+1), ypplay(klon,klev) |
---|
| 19 | REAL yustar(klon) |
---|
| 20 | real yzlay(klon,klev),yzlev(klon,klev+1),yteta(klon,klev) |
---|
| 21 | |
---|
| 22 | integer i |
---|
| 23 | |
---|
| 24 | c....................................................................... |
---|
| 25 | c |
---|
| 26 | c En entree : |
---|
| 27 | c ----------- |
---|
| 28 | c |
---|
| 29 | c zlev : altitude a chaque niveau (interface inferieure de la couche |
---|
| 30 | c de meme indice) |
---|
| 31 | c ustar : u* |
---|
| 32 | c |
---|
| 33 | c teta : temperature potentielle au centre de chaque couche |
---|
| 34 | c (en entree : la valeur au debut du pas de temps) |
---|
| 35 | c |
---|
| 36 | c en sortier : |
---|
| 37 | c ------------ |
---|
| 38 | c |
---|
| 39 | c km : diffusivite turbulente de quantite de mouvement (au bas de chaque |
---|
| 40 | c couche) |
---|
| 41 | c (en sortie : la valeur a la fin du pas de temps) |
---|
| 42 | c kn : diffusivite turbulente des scalaires (au bas de chaque couche) |
---|
| 43 | c (en sortie : la valeur a la fin du pas de temps) |
---|
| 44 | c |
---|
| 45 | c....................................................................... |
---|
| 46 | |
---|
| 47 | real ustar(klon) |
---|
| 48 | real kmin,qmin,pblhmin(klon),coriol(klon) |
---|
| 49 | REAL zlev(klon,klev+1) |
---|
| 50 | REAL teta(klon,klev) |
---|
| 51 | |
---|
| 52 | REAL km(klon,klev+1) |
---|
| 53 | REAL kn(klon,klev+1) |
---|
| 54 | integer l_mix,ngrid |
---|
| 55 | |
---|
| 56 | |
---|
| 57 | integer nlay,nlev |
---|
| 58 | PARAMETER (nlay=klev) |
---|
| 59 | PARAMETER (nlev=klev+1) |
---|
| 60 | |
---|
| 61 | integer ig,k |
---|
| 62 | |
---|
| 63 | real kap |
---|
| 64 | save kap |
---|
| 65 | data kap/0.4/ |
---|
| 66 | |
---|
| 67 | real frif,falpha,fsm |
---|
| 68 | real fl,zzz,zl0,zq2,zn2 |
---|
| 69 | |
---|
| 70 | |
---|
| 71 | c....................................................................... |
---|
| 72 | c en attendant une version ou les zlev, et zlay soient |
---|
| 73 | c disponibles. |
---|
| 74 | c Debut de la partie qui doit etre unclue a terme dans clmain. |
---|
| 75 | c |
---|
| 76 | do i=1,ngrid |
---|
| 77 | yzlay(i,1)=RD*yt(i,1)/(0.5*(ypaprs(i,1)+ypplay(i,1))) |
---|
| 78 | . *(ypaprs(i,1)-ypplay(i,1))/RG |
---|
| 79 | enddo |
---|
| 80 | do k=2,klev |
---|
| 81 | do i=1,ngrid |
---|
| 82 | yzlay(i,k)=yzlay(i,k-1)+RD*0.5*(yt(i,k-1)+yt(i,k)) |
---|
| 83 | s /ypaprs(i,k)*(ypplay(i,k-1)-ypplay(i,k))/RG |
---|
| 84 | enddo |
---|
| 85 | enddo |
---|
| 86 | do k=1,klev |
---|
| 87 | do i=1,ngrid |
---|
| 88 | cATTENTION:on passe la temperature potentielle virt. pour le calcul de K |
---|
| 89 | yteta(i,k)=yt(i,k)*(ypaprs(i,1)/ypplay(i,k))**rkappa |
---|
| 90 | s *(1.+0.61*yq(i,k)) |
---|
| 91 | enddo |
---|
| 92 | enddo |
---|
| 93 | do i=1,ngrid |
---|
| 94 | yzlev(i,1)=0. |
---|
| 95 | yzlev(i,klev+1)=2.*yzlay(i,klev)-yzlay(i,klev-1) |
---|
| 96 | enddo |
---|
| 97 | do k=2,klev |
---|
| 98 | do i=1,ngrid |
---|
| 99 | yzlev(i,k)=0.5*(yzlay(i,k)+yzlay(i,k-1)) |
---|
| 100 | enddo |
---|
| 101 | enddo |
---|
| 102 | |
---|
| 103 | |
---|
| 104 | yustar(:) =SQRT(ycoefm(:,1)*(yu(:,1)*yu(:,1)+yv(:,1)*yv(:,1))) |
---|
| 105 | |
---|
| 106 | c Fin de la partie qui doit etre unclue a terme dans clmain. |
---|
| 107 | |
---|
| 108 | Cette routine est ecrite pour avoir en entree ustar, teta et zlev |
---|
| 109 | c Ici, on a inclut le calcul de ces trois variables dans la routine |
---|
| 110 | c coefkzmin en attendant une nouvelle version de la couche limite |
---|
| 111 | c ou ces variables seront disponibles. |
---|
| 112 | |
---|
| 113 | c Debut de la routine coefkzmin proprement dite. |
---|
| 114 | |
---|
| 115 | ustar=yustar |
---|
| 116 | teta=yteta |
---|
| 117 | zlev=yzlev |
---|
| 118 | |
---|
| 119 | do ig=1,ngrid |
---|
| 120 | coriol(ig)=1.e-4 |
---|
| 121 | pblhmin(ig)=0.07*ustar(ig)/max(abs(coriol(ig)),2.546e-5) |
---|
| 122 | enddo |
---|
| 123 | |
---|
| 124 | do k=2,klev |
---|
| 125 | do ig=1,ngrid |
---|
| 126 | if (teta(ig,2).gt.teta(ig,1)) then |
---|
| 127 | qmin=ustar(ig)*(max(1.-zlev(ig,k)/pblhmin(ig),0.))**2 |
---|
| 128 | kmin=kap*zlev(ig,k)*qmin |
---|
| 129 | else |
---|
| 130 | kmin=0. ! kmin n'est utilise que pour les SL stables. |
---|
| 131 | endif |
---|
| 132 | kn(ig,k)=kmin |
---|
| 133 | km(ig,k)=kmin |
---|
| 134 | enddo |
---|
| 135 | enddo |
---|
| 136 | |
---|
| 137 | |
---|
| 138 | return |
---|
| 139 | end |
---|