trunk/dyn3d/caladvtrac.f

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 dimens_m, only: iim, jjm, llm, nqmx
  use paramet_m, only: ip1jmp1
  use comconst, only: dtvr
  use conf_gcm_m, only: iapp_tracvl
  use filtreg_m, only: filtreg

  IMPLICIT NONE

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

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

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

  ! Local:

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