! $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 lmdz_comgeom IMPLICIT NONE ! INCLUDE "dimensions.h" INCLUDE "paramet.h" ! ! ! 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 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)>0. & .AND. dzq(ij,l)*dzqw(l)>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