GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/tend_to_tke.F90 Lines: 37 37 100.0 %
Date: 2023-06-30 12:56:34 Branches: 56 56 100.0 %

Line Branch Exec Source
1
!***************************************************************************************
2
! tend_to_tke.F90
3
!*************
4
!
5
! Subroutine that adds a tendency on the TKE created by the
6
! fluxes of momentum retrieved from the wind speed tendencies
7
! of the physics.
8
!
9
! The basic concept is the following:
10
! the TKE equation writes  de/dt = -u'w' du/dz -v'w' dv/dz +g/theta dtheta/dz +......
11
!
12
!
13
! We expect contributions to the term u'w' and v'w' that do not come from the Yamada
14
! scheme, for instance: gravity waves, drag from high vegetation..... These contributions
15
! need to be accounted for.
16
! we explicitely calculate the fluxes, integrating the wind speed
17
!                        tendency from the top of the atmospher
18
!
19
!
20
!
21
! contacts: Frederic Hourdin, Etienne Vignon
22
!
23
! History:
24
!---------
25
! - 1st redaction, Etienne, 15/10/2016
26
! Ajout des 4 sous surfaces pour la tke
27
! on sort l'ajout des tendances du if sur les deux cas, pour ne pas
28
! dupliuqer les lignes
29
! on enleve le pas de temps qui disprait dans les calculs
30
!
31
!
32
!**************************************************************************************
33
34
288
 SUBROUTINE tend_to_tke(dt,plev,exner,temp,windu,windv,dt_a,du_a,dv_a,pctsrf,tke)
35
36
 USE dimphy, ONLY: klon, klev
37
 USE indice_sol_mod, ONLY: nbsrf
38
39
IMPLICIT NONE
40
INCLUDE "YOMCST.h"
41
42
! Declarations
43
!==============
44
45
46
! Inputs
47
!-------
48
  REAL dt                   ! Time step [s]
49
  REAL plev(klon,klev+1)    ! inter-layer pressure [Pa]
50
  REAL temp(klon,klev)      ! temperature [K], grid-cell average or for a one subsurface
51
  REAL windu(klon,klev)     ! zonal wind [m/s], grid-cell average or for a one subsurface
52
  REAL windv(klon,klev)     ! meridonal wind [m/s], grid-cell average or for a one subsurface
53
  REAL exner(klon,klev)     ! Fonction d'Exner = T/theta
54
  REAL dt_a(klon,klev)      ! Temperature tendency [K], grid-cell average or for a one subsurface
55
  REAL du_a(klon,klev)      ! Zonal wind speed tendency [m/s], grid-cell average or for a one subsurface
56
  REAL dv_a(klon,klev)      ! Meridional wind speed tendency [m/s], grid-cell average or for a one subsurface
57
  REAL pctsrf(klon,nbsrf+1)       ! Turbulent Kinetic energy [m2/s2], grid-cell average or for a subsurface
58
59
! Inputs/Outputs
60
!---------------
61
  REAL tke(klon,klev+1,nbsrf+1)       ! Turbulent Kinetic energy [m2/s2], grid-cell average or for a subsurface
62
63
64
! Local
65
!-------
66
67
68
  INTEGER i,k,isrf                 ! indices
69
576
  REAL    masse(klon,klev)          ! mass in the layers [kg/m2]
70
576
  REAL    unsmasse(klon,klev+1)     ! linear mass in the layers [kg/m2]
71
576
  REAL    flux_rhotw(klon,klev+1)   ! flux massique de tempe. pot. rho*u'*theta'
72
576
  REAL    flux_rhouw(klon,klev+1)   ! flux massique de quantit?? de mouvement rho*u'*w' [kg/m/s2]
73
576
  REAL    flux_rhovw(klon,klev+1)   ! flux massique de quantit?? de mouvement rho*v'*w' [kg/m/s2]
74
576
  REAL    tendt(klon,klev)        ! new temperature tke tendency [m2/s2/s]
75
576
  REAL    tendu(klon,klev)        ! new zonal tke tendency [m2/s2/s]
76
288
  REAL    tendv(klon,klev)        ! new meridonal tke tendency [m2/s2/s]
77
78
79
80
81
! First calculations:
82
!=====================
83
84

11462688
      unsmasse(:,:)=0.
85
11520
      DO k=1,klev
86
11175840
         masse(:,k)=(plev(:,k)-plev(:,k+1))/RG
87
11175840
         unsmasse(:,k)=unsmasse(:,k)+0.5/masse(:,k)
88
11176128
         unsmasse(:,k+1)=unsmasse(:,k+1)+0.5/masse(:,k)
89
      END DO
90
91

11176128
      tendu(:,:)=0.0
92

11176128
      tendv(:,:)=0.0
93
94
! Method 1: Calculation of fluxes using a downward integration
95
!============================================================
96
97
98
99
! Flux calculation
100
101
286560
 flux_rhotw(:,klev+1)=0.
102
286560
 flux_rhouw(:,klev+1)=0.
103
286560
 flux_rhovw(:,klev+1)=0.
104
105
11520
   DO k=klev,1,-1
106
11175840
      flux_rhotw(:,k)=flux_rhotw(:,k+1)+masse(:,k)*dt_a(:,k)/exner(:,k)
107
11175840
      flux_rhouw(:,k)=flux_rhouw(:,k+1)+masse(:,k)*du_a(:,k)
108
11176128
      flux_rhovw(:,k)=flux_rhovw(:,k+1)+masse(:,k)*dv_a(:,k)
109
   ENDDO
110
111
112
! TKE update:
113
114
11232
   DO k=2,klev
115
10889280
      tendt(:,k)=-flux_rhotw(:,k)*(exner(:,k)-exner(:,k-1))*unsmasse(:,k)*RCPD
116
10889280
      tendu(:,k)=-flux_rhouw(:,k)*(windu(:,k)-windu(:,k-1))*unsmasse(:,k)
117
10889568
      tendv(:,k)=-flux_rhovw(:,k)*(windv(:,k)-windv(:,k-1))*unsmasse(:,k)
118
   ENDDO
119
286560
   tendt(:,1)=-flux_rhotw(:,1)*(exner(:,1)-1.)*unsmasse(:,1)*RCPD
120
286560
   tendu(:,1)=-1.*flux_rhouw(:,1)*windu(:,1)*unsmasse(:,1)
121
286560
   tendv(:,1)=-1.*flux_rhovw(:,1)*windv(:,1)*unsmasse(:,1)
122
123
124
1440
 DO isrf=1,nbsrf
125
46368
    DO k=1,klev
126
44704512
       DO i=1,klon
127
44703360
          IF (pctsrf(i,isrf)>0.) THEN
128
18439278
            tke(i,k,isrf)= tke(i,k,isrf)+tendu(i,k)+tendv(i,k)+tendt(i,k)
129
18439278
            tke(i,k,isrf)= max(tke(i,k,isrf),1.e-10)
130
          ENDIF
131
       ENDDO
132
    ENDDO
133
 ENDDO
134
135
136
!  IF (klon==1) THEN
137
!  CALL iophys_ecrit('u',klev,'u','',windu)
138
!  CALL iophys_ecrit('v',klev,'v','',windu)
139
!  CALL iophys_ecrit('t',klev,'t','',temp)
140
!  CALL iophys_ecrit('tke1',klev,'tke1','',tke(:,1:klev,1))
141
!  CALL iophys_ecrit('tke2',klev,'tke2','',tke(:,1:klev,2))
142
!  CALL iophys_ecrit('tke3',klev,'tke3','',tke(:,1:klev,3))
143
!  CALL iophys_ecrit('tke4',klev,'tke4','',tke(:,1:klev,4))
144
!  CALL iophys_ecrit('theta',klev,'theta','',temp/exner)
145
!  CALL iophys_ecrit('Duv',klev,'Duv','',tendu(:,1:klev)+tendv(:,1:klev))
146
!  CALL iophys_ecrit('Dt',klev,'Dt','',tendt(:,1:klev))
147
!  ENDIF
148
149
288
 END SUBROUTINE tend_to_tke