SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
coupling_inland_watern.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 coupling_inland_water_n (FM, WM, DGL, U, DST, SLT, &
7  hprogram, hcoupling, ptimec, &
8  ptstep, kyear, kmonth, kday, ptime, ki, ksv, ksw, ptsun, pzenith, pzenith2, &
9  pazim, pzref, puref, pzs, pu, pv, pqa, pta, prhoa, psv, pco2, hsv, &
10  prain, psnow, plw, pdir_sw, psca_sw, psw_bands, pps, ppa, &
11  psftq, psfth, psfts, psfco2, psfu, psfv, &
12  ptrad, pdir_alb, psca_alb, pemis, ptsurf, pz0, pz0h, pqsurf, &
13  ppew_a_coef, ppew_b_coef, &
14  ppet_a_coef, ppeq_a_coef, ppet_b_coef, ppeq_b_coef, &
15  htest )
16 ! ###############################################################################
17 !
18 !!**** *COUPLING_INLAND_WATER_n * - Chooses the surface schemes for lakes
19 !!
20 !! PURPOSE
21 !! -------
22 !
23 !!** METHOD
24 !! ------
25 !!
26 !! REFERENCE
27 !! ---------
28 !!
29 !!
30 !! AUTHOR
31 !! ------
32 !! V. Masson
33 !!
34 !! MODIFICATIONS
35 !! -------------
36 !! Original 01/2004
37 !! B. Decharme 04/2013 new coupling variables
38 !----------------------------------------------------------------
39 !
40 !
42 USE modd_surfex_n, ONLY : flake_model_t
43 !
45 USE modd_surf_atm_n, ONLY : surf_atm_t
46 USE modd_dst_n, ONLY : dst_t
47 USE modd_slt_n, ONLY : slt_t
48 !
49 !
50 !
51 USE modd_csts, ONLY : xtt
52 !
53 USE yomhook ,ONLY : lhook, dr_hook
54 USE parkind1 ,ONLY : jprb
55 !
56 USE modi_coupling_flake_orography_n
57 !
58 USE modi_coupling_ideal_flux
59 !
60 USE modi_coupling_watflux_orog_n
61 !
62 IMPLICIT NONE
63 !
64 !* 0.1 declarations of arguments
65 !
66 !
67 !
68 TYPE(flake_model_t), INTENT(INOUT) :: fm
69 TYPE(watflux_model_t), INTENT(INOUT) :: wm
70 TYPE(diag_ideal_t), INTENT(INOUT) :: dgl
71 TYPE(surf_atm_t), INTENT(INOUT) :: u
72 TYPE(dst_t), INTENT(INOUT) :: dst
73 TYPE(slt_t), INTENT(INOUT) :: slt
74 !
75 !
76  CHARACTER(LEN=6), INTENT(IN) :: hprogram ! program calling surf. schemes
77  CHARACTER(LEN=1), INTENT(IN) :: hcoupling ! type of coupling
78  ! 'E' : explicit
79  ! 'I' : implicit
80 REAL, INTENT(IN) :: ptimec ! cumulated time since beginning of simulation
81 INTEGER, INTENT(IN) :: kyear ! current year (UTC)
82 INTEGER, INTENT(IN) :: kmonth ! current month (UTC)
83 INTEGER, INTENT(IN) :: kday ! current day (UTC)
84 REAL, INTENT(IN) :: ptime ! current time since midnight (UTC, s)
85 INTEGER, INTENT(IN) :: ki ! number of points
86 INTEGER, INTENT(IN) :: ksv ! number of scalars
87 INTEGER, INTENT(IN) :: ksw ! number of short-wave spectral bands
88 REAL, DIMENSION(KI), INTENT(IN) :: ptsun ! solar time (s from midnight)
89 REAL, INTENT(IN) :: ptstep ! atmospheric time-step (s)
90 REAL, DIMENSION(KI), INTENT(IN) :: pzref ! height of T,q forcing (m)
91 REAL, DIMENSION(KI), INTENT(IN) :: puref ! height of wind forcing (m)
92 !
93 REAL, DIMENSION(KI), INTENT(IN) :: pta ! air temperature forcing (K)
94 REAL, DIMENSION(KI), INTENT(IN) :: pqa ! air humidity forcing (kg/m3)
95 REAL, DIMENSION(KI), INTENT(IN) :: prhoa ! air density (kg/m3)
96 REAL, DIMENSION(KI,KSV),INTENT(IN) :: psv ! scalar variables
97 ! ! chemistry: first char. in HSV: '#' (molecule/m3)
98 ! !
99  CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: hsv ! name of all scalar variables
100 REAL, DIMENSION(KI), INTENT(IN) :: pu ! zonal wind (m/s)
101 REAL, DIMENSION(KI), INTENT(IN) :: pv ! meridian wind (m/s)
102 REAL, DIMENSION(KI,KSW),INTENT(IN) :: pdir_sw ! direct solar radiation (on horizontal surf.)
103 ! ! (W/m2)
104 REAL, DIMENSION(KI,KSW),INTENT(IN) :: psca_sw ! diffuse solar radiation (on horizontal surf.)
105 ! ! (W/m2)
106 REAL, DIMENSION(KSW),INTENT(IN) :: psw_bands ! mean wavelength of each shortwave band (m)
107 REAL, DIMENSION(KI), INTENT(IN) :: pzenith ! zenithal angle at t (radian from the vertical)
108 REAL, DIMENSION(KI), INTENT(IN) :: pzenith2 ! zenithal angle at t+1 (radian from the vertical)
109 REAL, DIMENSION(KI), INTENT(IN) :: pazim ! azimuthal angle (radian from North, clockwise)
110 REAL, DIMENSION(KI), INTENT(IN) :: plw ! longwave radiation (on horizontal surf.)
111 ! ! (W/m2)
112 REAL, DIMENSION(KI), INTENT(IN) :: pps ! pressure at atmospheric model surface (Pa)
113 REAL, DIMENSION(KI), INTENT(IN) :: ppa ! pressure at forcing level (Pa)
114 REAL, DIMENSION(KI), INTENT(IN) :: pzs ! atmospheric model orography (m)
115 REAL, DIMENSION(KI), INTENT(IN) :: pco2 ! CO2 concentration in the air (kg/m3)
116 REAL, DIMENSION(KI), INTENT(IN) :: psnow ! snow precipitation (kg/m2/s)
117 REAL, DIMENSION(KI), INTENT(IN) :: prain ! liquid precipitation (kg/m2/s)
118 !
119 !
120 REAL, DIMENSION(KI), INTENT(OUT) :: psfth ! flux of heat (W/m2)
121 REAL, DIMENSION(KI), INTENT(OUT) :: psftq ! flux of water vapor (kg/m2/s)
122 REAL, DIMENSION(KI), INTENT(OUT) :: psfu ! zonal momentum flux (Pa)
123 REAL, DIMENSION(KI), INTENT(OUT) :: psfv ! meridian momentum flux (Pa)
124 REAL, DIMENSION(KI), INTENT(OUT) :: psfco2 ! flux of CO2 (m/s*kg_CO2/kg_air)
125 REAL, DIMENSION(KI,KSV),INTENT(OUT):: psfts ! flux of scalar var. (kg/m2/s)
126 !
127 REAL, DIMENSION(KI), INTENT(OUT) :: ptrad ! radiative temperature (K)
128 REAL, DIMENSION(KI,KSW),INTENT(OUT):: pdir_alb! direct albedo for each spectral band (-)
129 REAL, DIMENSION(KI,KSW),INTENT(OUT):: psca_alb! diffuse albedo for each spectral band (-)
130 REAL, DIMENSION(KI), INTENT(OUT) :: pemis ! emissivity (-)
131 !
132 REAL, DIMENSION(KI), INTENT(OUT) :: ptsurf ! surface effective temperature (K)
133 REAL, DIMENSION(KI), INTENT(OUT) :: pz0 ! roughness length for momentum (m)
134 REAL, DIMENSION(KI), INTENT(OUT) :: pz0h ! roughness length for heat (m)
135 REAL, DIMENSION(KI), INTENT(OUT) :: pqsurf ! specific humidity at surface (kg/kg)
136 !
137 REAL, DIMENSION(KI), INTENT(IN) :: ppew_a_coef! implicit coefficients
138 REAL, DIMENSION(KI), INTENT(IN) :: ppew_b_coef! needed if HCOUPLING='I'
139 REAL, DIMENSION(KI), INTENT(IN) :: ppet_a_coef
140 REAL, DIMENSION(KI), INTENT(IN) :: ppeq_a_coef
141 REAL, DIMENSION(KI), INTENT(IN) :: ppet_b_coef
142 REAL, DIMENSION(KI), INTENT(IN) :: ppeq_b_coef
143  CHARACTER(LEN=2), INTENT(IN) :: htest ! must be equal to 'OK'
144 REAL(KIND=JPRB) :: zhook_handle
145 !
146 !* 0.2 declarations of local variables
147 !
148 !-------------------------------------------------------------------------------------
149 !
150 IF (lhook) CALL dr_hook('COUPLING_INLAND_WATER_N',0,zhook_handle)
151 IF (u%CWATER=='WATFLX') THEN
152  CALL coupling_watflux_orog_n(wm, dst, slt, &
153  hprogram, hcoupling, ptimec, &
154  ptstep, kyear, kmonth, kday, ptime, &
155  ki, ksv, ksw, &
156  ptsun, pzenith, pzenith2, pazim, &
157  pzref, puref, pzs, pu, pv, pqa, pta, prhoa, psv, pco2, hsv, &
158  prain, psnow, plw, pdir_sw, psca_sw, psw_bands, pps, ppa, &
159  psftq, psfth, psfts, psfco2, psfu, psfv, &
160  ptrad, pdir_alb, psca_alb, pemis, ptsurf, pz0, pz0h, pqsurf, &
161  ppew_a_coef, ppew_b_coef, &
162  ppet_a_coef, ppeq_a_coef, ppet_b_coef, ppeq_b_coef, &
163  htest )
164 ELSE IF (u%CWATER=='FLUX ') THEN
165  CALL coupling_ideal_flux(dgl, &
166  hprogram, hcoupling, ptimec, &
167  ptstep, kyear, kmonth, kday, ptime, &
168  ki, ksv, ksw, &
169  ptsun, pzenith, pazim, &
170  pzref, puref, pzs, pu, pv, pqa, pta, prhoa, psv, pco2, hsv, &
171  prain, psnow, plw, pdir_sw, psca_sw, psw_bands, pps, ppa, &
172  psftq, psfth, psfts, psfco2, psfu, psfv, &
173  ptrad, pdir_alb, psca_alb, pemis, ptsurf, pz0, pz0h, pqsurf, &
174  ppew_a_coef, ppew_b_coef, &
175  ppet_a_coef, ppeq_a_coef, ppet_b_coef, ppeq_b_coef, &
176  htest )
177 ELSE IF (u%CWATER=='FLAKE ') THEN
178  CALL coupling_flake_orography_n(fm, dst, slt, &
179  hprogram, hcoupling, &
180  ptstep, kyear, kmonth, kday, ptime, &
181  ki, ksv, ksw, &
182  ptsun, pzenith, pzenith2, pazim, &
183  pzref, puref, pzs, pu, pv, pqa, pta, prhoa, psv, pco2, hsv, &
184  prain, psnow, plw, pdir_sw, psca_sw, psw_bands, pps, ppa, &
185  psftq, psfth, psfts, psfco2, psfu, psfv, &
186  ptrad, pdir_alb, psca_alb, pemis, ptsurf, pz0, pz0h, pqsurf, &
187  ppew_a_coef, ppew_b_coef, &
188  ppet_a_coef, ppeq_a_coef, ppet_b_coef, ppeq_b_coef, &
189  htest )
190 ELSE IF (u%CWATER=='NONE ') THEN
191  psfth = 0.
192  psftq = 0.
193  psfts = 0.
194  psfu = 0.
195  psfv = 0.
196  psfco2= 0.
197 !
198  ptrad = xtt
199  pdir_alb = 0.
200  psca_alb = 0.
201  pemis = 1.
202 !
203  ptsurf = xtt
204  pz0 = 0.001
205  pz0h = 0.001
206  pqsurf = 0.0
207 !
208 END IF
209 IF (lhook) CALL dr_hook('COUPLING_INLAND_WATER_N',1,zhook_handle)
210 !
211 !-------------------------------------------------------------------------------------
212 !
213 END SUBROUTINE coupling_inland_water_n
subroutine coupling_ideal_flux(DGL, HPROGRAM, HCOUPLING, PTIMEC, 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, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST)
subroutine coupling_flake_orography_n(FM, DST, SLT, HPROGRAM, HCOUPLING, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, 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, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST)
subroutine coupling_watflux_orog_n(WM, DST, SLT, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, 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, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST)
subroutine coupling_inland_water_n(FM, WM, DGL, U, DST, SLT, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, 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, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST)