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

Last change on this file since 5118 was 5117, checked in by abarral, 4 months ago

rename modules properly lmdz_*
move some unused files to obsolete/
(lint) uppercase fortran keywords

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