trunk/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, 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., 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	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	40	SUBROUTINE caladvtrac(q, pbaru, pbarv, p, masse, dq, teta, pk)
8	guez	3
9	guez	40	! From dyn3d/caladvtrac.F, version 1.3 2005/04/13 08:58:34
10	guez	3
11	guez	40	! 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	guez	3
15	guez	40	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	guez	3
22	guez	40	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	guez	3
27	guez	40	real, intent(out):: dq(iim + 1, jjm + 1, llm, 2)
28			! (n'est utilisé et dimensionné que pour l'eau vapeur et liquide)
29	guez	3
30	guez	44	REAL, intent(in):: teta(ip1jmp1, llm)
31			real pk(ip1jmp1, llm)
32	guez	3
33	guez	40	! Local:
34	guez	3
35	guez	40	EXTERNAL qminimum
36			INTEGER l, iq, iapptrac
37			REAL finmasse(iim + 1, jjm + 1, llm), dtvrtrac
38	guez	3
39	guez	40	!------------------------------------------------
40	guez	3
41	guez	40	dq = q(:, :, :, :2) ! initialisation
42	guez	3
43	guez	40	! Advection:
44			CALL advtrac(pbaru, pbarv, p, masse, q, iapptrac, teta, pk)
45	guez	3
46	guez	40	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	guez	3
50	guez	40	! On appelle "qminimum" uniquement pour l'eau vapeur et liquide
51			CALL qminimum(q, 2, finmasse)
52	guez	3
53	guez	40	finmasse = masse
54			CALL filtreg(finmasse, jjm + 1, llm, -2, 2, .TRUE., 1)
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