source: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limz.f90 @ 5295

Last change on this file since 5295 was 5159, checked in by abarral, 3 months ago

Put dimensions.h and paramet.h into modules

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 1.9 KB
RevLine 
[5099]1
[524]2! $Header$
[5099]3
[5105]4SUBROUTINE limz(s0,sz,sm,pente_max)
[5159]5
[5105]6  ! Auteurs:   P.Le Van, F.Hourdin, F.Forget
[5159]7
[5105]8  !    ********************************************************************
9  ! Shema  d'advection " pseudo amont " .
10  !    ********************************************************************
11  ! nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
[5159]12
13
[5105]14  !   --------------------------------------------------------------------
[5136]15  USE lmdz_comgeom
16
[5159]17USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
18  USE lmdz_paramet
[5105]19  IMPLICIT NONE
20  !
[5159]21
22
23
24
[5105]25  !   Arguments:
26  !   ----------
[5116]27  REAL :: pente_max
[5105]28  REAL :: s0(ip1jmp1,llm),sm(ip1jmp1,llm)
[5116]29  REAL :: sz(ip1jmp1,llm)
[5159]30
[5105]31  !  Local
32  !   ---------
[5159]33
[5105]34  INTEGER :: ij,l,j,i,iju,ijq,indu(ip1jmp1),niju
[5116]35  INTEGER :: n0,iadvplus(ip1jmp1,llm),nl(llm)
[5159]36
[5105]37  REAL :: q(ip1jmp1,llm)
[5116]38  REAL :: dzq(ip1jmp1,llm)
[524]39
40
[5105]41  REAL :: new_m,zm
[5116]42  REAL :: dzqw(ip1jmp1)
43  REAL :: adzqw(ip1jmp1),dzqmax(ip1jmp1)
[524]44
[5105]45  Logical :: extremum,first
46  save first
[524]47
[5105]48  data first/.TRUE./
[524]49
50
[5105]51   DO  l = 1,llm
52     DO  ij=1,ip1jmp1
53           q(ij,l) = s0(ij,l) / sm ( ij,l )
54           dzq(ij,l) = sz(ij,l) /sm(ij,l)
55     ENDDO
56   ENDDO
[524]57
[5105]58  !   calcul de la pente en haut et en bas de la maille
[5158]59   DO ij=1,ip1jmp1
60   DO l = 1, llm-1
[5105]61        dzqw(l)=q(ij,l+1)-q(ij,l)
62     enddo
63        dzqw(llm)=0.
[524]64
[5158]65     DO  l=1,llm
[5105]66        adzqw(l)=abs(dzqw(l))
67     enddo
[524]68
[5105]69  !   calcul de la pente maximum dans la maille en valeur absolue
[524]70
[5158]71     DO l=2,llm-1
[5105]72        dzqmax(l)=pente_max*min(adzqw(l-1),adzqw(l))
73     enddo
[524]74
[5105]75  !   calcul de la pente avec limitation
[524]76
[5158]77     DO l=2,llm-1
[5116]78        IF(     dzqw(l-1)*dzqw(l)>0. &
[5117]79              .AND. dzq(ij,l)*dzqw(l)>0.) THEN
[5105]80          dzq(ij,l)= &
81                sign(min(abs(dzq(ij,l)),dzqmax(l)),dzq(ij,l))
82        else
83  !   extremum local
84           dzq(ij,l)=0.
85        endif
86     enddo
[524]87
[5105]88     DO  l=1,llm
89           sz(ij,l) = dzq(ij,l)*sm(ij,l)
90     ENDDO
[524]91
[5105]92   ENDDO
[524]93
[5105]94  RETURN
95END SUBROUTINE limz
Note: See TracBrowser for help on using the repository browser.