Sources/dyn3d/caladvtrac.f

module caladvtrac_m

  IMPLICIT NONE

contains

  SUBROUTINE caladvtrac(q, pbaru, pbarv, p, masse, dq, 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é spécifique pour eau vapeur
    ! Schéma de Van Leer

    use advtrac_m, only: advtrac
    use comconst, only: dtvr
    use conf_gcm_m, only: iapp_tracvl
    use dimens_m, only: iim, jjm, llm, nqmx
    use filtreg_m, only: filtreg
    use paramet_m, only: ip1jmp1

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

    real, intent(out):: dq(iim + 1, jjm + 1, llm, 2)
    ! (n'est utilisé et dimensionné que pour l'eau vapeur et liquide)

    REAL teta(ip1jmp1, llm), pk(ip1jmp1, llm)

    ! Local:

    EXTERNAL qminimum
    INTEGER l, iq, iapptrac
    REAL finmasse(iim + 1, jjm + 1, llm), dtvrtrac

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

    dq = q(:, :, :, :2) ! initialisation

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

    IF (iapptrac == iapp_tracvl) THEN
       ! Calcul  de deltap  qu'on stocke dans finmasse
       forall (l = 1:llm) finmasse(:, :, l) =  p(:, :, l) - p(:, :, l+1) 

       ! On appelle "qminimum" uniquement  pour l'eau vapeur et liquide
       CALL qminimum(q, 2, finmasse)

       finmasse = masse
       CALL filtreg(finmasse, jjm + 1, llm, -2, 2, .TRUE., 1)

       ! Calcul de "dq" pour l'eau, pour le passer à la physique
       dtvrtrac = iapp_tracvl * dtvr
       DO iq = 1, 2
          dq(:, :, :, iq) = (q(:, :, :, iq) - dq(:, :, :, iq)) * finmasse &
               /  dtvrtrac
       ENDDO
    ELSE
       dq = 0.
    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, dq, teta, pk)
8
9	! From dyn3d/caladvtrac.F, version 1.3 2005/04/13 08:58:34
10
11	! Authors : F. Hourdin, P. Le Van, F. Forget, F. Codron
12	! F. Codron (10/99) : ajout humidité spécifique pour eau vapeur
13	! Schéma de Van Leer
14
15	use advtrac_m, only: advtrac
16	use comconst, only: dtvr
17	use conf_gcm_m, only: iapp_tracvl
18	use dimens_m, only: iim, jjm, llm, nqmx
19	use filtreg_m, only: filtreg
20	use paramet_m, only: ip1jmp1
21
22	REAL pbaru(ip1jmp1, llm), pbarv((iim + 1) * jjm, llm)
23	real masse(iim + 1, jjm + 1, llm)
24	REAL, intent(in):: p(iim + 1, jjm + 1, llm + 1)
25	real, intent(inout):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx)
26
27	real, intent(out):: dq(iim + 1, jjm + 1, llm, 2)
28	! (n'est utilisé et dimensionné que pour l'eau vapeur et liquide)
29
30	REAL teta(ip1jmp1, llm), pk(ip1jmp1, llm)
31
32	! Local:
33
34	EXTERNAL qminimum
35	INTEGER l, iq, iapptrac
36	REAL finmasse(iim + 1, jjm + 1, llm), dtvrtrac
37
38	!------------------------------------------------
39
40	dq = q(:, :, :, :2) ! initialisation
41
42	! Advection:
43	CALL advtrac(pbaru, pbarv, p, masse, q, iapptrac, teta, pk)
44
45	IF (iapptrac == iapp_tracvl) THEN
46	! Calcul de deltap qu'on stocke dans finmasse
47	forall (l = 1:llm) finmasse(:, :, l) = p(:, :, l) - p(:, :, l+1)
48
49	! On appelle "qminimum" uniquement pour l'eau vapeur et liquide
50	CALL qminimum(q, 2, finmasse)
51
52	finmasse = masse
53	CALL filtreg(finmasse, jjm + 1, llm, -2, 2, .TRUE., 1)
54
55	! Calcul de "dq" pour l'eau, pour le passer à la physique
56	dtvrtrac = iapp_tracvl * dtvr
57	DO iq = 1, 2
58	dq(:, :, :, iq) = (q(:, :, :, iq) - dq(:, :, :, iq)) * finmasse &
59	/ dtvrtrac
60	ENDDO
61	ELSE
62	dq = 0.
63	ENDIF
64
65	END SUBROUTINE caladvtrac
66
67	end module caladvtrac_m