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	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	use filtreg_m, only: filtreg
14
15	IMPLICIT NONE
16
17	REAL pbaru(ip1jmp1, llm), pbarv((iim + 1) * jjm, llm), masse(ip1jmp1, llm)
18	REAL, intent(in):: p(ip1jmp1, llm + 1)
19	real q(ip1jmp1, llm, nqmx)
20
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