libf/dyn3d/caladvtrac.f90

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, intent(in):: teta(ip1jmp1, llm)
    real 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.)

       ! 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, intent(in):: teta(ip1jmp1, llm)
31	real pk(ip1jmp1, llm)
32
33	! Local:
34
35	EXTERNAL qminimum
36	INTEGER l, iq, iapptrac
37	REAL finmasse(iim + 1, jjm + 1, llm), dtvrtrac
38
39	!------------------------------------------------
40
41	dq = q(:, :, :, :2) ! initialisation
42
43	! Advection:
44	CALL advtrac(pbaru, pbarv, p, masse, q, iapptrac, teta, pk)
45
46	IF (iapptrac == iapp_tracvl) THEN
47	! Calcul de deltap qu'on stocke dans finmasse
48	forall (l = 1:llm) finmasse(:, :, l) = p(:, :, l) - p(:, :, l+1)
49
50	! On appelle "qminimum" uniquement pour l'eau vapeur et liquide
51	CALL qminimum(q, 2, finmasse)
52
53	finmasse = masse
54	CALL filtreg(finmasse, jjm + 1, llm, -2, 2, .TRUE.)
55
56	! Calcul de "dq" pour l'eau, pour le passer à la physique
57	dtvrtrac = iapp_tracvl * dtvr
58	DO iq = 1, 2
59	dq(:, :, :, iq) = (q(:, :, :, iq) - dq(:, :, :, iq)) * finmasse &
60	/ dtvrtrac
61	ENDDO
62	ELSE
63	dq = 0.
64	ENDIF
65
66	END SUBROUTINE caladvtrac
67
68	end module caladvtrac_m