source: LMDZ6/branches/Amaury_dev/libf/dyn3d/caladvtrac.F90 @ 5139

Last change on this file since 5139 was 5134, checked in by abarral, 4 months ago

Replace academic.h, alpale.h, comdissip.h, comdissipn.h, comdissnew.h by modules
Remove unused clesph0.h

  • 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.3 KB
Line 
1! $Id: caladvtrac.F90 5134 2024-07-26 15:56:37Z abarral $
2
3!
4!
5SUBROUTINE caladvtrac(q, pbaru, pbarv, &
6        p, masse, dq, teta, &
7        flxw, pk)
8  !
9  USE infotrac, ONLY: nqtot
10  USE control_mod, ONLY: iapp_tracvl, planet_type
11  USE comconst_mod, ONLY: dtvr
12  USE lmdz_filtreg, ONLY: filtreg
13  USE lmdz_ssum_scopy, ONLY: scopy
14
15  IMPLICIT NONE
16  !
17  ! Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron
18  !
19  ! F.Codron (10/99) : ajout humidite specifique pour eau vapeur
20  !=======================================================================
21  !
22  !   Shema de  Van Leer
23  !
24  !=======================================================================
25
26  INCLUDE "dimensions.h"
27  INCLUDE "paramet.h"
28
29  !   Arguments:
30  !   ----------
31  REAL :: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm), masse(ip1jmp1, llm)
32  REAL :: p(ip1jmp1, llmp1), q(ip1jmp1, llm, nqtot)
33  REAL :: dq(ip1jmp1, llm, nqtot)
34  REAL :: teta(ip1jmp1, llm), pk(ip1jmp1, llm)
35  REAL :: flxw(ip1jmp1, llm)
36
37  !  ..................................................................
38  !
39  !  .. dq n'est utilise et dimensionne que pour l'eau  vapeur et liqu.
40  !
41  !  ..................................................................
42  !
43  !   Local:
44  !   ------
45
46  EXTERNAL  advtrac, minmaxq, qminimum
47  INTEGER :: ij, l, iq, iapptrac
48  REAL :: finmasse(ip1jmp1, llm), dtvrtrac
49
50  !c
51  !
52  ! Earth-specific stuff for the first 2 tracers (water)
53  IF (planet_type=="earth") THEN
54    ! initialisation
55    ! CRisi: il faut gérer tous les traceurs si on veut pouvoir faire des
56    ! isotopes
57    ! dq(:,:,1:2)=q(:,:,1:2)
58    dq(:, :, 1:nqtot) = q(:, :, 1:nqtot)
59
60    !  test des valeurs minmax
61    !c        CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur (a) ')
62    !c        CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide(a) ')
63  ENDIF ! of if (planet_type.EQ."earth")
64  !   advection
65
66  CALL advtrac(pbaru, pbarv, &
67          p, masse, q, iapptrac, teta, &
68          flxw, pk)
69
70  !
71
72  IF(iapptrac==iapp_tracvl) THEN
73    IF (planet_type=="earth") THEN
74      ! Earth-specific treatment for the first 2 tracers (water)
75      !
76      !c          CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur     ')
77      !c          CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide    ')
78
79      !c     ....  Calcul  de deltap  qu'on stocke dans finmasse   ...
80      !
81      DO l = 1, llm
82        DO ij = 1, ip1jmp1
83          finmasse(ij, l) = p(ij, l) - p(ij, l + 1)
84        ENDDO
85      ENDDO
86
87      !WRITE(*,*) 'caladvtrac 87'
88      CALL qminimum(q, nqtot, finmasse)
89      !WRITE(*,*) 'caladvtrac 89'
90
91      CALL SCOPY   (ip1jmp1 * llm, masse, 1, finmasse, 1)
92      CALL filtreg (finmasse, jjp1, llm, -2, 2, .TRUE., 1)
93      !
94      !   *****  Calcul de dq pour l'eau , pour le passer a la physique ******
95      !   ********************************************************************
96      !
97      dtvrtrac = iapp_tracvl * dtvr
98      !
99      DO iq = 1, nqtot
100        DO l = 1, llm
101          DO ij = 1, ip1jmp1
102            dq(ij, l, iq) = (q(ij, l, iq) - dq(ij, l, iq)) * finmasse(ij, l) &
103                    / dtvrtrac
104          ENDDO
105        ENDDO
106      ENDDO
107      !
108    endif ! of if (planet_type.EQ."earth")
109  ELSE
110    IF (planet_type=="earth") THEN
111      ! Earth-specific treatment for the first 2 tracers (water)
112      dq(:, :, 1:nqtot) = 0.
113    endif ! of if (planet_type.EQ."earth")
114  ENDIF ! of IF( iapptrac.EQ.iapp_tracvl )
115
116END SUBROUTINE caladvtrac
117
118
Note: See TracBrowser for help on using the repository browser.