[3] | 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) |
---|
[101] | 7 | c....................................................................... |
---|
| 8 | use dimphy |
---|
[3] | 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. |
---|
[101] | 93 | c do k=2,klevp1 |
---|
| 94 | do k=2,klev |
---|
[3] | 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 |
---|