My Project
 All Classes Files Functions Variables Macros
ocean_cpl_mod.F90
Go to the documentation of this file.
1 !
2 MODULE ocean_cpl_mod
3 !
4 ! This module is used both for the sub-surface ocean and sea-ice for the case of a
5 ! coupled model configuration, ocean=couple.
6 !
7 
8  IMPLICIT NONE
9  PRIVATE
10 
11  PUBLIC :: ocean_cpl_init, ocean_cpl_noice, ocean_cpl_ice
12 
13 !****************************************************************************************
14 !
15 CONTAINS
16 !
17 !****************************************************************************************
18 !
19  SUBROUTINE ocean_cpl_init(dtime, rlon, rlat)
20 !
21 ! Allocate fields for this module and initailize the module mod_cpl
22 !
23  USE dimphy, ONLY : klon
24  USE cpl_mod
25 
26 ! Input arguments
27 !*************************************************************************************
28  REAL, INTENT(IN) :: dtime
29  REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
30 
31 ! Local variables
32 !*************************************************************************************
33  INTEGER :: error
34  CHARACTER (len = 80) :: abort_message
35  CHARACTER (len = 20) :: modname = 'ocean_cpl_init'
36 
37 ! Initialize module cpl_init
38  CALL cpl_init(dtime, rlon, rlat)
39 
40  END SUBROUTINE ocean_cpl_init
41 !
42 !****************************************************************************************
43 !
44  SUBROUTINE ocean_cpl_noice( &
45  swnet, lwnet, alb1, &
46  windsp, fder_old, &
47  itime, dtime, knon, knindex, &
48  p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
49  acoefh, acoefq, bcoefh, bcoefq, &
50  acoefu, acoefv, bcoefu, bcoefv, &
51  ps, u1, v1, &
52  radsol, snow, agesno, &
53  qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
54  tsurf_new, dflux_s, dflux_l)
55 
56 !
57 ! This subroutine treats the "open ocean", all grid points that are not entierly covered
58 ! by ice. The subroutine first receives fields from coupler, then some calculations at
59 ! surface is done and finally it sends some fields to the coupler.
60 !
61  USE dimphy, ONLY : klon
62  USE cpl_mod
63  USE calcul_fluxs_mod
64 
65  include "indicesol.h"
66  include "YOMCST.h"
67 !
68 ! Input arguments
69 !****************************************************************************************
70  INTEGER, INTENT(IN) :: itime, knon
71  INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
72  REAL, INTENT(IN) :: dtime
73  REAL, DIMENSION(klon), INTENT(IN) :: swnet
74  REAL, DIMENSION(klon), INTENT(IN) :: lwnet
75  REAL, DIMENSION(klon), INTENT(IN) :: alb1 ! albedo in visible SW interval
76  REAL, DIMENSION(klon), INTENT(IN) :: windsp
77  REAL, DIMENSION(klon), INTENT(IN) :: fder_old
78  REAL, DIMENSION(klon), INTENT(IN) :: p1lay
79  REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragm
80  REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
81  REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
82  REAL, DIMENSION(klon), INTENT(IN) :: acoefh, acoefq, bcoefh, bcoefq
83  REAL, DIMENSION(klon), INTENT(IN) :: acoefu, acoefv, bcoefu, bcoefv
84  REAL, DIMENSION(klon), INTENT(IN) :: ps
85  REAL, DIMENSION(klon), INTENT(IN) :: u1, v1
86 
87 ! In/Output arguments
88 !****************************************************************************************
89  REAL, DIMENSION(klon), INTENT(INOUT) :: radsol
90  REAL, DIMENSION(klon), INTENT(INOUT) :: snow
91  REAL, DIMENSION(klon), INTENT(INOUT) :: agesno
92 
93 ! Output arguments
94 !****************************************************************************************
95  REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
96  REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
97  REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
98  REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
99  REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
100 
101 ! Local variables
102 !****************************************************************************************
103  INTEGER :: i
104  INTEGER, DIMENSION(1) :: iloc
105  REAL, DIMENSION(klon) :: cal, beta, dif_grnd
106  REAL, DIMENSION(klon) :: fder_new
107  REAL, DIMENSION(klon) :: tsurf_cpl
108  REAL, DIMENSION(klon) :: u0_cpl, v0_cpl
109  REAL, DIMENSION(klon) :: u1_lay, v1_lay
110  LOGICAL :: check=.false.
111 
112 ! End definitions
113 !****************************************************************************************
114 
115  IF (check) WRITE(*,*)' Entering ocean_cpl_noice'
116 
117 !****************************************************************************************
118 ! Receive sea-surface temperature(tsurf_cpl) from coupler
119 !
120 !****************************************************************************************
121  CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl, u0_cpl, v0_cpl)
122 
123 !****************************************************************************************
124 ! Calculate fluxes at surface
125 !
126 !****************************************************************************************
127  cal = 0.
128  beta = 1.
129  dif_grnd = 0.
130  agesno(:) = 0.
131 
132  DO i = 1, knon
133  u1_lay(i) = u1(i) - u0_cpl(i)
134  v1_lay(i) = v1(i) - v0_cpl(i)
135  END DO
136 
137  CALL calcul_fluxs(knon, is_oce, dtime, &
138  tsurf_cpl, p1lay, cal, beta, cdragh, ps, &
139  precip_rain, precip_snow, snow, qsurf, &
140  radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
141  acoefh, acoefq, bcoefh, bcoefq, &
142  tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
143 
144 ! - Flux calculation at first modele level for U and V
145  CALL calcul_flux_wind(knon, dtime, &
146  u0_cpl, v0_cpl, u1, v1, cdragm, &
147  acoefu, acoefv, bcoefu, bcoefv, &
148  p1lay, temp_air, &
149  flux_u1, flux_v1)
150 
151 !****************************************************************************************
152 ! Calculate fder : flux derivative (sensible and latente)
153 !
154 !****************************************************************************************
155  fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
156 
157  iloc = maxloc(fder_new(1:klon))
158  IF (check .AND. fder_new(iloc(1))> 0.) THEN
159  WRITE(*,*)'**** Debug fder****'
160  WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
161  WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
162  dflux_s(iloc(1)), dflux_l(iloc(1))
163  ENDIF
164 
165 !****************************************************************************************
166 ! Send and cumulate fields to the coupler
167 !
168 !****************************************************************************************
169 
170  CALL cpl_send_ocean_fields(itime, knon, knindex, &
171  swnet, lwnet, fluxlat, fluxsens, &
172  precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1, windsp)
173 
174 
175  END SUBROUTINE ocean_cpl_noice
176 !
177 !****************************************************************************************
178 !
179  SUBROUTINE ocean_cpl_ice( &
180  rlon, rlat, swnet, lwnet, alb1, &
181  fder_old, &
182  itime, dtime, knon, knindex, &
183  lafin, &
184  p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
185  acoefh, acoefq, bcoefh, bcoefq, &
186  acoefu, acoefv, bcoefu, bcoefv, &
187  ps, u1, v1, pctsrf, &
188  radsol, snow, qsurf, &
189  alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
190  tsurf_new, dflux_s, dflux_l)
191 !
192 ! This subroutine treats the ocean where there is ice. The subroutine first receives
193 ! fields from coupler, then some calculations at surface is done and finally sends
194 ! some fields to the coupler.
195 !
196  USE dimphy, ONLY : klon
197  USE cpl_mod
198  USE calcul_fluxs_mod
199 
200  include "indicesol.h"
201  include "YOMCST.h"
202 
203 ! Input arguments
204 !****************************************************************************************
205  INTEGER, INTENT(IN) :: itime, knon
206  INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
207  LOGICAL, INTENT(IN) :: lafin
208  REAL, INTENT(IN) :: dtime
209  REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
210  REAL, DIMENSION(klon), INTENT(IN) :: swnet
211  REAL, DIMENSION(klon), INTENT(IN) :: lwnet
212  REAL, DIMENSION(klon), INTENT(IN) :: alb1 ! albedo in visible SW interval
213  REAL, DIMENSION(klon), INTENT(IN) :: fder_old
214  REAL, DIMENSION(klon), INTENT(IN) :: p1lay
215  REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragm
216  REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
217  REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
218  REAL, DIMENSION(klon), INTENT(IN) :: acoefh, acoefq, bcoefh, bcoefq
219  REAL, DIMENSION(klon), INTENT(IN) :: acoefu, acoefv, bcoefu, bcoefv
220  REAL, DIMENSION(klon), INTENT(IN) :: ps
221  REAL, DIMENSION(klon), INTENT(IN) :: u1, v1
222  REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
223 
224 ! In/output arguments
225 !****************************************************************************************
226  REAL, DIMENSION(klon), INTENT(INOUT) :: radsol
227  REAL, DIMENSION(klon), INTENT(INOUT) :: snow
228 
229 ! Output arguments
230 !****************************************************************************************
231  REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
232  REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new, alb2_new
233  REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
234  REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
235  REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
236  REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
237 
238 ! Local variables
239 !****************************************************************************************
240  INTEGER :: i
241  INTEGER, DIMENSION(1) :: iloc
242  LOGICAL :: check=.false.
243  REAL, PARAMETER :: t_grnd=271.35
244  REAL, DIMENSION(klon) :: cal, beta, dif_grnd
245  REAL, DIMENSION(klon) :: tsurf_cpl, fder_new
246  REAL, DIMENSION(klon) :: alb_cpl
247  REAL, DIMENSION(klon) :: u0, v0
248  REAL, DIMENSION(klon) :: u1_lay, v1_lay
249 
250 ! End definitions
251 !****************************************************************************************
252 
253  IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
254 
255 !****************************************************************************************
256 ! Receive ocean temperature(tsurf_cpl) and albedo(alb_new) from coupler
257 !
258 !****************************************************************************************
259 
260  CALL cpl_receive_seaice_fields(knon, knindex, &
261  tsurf_cpl, alb_cpl, u0, v0)
262 
263  alb1_new(1:knon) = alb_cpl(1:knon)
264  alb2_new(1:knon) = alb_cpl(1:knon)
265 
266 
267 !****************************************************************************************
268 ! Calculate fluxes at surface
269 !
270 !****************************************************************************************
271  cal = 0.
272  dif_grnd = 0.
273  beta = 1.0
274 
275  DO i = 1, knon
276  u1_lay(i) = u1(i) - u0(i)
277  v1_lay(i) = v1(i) - v0(i)
278  END DO
279 
280  CALL calcul_fluxs(knon, is_sic, dtime, &
281  tsurf_cpl, p1lay, cal, beta, cdragh, ps, &
282  precip_rain, precip_snow, snow, qsurf, &
283  radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
284  acoefh, acoefq, bcoefh, bcoefq, &
285  tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
286 
287 
288 ! - Flux calculation at first modele level for U and V
289  CALL calcul_flux_wind(knon, dtime, &
290  u0, v0, u1, v1, cdragm, &
291  acoefu, acoefv, bcoefu, bcoefv, &
292  p1lay, temp_air, &
293  flux_u1, flux_v1)
294 
295 !****************************************************************************************
296 ! Calculate fder : flux derivative (sensible and latente)
297 !
298 !****************************************************************************************
299  fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
300 
301  iloc = maxloc(fder_new(1:klon))
302  IF (check .AND. fder_new(iloc(1))> 0.) THEN
303  WRITE(*,*)'**** Debug fder ****'
304  WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
305  WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
306  dflux_s(iloc(1)), dflux_l(iloc(1))
307  ENDIF
308 
309 !****************************************************************************************
310 ! Send and cumulate fields to the coupler
311 !
312 !****************************************************************************************
313 
314  CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, &
315  pctsrf, lafin, rlon, rlat, &
316  swnet, lwnet, fluxlat, fluxsens, &
317  precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1)
318 
319 
320  END SUBROUTINE ocean_cpl_ice
321 !
322 !****************************************************************************************
323 !
324 END MODULE ocean_cpl_mod