source: LMDZ4/trunk/libf/phylmd/ocean_cpl_mod.F90 @ 985

Last change on this file since 985 was 888, checked in by Laurent Fairhead, 17 years ago

Modifications sur l'albedo JG
LF
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 14.5 KB
RevLine 
[782]1!
2! $Header$
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  USE dimphy,           ONLY : klon
11  USE cpl_mod
12  USE calcul_fluxs_mod, ONLY : calcul_fluxs
13  USE climb_wind_mod,   ONLY : calcul_wind_flux
14
15  IMPLICIT NONE
16  PRIVATE
17
18  PUBLIC :: ocean_cpl_init, ocean_cpl_get_vars, ocean_cpl_noice, ocean_cpl_ice
19
20  REAL, ALLOCATABLE, DIMENSION(:), SAVE       :: tmp_flux_o
21  !$OMP THREADPRIVATE(tmp_flux_o)
22  REAL, ALLOCATABLE, DIMENSION(:), SAVE       :: tmp_flux_g
23  !$OMP THREADPRIVATE(tmp_flux_g)
24
25!****************************************************************************************
26!
27CONTAINS
28!
29!****************************************************************************************
30!
31  SUBROUTINE ocean_cpl_init(dtime, rlon, rlat)
32!
33! Allocate fields for this module and initailize the module mod_cpl
34!
35! Input arguments
36!*************************************************************************************
37    REAL, INTENT(IN)                  :: dtime
38    REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
39
40! Local variables
41!*************************************************************************************
42    INTEGER              :: error
43    CHARACTER (len = 80) :: abort_message
44    CHARACTER (len = 20) :: modname = 'ocean_cpl_init'
45
46
47    ALLOCATE(tmp_flux_o(klon), stat = error)
48    IF (error /= 0) THEN
49       abort_message='Pb allocation tmp_flux_o'
50       CALL abort_gcm(modname,abort_message,1)
51    ENDIF
52
53    ALLOCATE(tmp_flux_g(klon), stat = error)
54    IF (error /= 0) THEN
55       abort_message='Pb allocation tmp_flux_g'
56       CALL abort_gcm(modname,abort_message,1)
57    ENDIF
58
59! Initialize module cpl_init
60    CALL cpl_init(dtime, rlon, rlat)
61   
62  END SUBROUTINE ocean_cpl_init
63!
64!****************************************************************************************
65!
66  SUBROUTINE ocean_cpl_noice( &
[888]67       swnet, lwnet, alb1, &
[782]68       windsp, &
69       fder_old, &
70       itime, dtime, knon, knindex, &
71       p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, &
72       petAcoef, peqAcoef, petBcoef, peqBcoef, &
73       ps, u1_lay, v1_lay, pctsrf_in, &
[888]74       radsol, snow, agesno, &
75       qsurf, evap, fluxsens, fluxlat, &
[782]76       tsurf_new, dflux_s, dflux_l, pctsrf_oce)
77!
78! This subroutine treats the "open ocean", all grid points that are not entierly covered
79! by ice. The subroutine first receives fields from coupler, then some calculations at
80! surface is done and finally it sends some fields to the coupler.
81!
[793]82    INCLUDE "indicesol.h"
83    INCLUDE "YOMCST.h"
[782]84!   
85! Input arguments 
86!****************************************************************************************
87    INTEGER, INTENT(IN)                      :: itime, knon
88    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
89    REAL, INTENT(IN)                         :: dtime
[888]90    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
91    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
92    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
[782]93    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
94    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
95    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
96    REAL, DIMENSION(klon), INTENT(IN)        :: tq_cdrag
97    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
98    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
99    REAL, DIMENSION(klon), INTENT(IN)        :: petAcoef, peqAcoef
100    REAL, DIMENSION(klon), INTENT(IN)        :: petBcoef, peqBcoef
101    REAL, DIMENSION(klon), INTENT(IN)        :: ps
102    REAL, DIMENSION(klon), INTENT(IN)        :: u1_lay, v1_lay
103    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf_in
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)       :: tsurf_new
116    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
117    REAL, DIMENSION(klon), INTENT(OUT)       :: pctsrf_oce
118
119! Local variables
120!****************************************************************************************
121    INTEGER               :: i
122    INTEGER, DIMENSION(1) :: iloc
123    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
124    REAL, DIMENSION(klon) :: zx_sl
125    REAL, DIMENSION(klon) :: fder_new
126    REAL, DIMENSION(klon) :: tsurf_cpl
127    REAL, DIMENSION(klon) :: taux, tauy
128    LOGICAL               :: check=.FALSE.
129
130! End definitions
131!****************************************************************************************
132
133    IF (check) WRITE(*,*)' Entering ocean_cpl_noice'
134
135!****************************************************************************************
136! Receive sea-surface temperature(tsurf_cpl) and new fraction of ocean surface(pctsrf_oce)
137! from coupler
138!
139!****************************************************************************************
140    CALL cpl_receive_ocean_fields(itime, dtime, knon, knindex, pctsrf_in, &
141         tsurf_cpl, pctsrf_oce)
142
143!****************************************************************************************
144! Calculate fluxes at surface
145!
146!****************************************************************************************
147    cal = 0.
148    beta = 1.
149    dif_grnd = 0.
150    agesno(:) = 0.
151   
152    CALL calcul_fluxs(knon, is_oce, dtime, &
153         tsurf_cpl, p1lay, cal, beta, tq_cdrag, ps, &
154         precip_rain, precip_snow, snow, qsurf,  &
155         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
156         petAcoef, peqAcoef, petBcoef, peqBcoef, &
157         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
158   
159    ! Calcultate the flux of u and v at surface
[803]160    CALL calcul_wind_flux(knon, dtime, taux, tauy)
161   
[782]162
163!****************************************************************************************
164! Calculate fder : flux derivative (sensible and latente)
165!
166!****************************************************************************************
167    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
168   
169    iloc = MAXLOC(fder_new(1:klon))
170    IF (check .AND. fder_new(iloc(1))> 0.) THEN
171       WRITE(*,*)'**** Debug fder****'
172       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
173       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
174            dflux_s(iloc(1)), dflux_l(iloc(1))
175    ENDIF
176
177!****************************************************************************************
178! Flux ocean-atmosphere useful for "slab" ocean but here calculated only for printing
179! usage later in physiq 
180!
181!****************************************************************************************
182    tmp_flux_o(:) = 0.0
183    DO i=1, knon
184       zx_sl(i) = RLVTT
185       IF (tsurf_new(i) .LT. RTT) zx_sl(i) = RLSTT
186       !IM     flux_o(i) = fluxsens(i)-evap(i)*zx_sl(i)
187       !       flux_o(i) = fluxsens(i) + fluxlat(i)
188       IF (pctsrf_oce(knindex(i)) .GT. epsfra) THEN
189          tmp_flux_o(knindex(i)) = fluxsens(i) + fluxlat(i)
190       ENDIF
191    ENDDO
192
193
194!****************************************************************************************
195! Send and cumulate fields to the coupler
196!
197!****************************************************************************************
198
199    CALL cpl_send_ocean_fields(itime, knon, knindex, &
[888]200         swnet, lwnet, fluxlat, fluxsens, &
201         precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, taux, tauy, windsp)
[782]202   
203
204  END SUBROUTINE ocean_cpl_noice
205!
206!****************************************************************************************
207!
208  SUBROUTINE ocean_cpl_ice( &
[888]209       rlon, rlat, swnet, lwnet, alb1, &
[782]210       fder_old, &
211       itime, dtime, knon, knindex, &
212       lafin, &
213       p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, &
214       petAcoef, peqAcoef, petBcoef, peqBcoef, &
215       ps, u1_lay, v1_lay, pctsrf_in, &
216       radsol, snow, qsurf, &
[888]217       alb1_new, alb2_new, evap, fluxsens, fluxlat, &
218       tsurf_new, dflux_s, dflux_l, pctsrf_sic)
[782]219!
220! This subroutine treats the ocean where there is ice. The subroutine first receives
221! fields from coupler, then some calculations at surface is done and finally sends
222! some fields to the coupler.
223!   
[793]224    INCLUDE "indicesol.h"
225    INCLUDE "YOMCST.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
239    REAL, DIMENSION(klon), INTENT(IN)        :: tq_cdrag
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)        :: petAcoef, peqAcoef
243    REAL, DIMENSION(klon), INTENT(IN)        :: petBcoef, peqBcoef
244    REAL, DIMENSION(klon), INTENT(IN)        :: ps
245    REAL, DIMENSION(klon), INTENT(IN)        :: u1_lay, v1_lay
246    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf_in
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
[888]258    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
[782]259    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
260    REAL, DIMENSION(klon), INTENT(OUT)       :: pctsrf_sic
261
262! Local variables
263!****************************************************************************************
264    INTEGER                 :: i
265    INTEGER, DIMENSION(1)   :: iloc
266    LOGICAL                 :: check=.FALSE.
267    REAL, PARAMETER         :: t_grnd=271.35
268    REAL, DIMENSION(klon)   :: cal, beta, dif_grnd
269    REAL, DIMENSION(klon)   :: tsurf_cpl, fder_new
270    REAL, DIMENSION(klon)   :: taux, tauy
[888]271    REAL, DIMENSION(klon)   :: alb_cpl
[782]272
273! End definitions
274!****************************************************************************************
275   
276    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
277
278!****************************************************************************************
[888]279! Receive ocean temperature(tsurf_cpl), albedo(alb_cpl) and new fraction of
[782]280! seaice(pctsrf_sic) from coupler
281!
282!****************************************************************************************
283
284    CALL cpl_receive_seaice_fields(knon, knindex, &
[888]285         tsurf_cpl, alb_cpl, pctsrf_sic)
286
287    alb1_new(1:knon) = alb_cpl(1:knon)
288    alb2_new(1:knon) = alb_cpl(1:knon)   
289
[782]290   
291!****************************************************************************************
292! Calculate fluxes at surface
293!
294!****************************************************************************************
295    cal = 0.
296    dif_grnd = 0.
297    beta = 1.0
298   
299
300    CALL calcul_fluxs(knon, is_sic, dtime, &
301         tsurf_cpl, p1lay, cal, beta, tq_cdrag, ps, &
302         precip_rain, precip_snow, snow, qsurf,  &
303         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
304         petAcoef, peqAcoef, petBcoef, peqBcoef, &
305         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
306
307    ! Calcultate the flux of u and v at surface
[803]308    CALL calcul_wind_flux(knon, dtime, taux, tauy)
309   
[782]310!****************************************************************************************
311! Flux ocean-atmosphere useful for "slab" ocean but here calculated only for printing
312! usage later in physiq 
313!
314!  IM: faire dependre le coefficient de conduction de la glace de mer
315!      de l'epaisseur de la glace de mer, dans l'hypothese ou le coeff.
316!      actuel correspond a 3m de glace de mer, cf. L.Li
317!
318!****************************************************************************************
319    tmp_flux_g(:) = 0.0
320    DO i = 1, knon
321       IF (cal(i) .GT. 1.0e-15 .AND. pctsrf_sic(knindex(i)) .GT. epsfra) &
322            tmp_flux_g(knindex(i)) = (tsurf_new(i)-t_grnd) * &
323            dif_grnd(i) * RCPD/cal(i)
324    ENDDO
325   
326!****************************************************************************************
327! Calculate fder : flux derivative (sensible and latente)
328!
329!****************************************************************************************
330    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
331   
332    iloc = MAXLOC(fder_new(1:klon))
333    IF (check .AND. fder_new(iloc(1))> 0.) THEN
334       WRITE(*,*)'**** Debug fder ****'
335       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
336       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
337            dflux_s(iloc(1)), dflux_l(iloc(1))
338    ENDIF
339
340!****************************************************************************************
341! Send and cumulate fields to the coupler
342!
343!****************************************************************************************
344
345    CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, &
346       pctsrf_in, lafin, rlon, rlat, &
[888]347       swnet, lwnet, fluxlat, fluxsens, &
348       precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, taux, tauy)
[782]349 
350
351  END SUBROUTINE ocean_cpl_ice
352! 
353!****************************************************************************************
354!
355  SUBROUTINE ocean_cpl_get_vars(flux_o, flux_g)
356
357! This subroutine returns variables private in this module to an external
358! routine (physiq).
359
360    REAL, DIMENSION(klon), INTENT(OUT) :: flux_o
361    REAL, DIMENSION(klon), INTENT(OUT) :: flux_g
362
363! Set the output variables
364    flux_o(:) = tmp_flux_o(:)
365    flux_g(:) = tmp_flux_g(:)
366
367  END SUBROUTINE ocean_cpl_get_vars
368!
369!****************************************************************************************
370!
371END MODULE ocean_cpl_mod
Note: See TracBrowser for help on using the repository browser.