*=*=*=*= vdifc.html =*=*=*=*
SUBROUTINE vdifc(ngrid,nlay,co2ice,ppopsk, $ ptimestep,pcapcal, $ pplay,pplev,pzlay,pzlev, $ pz0, $ pu,pv,ph,ptsrf,pemis, $ pdufi,pdvfi,pdhfi,pfluxsrf, $ pdudif,pdvdif,pdhdif,pdtsrf, & pq2,lecrit) IMPLICIT NONE c======================================================================= c c Diffusion verticale c Shema implicite c On commence par rajouter au variables x la tendance physique c et on resoult en fait: c x(t+1) = x(t) + dt * (dx/dt)phys(t) + dt * (dx/dt)difv(t+1) c c======================================================================= c----------------------------------------------------------------------- c declarations: c ------------- #include "dimensions.h" #include "dimphys.h" #include "comcstfi.h" #include "callkeys.h" c c arguments: c ---------- INTEGER ngrid,nlay REAL ptimestep REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1) REAL pzlay(ngrid,nlay),pzlev(ngrid,nlay+1) REAL pu(ngrid,nlay),pv(ngrid,nlay),ph(ngrid,nlay) REAL ptsrf(ngrid),pemis(ngrid) REAL pdufi(ngrid,nlay),pdvfi(ngrid,nlay),pdhfi(ngrid,nlay) REAL pfluxsrf(ngrid) REAL pdudif(ngrid,nlay),pdvdif(ngrid,nlay),pdhdif(ngrid,nlay) REAL pdtsrf(ngrid),pcapcal(ngrid) REAL pq2(ngrid,nlay+1) c! c Argument added for condensation: REAL co2ice (ngrid), ppopsk(ngrid,nlay) logical lecrit REAL pz0 c c local: c ------ INTEGER ilev,ig,ilay,nlev,ierr REAL z4st,zdplanck(ngridmx) REAL zkv(ngridmx,nlayermx+1),zkh(ngridmx,nlayermx+1) REAL zcdv(ngridmx),zcdh(ngridmx) REAL zcdv_true(ngridmx),zcdh_true(ngridmx) REAL zu(ngridmx,nlayermx),zv(ngridmx,nlayermx) REAL zh(ngridmx,nlayermx) REAL ztsrf2(ngridmx) REAL z1(ngridmx),z2(ngridmx) REAL za(ngridmx,nlayermx),zb(ngridmx,nlayermx) REAL zb0(ngridmx,nlayermx) REAL zc(ngridmx,nlayermx),zd(ngridmx,nlayermx) REAL zcst1 c! c! modif my REAL zu2 c! EXTERNAL SSUM,SCOPY REAL SSUM LOGICAL firstcall SAVE firstcall c variable added for condensation: c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ REAL hh , zhcond(ngridmx,nlayermx), tconds REAL latcond,tcond1mb REAL acond,bcond SAVE acond,bcond DATA latcond,tcond1mb/5.9e5,136.27/ DATA firstcall/.true./ c ** un petit test de coherence c -------------------------- IF (firstcall) THEN IF(ngrid.NE.ngridmx) THEN PRINT*,'STOP dans coefdifv' PRINT*,'probleme de dimensions :' PRINT*,'ngrid =',ngrid PRINT*,'ngridmx =',ngridmx STOP ENDIF c To compute: Tcond= 1./(bcond-acond*log(.0095*p)) (p in pascal) bcond=1./tcond1mb acond=r/latcond PRINT*,'In vdifc: Tcond(P=1mb)=',tcond1mb,' Lcond=',latcond PRINT*,'acond,bcond,ccond',acond,bcond,acond firstcall=.false. ENDIF c----------------------------------------------------------------------- c 1. initialisation c ----------------- nlev=nlay+1 c ** calcul de rho*dz et dt*rho/dz=dt*rho**2 g/dp c avec rho=p/RT=p/ (R Theta) (p/ps)**kappa c ---------------------------------------- DO ilay=1,nlay DO ig=1,ngrid za(ig,ilay)=(pplev(ig,ilay)-pplev(ig,ilay+1))/g ENDDO ENDDO zcst1=4.*g*ptimestep/(r*r) DO ilev=2,nlev-1 DO ig=1,ngrid zb0(ig,ilev)=pplev(ig,ilev)* s (pplev(ig,1)/pplev(ig,ilev))**rcp / s (ph(ig,ilev-1)+ph(ig,ilev)) zb0(ig,ilev)=zcst1*zb0(ig,ilev)*zb0(ig,ilev)/ s (pplay(ig,ilev-1)-pplay(ig,ilev)) ENDDO ENDDO DO ig=1,ngrid zb0(ig,1)=ptimestep*pplev(ig,1)/(r*ptsrf(ig)) ENDDO c ** diagnostique pour l'initialisation c ---------------------------------- IF(lecrit) THEN ig=ngrid/2+1 PRINT*,'Pression (mbar) ,altitude (km),u,v,theta, rho dz' DO ilay=1,nlay WRITE(*,'(6f11.5)') s .01*pplay(ig,ilay),.001*pzlay(ig,ilay), s pu(ig,ilay),pv(ig,ilay),ph(ig,ilay),za(ig,ilay) ENDDO PRINT*,'Pression (mbar) ,altitude (km),zb' DO ilev=1,nlay WRITE(*,'(3f15.7)') s .01*pplev(ig,ilev),.001*pzlev(ig,ilev), s zb0(ig,ilev) ENDDO ENDIF c Potential Condensation temperature: c ----------------------------------- if (callcond) then DO ilev=1,nlay DO ig=1,ngrid zhcond(ig,ilev) = & (1./(bcond-acond*log(.0095*pplay(ig,ilev))))/ppopsk(ig,ilev) END DO END DO else DO ilev=1,nlay DO ig=1,ngrid zhcond(ig,ilev) = 0. END DO END DO end if c----------------------------------------------------------------------- c 2. ajout des tendances physiques c ----------------------------- DO ilev=1,nlay DO ig=1,ngrid zu(ig,ilev)=pu(ig,ilev)+pdufi(ig,ilev)*ptimestep zv(ig,ilev)=pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep zh(ig,ilev)=ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep zh(ig,ilev)=max(zh(ig,ilev),zhcond(ig,ilev)) ENDDO ENDDO c----------------------------------------------------------------------- c 3. schema de turbulence c -------------------- c ** source d'energie cinetique turbulente a la surface c (condition aux limites du schema de diffusion turbulente c dans la couche limite c --------------------- CALL vdif_cd( ngrid,pz0,g,pzlay,pu,pv,ptsrf,ph & ,zcdv_true,zcdh_true) DO ig=1,ngrid zu2=pu(ig,1)*pu(ig,1)+pv(ig,1)*pv(ig,1) zcdv(ig)=zcdv_true(ig)*sqrt(zu2) zcdh(ig)=zcdh_true(ig)*sqrt(zu2) ENDDO c ** schema de diffusion turbulente dans la couche limite c ---------------------------------------------------- c Ancienne couche limite: c~~~~~~~~~~~~~~~~~~~~~~~~ c if (.not.mellor) then c CALL vdif_k(ngrid,nlay, c s ptimestep,pz0,g,pzlev,pzlay,pu,pv,ph,zcdv,zkv,zkh) c else c c Nouvelle couche limite: c~~~~~~~~~~~~~~~~~~~~~~~~ c IF (ngrid.EQ.1) THEN c CALL vdif_kcd(ptimestep,g,pzlev,pzlay c._. CALL vdif_k20(ptimestep,g,pzlev,pzlay c & ,pu,pv,ph,zcdv_true c & ,pq2,zkv,zkh) c ELSE c._. CALL vdif_kshear(ptimestep,g,pzlev,pzlay CALL vdif_kc(ptimestep,g,pzlev,pzlay & ,pu,pv,ph,zcdv_true & ,pq2,zkv,zkh) c ENDIF c endif c ** diagnostique pour le schema de turbulence c ----------------------------------------- IF(lecrit) THEN PRINT* PRINT*,'Diagnostic for the vertical turbulent mixing' PRINT*,'Cd for momentum and portential temperature' PRINT*,zcdv(ngrid/2+1),zcdh(ngrid/2+1) PRINT*,'Mixing coefficient for momentum and pot.temp.' DO ilev=1,nlay PRINT*,zkv(ngrid/2+1,ilev),zkh(ngrid/2+1,ilev) ENDDO ENDIF c----------------------------------------------------------------------- c 4. inversion pour l'implicite sur u c -------------------------------- c ** l'equation est c u(t+1) = u(t) + dt * {(du/dt)phys}(t) + dt * {(du/dt)difv}(t+1) c avec c /zu/ = u(t) + dt * {(du/dt)phys}(t) (voir paragraphe 2.) c et c dt * {(du/dt)difv}(t+1) = dt * {(d/dz)[ Ku (du/dz) ]}(t+1) c donc les entrees sont /zcdv/ pour la condition a la limite sol c et /zkv/ = Ku CALL multipl((nlay-1)*ngrid,zkv(1,2),zb0(1,2),zb(1,2)) CALL multipl(ngrid,zcdv,zb0,zb) DO ig=1,ngrid z1(ig)=1./(za(ig,nlay)+zb(ig,nlay)) zc(ig,nlay)=za(ig,nlay)*zu(ig,nlay)*z1(ig) zd(ig,nlay)=zb(ig,nlay)*z1(ig) ENDDO DO ilay=nlay-1,1,-1 DO ig=1,ngrid z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+ $ zb(ig,ilay+1)*(1.-zd(ig,ilay+1))) zc(ig,ilay)=(za(ig,ilay)*zu(ig,ilay)+ $ zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig) zd(ig,ilay)=zb(ig,ilay)*z1(ig) ENDDO ENDDO DO ig=1,ngrid zu(ig,1)=zc(ig,1) ENDDO DO ilay=2,nlay DO ig=1,ngrid zu(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zu(ig,ilay-1) ENDDO ENDDO c----------------------------------------------------------------------- c 5. inversion pour l'implicite sur v c -------------------------------- c ** l'equation est c v(t+1) = v(t) + dt * {(dv/dt)phys}(t) + dt * {(dv/dt)difv}(t+1) c avec c /zv/ = v(t) + dt * {(dv/dt)phys}(t) (voir paragraphe 2.) c et c dt * {(dv/dt)difv}(t+1) = dt * {(d/dz)[ Kv (dv/dz) ]}(t+1) c donc les entrees sont /zcdv/ pour la condition a la limite sol c et /zkv/ = Kv DO ig=1,ngrid z1(ig)=1./(za(ig,nlay)+zb(ig,nlay)) zc(ig,nlay)=za(ig,nlay)*zv(ig,nlay)*z1(ig) zd(ig,nlay)=zb(ig,nlay)*z1(ig) ENDDO DO ilay=nlay-1,1,-1 DO ig=1,ngrid z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+ $ zb(ig,ilay+1)*(1.-zd(ig,ilay+1))) zc(ig,ilay)=(za(ig,ilay)*zv(ig,ilay)+ $ zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig) zd(ig,ilay)=zb(ig,ilay)*z1(ig) ENDDO ENDDO DO ig=1,ngrid zv(ig,1)=zc(ig,1) ENDDO DO ilay=2,nlay DO ig=1,ngrid zv(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*zv(ig,ilay-1) ENDDO ENDDO c----------------------------------------------------------------------- c 6. inversion pour l'implicite sur h sans oublier le couplage c avec le sol (conduction) c ------------------------ c ** l'equation est c h(t+1) = h(t) + dt * {(dh/dt)phys}(t) + dt * {(dh/dt)difv}(t+1) c avec c /zh/ = h(t) + dt * {(dh/dt)phys}(t) (voir paragraphe 2.) c et c dt * {(dh/dt)difv}(t+1) = dt * {(d/dz)[ Kh (dh/dz) ]}(t+1) c donc les entrees sont /zcdh/ pour la condition de raccord au sol c et /zkh/ = Kh c ------------- CALL multipl((nlay-1)*ngrid,zkh(1,2),zb0(1,2),zb(1,2)) CALL multipl(ngrid,zcdh,zb0,zb) DO ig=1,ngrid z1(ig)=1./(za(ig,nlay)+zb(ig,nlay)) zc(ig,nlay)=za(ig,nlay)*zh(ig,nlay)*z1(ig) zd(ig,nlay)=zb(ig,nlay)*z1(ig) ENDDO DO ilay=nlay-1,1,-1 DO ig=1,ngrid z1(ig)=1./(za(ig,ilay)+zb(ig,ilay)+ $ zb(ig,ilay+1)*(1.-zd(ig,ilay+1))) zc(ig,ilay)=(za(ig,ilay)*zh(ig,ilay)+ $ zb(ig,ilay+1)*zc(ig,ilay+1))*z1(ig) zd(ig,ilay)=zb(ig,ilay)*z1(ig) ENDDO ENDDO c ** calcul de (d Planck / dT) a la temperature d'interface c ------------------------------------------------------ z4st=4.*5.67e-8*ptimestep DO ig=1,ngrid zdplanck(ig)=z4st*pemis(ig)*ptsrf(ig)*ptsrf(ig)*ptsrf(ig) ENDDO c ** calcul de la temperature_d'interface et de sa tendance. c on ecrit que la somme des flux est nulle a l'interface c a t + \delta t, c c'est a dire le flux radiatif a {t + \delta t} c + le flux turbulent a {t + \delta t} c qui s'ecrit K (T1-Tsurf) avec T1 = d1 Tsurf + c1 c (notation K dt = /cpp*b/) c + le flux dans le sol a t c + l'evolution du flux dans le sol lorsque la temperature d'interface c passe de sa valeur a t a sa valeur a {t + \delta t}. c ---------------------------------------------------- DO ig=1,ngrid z1(ig)=pcapcal(ig)*ptsrf(ig)+cpp*zb(ig,1)*zc(ig,1) s +zdplanck(ig)*ptsrf(ig)+ pfluxsrf(ig)*ptimestep z2(ig)= pcapcal(ig)+cpp*zb(ig,1)*(1.-zd(ig,1))+zdplanck(ig) ztsrf2(ig)=z1(ig)/z2(ig) pdtsrf(ig)=(ztsrf2(ig)-ptsrf(ig))/ptimestep c Modif speciale CO2 condensation: tconds = 1./(bcond-acond*log(.0095*pplev(ig,1))) if ((callcond).and. & ((co2ice(ig).ne.0).or.(ztsrf2(ig).lt.tconds)))then zh(ig,1)=zc(ig,1)+zd(ig,1)*tconds else zh(ig,1)=zc(ig,1)+zd(ig,1)*ztsrf2(ig) end if ENDDO c ** et a partir de la temperature au sol on remonte c ----------------------------------------------- DO ilay=2,nlay DO ig=1,ngrid hh = max( zh(ig,ilay-1) , zhcond(ig,ilay-1) ) ! modif co2cond zh(ig,ilay)=zc(ig,ilay)+zd(ig,ilay)*hh ENDDO ENDDO c----------------------------------------------------------------------- c 7. calcul final des tendances de la diffusion verticale c ---------------------------------------------------- DO ilev = 1, nlay DO ig=1,ngrid pdudif(ig,ilev)=( zu(ig,ilev)- $ (pu(ig,ilev)+pdufi(ig,ilev)*ptimestep) )/ptimestep pdvdif(ig,ilev)=( zv(ig,ilev)- $ (pv(ig,ilev)+pdvfi(ig,ilev)*ptimestep) )/ptimestep hh = max(ph(ig,ilev)+pdhfi(ig,ilev)*ptimestep , $ zhcond(ig,ilev)) ! modif co2cond pdhdif(ig,ilev)=( zh(ig,ilev)- hh )/ptimestep ENDDO ENDDO c ** diagnostique final c ------------------ IF(lecrit) THEN PRINT*,'In vdif' PRINT*,'Ts (t) and Ts (t+st)' WRITE(*,'(a10,3a15)') s 'theta(t)','theta(t+dt)','u(t)','u(t+dt)' PRINT*,ptsrf(ngrid/2+1),ztsrf2(ngrid/2+1) DO ilev=1,nlay WRITE(*,'(4f15.7)') s ph(ngrid/2+1,ilev),zh(ngrid/2+1,ilev), s pu(ngrid/2+1,ilev),zu(ngrid/2+1,ilev) ENDDO ENDIF c----------------------------------------------------------------------- RETURN END