SURFEX v8.1
General documentation of Surfex
canopy_evol_temp.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 ! #########
6  SUBROUTINE canopy_evol_temp(SB, KI, PTSTEP, KIMPL ,PTHA, PK, PDKDDVDZ, &
7  PSFLUX_T, PFORC_T, PDFORC_TDT, PTH, PWTH, PALFA, PBETA)
8 ! #########################################
9 !
10 !!**** *CANOPY_EVOL_TEMP* - evolution of wind in canopy
11 !!
12 !!
13 !! PURPOSE
14 !! -------
15 !!
16 !!** METHOD
17 !! ------
18 !!
19 !! EXTERNAL
20 !! --------
21 !!
22 !!
23 !! IMPLICIT ARGUMENTS
24 !! ------------------
25 !!
26 !! REFERENCE
27 !! ---------
28 !!
29 !!
30 !! AUTHOR
31 !! ------
32 !! V. Masson *Meteo France*
33 !!
34 !! MODIFICATIONS
35 !! -------------
36 !! Original 07/2006
37 !-------------------------------------------------------------------------------
38 !
39 !* 0. DECLARATIONS
40 ! ------------
41 !
42 USE modd_canopy_n, ONLY : canopy_t
43 !
44 USE modi_canopy_evol_field
45 !
46 USE yomhook ,ONLY : lhook, dr_hook
47 USE parkind1 ,ONLY : jprb
48 !
49 IMPLICIT NONE
50 !
51 !* 0.1 Declarations of arguments
52 ! -------------------------
53 !
54 TYPE(canopy_t), INTENT(INOUT) :: SB
55 !
56 INTEGER, INTENT(IN) :: KI ! number of horizontal points
57 REAL, INTENT(IN) :: PTSTEP ! time-step (s)
58 INTEGER, INTENT(IN) :: KIMPL ! implicitation code:
59 ! ! 1 : computes only alfa and beta coupling
60 ! ! coefficients for all variables
61 ! ! 2 : computes temporal evolution of the
62 ! ! variables
63 REAL, DIMENSION(KI), INTENT(IN) :: PTHA ! potential temp. at forcing level (K)
64 REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PK ! mixing exchange coefficient (m2/s)
65 REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PDKDDVDZ ! derivative of mixing coefficient as a
66 ! ! function of vertical gradient of wind
67 ! ! (at mid levels) (m2)
68 REAL, DIMENSION(KI), INTENT(IN) :: PSFLUX_T ! surface flux w'Th' (mK/s)
69 REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PFORC_T ! tendency of wind due to canopy drag (K/s)
70 REAL, DIMENSION(KI,SB%NLVL), INTENT(IN) :: PDFORC_TDT! formal derivative of the tendency of
71 ! ! wind due to canopy drag (1/s)
72 REAL, DIMENSION(KI,SB%NLVL), INTENT(INOUT) :: PTH ! pot. temp. at canopy levels (K)
73 REAL, DIMENSION(KI,SB%NLVL), INTENT(OUT) :: PWTH ! turbulent flux (at half levels) (mK/s)
74 REAL, DIMENSION(KI), INTENT(OUT) :: PALFA ! V+(1) = alfa F(1) + beta
75 REAL, DIMENSION(KI), INTENT(OUT) :: PBETA ! V+(1) = alfa F(1) + beta
76 !
77 !
78 !* 0.2 Declarations of local variables
79 ! -------------------------------
80 !
81 INTEGER :: JLAYER ! loop counter on layers
82 !
83 REAL, DIMENSION(KI,SB%NLVL) :: ZDTHDZ ! dTh/dz at mid levels
84 REAL, DIMENSION(KI,SB%NLVL) :: ZF ! turbulent flux at mid levels
85 REAL, DIMENSION(KI,SB%NLVL) :: ZDFDDVDZ ! derivative of turbulent flux as a
86 ! ! function of vertical gradient of wind variable
87 ! ! (at mid levels)
88 REAL, DIMENSION(KI,SB%NLVL) :: ZEXT ! external forcing at full levels
89 REAL, DIMENSION(KI,SB%NLVL) :: ZDEXTDV ! derivative of external forcing as a
90 ! ! function of vertical variable
91 ! ! (at full levels)
92 REAL, DIMENSION(KI,SB%NLVL) :: ZTH ! work variable : pot. temp at futur instant
93 ! ! (or past at the end of the routine)
94 REAL, DIMENSION(KI) :: ZDTHADT ! dTHa/dt at forcing level
95 REAL, DIMENSION(KI) :: ZDWTHDZ ! dw'Th'/dz at forcing level
96 LOGICAL :: LIMPL
97 REAL(KIND=JPRB) :: ZHOOK_HANDLE
98 !
99 !-------------------------------------------------------------------------------
100 !
101 !
102 !* 1. initializations
103 ! ---------------
104 !
105 !* external forces
106 !
107 IF (lhook) CALL dr_hook('CANOPY_EVOL_TEMP',0,zhook_handle)
108 zext = 0.
109 zdextdv = 0.
110 !
111 !-------------------------------------------------------------------------------
112 !
113 !* 5. Forcing due to drag (at full levels)
114 ! -------------------
115 !
116 zext = zext + pforc_t
117 zdextdv = zdextdv + pdforc_tdt
118 !
119 !-------------------------------------------------------------------------------
120 !
121 !* 6. External forcing due to large-scale forces (at full levels)
122 ! ------------------------------------------
123 !
124 !
125 !* forces due to large-scale forcing
126 !
127 ! These are computed from wind evolution equation at forcing level :
128 !
129 ! dUa/dt = Large_Scale_Forcing - d(u'w')/dz|z=forcing_level
130 !
131 ! because vertical derivative of turbulent flux is not available at forcing
132 ! level, one must make the assumption that the turbulent flux is uniform
133 ! between the forcing level and the level just below.
134 ! This means that one assume that the forcing layer is in the inertial sublayer
135 ! (where turbulent fluxes are constant).
136 !
137 zdthadt(:) = ( ptha(:) - pth(:,sb%NLVL) ) /ptstep
138 !
139 zdwthdz(:) = 0.
140 !
141 DO jlayer=1,sb%NLVL
142  zext(:,jlayer) = zext(:,jlayer) + zdwthdz(:) + zdthadt(:)
143 END DO
144 !
145  CALL canopy_evol_field(ki, sb%NLVL, ptstep, kimpl, pk, pdkddvdz, &
146  psflux_t, pforc_t, pdforc_tdt, sb%XDZ, sb%XDZF, &
147  zext, zdextdv, pth, pwth, palfa, pbeta )
148 !
149 IF (lhook) CALL dr_hook('CANOPY_EVOL_TEMP',1,zhook_handle)
150 !----------------------------------------------------------------
151 !
152 END SUBROUTINE canopy_evol_temp
integer, parameter jprb
Definition: parkind1.F90:32
subroutine canopy_evol_field(KI, KLVL, PTSTEP, KIMPL, PK, PDKDDVDZ
logical lhook
Definition: yomhook.F90:15
subroutine canopy_evol_temp(SB, KI, PTSTEP, KIMPL,PTHA, PK, PDKDD