source: LMDZ6/trunk/libf/phylmd/ocean_cpl_mod.F90 @ 3981

Last change on this file since 3981 was 3815, checked in by lguez, 3 years ago

Merge Ocean_skin branch back into trunk
  • 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: 15.1 KB
Line 
1!
2! $Id: ocean_cpl_mod.F90 3815 2021-02-01 14:30:57Z 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, tsurf_in, &
55       radsol, snow, agesno, &
56       qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
57       tsurf_new, dflux_s, dflux_l, sens_prec_liq, sss, delta_sal, rhoa, &
58       delta_sst)
59
60!
61! This subroutine treats the "open ocean", all grid points that are not entierly covered
62! by ice. The subroutine first receives fields from coupler, then some calculations at
63! surface is done and finally it sends some fields to the coupler.
64!
65    USE dimphy,           ONLY : klon
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, cpl_receive_ocean_fields, &
70         cpl_send_ocean_fields
71    use config_ocean_skin_m, only: activate_ocean_skin
72
73    INCLUDE "YOMCST.h"
74    INCLUDE "clesphys.h"
75!   
76! Input arguments 
77!****************************************************************************************
78    INTEGER, INTENT(IN)                      :: itime, knon
79    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
80    REAL, INTENT(IN)                         :: dtime
81    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
82    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
83    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
84    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
85    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
86    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
87    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragq, cdragm
88    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
89    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
90    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
91    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
92    REAL, DIMENSION(klon), INTENT(IN)        :: ps
93    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
94    REAL, INTENT(IN) :: tsurf_in(:) ! (klon)
95
96    real, intent(in):: delta_sal(:) ! (knon)
97    ! ocean-air interface salinity minus bulk salinity, in ppt
98
99    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
100
101    REAL, intent(in):: delta_sst(:) ! (knon)
102    ! Ocean-air interface temperature minus bulk SST, in K. Defined
103    ! only if activate_ocean_skin >= 1.
104
105! In/Output arguments
106!****************************************************************************************
107    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
108    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
109    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
110 
111! Output arguments
112!****************************************************************************************
113    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
114    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
115    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
116    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
117    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
118    REAL, intent(out):: sens_prec_liq(:) ! (knon)
119
120    REAL, INTENT(OUT):: sss(:) ! (klon)
121    ! bulk salinity of the surface layer of the ocean, in ppt
122 
123
124! Local variables
125!****************************************************************************************
126    INTEGER               :: i, j
127    INTEGER, DIMENSION(1) :: iloc
128    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
129    REAL, DIMENSION(klon) :: fder_new
130    REAL, DIMENSION(klon) :: tsurf_cpl
131    REAL, DIMENSION(klon) :: u0_cpl, v0_cpl
132    REAL, DIMENSION(klon) :: u1_lay, v1_lay
133    LOGICAL               :: check=.FALSE.
134    REAL sens_prec_sol(knon) 
135    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol   
136
137! End definitions
138!****************************************************************************************
139
140    IF (check) WRITE(*,*)' Entering ocean_cpl_noice'
141
142!****************************************************************************************
143! Receive sea-surface temperature(tsurf_cpl) from coupler
144!
145!****************************************************************************************
146    CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl, u0_cpl, v0_cpl, &
147         sss)
148
149!****************************************************************************************
150! Calculate fluxes at surface
151!
152!****************************************************************************************
153    cal = 0.
154    beta = 1.
155    dif_grnd = 0.
156    agesno(:) = 0.
157    lat_prec_liq = 0.; lat_prec_sol = 0.
158   
159
160    DO i = 1, knon
161       u1_lay(i) = u1(i) - u0_cpl(i)
162       v1_lay(i) = v1(i) - v0_cpl(i)
163    END DO
164
165    CALL calcul_fluxs(knon, is_oce, dtime, &
166         merge(tsurf_in, tsurf_cpl, activate_ocean_skin == 2), p1lay, cal, &
167         beta, cdragh, cdragq, ps, &
168         precip_rain, precip_snow, snow, qsurf,  &
169         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
170         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
171         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
172         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
173
174    if (activate_ocean_skin == 2) then
175       ! tsurf_new was set to tsurf_in in calcul_flux, correct it to
176       ! the new bulk SST tsurf_cpl:
177       tsurf_new = tsurf_cpl
178    end if
179
180    ! assertion: tsurf_new == tsurf_cpl
181   
182    do j = 1, knon
183      i = knindex(j)
184      sens_prec_liq_o(i,1) = sens_prec_liq(j)
185      sens_prec_sol_o(i,1) = sens_prec_sol(j)
186      lat_prec_liq_o(i,1) = lat_prec_liq(j)
187      lat_prec_sol_o(i,1) = lat_prec_sol(j)
188    enddo
189
190
191   
192! - Flux calculation at first modele level for U and V
193    CALL calcul_flux_wind(knon, dtime, &
194         u0_cpl, v0_cpl, u1, v1, gustiness, cdragm, &
195         AcoefU, AcoefV, BcoefU, BcoefV, &
196         p1lay, temp_air, &
197         flux_u1, flux_v1) 
198
199!****************************************************************************************
200! Calculate fder : flux derivative (sensible and latente)
201!
202!****************************************************************************************
203    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
204   
205    iloc = MAXLOC(fder_new(1:klon))
206    IF (check .AND. fder_new(iloc(1))> 0.) THEN
207       WRITE(*,*)'**** Debug fder****'
208       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
209       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
210            dflux_s(iloc(1)), dflux_l(iloc(1))
211    ENDIF
212
213!****************************************************************************************
214! Send and cumulate fields to the coupler
215!
216!****************************************************************************************
217
218    CALL cpl_send_ocean_fields(itime, knon, knindex, swnet, lwnet, fluxlat, &
219         fluxsens, precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, &
220         flux_u1, flux_v1, windsp, sens_prec_liq, sens_prec_sol, lat_prec_liq, &
221         lat_prec_sol, delta_sst, delta_sal)
222
223  END SUBROUTINE ocean_cpl_noice
224!
225!****************************************************************************************
226!
227  SUBROUTINE ocean_cpl_ice( &
228       rlon, rlat, swnet, lwnet, alb1, &
229       fder_old, &
230       itime, dtime, knon, knindex, &
231       lafin, &
232       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
233       AcoefH, AcoefQ, BcoefH, BcoefQ, &
234       AcoefU, AcoefV, BcoefU, BcoefV, &
235       ps, u1, v1, gustiness, pctsrf, &
236       radsol, snow, qsurf, &
237       alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
238       tsurf_new, dflux_s, dflux_l, rhoa)
239!
240! This subroutine treats the ocean where there is ice. The subroutine first receives
241! fields from coupler, then some calculations at surface is done and finally sends
242! some fields to the coupler.
243!   
244    USE dimphy,           ONLY : klon
245    USE cpl_mod
246    USE calcul_fluxs_mod
247    USE indice_sol_mod
248    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
249
250    INCLUDE "YOMCST.h"
251    INCLUDE "clesphys.h"
252
253! Input arguments
254!****************************************************************************************
255    INTEGER, INTENT(IN)                      :: itime, knon
256    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
257    LOGICAL, INTENT(IN)                      :: lafin
258    REAL, INTENT(IN)                         :: dtime
259    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
260    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
261    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
262    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
263    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
264    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
265    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
266    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
267    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
268    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
269    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
270    REAL, DIMENSION(klon), INTENT(IN)        :: ps
271    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
272    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
273    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
274
275! In/output arguments
276!****************************************************************************************
277    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
278    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
279
280! Output arguments
281!****************************************************************************************
282    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
283    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
284    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
285    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
286    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
287    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
288 
289
290! Local variables
291!****************************************************************************************
292    INTEGER                 :: i, j
293    INTEGER, DIMENSION(1)   :: iloc
294    LOGICAL                 :: check=.FALSE.
295    REAL, PARAMETER         :: t_grnd=271.35
296    REAL, DIMENSION(klon)   :: cal, beta, dif_grnd
297    REAL, DIMENSION(klon)   :: tsurf_cpl, fder_new
298    REAL, DIMENSION(klon)   :: alb_cpl
299    REAL, DIMENSION(klon)   :: u0, v0
300    REAL, DIMENSION(klon)   :: u1_lay, v1_lay
301    REAL sens_prec_liq(knon), sens_prec_sol(knon)   
302    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol   
303
304! End definitions
305!****************************************************************************************
306   
307    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
308
309    lat_prec_liq = 0.; lat_prec_sol = 0.
310
311!****************************************************************************************
312! Receive ocean temperature(tsurf_cpl) and albedo(alb_new) from coupler
313!
314!****************************************************************************************
315
316    CALL cpl_receive_seaice_fields(knon, knindex, &
317         tsurf_cpl, alb_cpl, u0, v0)
318
319    alb1_new(1:knon) = alb_cpl(1:knon)
320    alb2_new(1:knon) = alb_cpl(1:knon)   
321
322   
323!****************************************************************************************
324! Calculate fluxes at surface
325!
326!****************************************************************************************
327    cal = 0.
328    dif_grnd = 0.
329    beta = 1.0
330   
331    DO i = 1, knon
332       u1_lay(i) = u1(i) - u0(i)
333       v1_lay(i) = v1(i) - v0(i)
334    END DO
335
336    CALL calcul_fluxs(knon, is_sic, dtime, &
337         tsurf_cpl, p1lay, cal, beta, cdragh, cdragh, ps, &
338         precip_rain, precip_snow, snow, qsurf,  &
339         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
340         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
341         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
342         sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, rhoa)
343    do j = 1, knon
344      i = knindex(j)
345      sens_prec_liq_o(i,2) = sens_prec_liq(j)
346      sens_prec_sol_o(i,2) = sens_prec_sol(j)
347      lat_prec_liq_o(i,2) = lat_prec_liq(j)
348      lat_prec_sol_o(i,2) = lat_prec_sol(j)
349    enddo
350
351
352! - Flux calculation at first modele level for U and V
353    CALL calcul_flux_wind(knon, dtime, &
354         u0, v0, u1, v1, gustiness, cdragm, &
355         AcoefU, AcoefV, BcoefU, BcoefV, &
356         p1lay, temp_air, &
357         flux_u1, flux_v1) 
358
359!****************************************************************************************
360! Calculate fder : flux derivative (sensible and latente)
361!
362!****************************************************************************************
363    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
364   
365    iloc = MAXLOC(fder_new(1:klon))
366    IF (check .AND. fder_new(iloc(1))> 0.) THEN
367       WRITE(*,*)'**** Debug fder ****'
368       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
369       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
370            dflux_s(iloc(1)), dflux_l(iloc(1))
371    ENDIF
372
373!****************************************************************************************
374! Send and cumulate fields to the coupler
375!
376!****************************************************************************************
377
378    CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, &
379       pctsrf, lafin, rlon, rlat, &
380       swnet, lwnet, fluxlat, fluxsens, &
381       precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1,&
382       sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
383
384 
385
386  END SUBROUTINE ocean_cpl_ice
387! 
388!****************************************************************************************
389!
390END MODULE ocean_cpl_mod
Note: See TracBrowser for help on using the repository browser.