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

Last change on this file since 3069 was 2886, checked in by Laurent Fairhead, 7 years ago

Merged trunk changes r2865:2885 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.1 KB
RevLine 
[782]1!
[2542]2! $Id: ocean_cpl_mod.F90 2886 2017-05-20 07:41:16Z dcugnet $
3!
[782]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
[996]13  PUBLIC :: ocean_cpl_init, ocean_cpl_noice, ocean_cpl_ice
[782]14
[2542]15
[782]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!
[1067]26    USE dimphy,           ONLY : klon
27    USE cpl_mod
28
[782]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( &
[888]48       swnet, lwnet, alb1, &
[1067]49       windsp, fder_old, &
[782]50       itime, dtime, knon, knindex, &
[2298]51       p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, temp_air, spechum, &
[1067]52       AcoefH, AcoefQ, BcoefH, BcoefQ, &
53       AcoefU, AcoefV, BcoefU, BcoefV, &
[2298]54       ps, u1, v1, gustiness, &
[888]55       radsol, snow, agesno, &
[1067]56       qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
[996]57       tsurf_new, dflux_s, dflux_l)
[1067]58
[782]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!
[1067]64    USE dimphy,           ONLY : klon
65    USE cpl_mod
66    USE calcul_fluxs_mod
[1795]67    USE indice_sol_mod
[2542]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
[1067]70
[793]71    INCLUDE "YOMCST.h"
[2298]72    INCLUDE "clesphys.h"
[782]73!   
74! Input arguments 
75!****************************************************************************************
76    INTEGER, INTENT(IN)                      :: itime, knon
77    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
78    REAL, INTENT(IN)                         :: dtime
[888]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
[782]82    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
83    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
84    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
[2298]85    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragq, cdragm
[782]86    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
87    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
[1067]88    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
89    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
[782]90    REAL, DIMENSION(klon), INTENT(IN)        :: ps
[2298]91    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
[782]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
[1067]103    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
[782]104    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
105    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
[2542]106 
[782]107
108! Local variables
109!****************************************************************************************
[2542]110    INTEGER               :: i, j
[782]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
[1067]115    REAL, DIMENSION(klon) :: u0_cpl, v0_cpl
116    REAL, DIMENSION(klon) :: u1_lay, v1_lay
[782]117    LOGICAL               :: check=.FALSE.
[2542]118    REAL, DIMENSION(klon) :: sens_prec_liq, sens_prec_sol   
119    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol   
[782]120
121! End definitions
122!****************************************************************************************
123
124    IF (check) WRITE(*,*)' Entering ocean_cpl_noice'
125
126!****************************************************************************************
[996]127! Receive sea-surface temperature(tsurf_cpl) from coupler
[782]128!
129!****************************************************************************************
[1067]130    CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl, u0_cpl, v0_cpl)
[782]131
132!****************************************************************************************
133! Calculate fluxes at surface
134!
135!****************************************************************************************
136    cal = 0.
137    beta = 1.
138    dif_grnd = 0.
139    agesno(:) = 0.
[2542]140    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
141   
[1067]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
[782]148    CALL calcul_fluxs(knon, is_oce, dtime, &
[2298]149         tsurf_cpl, p1lay, cal, beta, cdragh, cdragq, ps, &
[782]150         precip_rain, precip_snow, snow, qsurf,  &
[2298]151         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
152         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
[2542]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
[782]164   
[1067]165! - Flux calculation at first modele level for U and V
166    CALL calcul_flux_wind(knon, dtime, &
[2298]167         u0_cpl, v0_cpl, u1, v1, gustiness, cdragm, &
[1067]168         AcoefU, AcoefV, BcoefU, BcoefV, &
169         p1lay, temp_air, &
170         flux_u1, flux_v1) 
[782]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, &
[888]192         swnet, lwnet, fluxlat, fluxsens, &
[2886]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)
[782]195   
196
197  END SUBROUTINE ocean_cpl_noice
198!
199!****************************************************************************************
200!
201  SUBROUTINE ocean_cpl_ice( &
[888]202       rlon, rlat, swnet, lwnet, alb1, &
[782]203       fder_old, &
204       itime, dtime, knon, knindex, &
205       lafin, &
[1067]206       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
207       AcoefH, AcoefQ, BcoefH, BcoefQ, &
208       AcoefU, AcoefV, BcoefU, BcoefV, &
[2298]209       ps, u1, v1, gustiness, pctsrf, &
[782]210       radsol, snow, qsurf, &
[1067]211       alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
[996]212       tsurf_new, dflux_s, dflux_l)
[782]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!   
[1067]218    USE dimphy,           ONLY : klon
219    USE cpl_mod
220    USE calcul_fluxs_mod
[1795]221    USE indice_sol_mod
[2542]222    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
[1067]223
[793]224    INCLUDE "YOMCST.h"
[2298]225    INCLUDE "clesphys.h"
[782]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
[888]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
[782]237    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
238    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
[1067]239    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
[782]240    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
241    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
[1067]242    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
243    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
[782]244    REAL, DIMENSION(klon), INTENT(IN)        :: ps
[2298]245    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
[996]246    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
[782]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
[888]256    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
[782]257    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
[1067]258    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
[888]259    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
[782]260    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
[2542]261 
[782]262
263! Local variables
264!****************************************************************************************
[2542]265    INTEGER                 :: i, j
[782]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
[888]271    REAL, DIMENSION(klon)   :: alb_cpl
[1067]272    REAL, DIMENSION(klon)   :: u0, v0
273    REAL, DIMENSION(klon)   :: u1_lay, v1_lay
[2542]274    REAL, DIMENSION(klon) :: sens_prec_liq, sens_prec_sol   
275    REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol   
[782]276
277! End definitions
278!****************************************************************************************
279   
280    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
281
[2542]282    sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
283
[782]284!****************************************************************************************
[996]285! Receive ocean temperature(tsurf_cpl) and albedo(alb_new) from coupler
[782]286!
287!****************************************************************************************
288
289    CALL cpl_receive_seaice_fields(knon, knindex, &
[1146]290         tsurf_cpl, alb_cpl, u0, v0)
[888]291
292    alb1_new(1:knon) = alb_cpl(1:knon)
293    alb2_new(1:knon) = alb_cpl(1:knon)   
294
[782]295   
296!****************************************************************************************
297! Calculate fluxes at surface
298!
299!****************************************************************************************
300    cal = 0.
301    dif_grnd = 0.
302    beta = 1.0
303   
[1146]304    DO i = 1, knon
305       u1_lay(i) = u1(i) - u0(i)
306       v1_lay(i) = v1(i) - v0(i)
307    END DO
[782]308
309    CALL calcul_fluxs(knon, is_sic, dtime, &
[2298]310         tsurf_cpl, p1lay, cal, beta, cdragh, cdragh, ps, &
[782]311         precip_rain, precip_snow, snow, qsurf,  &
[2298]312         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
313         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
[2542]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
[782]323
[1067]324
325! - Flux calculation at first modele level for U and V
326    CALL calcul_flux_wind(knon, dtime, &
[2298]327         u0, v0, u1, v1, gustiness, cdragm, &
[1067]328         AcoefU, AcoefV, BcoefU, BcoefV, &
329         p1lay, temp_air, &
330         flux_u1, flux_v1) 
331
[782]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, &
[996]352       pctsrf, lafin, rlon, rlat, &
[888]353       swnet, lwnet, fluxlat, fluxsens, &
[2886]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)
[2542]356
[782]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.