trunk/dyn3d/caladvtrac.f

module caladvtrac_m

  IMPLICIT NONE

contains

  SUBROUTINE caladvtrac(q, pbaru, pbarv, p, masse, teta, pk)

    ! From dyn3d/caladvtrac.F, version 1.3 2005/04/13 08:58:34
    ! Authors: F. Hourdin, P. Le Van, F. Forget, F. Codron
    ! F. Codron (10/99) : ajout humidit\'e sp\'ecifique pour eau vapeur
    ! Sch\'ema de Van Leer

    ! Calcul des tendances advection des traceurs (dont l'humidit\'e)

    use advtrac_m, only: advtrac
    use conf_gcm_m, only: iapp_tracvl
    use dimens_m, only: iim, jjm, llm
    use paramet_m, only: ip1jmp1
    use qminimum_m, only: qminimum

    real, intent(inout):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx)
    REAL, intent(in):: pbaru(ip1jmp1, llm), pbarv((iim + 1) * jjm, llm)
    REAL, intent(in):: p(iim + 1, jjm + 1, llm + 1)
    real, intent(in):: masse(iim + 1, jjm + 1, llm)
    REAL, intent(in):: teta(ip1jmp1, llm)
    real, intent(in):: pk(ip1jmp1, llm)

    ! Local:
    INTEGER l, iapptrac
    REAL finmasse(iim + 1, jjm + 1, llm)

    !------------------------------------------------

    ! Advection:
    CALL advtrac(pbaru, pbarv, p, masse, q, iapptrac, teta, pk)

    IF (iapptrac == iapp_tracvl) THEN
       forall (l = 1:llm) finmasse(:, :, l) =  p(:, :, l) - p(:, :, l+1) 

       ! Uniquement pour l'eau vapeur et liquide:
       CALL qminimum(q, 2, finmasse)
    ENDIF

  END SUBROUTINE caladvtrac

end module caladvtrac_m
1	module caladvtrac_m
2
3	IMPLICIT NONE
4
5	contains
6
7	SUBROUTINE caladvtrac(q, pbaru, pbarv, p, masse, teta, pk)
8
9	! From dyn3d/caladvtrac.F, version 1.3 2005/04/13 08:58:34
10	! Authors: F. Hourdin, P. Le Van, F. Forget, F. Codron
11	! F. Codron (10/99) : ajout humidit\'e sp\'ecifique pour eau vapeur
12	! Sch\'ema de Van Leer
13
14	! Calcul des tendances advection des traceurs (dont l'humidit\'e)
15
16	use advtrac_m, only: advtrac
17	use conf_gcm_m, only: iapp_tracvl
18	use dimens_m, only: iim, jjm, llm
19	use paramet_m, only: ip1jmp1
20	use qminimum_m, only: qminimum
21
22	real, intent(inout):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx)
23	REAL, intent(in):: pbaru(ip1jmp1, llm), pbarv((iim + 1) * jjm, llm)
24	REAL, intent(in):: p(iim + 1, jjm + 1, llm + 1)
25	real, intent(in):: masse(iim + 1, jjm + 1, llm)
26	REAL, intent(in):: teta(ip1jmp1, llm)
27	real, intent(in):: pk(ip1jmp1, llm)
28
29	! Local:
30	INTEGER l, iapptrac
31	REAL finmasse(iim + 1, jjm + 1, llm)
32
33	!------------------------------------------------
34
35	! Advection:
36	CALL advtrac(pbaru, pbarv, p, masse, q, iapptrac, teta, pk)
37
38	IF (iapptrac == iapp_tracvl) THEN
39	forall (l = 1:llm) finmasse(:, :, l) = p(:, :, l) - p(:, :, l+1)
40
41	! Uniquement pour l'eau vapeur et liquide:
42	CALL qminimum(q, 2, finmasse)
43	ENDIF
44
45	END SUBROUTINE caladvtrac
46
47	end module caladvtrac_m