Sources/dyn3d/limx.f


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

SUBROUTINE limx(s0, sx, 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 sx(ip1jmp1, llm)

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

  INTEGER ij, l

  REAL q(ip1jmp1, llm)
  REAL dxq(ip1jmp1, llm)

  REAL dxqu(ip1jmp1)
  REAL adxqu(ip1jmp1), dxqmax(ip1jmp1)

  EXTERNAL convflu

  DO l = 1, llm
    DO ij = 1, ip1jmp1
      q(ij, l) = s0(ij, l)/sm(ij, l)
      dxq(ij, l) = sx(ij, l)/sm(ij, l)
    END DO
  END DO

  ! calcul de la pente a droite et a gauche de la maille

  DO l = 1, llm
    DO ij = iip2, ip1jm - 1
      dxqu(ij) = q(ij+1, l) - q(ij, l)
    END DO
    DO ij = iip1 + iip1, ip1jm, iip1
      dxqu(ij) = dxqu(ij-iim)
    END DO

    DO ij = iip2, ip1jm
      adxqu(ij) = abs(dxqu(ij))
    END DO

    ! calcul de la pente maximum dans la maille en valeur absolue

    DO ij = iip2 + 1, ip1jm
      dxqmax(ij) = pente_max*min(adxqu(ij-1), adxqu(ij))
    END DO

    DO ij = iip1 + iip1, ip1jm, iip1
      dxqmax(ij-iim) = dxqmax(ij)
    END DO

    ! calcul de la pente avec limitation

    DO ij = iip2 + 1, ip1jm
      IF (dxqu(ij-1)*dxqu(ij)>0. .AND. dxq(ij,l)*dxqu(ij)>0.) THEN
        dxq(ij, l) = sign(min(abs(dxq(ij,l)),dxqmax(ij)), dxq(ij,l))
      ELSE
        ! extremum local
        dxq(ij, l) = 0.
      END IF
    END DO
    DO ij = iip1 + iip1, ip1jm, iip1
      dxq(ij-iim, l) = dxq(ij, l)
    END DO

    DO ij = 1, ip1jmp1
      sx(ij, l) = dxq(ij, l)*sm(ij, l)
    END DO

  END DO

  RETURN
END SUBROUTINE limx
1
2	! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/limx.F,v 1.1.1.1 2004/05/19
3	! 12:53:06 lmdzadmin Exp $
4
5	SUBROUTINE limx(s0, sx, 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 sx(ip1jmp1, llm)
31
32	! Local
33	! ---------
34
35	INTEGER ij, l
36
37	REAL q(ip1jmp1, llm)
38	REAL dxq(ip1jmp1, llm)
39
40	REAL dxqu(ip1jmp1)
41	REAL adxqu(ip1jmp1), dxqmax(ip1jmp1)
42
43	EXTERNAL convflu
44
45	DO l = 1, llm
46	DO ij = 1, ip1jmp1
47	q(ij, l) = s0(ij, l)/sm(ij, l)
48	dxq(ij, l) = sx(ij, l)/sm(ij, l)
49	END DO
50	END DO
51
52	! calcul de la pente a droite et a gauche de la maille
53
54	DO l = 1, llm
55	DO ij = iip2, ip1jm - 1
56	dxqu(ij) = q(ij+1, l) - q(ij, l)
57	END DO
58	DO ij = iip1 + iip1, ip1jm, iip1
59	dxqu(ij) = dxqu(ij-iim)
60	END DO
61
62	DO ij = iip2, ip1jm
63	adxqu(ij) = abs(dxqu(ij))
64	END DO
65
66	! calcul de la pente maximum dans la maille en valeur absolue
67
68	DO ij = iip2 + 1, ip1jm
69	dxqmax(ij) = pente_max*min(adxqu(ij-1), adxqu(ij))
70	END DO
71
72	DO ij = iip1 + iip1, ip1jm, iip1
73	dxqmax(ij-iim) = dxqmax(ij)
74	END DO
75
76	! calcul de la pente avec limitation
77
78	DO ij = iip2 + 1, ip1jm
79	IF (dxqu(ij-1)dxqu(ij)>0. .AND. dxq(ij,l)dxqu(ij)>0.) THEN
80	dxq(ij, l) = sign(min(abs(dxq(ij,l)),dxqmax(ij)), dxq(ij,l))
81	ELSE
82	! extremum local
83	dxq(ij, l) = 0.
84	END IF
85	END DO
86	DO ij = iip1 + iip1, ip1jm, iip1
87	dxq(ij-iim, l) = dxq(ij, l)
88	END DO
89
90	DO ij = 1, ip1jmp1
91	sx(ij, l) = dxq(ij, l)*sm(ij, l)
92	END DO
93
94	END DO
95
96	RETURN
97	END SUBROUTINE limx