source: LMDZ5/branches/testing/libf/phylmd/ocean_cpl_mod.F90 @ 2546

Last change on this file since 2546 was 2546, checked in by Laurent Fairhead, 8 years ago

Merged trunk changes r2541:2545 into testing branch
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 14.2 KB
Line 
1!
2! $Id: ocean_cpl_mod.F90 2546 2016-06-07 07:55:12Z fairhead $
3!
4MODULE ocean_cpl_mod
5!
6! This module is used both for the sub-surface ocean and sea-ice for the case of a
7! coupled model configuration, ocean=couple.
8!
9
10  IMPLICIT NONE
11  PRIVATE
12
13  PUBLIC :: ocean_cpl_init, ocean_cpl_noice, ocean_cpl_ice
14
15
16!****************************************************************************************
17!
18CONTAINS
19!
20!****************************************************************************************
21!
22  SUBROUTINE ocean_cpl_init(dtime, rlon, rlat)
23!
24! Allocate fields for this module and initailize the module mod_cpl
25!
26    USE dimphy,           ONLY : klon
27    USE cpl_mod
28
29! Input arguments
30!*************************************************************************************
31    REAL, INTENT(IN)                  :: dtime
32    REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
33
34! Local variables
35!*************************************************************************************
36    INTEGER              :: error
37    CHARACTER (len = 80) :: abort_message
38    CHARACTER (len = 20) :: modname = 'ocean_cpl_init'
39
40! Initialize module cpl_init
41    CALL cpl_init(dtime, rlon, rlat)
42   
43  END SUBROUTINE ocean_cpl_init
44!
45!****************************************************************************************
46!
47  SUBROUTINE ocean_cpl_noice( &
48       swnet, lwnet, alb1, &
49       windsp, fder_old, &
50       itime, dtime, knon, knindex, &
51       p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, temp_air, spechum, &
52       AcoefH, AcoefQ, BcoefH, BcoefQ, &
53       AcoefU, AcoefV, BcoefU, BcoefV, &
54       ps, u1, v1, gustiness, &
55       radsol, snow, agesno, &
56       qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
57       tsurf_new, dflux_s, dflux_l)
58
59!
60! This subroutine treats the "open ocean", all grid points that are not entierly covered
61! by ice. The subroutine first receives fields from coupler, then some calculations at
62! surface is done and finally it sends some fields to the coupler.
63!
64    USE dimphy,           ONLY : klon
65    USE cpl_mod
66    USE calcul_fluxs_mod
67    USE indice_sol_mod
68    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
69    USE cpl_mod,             ONLY : gath2cpl
70
71    INCLUDE "YOMCST.h"
72    INCLUDE "clesphys.h"
73!   
74! Input arguments 
75!****************************************************************************************
76    INTEGER, INTENT(IN)                      :: itime, knon
77    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
78    REAL, INTENT(IN)                         :: dtime
79    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
80    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
81    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
82    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
83    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
84    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
85    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragq, cdragm
86    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
87    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
88    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
89    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
90    REAL, DIMENSION(klon), INTENT(IN)        :: ps
91    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
92
93! In/Output arguments
94!****************************************************************************************
95    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
96    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
97    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
98 
99! Output arguments
100!****************************************************************************************
101    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
102    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
103    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
104    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
105    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
106 
107
108! Local variables
109!****************************************************************************************
110    INTEGER               :: i, j
111    INTEGER, DIMENSION(1) :: iloc
112    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
113    REAL, DIMENSION(klon) :: fder_new
114    REAL, DIMENSION(klon) :: tsurf_cpl
115    REAL, DIMENSION(klon) :: u0_cpl, v0_cpl
116    REAL, DIMENSION(klon) :: u1_lay, v1_lay
117    LOGICAL               :: check=.FALSE.
118    REAL, DIMENSION(klon) :: sens_prec_liq, sens_prec_sol   
119    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol   
120
121! End definitions
122!****************************************************************************************
123
124    IF (check) WRITE(*,*)' Entering ocean_cpl_noice'
125
126!****************************************************************************************
127! Receive sea-surface temperature(tsurf_cpl) from coupler
128!
129!****************************************************************************************
130    CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl, u0_cpl, v0_cpl)
131
132!****************************************************************************************
133! Calculate fluxes at surface
134!
135!****************************************************************************************
136    cal = 0.
137    beta = 1.
138    dif_grnd = 0.
139    agesno(:) = 0.
140    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
141   
142
143    DO i = 1, knon
144       u1_lay(i) = u1(i) - u0_cpl(i)
145       v1_lay(i) = v1(i) - v0_cpl(i)
146    END DO
147
148    CALL calcul_fluxs(knon, is_oce, dtime, &
149         tsurf_cpl, p1lay, cal, beta, cdragh, cdragq, ps, &
150         precip_rain, precip_snow, snow, qsurf,  &
151         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
152         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
153         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
154         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
155    do j = 1, knon
156      i = knindex(j)
157      sens_prec_liq_o(i,1) = sens_prec_liq(j)
158      sens_prec_sol_o(i,1) = sens_prec_sol(j)
159      lat_prec_liq_o(i,1) = lat_prec_liq(j)
160      lat_prec_sol_o(i,1) = lat_prec_sol(j)
161    enddo
162
163
164   
165! - Flux calculation at first modele level for U and V
166    CALL calcul_flux_wind(knon, dtime, &
167         u0_cpl, v0_cpl, u1, v1, gustiness, cdragm, &
168         AcoefU, AcoefV, BcoefU, BcoefV, &
169         p1lay, temp_air, &
170         flux_u1, flux_v1) 
171
172!****************************************************************************************
173! Calculate fder : flux derivative (sensible and latente)
174!
175!****************************************************************************************
176    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
177   
178    iloc = MAXLOC(fder_new(1:klon))
179    IF (check .AND. fder_new(iloc(1))> 0.) THEN
180       WRITE(*,*)'**** Debug fder****'
181       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
182       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
183            dflux_s(iloc(1)), dflux_l(iloc(1))
184    ENDIF
185
186!****************************************************************************************
187! Send and cumulate fields to the coupler
188!
189!****************************************************************************************
190
191    CALL cpl_send_ocean_fields(itime, knon, knindex, &
192         swnet, lwnet, fluxlat, fluxsens, &
193         precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1, windsp&
194         )
195!         ,sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
196   
197
198  END SUBROUTINE ocean_cpl_noice
199!
200!****************************************************************************************
201!
202  SUBROUTINE ocean_cpl_ice( &
203       rlon, rlat, swnet, lwnet, alb1, &
204       fder_old, &
205       itime, dtime, knon, knindex, &
206       lafin, &
207       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
208       AcoefH, AcoefQ, BcoefH, BcoefQ, &
209       AcoefU, AcoefV, BcoefU, BcoefV, &
210       ps, u1, v1, gustiness, pctsrf, &
211       radsol, snow, qsurf, &
212       alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
213       tsurf_new, dflux_s, dflux_l)
214!
215! This subroutine treats the ocean where there is ice. The subroutine first receives
216! fields from coupler, then some calculations at surface is done and finally sends
217! some fields to the coupler.
218!   
219    USE dimphy,           ONLY : klon
220    USE cpl_mod
221    USE calcul_fluxs_mod
222    USE indice_sol_mod
223    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
224
225    INCLUDE "YOMCST.h"
226    INCLUDE "clesphys.h"
227
228! Input arguments
229!****************************************************************************************
230    INTEGER, INTENT(IN)                      :: itime, knon
231    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
232    LOGICAL, INTENT(IN)                      :: lafin
233    REAL, INTENT(IN)                         :: dtime
234    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
235    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
236    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
237    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
238    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
239    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
240    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
241    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
242    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
243    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
244    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
245    REAL, DIMENSION(klon), INTENT(IN)        :: ps
246    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
247    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
248
249! In/output arguments
250!****************************************************************************************
251    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
252    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
253
254! Output arguments
255!****************************************************************************************
256    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
257    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
258    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
259    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
260    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
261    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
262 
263
264! Local variables
265!****************************************************************************************
266    INTEGER                 :: i, j
267    INTEGER, DIMENSION(1)   :: iloc
268    LOGICAL                 :: check=.FALSE.
269    REAL, PARAMETER         :: t_grnd=271.35
270    REAL, DIMENSION(klon)   :: cal, beta, dif_grnd
271    REAL, DIMENSION(klon)   :: tsurf_cpl, fder_new
272    REAL, DIMENSION(klon)   :: alb_cpl
273    REAL, DIMENSION(klon)   :: u0, v0
274    REAL, DIMENSION(klon)   :: u1_lay, v1_lay
275    REAL, DIMENSION(klon) :: sens_prec_liq, sens_prec_sol   
276    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol   
277
278! End definitions
279!****************************************************************************************
280   
281    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
282
283    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
284
285!****************************************************************************************
286! Receive ocean temperature(tsurf_cpl) and albedo(alb_new) from coupler
287!
288!****************************************************************************************
289
290    CALL cpl_receive_seaice_fields(knon, knindex, &
291         tsurf_cpl, alb_cpl, u0, v0)
292
293    alb1_new(1:knon) = alb_cpl(1:knon)
294    alb2_new(1:knon) = alb_cpl(1:knon)   
295
296   
297!****************************************************************************************
298! Calculate fluxes at surface
299!
300!****************************************************************************************
301    cal = 0.
302    dif_grnd = 0.
303    beta = 1.0
304   
305    DO i = 1, knon
306       u1_lay(i) = u1(i) - u0(i)
307       v1_lay(i) = v1(i) - v0(i)
308    END DO
309
310    CALL calcul_fluxs(knon, is_sic, dtime, &
311         tsurf_cpl, p1lay, cal, beta, cdragh, cdragh, ps, &
312         precip_rain, precip_snow, snow, qsurf,  &
313         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
314         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
315         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
316         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
317    do j = 1, knon
318      i = knindex(j)
319      sens_prec_liq_o(i,2) = sens_prec_liq(j)
320      sens_prec_sol_o(i,2) = sens_prec_sol(j)
321      lat_prec_liq_o(i,2) = lat_prec_liq(j)
322      lat_prec_sol_o(i,2) = lat_prec_sol(j)
323    enddo
324
325
326! - Flux calculation at first modele level for U and V
327    CALL calcul_flux_wind(knon, dtime, &
328         u0, v0, u1, v1, gustiness, cdragm, &
329         AcoefU, AcoefV, BcoefU, BcoefV, &
330         p1lay, temp_air, &
331         flux_u1, flux_v1) 
332
333!****************************************************************************************
334! Calculate fder : flux derivative (sensible and latente)
335!
336!****************************************************************************************
337    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
338   
339    iloc = MAXLOC(fder_new(1:klon))
340    IF (check .AND. fder_new(iloc(1))> 0.) THEN
341       WRITE(*,*)'**** Debug fder ****'
342       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
343       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
344            dflux_s(iloc(1)), dflux_l(iloc(1))
345    ENDIF
346
347!****************************************************************************************
348! Send and cumulate fields to the coupler
349!
350!****************************************************************************************
351
352    CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, &
353       pctsrf, lafin, rlon, rlat, &
354       swnet, lwnet, fluxlat, fluxsens, &
355       precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1 &
356       )
357!      ,sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
358
359 
360
361  END SUBROUTINE ocean_cpl_ice
362! 
363!****************************************************************************************
364!
365END MODULE ocean_cpl_mod
Note: See TracBrowser for help on using the repository browser.