Sources/dyn3d/limz.f


! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/limz.F,v 1.1.1.1 2004/05/19
! 12:53:07 lmdzadmin Exp $

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 dimens_m
  USE paramet_m
  USE comconst
  USE disvert_m
  USE conf_gcm_m
  USE comgeom
  IMPLICIT NONE


  ! Arguments:
  ! ----------
  REAL pente_max
  REAL s0(ip1jmp1, llm), sm(ip1jmp1, llm)
  REAL sz(ip1jmp1, llm)

  ! Local
  ! ---------

  INTEGER ij, l

  REAL q(ip1jmp1, llm)
  REAL dzq(ip1jmp1, llm)

  REAL dzqw(ip1jmp1)
  REAL adzqw(ip1jmp1), dzqmax(ip1jmp1)

  LOGICAL first
  SAVE first

  REAL ssum
  INTEGER ismax, ismin
  EXTERNAL ssum, convflu, 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)
    END DO
  END DO

  ! 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)
    END DO
    dzqw(llm) = 0.

    DO l = 1, llm
      adzqw(l) = abs(dzqw(l))
    END DO

    ! 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))
    END DO

    ! 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.
      END IF
    END DO

    DO l = 1, llm
      sz(ij, l) = dzq(ij, l)*sm(ij, l)
    END DO

  END DO

  RETURN
END SUBROUTINE limz
1
2	! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/limz.F,v 1.1.1.1 2004/05/19
3	! 12:53:07 lmdzadmin Exp $
4
5	SUBROUTINE limz(s0, sz, sm, pente_max)
6
7	! Auteurs: P.Le Van, F.Hourdin, F.Forget
8
9	! ********************************************************************
10	! Shema d'advection " pseudo amont " .
11	! ********************************************************************
12	! nq,iq,q,pbaru,pbarv,w sont des arguments d'entree pour le s-pg ....
13
14
15	! --------------------------------------------------------------------
16	USE dimens_m
17	USE paramet_m
18	USE comconst
19	USE disvert_m
20	USE conf_gcm_m
21	USE comgeom
22	IMPLICIT NONE
23
24
25
26	! Arguments:
27	! ----------
28	REAL pente_max
29	REAL s0(ip1jmp1, llm), sm(ip1jmp1, llm)
30	REAL sz(ip1jmp1, llm)
31
32	! Local
33	! ---------
34
35	INTEGER ij, l
36
37	REAL q(ip1jmp1, llm)
38	REAL dzq(ip1jmp1, llm)
39
40	REAL dzqw(ip1jmp1)
41	REAL adzqw(ip1jmp1), dzqmax(ip1jmp1)
42
43	LOGICAL first
44	SAVE first
45
46	REAL ssum
47	INTEGER ismax, ismin
48	EXTERNAL ssum, convflu, ismin, ismax
49
50	DATA first/.TRUE./
51
52
53	DO l = 1, llm
54	DO ij = 1, ip1jmp1
55	q(ij, l) = s0(ij, l)/sm(ij, l)
56	dzq(ij, l) = sz(ij, l)/sm(ij, l)
57	END DO
58	END DO
59
60	! calcul de la pente en haut et en bas de la maille
61	DO ij = 1, ip1jmp1
62	DO l = 1, llm - 1
63	dzqw(l) = q(ij, l+1) - q(ij, l)
64	END DO
65	dzqw(llm) = 0.
66
67	DO l = 1, llm
68	adzqw(l) = abs(dzqw(l))
69	END DO
70
71	! calcul de la pente maximum dans la maille en valeur absolue
72
73	DO l = 2, llm - 1
74	dzqmax(l) = pente_max*min(adzqw(l-1), adzqw(l))
75	END DO
76
77	! calcul de la pente avec limitation
78
79	DO l = 2, llm - 1
80	IF (dzqw(l-1)dzqw(l)>0. .AND. dzq(ij,l)dzqw(l)>0.) THEN
81	dzq(ij, l) = sign(min(abs(dzq(ij,l)),dzqmax(l)), dzq(ij,l))
82	ELSE
83	! extremum local
84	dzq(ij, l) = 0.
85	END IF
86	END DO
87
88	DO l = 1, llm
89	sz(ij, l) = dzq(ij, l)*sm(ij, l)
90	END DO
91
92	END DO
93
94	RETURN
95	END SUBROUTINE limz