source: LMDZ6/branches/Optimisation_LMDZ/libf/phylmd/ocean_cpl_mod.F90 @ 3763

Last change on this file since 3763 was 3102, checked in by oboucher, 7 years ago

Removing x permission from these files
  • 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:keywords set to Id
File size: 14.1 KB
Line 
1!
2! $Id: ocean_cpl_mod.F90 3102 2017-12-03 20:27:42Z adurocher $
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         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
195   
196
197  END SUBROUTINE ocean_cpl_noice
198!
199!****************************************************************************************
200!
201  SUBROUTINE ocean_cpl_ice( &
202       rlon, rlat, swnet, lwnet, alb1, &
203       fder_old, &
204       itime, dtime, knon, knindex, &
205       lafin, &
206       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
207       AcoefH, AcoefQ, BcoefH, BcoefQ, &
208       AcoefU, AcoefV, BcoefU, BcoefV, &
209       ps, u1, v1, gustiness, pctsrf, &
210       radsol, snow, qsurf, &
211       alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
212       tsurf_new, dflux_s, dflux_l)
213!
214! This subroutine treats the ocean where there is ice. The subroutine first receives
215! fields from coupler, then some calculations at surface is done and finally sends
216! some fields to the coupler.
217!   
218    USE dimphy,           ONLY : klon
219    USE cpl_mod
220    USE calcul_fluxs_mod
221    USE indice_sol_mod
222    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
223
224    INCLUDE "YOMCST.h"
225    INCLUDE "clesphys.h"
226
227! Input arguments
228!****************************************************************************************
229    INTEGER, INTENT(IN)                      :: itime, knon
230    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
231    LOGICAL, INTENT(IN)                      :: lafin
232    REAL, INTENT(IN)                         :: dtime
233    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
234    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
235    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
236    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
237    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
238    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
239    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
240    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
241    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
242    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
243    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
244    REAL, DIMENSION(klon), INTENT(IN)        :: ps
245    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
246    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
247
248! In/output arguments
249!****************************************************************************************
250    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
251    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
252
253! Output arguments
254!****************************************************************************************
255    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
256    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
257    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
258    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
259    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
260    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
261 
262
263! Local variables
264!****************************************************************************************
265    INTEGER                 :: i, j
266    INTEGER, DIMENSION(1)   :: iloc
267    LOGICAL                 :: check=.FALSE.
268    REAL, PARAMETER         :: t_grnd=271.35
269    REAL, DIMENSION(klon)   :: cal, beta, dif_grnd
270    REAL, DIMENSION(klon)   :: tsurf_cpl, fder_new
271    REAL, DIMENSION(klon)   :: alb_cpl
272    REAL, DIMENSION(klon)   :: u0, v0
273    REAL, DIMENSION(klon)   :: u1_lay, v1_lay
274    REAL, DIMENSION(klon) :: sens_prec_liq, sens_prec_sol   
275    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol   
276
277! End definitions
278!****************************************************************************************
279   
280    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
281
282    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
283
284!****************************************************************************************
285! Receive ocean temperature(tsurf_cpl) and albedo(alb_new) from coupler
286!
287!****************************************************************************************
288
289    CALL cpl_receive_seaice_fields(knon, knindex, &
290         tsurf_cpl, alb_cpl, u0, v0)
291
292    alb1_new(1:knon) = alb_cpl(1:knon)
293    alb2_new(1:knon) = alb_cpl(1:knon)   
294
295   
296!****************************************************************************************
297! Calculate fluxes at surface
298!
299!****************************************************************************************
300    cal = 0.
301    dif_grnd = 0.
302    beta = 1.0
303   
304    DO i = 1, knon
305       u1_lay(i) = u1(i) - u0(i)
306       v1_lay(i) = v1(i) - v0(i)
307    END DO
308
309    CALL calcul_fluxs(knon, is_sic, dtime, &
310         tsurf_cpl, p1lay, cal, beta, cdragh, cdragh, ps, &
311         precip_rain, precip_snow, snow, qsurf,  &
312         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
313         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
314         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
315         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
316    do j = 1, knon
317      i = knindex(j)
318      sens_prec_liq_o(i,2) = sens_prec_liq(j)
319      sens_prec_sol_o(i,2) = sens_prec_sol(j)
320      lat_prec_liq_o(i,2) = lat_prec_liq(j)
321      lat_prec_sol_o(i,2) = lat_prec_sol(j)
322    enddo
323
324
325! - Flux calculation at first modele level for U and V
326    CALL calcul_flux_wind(knon, dtime, &
327         u0, v0, u1, v1, gustiness, cdragm, &
328         AcoefU, AcoefV, BcoefU, BcoefV, &
329         p1lay, temp_air, &
330         flux_u1, flux_v1) 
331
332!****************************************************************************************
333! Calculate fder : flux derivative (sensible and latente)
334!
335!****************************************************************************************
336    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
337   
338    iloc = MAXLOC(fder_new(1:klon))
339    IF (check .AND. fder_new(iloc(1))> 0.) THEN
340       WRITE(*,*)'**** Debug fder ****'
341       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
342       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
343            dflux_s(iloc(1)), dflux_l(iloc(1))
344    ENDIF
345
346!****************************************************************************************
347! Send and cumulate fields to the coupler
348!
349!****************************************************************************************
350
351    CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, &
352       pctsrf, lafin, rlon, rlat, &
353       swnet, lwnet, fluxlat, fluxsens, &
354       precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1,&
355       sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
356
357 
358
359  END SUBROUTINE ocean_cpl_ice
360! 
361!****************************************************************************************
362!
363END MODULE ocean_cpl_mod
Note: See TracBrowser for help on using the repository browser.