Newer
Older
!SURFEX_LIC Copyright 1994-2014 Meteo-France
!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SURFEX_LIC for details. version 1.
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
! ###############################################################################
SUBROUTINE COUPLING_TEB_OROGRAPHY_n(HPROGRAM, HCOUPLING, &
PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PAZIM, &
PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, &
PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, &
PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, &
PPEW_A_COEF, PPEW_B_COEF, &
PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, &
HTEST )
! ###############################################################################
!
!!**** *COUPLING_TEB_OROGRAPHY_n * - Modifies the input forcing if not
!! initially at town level
!!
!! PURPOSE
!! -------
!
!!** METHOD
!! ------
!!
!! REFERENCE
!! ---------
!!
!!
!! AUTHOR
!! ------
!! V. Masson
!!
!! MODIFICATIONS
!! -------------
!! Original 01/2004
!! B. Decharme 2008 reset the subgrid topographic effect on the forcing
!! J. Escobar 09/2012 SIZE(PTA) not allowed without-interface , replace by KI
!!-------------------------------------------------------------
!
USE MODD_CSTS, ONLY : XCPD, XRD, XP00
USE MODD_TEB_n, ONLY : XZS
!
USE MODD_SURF_ATM, ONLY : LVERTSHIFT
!
USE MODI_FORCING_VERT_SHIFT
!
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
!
USE MODI_COUPLING_TEB_n
!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling
! 'E' : explicit
! 'I' : implicit
INTEGER, INTENT(IN) :: KYEAR ! current year (UTC)
INTEGER, INTENT(IN) :: KMONTH ! current month (UTC)
INTEGER, INTENT(IN) :: KDAY ! current day (UTC)
REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s)
INTEGER, INTENT(IN) :: KI ! number of points
INTEGER, INTENT(IN) :: KSV ! number of scalars
INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands
REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight)
REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s)
REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m)
REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m)
!
REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K)
REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3)
REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3)
REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables
! ! chemistry: first char. in HSV: '#' (molecule/m3)
! !
CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables
REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s)
REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s)
REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.)
! ! (W/m2)
REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.)
! ! (W/m2)
REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m)
REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle (radian from the vertical)
REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! azimuthal angle (radian from North, clockwise)
REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.)
! ! (W/m2)
REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa)
REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa)
REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m)
REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3)
REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s)
REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s)
!
!
REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2)
REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s)
REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa)
REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa)
REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 (kg/m2/s)
REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s)
!
REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K)
REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band (-)
REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-)
REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity (-)
!
REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients
REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I'
REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
!
!* 0.2 declarations of local variables
!
REAL, DIMENSION(KI) :: ZPEQ_B_COEF ! 1st explicit coefficient
REAL, DIMENSION(KI) :: ZPET_B_COEF ! 2nd explicit coefficient
!
REAL, DIMENSION(KI) :: ZTA ! Temperature at forcing height above surface orography
REAL, DIMENSION(KI) :: ZPA ! Pressure at forcing height above surface orography
REAL, DIMENSION(KI) :: ZPS ! Pressure at surface orography
REAL, DIMENSION(KI) :: ZQA ! Humidity at forcing height above surface orography
REAL, DIMENSION(KI) :: ZRHOA ! Density at forcing height above surface orography
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
! Preliminaries:
!-------------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('COUPLING_TEB_OROGRAPHY_N',0,ZHOOK_HANDLE)
!
ZPEQ_B_COEF = PPEQ_B_COEF
ZPET_B_COEF = PPET_B_COEF
!
IF(LVERTSHIFT)THEN
!
CALL FORCING_VERT_SHIFT(PZS,XZS,PTA,PQA,PPA,PRHOA,ZTA,ZQA,ZPA,ZRHOA)
!
ZPS = ZPA + (PPS - PPA)
!
IF (HCOUPLING=='I') THEN
ZPEQ_B_COEF = PPEQ_B_COEF + ZQA - PQA
ZPET_B_COEF = PPET_B_COEF + ZTA/(ZPA/XP00)**(XRD/XCPD) - PTA/(PPA/XP00)**(XRD/XCPD)
ENDIF
!
ELSE
!
ZTA = PTA
ZQA = PQA
ZPS = PPS
ZPA = PPS
ZRHOA = PRHOA
!
ENDIF
!
CALL COUPLING_TEB_n(HPROGRAM, HCOUPLING, &
PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
KI, KSV, KSW, &
PTSUN, PZENITH, PAZIM, &
PZREF, PUREF, XZS, PU, PV, ZQA, ZTA, ZRHOA,PSV, PCO2, HSV, &
PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, ZPS, ZPA, &
PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, &
PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, &
PPEW_A_COEF, PPEW_B_COEF, &
PPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, &
'OK' )
IF (LHOOK) CALL DR_HOOK('COUPLING_TEB_OROGRAPHY_N',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------------
!
END SUBROUTINE COUPLING_TEB_OROGRAPHY_n