| 1 | ! |
|---|
| 2 | ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/yamada.F,v 1.1 2004/06/22 11:45:36 lmdzadmin Exp $ |
|---|
| 3 | ! |
|---|
| 4 | SUBROUTINE yamada(ngrid,dt,g,rconst,plev,temp |
|---|
| 5 | s ,zlev,zlay,u,v,teta,cd,q2,km,kn,ustar |
|---|
| 6 | s ,l_mix) |
|---|
| 7 | c....................................................................... |
|---|
| 8 | use dimphy |
|---|
| 9 | IMPLICIT NONE |
|---|
| 10 | c....................................................................... |
|---|
| 11 | c |
|---|
| 12 | c dt : pas de temps |
|---|
| 13 | c g : g |
|---|
| 14 | c zlev : altitude a chaque niveau (interface inferieure de la couche |
|---|
| 15 | c de meme indice) |
|---|
| 16 | c zlay : altitude au centre de chaque couche |
|---|
| 17 | c u,v : vitesse au centre de chaque couche |
|---|
| 18 | c (en entree : la valeur au debut du pas de temps) |
|---|
| 19 | c teta : temperature potentielle au centre de chaque couche |
|---|
| 20 | c (en entree : la valeur au debut du pas de temps) |
|---|
| 21 | c cd : cdrag |
|---|
| 22 | c (en entree : la valeur au debut du pas de temps) |
|---|
| 23 | c q2 : $q^2$ au bas de chaque couche |
|---|
| 24 | c (en entree : la valeur au debut du pas de temps) |
|---|
| 25 | c (en sortie : la valeur a la fin du pas de temps) |
|---|
| 26 | c km : diffusivite turbulente de quantite de mouvement (au bas de chaque |
|---|
| 27 | c couche) |
|---|
| 28 | c (en sortie : la valeur a la fin du pas de temps) |
|---|
| 29 | c kn : diffusivite turbulente des scalaires (au bas de chaque couche) |
|---|
| 30 | c (en sortie : la valeur a la fin du pas de temps) |
|---|
| 31 | c |
|---|
| 32 | c....................................................................... |
|---|
| 33 | REAL dt,g,rconst |
|---|
| 34 | real plev(klon,klev+1),temp(klon,klev) |
|---|
| 35 | real ustar(klon),snstable |
|---|
| 36 | REAL zlev(klon,klev+1) |
|---|
| 37 | REAL zlay(klon,klev) |
|---|
| 38 | REAL u(klon,klev) |
|---|
| 39 | REAL v(klon,klev) |
|---|
| 40 | REAL teta(klon,klev) |
|---|
| 41 | REAL cd(klon) |
|---|
| 42 | REAL q2(klon,klev+1) |
|---|
| 43 | REAL km(klon,klev+1) |
|---|
| 44 | REAL kn(klon,klev+1) |
|---|
| 45 | integer l_mix,ngrid |
|---|
| 46 | |
|---|
| 47 | logical first |
|---|
| 48 | save first |
|---|
| 49 | data first/.true./ |
|---|
| 50 | |
|---|
| 51 | integer ig,k |
|---|
| 52 | |
|---|
| 53 | real ri,zrif,zalpha,zsm |
|---|
| 54 | real rif(klon,klev+1),sm(klon,klev+1),alpha(klon,klev) |
|---|
| 55 | |
|---|
| 56 | real m2(klon,klev+1),dz(klon,klev+1),zq,n2(klon,klev+1) |
|---|
| 57 | real l(klon,klev+1),l0(klon) |
|---|
| 58 | |
|---|
| 59 | real sq(klon),sqz(klon),zz(klon,klev+1) |
|---|
| 60 | integer iter |
|---|
| 61 | |
|---|
| 62 | real ric,rifc,b1,kap |
|---|
| 63 | save ric,rifc,b1,kap |
|---|
| 64 | data ric,rifc,b1,kap/0.195,0.191,16.6,0.3/ |
|---|
| 65 | |
|---|
| 66 | real frif,falpha,fsm |
|---|
| 67 | |
|---|
| 68 | frif(ri)=0.6588*(ri+0.1776-sqrt(ri*ri-0.3221*ri+0.03156)) |
|---|
| 69 | falpha(ri)=1.318*(0.2231-ri)/(0.2341-ri) |
|---|
| 70 | fsm(ri)=1.96*(0.1912-ri)*(0.2341-ri)/((1.-ri)*(0.2231-ri)) |
|---|
| 71 | |
|---|
| 72 | if (0.eq.1.and.first) then |
|---|
| 73 | do ig=1,1000 |
|---|
| 74 | ri=(ig-800.)/500. |
|---|
| 75 | if (ri.lt.ric) then |
|---|
| 76 | zrif=frif(ri) |
|---|
| 77 | else |
|---|
| 78 | zrif=rifc |
|---|
| 79 | endif |
|---|
| 80 | if(zrif.lt.0.16) then |
|---|
| 81 | zalpha=falpha(zrif) |
|---|
| 82 | zsm=fsm(zrif) |
|---|
| 83 | else |
|---|
| 84 | zalpha=1.12 |
|---|
| 85 | zsm=0.085 |
|---|
| 86 | endif |
|---|
| 87 | print*,ri,rif,zalpha,zsm |
|---|
| 88 | enddo |
|---|
| 89 | first=.false. |
|---|
| 90 | endif |
|---|
| 91 | |
|---|
| 92 | c Correction d'un bug sauvage a verifier. |
|---|
| 93 | c do k=2,klevp1 |
|---|
| 94 | do k=2,klev |
|---|
| 95 | do ig=1,ngrid |
|---|
| 96 | dz(ig,k)=zlay(ig,k)-zlay(ig,k-1) |
|---|
| 97 | m2(ig,k)=((u(ig,k)-u(ig,k-1))**2+(v(ig,k)-v(ig,k-1))**2) |
|---|
| 98 | s /(dz(ig,k)*dz(ig,k)) |
|---|
| 99 | n2(ig,k)=g*2.*(teta(ig,k)-teta(ig,k-1)) |
|---|
| 100 | s /(teta(ig,k-1)+teta(ig,k)) /dz(ig,k) |
|---|
| 101 | ri=n2(ig,k)/max(m2(ig,k),1.e-10) |
|---|
| 102 | if (ri.lt.ric) then |
|---|
| 103 | rif(ig,k)=frif(ri) |
|---|
| 104 | else |
|---|
| 105 | rif(ig,k)=rifc |
|---|
| 106 | endif |
|---|
| 107 | if(rif(ig,k).lt.0.16) then |
|---|
| 108 | alpha(ig,k)=falpha(rif(ig,k)) |
|---|
| 109 | sm(ig,k)=fsm(rif(ig,k)) |
|---|
| 110 | else |
|---|
| 111 | alpha(ig,k)=1.12 |
|---|
| 112 | sm(ig,k)=0.085 |
|---|
| 113 | endif |
|---|
| 114 | zz(ig,k)=b1*m2(ig,k)*(1.-rif(ig,k))*sm(ig,k) |
|---|
| 115 | enddo |
|---|
| 116 | enddo |
|---|
| 117 | |
|---|
| 118 | c iterration pour determiner la longueur de melange |
|---|
| 119 | |
|---|
| 120 | do ig=1,ngrid |
|---|
| 121 | l0(ig)=100. |
|---|
| 122 | enddo |
|---|
| 123 | do k=2,klev-1 |
|---|
| 124 | do ig=1,ngrid |
|---|
| 125 | l(ig,k)=l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig)) |
|---|
| 126 | enddo |
|---|
| 127 | enddo |
|---|
| 128 | |
|---|
| 129 | do iter=1,10 |
|---|
| 130 | do ig=1,ngrid |
|---|
| 131 | sq(ig)=1.e-10 |
|---|
| 132 | sqz(ig)=1.e-10 |
|---|
| 133 | enddo |
|---|
| 134 | do k=2,klev-1 |
|---|
| 135 | do ig=1,ngrid |
|---|
| 136 | q2(ig,k)=l(ig,k)**2*zz(ig,k) |
|---|
| 137 | l(ig,k)=min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig)) |
|---|
| 138 | s ,0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.e-10))) |
|---|
| 139 | zq=sqrt(q2(ig,k)) |
|---|
| 140 | sqz(ig)=sqz(ig)+zq*zlev(ig,k)*(zlay(ig,k)-zlay(ig,k-1)) |
|---|
| 141 | sq(ig)=sq(ig)+zq*(zlay(ig,k)-zlay(ig,k-1)) |
|---|
| 142 | enddo |
|---|
| 143 | enddo |
|---|
| 144 | do ig=1,ngrid |
|---|
| 145 | l0(ig)=0.2*sqz(ig)/sq(ig) |
|---|
| 146 | enddo |
|---|
| 147 | c(abd 3 5 2) print*,'ITER=',iter,' L0=',l0 |
|---|
| 148 | |
|---|
| 149 | enddo |
|---|
| 150 | |
|---|
| 151 | do k=2,klev |
|---|
| 152 | do ig=1,ngrid |
|---|
| 153 | l(ig,k)=min(l0(ig)*kap*zlev(ig,k)/(kap*zlev(ig,k)+l0(ig)) |
|---|
| 154 | s ,0.5*sqrt(q2(ig,k))/sqrt(max(n2(ig,k),1.e-10))) |
|---|
| 155 | q2(ig,k)=l(ig,k)**2*zz(ig,k) |
|---|
| 156 | km(ig,k)=l(ig,k)*sqrt(q2(ig,k))*sm(ig,k) |
|---|
| 157 | kn(ig,k)=km(ig,k)*alpha(ig,k) |
|---|
| 158 | enddo |
|---|
| 159 | enddo |
|---|
| 160 | |
|---|
| 161 | return |
|---|
| 162 | end |
|---|