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