source: LMDZ6/branches/Amaury_dev/libf/dyn3d/lmdz_caladvtrac.f90 @ 5218

Last change on this file since 5218 was 5186, checked in by abarral, 3 months ago

Encapsulate files in modules

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.5 KB
Line 
1MODULE lmdz_caladvtrac
2  IMPLICIT NONE; PRIVATE
3  PUBLIC caladvtrac
4
5CONTAINS
6
7  SUBROUTINE caladvtrac(q, pbaru, pbarv, &
8          p, masse, dq, teta, &
9          flxw, pk)
10
11    USE lmdz_infotrac, ONLY: nqtot
12    USE control_mod, ONLY: iapp_tracvl, planet_type
13    USE comconst_mod, ONLY: dtvr
14    USE lmdz_filtreg, ONLY: filtreg
15    USE lmdz_ssum_scopy, ONLY: scopy
16
17    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
18    USE lmdz_paramet
19    USE lmdz_advtrac, ONLY: advtrac
20
21    IMPLICIT NONE
22
23    ! Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron
24
25    ! F.Codron (10/99) : ajout humidite specifique pour eau vapeur
26    !=======================================================================
27
28    !   Shema de  Van Leer
29
30    !=======================================================================
31
32
33
34
35    !   Arguments:
36    !   ----------
37    REAL :: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm), masse(ip1jmp1, llm)
38    REAL :: p(ip1jmp1, llmp1), q(ip1jmp1, llm, nqtot)
39    REAL :: dq(ip1jmp1, llm, nqtot)
40    REAL :: teta(ip1jmp1, llm), pk(ip1jmp1, llm)
41    REAL :: flxw(ip1jmp1, llm)
42
43    !  ..................................................................
44
45    !  .. dq n'est utilise et dimensionne que pour l'eau  vapeur et liqu.
46
47    !  ..................................................................
48
49    !   Local:
50    !   ------
51
52    EXTERNAL  minmaxq, qminimum
53    INTEGER :: ij, l, iq, iapptrac
54    REAL :: finmasse(ip1jmp1, llm), dtvrtrac
55
56    !c
57
58    ! Earth-specific stuff for the first 2 tracers (water)
59    IF (planet_type=="earth") THEN
60      ! initialisation
61      ! CRisi: il faut gérer tous les traceurs si on veut pouvoir faire des
62      ! isotopes
63      ! dq(:,:,1:2)=q(:,:,1:2)
64      dq(:, :, 1:nqtot) = q(:, :, 1:nqtot)
65
66      !  test des valeurs minmax
67      !c        CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur (a) ')
68      !c        CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide(a) ')
69    ENDIF ! of if (planet_type.EQ."earth")
70    !   advection
71
72    CALL advtrac(pbaru, pbarv, &
73            p, masse, q, iapptrac, teta, &
74            flxw, pk)
75
76    !
77
78    IF(iapptrac==iapp_tracvl) THEN
79      IF (planet_type=="earth") THEN
80        ! Earth-specific treatment for the first 2 tracers (water)
81
82        !c          CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur     ')
83        !c          CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide    ')
84
85        !c     ....  Calcul  de deltap  qu'on stocke dans finmasse   ...
86
87        DO l = 1, llm
88          DO ij = 1, ip1jmp1
89            finmasse(ij, l) = p(ij, l) - p(ij, l + 1)
90          ENDDO
91        ENDDO
92
93        !WRITE(*,*) 'caladvtrac 87'
94        CALL qminimum(q, nqtot, finmasse)
95        !WRITE(*,*) 'caladvtrac 89'
96
97        CALL SCOPY   (ip1jmp1 * llm, masse, 1, finmasse, 1)
98        CALL filtreg (finmasse, jjp1, llm, -2, 2, .TRUE., 1)
99
100        !   *****  Calcul de dq pour l'eau , pour le passer a la physique ******
101        !   ********************************************************************
102
103        dtvrtrac = iapp_tracvl * dtvr
104
105        DO iq = 1, nqtot
106          DO l = 1, llm
107            DO ij = 1, ip1jmp1
108              dq(ij, l, iq) = (q(ij, l, iq) - dq(ij, l, iq)) * finmasse(ij, l) &
109                      / dtvrtrac
110            ENDDO
111          ENDDO
112        ENDDO
113
114      endif ! of if (planet_type.EQ."earth")
115    ELSE
116      IF (planet_type=="earth") THEN
117        ! Earth-specific treatment for the first 2 tracers (water)
118        dq(:, :, 1:nqtot) = 0.
119      endif ! of if (planet_type.EQ."earth")
120    ENDIF ! of IF( iapptrac.EQ.iapp_tracvl )
121
122  END SUBROUTINE caladvtrac
123
124
125END MODULE lmdz_caladvtrac
Note: See TracBrowser for help on using the repository browser.