! ! $Header$ ! SUBROUTINE limz(s0,sz,sm,pente_max) ! ! Auteurs: P.Le Van, F.Hourdin, F.Forget ! ! ******************************************************************** ! Shema d'advection " pseudo amont " . ! ******************************************************************** ! nq,iq,q,pbaru,pbarv,w sont des arguments d'entree pour le s-pg .... ! ! ! -------------------------------------------------------------------- USE comgeom_mod_h USE dimensions_mod, ONLY: iim, jjm, llm, ndm USE paramet_mod_h IMPLICIT NONE ! ! ! ! Arguments: ! ---------- real :: pente_max REAL :: s0(ip1jmp1,llm),sm(ip1jmp1,llm) real :: sz(ip1jmp1,llm) ! ! Local ! --------- ! INTEGER :: ij,l,j,i,iju,ijq,indu(ip1jmp1),niju integer :: n0,iadvplus(ip1jmp1,llm),nl(llm) ! REAL :: q(ip1jmp1,llm) real :: dzq(ip1jmp1,llm) REAL :: new_m,zm real :: dzqw(ip1jmp1) real :: adzqw(ip1jmp1),dzqmax(ip1jmp1) Logical :: extremum,first save first REAL :: SSUM,CVMGP,CVMGT integer :: ismax,ismin EXTERNAL SSUM, ismin,ismax data first/.true./ DO l = 1,llm DO ij=1,ip1jmp1 q(ij,l) = s0(ij,l) / sm ( ij,l ) dzq(ij,l) = sz(ij,l) /sm(ij,l) ENDDO ENDDO ! calcul de la pente en haut et en bas de la maille do ij=1,ip1jmp1 do l = 1, llm-1 dzqw(l)=q(ij,l+1)-q(ij,l) enddo dzqw(llm)=0. do l=1,llm adzqw(l)=abs(dzqw(l)) enddo ! calcul de la pente maximum dans la maille en valeur absolue do l=2,llm-1 dzqmax(l)=pente_max*min(adzqw(l-1),adzqw(l)) enddo ! calcul de la pente avec limitation do l=2,llm-1 if( dzqw(l-1)*dzqw(l).gt.0. & .and. dzq(ij,l)*dzqw(l).gt.0.) then dzq(ij,l)= & sign(min(abs(dzq(ij,l)),dzqmax(l)),dzq(ij,l)) else ! extremum local dzq(ij,l)=0. endif enddo DO l=1,llm sz(ij,l) = dzq(ij,l)*sm(ij,l) ENDDO ENDDO RETURN END SUBROUTINE limz