[524] | 1 | ! |
---|
[1067] | 2 | SUBROUTINE coefkzmin(knon,ypaprs,ypplay,yu,yv,yt,yq,ycdragm |
---|
[524] | 3 | . ,km,kn) |
---|
[1067] | 4 | |
---|
[766] | 5 | USE dimphy |
---|
[524] | 6 | IMPLICIT NONE |
---|
| 7 | |
---|
[782] | 8 | include "YOMCST.h" |
---|
[524] | 9 | |
---|
| 10 | c....................................................................... |
---|
| 11 | c Entrees modifies en attendant une version ou les zlev, et zlay soient |
---|
| 12 | c disponibles. |
---|
| 13 | |
---|
[1067] | 14 | REAL ycdragm(klon) |
---|
[524] | 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 | |
---|
[1550] | 52 | REAL km(klon,klev) |
---|
| 53 | REAL kn(klon,klev) |
---|
[1067] | 54 | integer knon |
---|
[524] | 55 | |
---|
| 56 | |
---|
| 57 | integer nlay,nlev |
---|
| 58 | integer ig,k |
---|
| 59 | |
---|
[766] | 60 | real,parameter :: kap=0.4 |
---|
[524] | 61 | |
---|
[766] | 62 | nlay=klev |
---|
| 63 | nlev=klev+1 |
---|
[524] | 64 | c....................................................................... |
---|
| 65 | c en attendant une version ou les zlev, et zlay soient |
---|
| 66 | c disponibles. |
---|
| 67 | c Debut de la partie qui doit etre unclue a terme dans clmain. |
---|
| 68 | c |
---|
[1067] | 69 | do i=1,knon |
---|
[524] | 70 | yzlay(i,1)=RD*yt(i,1)/(0.5*(ypaprs(i,1)+ypplay(i,1))) |
---|
| 71 | . *(ypaprs(i,1)-ypplay(i,1))/RG |
---|
| 72 | enddo |
---|
| 73 | do k=2,klev |
---|
[1067] | 74 | do i=1,knon |
---|
[524] | 75 | yzlay(i,k)=yzlay(i,k-1)+RD*0.5*(yt(i,k-1)+yt(i,k)) |
---|
| 76 | s /ypaprs(i,k)*(ypplay(i,k-1)-ypplay(i,k))/RG |
---|
| 77 | enddo |
---|
| 78 | enddo |
---|
| 79 | do k=1,klev |
---|
[1067] | 80 | do i=1,knon |
---|
[524] | 81 | cATTENTION:on passe la temperature potentielle virt. pour le calcul de K |
---|
| 82 | yteta(i,k)=yt(i,k)*(ypaprs(i,1)/ypplay(i,k))**rkappa |
---|
| 83 | s *(1.+0.61*yq(i,k)) |
---|
| 84 | enddo |
---|
| 85 | enddo |
---|
[1067] | 86 | do i=1,knon |
---|
[524] | 87 | yzlev(i,1)=0. |
---|
| 88 | yzlev(i,klev+1)=2.*yzlay(i,klev)-yzlay(i,klev-1) |
---|
| 89 | enddo |
---|
| 90 | do k=2,klev |
---|
[1067] | 91 | do i=1,knon |
---|
[524] | 92 | yzlev(i,k)=0.5*(yzlay(i,k)+yzlay(i,k-1)) |
---|
| 93 | enddo |
---|
| 94 | enddo |
---|
| 95 | |
---|
[1067] | 96 | yustar(1:knon) =SQRT(ycdragm(1:knon)* |
---|
| 97 | $ (yu(1:knon,1)*yu(1:knon,1)+yv(1:knon,1)*yv(1:knon,1))) |
---|
[524] | 98 | |
---|
| 99 | c Fin de la partie qui doit etre unclue a terme dans clmain. |
---|
| 100 | |
---|
| 101 | Cette routine est ecrite pour avoir en entree ustar, teta et zlev |
---|
| 102 | c Ici, on a inclut le calcul de ces trois variables dans la routine |
---|
| 103 | c coefkzmin en attendant une nouvelle version de la couche limite |
---|
| 104 | c ou ces variables seront disponibles. |
---|
| 105 | |
---|
| 106 | c Debut de la routine coefkzmin proprement dite. |
---|
| 107 | |
---|
| 108 | ustar=yustar |
---|
| 109 | teta=yteta |
---|
| 110 | zlev=yzlev |
---|
| 111 | |
---|
[1067] | 112 | do ig=1,knon |
---|
| 113 | coriol(ig)=1.e-4 |
---|
| 114 | pblhmin(ig)=0.07*ustar(ig)/max(abs(coriol(ig)),2.546e-5) |
---|
[524] | 115 | enddo |
---|
[1067] | 116 | |
---|
[524] | 117 | do k=2,klev |
---|
[1067] | 118 | do ig=1,knon |
---|
[524] | 119 | if (teta(ig,2).gt.teta(ig,1)) then |
---|
| 120 | qmin=ustar(ig)*(max(1.-zlev(ig,k)/pblhmin(ig),0.))**2 |
---|
| 121 | kmin=kap*zlev(ig,k)*qmin |
---|
| 122 | else |
---|
| 123 | kmin=0. ! kmin n'est utilise que pour les SL stables. |
---|
| 124 | endif |
---|
| 125 | kn(ig,k)=kmin |
---|
| 126 | km(ig,k)=kmin |
---|
| 127 | enddo |
---|
| 128 | enddo |
---|
| 129 | |
---|
| 130 | |
---|
| 131 | return |
---|
| 132 | end |
---|