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

Last change on this file since 5136 was 5134, checked in by abarral, 5 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
RevLine 
[1403]1! $Id: caladvtrac.F90 5134 2024-07-26 15:56:37Z 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
[5134]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.