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

Last change on this file since 5123 was 5119, checked in by abarral, 12 months ago

enforce PRIVATE by default in several modules, expose PUBLIC as needed
move eigen.f90 to obsolete/
(lint) aslong the way

  • 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
RevLine 
[1403]1! $Id: caladvtrac.F90 5119 2024-07-24 16:46:45Z abarral $
[5099]2
[5103]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
[5106]12  USE lmdz_filtreg, ONLY: filtreg
[5119]13  USE lmdz_ssum_scopy, ONLY: scopy
[524]14
[5103]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  !=======================================================================
[524]25
[5103]26  include "dimensions.h"
27  include "paramet.h"
[524]28
[5103]29  !   Arguments:
30  !   ----------
31  REAL :: pbaru(ip1jmp1, llm), pbarv(ip1jm, llm), masse(ip1jmp1, llm)
32  REAL :: p(ip1jmp1, llmp1), q(ip1jmp1, llm, nqtot)
[5116]33  REAL :: dq(ip1jmp1, llm, nqtot)
[5103]34  REAL :: teta(ip1jmp1, llm), pk(ip1jmp1, llm)
35  REAL :: flxw(ip1jmp1, llm)
[524]36
[5103]37  !  ..................................................................
38  !
39  !  .. dq n'est utilise et dimensionne que pour l'eau  vapeur et liqu.
40  !
41  !  ..................................................................
42  !
43  !   Local:
44  !   ------
[524]45
[5103]46  EXTERNAL  advtrac, minmaxq, qminimum
47  INTEGER :: ij, l, iq, iapptrac
48  REAL :: finmasse(ip1jmp1, llm), dtvrtrac
[524]49
[5103]50  !c
51  !
52  ! Earth-specific stuff for the first 2 tracers (water)
[5117]53  IF (planet_type=="earth") THEN
[5103]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)
[524]59
[5103]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) ')
[5117]63  ENDIF ! of if (planet_type.EQ."earth")
[5103]64  !   advection
[1454]65
[5103]66  CALL advtrac(pbaru, pbarv, &
67          p, masse, q, iapptrac, teta, &
68          flxw, pk)
[524]69
[5103]70  !
[524]71
[5103]72  IF(iapptrac==iapp_tracvl) THEN
[5117]73    IF (planet_type=="earth") THEN
[5103]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    ')
[524]78
[5103]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
[2270]86
[5116]87      !WRITE(*,*) 'caladvtrac 87'
[5103]88      CALL qminimum(q, nqtot, finmasse)
[5116]89      !WRITE(*,*) 'caladvtrac 89'
[524]90
[5103]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      !
[5117]108    endif ! of if (planet_type.EQ."earth")
[5103]109  ELSE
[5117]110    IF (planet_type=="earth") THEN
[5103]111      ! Earth-specific treatment for the first 2 tracers (water)
112      dq(:, :, 1:nqtot) = 0.
[5117]113    endif ! of if (planet_type.EQ."earth")
[5103]114  ENDIF ! of IF( iapptrac.EQ.iapp_tracvl )
[524]115
[5103]116END SUBROUTINE caladvtrac
[524]117
[5103]118
Note: See TracBrowser for help on using the repository browser.