GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: dyn3d/caladvtrac.F Lines: 21 21 100.0 %
Date: 2023-06-30 12:51:15 Branches: 27 30 90.0 %

Line Branch Exec Source
1
!
2
! $Id: caladvtrac.F 2597 2016-07-22 06:44:47Z emillour $
3
!
4
c
5
c
6
1441
            SUBROUTINE caladvtrac(q,pbaru,pbarv ,
7
1441
     *                   p ,masse, dq ,  teta,
8
     *                   flxw, pk)
9
c
10
      USE infotrac, ONLY : nqtot
11
      USE control_mod, ONLY : iapp_tracvl,planet_type
12
      USE comconst_mod, ONLY: dtvr
13
14
      IMPLICIT NONE
15
c
16
c     Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron
17
c
18
c     F.Codron (10/99) : ajout humidite specifique pour eau vapeur
19
c=======================================================================
20
c
21
c       Shema de  Van Leer
22
c
23
c=======================================================================
24
25
26
      include "dimensions.h"
27
      include "paramet.h"
28
29
c   Arguments:
30
c   ----------
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
c  ..................................................................
38
c
39
c  .. dq n'est utilise et dimensionne que pour l'eau  vapeur et liqu.
40
c
41
c  ..................................................................
42
c
43
c   Local:
44
c   ------
45
46
      EXTERNAL  advtrac,minmaxq, qminimum
47
      INTEGER ij,l, iq, iapptrac
48
      REAL finmasse(ip1jmp1,llm), dtvrtrac
49
50
cc
51
c
52
! Earth-specific stuff for the first 2 tracers (water)
53
1441
      if (planet_type.eq."earth") then
54
C 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

306293196
        dq(:,:,1:nqtot)=q(:,:,1:nqtot)
59
60
c  test des valeurs minmax
61
cc        CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur (a) ')
62
cc        CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide(a) ')
63
      endif ! of if (planet_type.eq."earth")
64
c   advection
65
66
        CALL advtrac( pbaru,pbarv,
67
     *       p,  masse,q,iapptrac, teta,
68
1441
     .       flxw, pk)
69
70
c
71
72
1441
      IF( iapptrac.EQ.iapp_tracvl ) THEN
73
288
        if (planet_type.eq."earth") then
74
! Earth-specific treatment for the first 2 tracers (water)
75
c
76
cc          CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur     ')
77
cc          CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide    ')
78
79
cc     ....  Calcul  de deltap  qu'on stocke dans finmasse   ...
80
c
81
11520
          DO l = 1, llm
82
12243168
           DO ij = 1, ip1jmp1
83
12242880
             finmasse(ij,l) =  p(ij,l) - p(ij,l+1)
84
           ENDDO
85
          ENDDO
86
87
          !write(*,*) 'caladvtrac 87'
88
288
          CALL qminimum( q, nqtot, finmasse )
89
          !write(*,*) 'caladvtrac 89'
90
91
288
          CALL SCOPY   ( ip1jmp1*llm, masse, 1, finmasse,       1 )
92
288
          CALL filtreg ( finmasse ,  jjp1,  llm, -2, 2, .TRUE., 1 )
93
c
94
c   *****  Calcul de dq pour l'eau , pour le passer a la physique ******
95
c   ********************************************************************
96
c
97
288
          dtvrtrac = iapp_tracvl * dtvr
98
c
99
1728
           DO iq = 1 , nqtot
100
57888
            DO l = 1 , llm
101
61215840
             DO ij = 1,ip1jmp1
102
             dq(ij,l,iq) = ( q(ij,l,iq) - dq(ij,l,iq) ) * finmasse(ij,l)
103
61214400
     *                               /  dtvrtrac
104
             ENDDO
105
            ENDDO
106
           ENDDO
107
c
108
        endif ! of if (planet_type.eq."earth")
109
      ELSE
110
1153
        if (planet_type.eq."earth") then
111
! Earth-specific treatment for the first 2 tracers (water)
112

245077068
          dq(:,:,1:nqtot)=0.
113
        endif ! of if (planet_type.eq."earth")
114
      ENDIF ! of IF( iapptrac.EQ.iapp_tracvl )
115
116
1441
      END
117
118