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

Last change on this file since 5139 was 5136, checked in by abarral, 8 weeks ago

Put comgeom.h, comgeom2.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)
5  !
6  ! Auteurs:   P.Le Van, F.Hourdin, F.Forget
7  !
8  !    ********************************************************************
9  ! Shema  d'advection " pseudo amont " .
10  !    ********************************************************************
11  ! nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
12  !
13  !
14  !   --------------------------------------------------------------------
[5136]15  USE lmdz_comgeom
16
[5105]17  IMPLICIT NONE
18  !
[5134]19  INCLUDE "dimensions.h"
20  INCLUDE "paramet.h"
[5105]21  !
22  !
23  !   Arguments:
24  !   ----------
[5116]25  REAL :: pente_max
[5105]26  REAL :: s0(ip1jmp1,llm),sm(ip1jmp1,llm)
[5116]27  REAL :: sz(ip1jmp1,llm)
[5105]28  !
29  !  Local
30  !   ---------
31  !
32  INTEGER :: ij,l,j,i,iju,ijq,indu(ip1jmp1),niju
[5116]33  INTEGER :: n0,iadvplus(ip1jmp1,llm),nl(llm)
[5105]34  !
35  REAL :: q(ip1jmp1,llm)
[5116]36  REAL :: dzq(ip1jmp1,llm)
[524]37
38
[5105]39  REAL :: new_m,zm
[5116]40  REAL :: dzqw(ip1jmp1)
41  REAL :: adzqw(ip1jmp1),dzqmax(ip1jmp1)
[524]42
[5105]43  Logical :: extremum,first
44  save first
[524]45
[5105]46  data first/.TRUE./
[524]47
48
[5105]49   DO  l = 1,llm
50     DO  ij=1,ip1jmp1
51           q(ij,l) = s0(ij,l) / sm ( ij,l )
52           dzq(ij,l) = sz(ij,l) /sm(ij,l)
53     ENDDO
54   ENDDO
[524]55
[5105]56  !   calcul de la pente en haut et en bas de la maille
57   do ij=1,ip1jmp1
58   do l = 1, llm-1
59        dzqw(l)=q(ij,l+1)-q(ij,l)
60     enddo
61        dzqw(llm)=0.
[524]62
[5105]63     do  l=1,llm
64        adzqw(l)=abs(dzqw(l))
65     enddo
[524]66
[5105]67  !   calcul de la pente maximum dans la maille en valeur absolue
[524]68
[5105]69     do l=2,llm-1
70        dzqmax(l)=pente_max*min(adzqw(l-1),adzqw(l))
71     enddo
[524]72
[5105]73  !   calcul de la pente avec limitation
[524]74
[5105]75     do l=2,llm-1
[5116]76        IF(     dzqw(l-1)*dzqw(l)>0. &
[5117]77              .AND. dzq(ij,l)*dzqw(l)>0.) THEN
[5105]78          dzq(ij,l)= &
79                sign(min(abs(dzq(ij,l)),dzqmax(l)),dzq(ij,l))
80        else
81  !   extremum local
82           dzq(ij,l)=0.
83        endif
84     enddo
[524]85
[5105]86     DO  l=1,llm
87           sz(ij,l) = dzq(ij,l)*sm(ij,l)
88     ENDDO
[524]89
[5105]90   ENDDO
[524]91
[5105]92  RETURN
93END SUBROUTINE limz
Note: See TracBrowser for help on using the repository browser.