source: LMDZ4/trunk/libf/phytherm/ocean_cpl_mod.F90 @ 837

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

Mise a jour des routines de phytherm vers la version V3 de LMDZ4
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.3 KB
Line 
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( &
67       sollw, albedo, &
68       windsp, &
69       fder_old, &
70       itime, dtime, knon, knindex, &
71       swdown, &
72       p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, &
73       petAcoef, peqAcoef, petBcoef, peqBcoef, &
74       ps, u1_lay, v1_lay, pctsrf_in, &
75       radsol, snow, qsurf, agesno, &
76       evap, fluxsens, fluxlat, &
77       tsurf_new, dflux_s, dflux_l, pctsrf_oce)
78!
79! This subroutine treats the "open ocean", all grid points that are not entierly covered
80! by ice. The subroutine first receives fields from coupler, then some calculations at
81! surface is done and finally it sends some fields to the coupler.
82!
83    INCLUDE "indicesol.h"
84    INCLUDE "YOMCST.h"
85!   
86! Input arguments 
87!****************************************************************************************
88    INTEGER, INTENT(IN)                      :: itime, knon
89    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
90    REAL, INTENT(IN)                         :: dtime
91    REAL, DIMENSION(klon), INTENT(IN)        :: sollw
92    REAL, DIMENSION(klon), INTENT(IN)        :: albedo
93    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
94    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
95    REAL, DIMENSION(klon), INTENT(IN)        :: swdown   
96    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
97    REAL, DIMENSION(klon), INTENT(IN)        :: tq_cdrag
98    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
99    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
100    REAL, DIMENSION(klon), INTENT(IN)        :: petAcoef, peqAcoef
101    REAL, DIMENSION(klon), INTENT(IN)        :: petBcoef, peqBcoef
102    REAL, DIMENSION(klon), INTENT(IN)        :: ps
103    REAL, DIMENSION(klon), INTENT(IN)        :: u1_lay, v1_lay
104    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf_in
105
106! In/Output arguments
107!****************************************************************************************
108    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
109    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
110    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
111 
112! Output arguments
113!****************************************************************************************
114    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
115    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
116    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
117    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
118    REAL, DIMENSION(klon), INTENT(OUT)       :: pctsrf_oce
119
120! Local variables
121!****************************************************************************************
122    INTEGER               :: i
123    INTEGER, DIMENSION(1) :: iloc
124    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
125    REAL, DIMENSION(klon) :: zx_sl
126    REAL, DIMENSION(klon) :: fder_new
127    REAL, DIMENSION(klon) :: tsurf_cpl
128    REAL, DIMENSION(klon) :: taux, tauy
129    LOGICAL               :: check=.FALSE.
130
131! End definitions
132!****************************************************************************************
133
134    IF (check) WRITE(*,*)' Entering ocean_cpl_noice'
135
136!****************************************************************************************
137! Receive sea-surface temperature(tsurf_cpl) and new fraction of ocean surface(pctsrf_oce)
138! from coupler
139!
140!****************************************************************************************
141    CALL cpl_receive_ocean_fields(itime, dtime, knon, knindex, pctsrf_in, &
142         tsurf_cpl, pctsrf_oce)
143
144!****************************************************************************************
145! Calculate fluxes at surface
146!
147!****************************************************************************************
148    cal = 0.
149    beta = 1.
150    dif_grnd = 0.
151    agesno(:) = 0.
152   
153    CALL calcul_fluxs(knon, is_oce, dtime, &
154         tsurf_cpl, p1lay, cal, beta, tq_cdrag, ps, &
155         precip_rain, precip_snow, snow, qsurf,  &
156         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
157         petAcoef, peqAcoef, petBcoef, peqBcoef, &
158         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
159   
160    ! Calcultate the flux of u and v at surface
161    CALL calcul_wind_flux(knon, dtime, taux, tauy)
162   
163
164!****************************************************************************************
165! Calculate fder : flux derivative (sensible and latente)
166!
167!****************************************************************************************
168    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
169   
170    iloc = MAXLOC(fder_new(1:klon))
171    IF (check .AND. fder_new(iloc(1))> 0.) THEN
172       WRITE(*,*)'**** Debug fder****'
173       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
174       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
175            dflux_s(iloc(1)), dflux_l(iloc(1))
176    ENDIF
177
178!****************************************************************************************
179! Flux ocean-atmosphere useful for "slab" ocean but here calculated only for printing
180! usage later in physiq 
181!
182!****************************************************************************************
183    tmp_flux_o(:) = 0.0
184    DO i=1, knon
185       zx_sl(i) = RLVTT
186       IF (tsurf_new(i) .LT. RTT) zx_sl(i) = RLSTT
187       !IM     flux_o(i) = fluxsens(i)-evap(i)*zx_sl(i)
188       !       flux_o(i) = fluxsens(i) + fluxlat(i)
189       IF (pctsrf_oce(knindex(i)) .GT. epsfra) THEN
190          tmp_flux_o(knindex(i)) = fluxsens(i) + fluxlat(i)
191       ENDIF
192    ENDDO
193
194
195!****************************************************************************************
196! Send and cumulate fields to the coupler
197!
198!****************************************************************************************
199
200    CALL cpl_send_ocean_fields(itime, knon, knindex, &
201         swdown, sollw, fluxlat, fluxsens, &
202         precip_rain, precip_snow, evap, tsurf_new, fder_new, albedo, taux, tauy, windsp)
203   
204
205  END SUBROUTINE ocean_cpl_noice
206!
207!****************************************************************************************
208!
209  SUBROUTINE ocean_cpl_ice( &
210       rlon, rlat, sollw, albedo, &
211       fder_old, &
212       itime, dtime, knon, knindex, &
213       lafin, &
214       swdown, &
215       p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, &
216       petAcoef, peqAcoef, petBcoef, peqBcoef, &
217       ps, u1_lay, v1_lay, pctsrf_in, &
218       radsol, snow, qsurf, &
219       alblw, evap, fluxsens, fluxlat, &
220       tsurf_new, alb_new, dflux_s, dflux_l, pctsrf_sic)
221!
222! This subroutine treats the ocean where there is ice. The subroutine first receives
223! fields from coupler, then some calculations at surface is done and finally sends
224! some fields to the coupler.
225!   
226    INCLUDE "indicesol.h"
227    INCLUDE "YOMCST.h"
228
229! Input arguments
230!****************************************************************************************
231    INTEGER, INTENT(IN)                      :: itime, knon
232    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
233    LOGICAL, INTENT(IN)                      :: lafin
234    REAL, INTENT(IN)                         :: dtime
235    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
236    REAL, DIMENSION(klon), INTENT(IN)        :: sollw
237    REAL, DIMENSION(klon), INTENT(IN)        :: albedo
238    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
239    REAL, DIMENSION(klon), INTENT(IN)        :: swdown
240    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
241    REAL, DIMENSION(klon), INTENT(IN)        :: tq_cdrag
242    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
243    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
244    REAL, DIMENSION(klon), INTENT(IN)        :: petAcoef, peqAcoef
245    REAL, DIMENSION(klon), INTENT(IN)        :: petBcoef, peqBcoef
246    REAL, DIMENSION(klon), INTENT(IN)        :: ps
247    REAL, DIMENSION(klon), INTENT(IN)        :: u1_lay, v1_lay
248    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf_in
249
250! In/output arguments
251!****************************************************************************************
252    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
253    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
254
255! Output arguments
256!****************************************************************************************
257    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
258    REAL, DIMENSION(klon), INTENT(OUT)       :: alblw
259    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
260    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new, alb_new
261    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
262    REAL, DIMENSION(klon), INTENT(OUT)       :: pctsrf_sic
263
264! Local variables
265!****************************************************************************************
266    INTEGER                 :: i
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)   :: taux, tauy
273
274! End definitions
275!****************************************************************************************
276   
277    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
278
279!****************************************************************************************
280! Receive ocean temperature(tsurf_cpl), albedo(alb_new) and new fraction of
281! seaice(pctsrf_sic) from coupler
282!
283!****************************************************************************************
284
285    CALL cpl_receive_seaice_fields(knon, knindex, &
286         tsurf_cpl, alb_new, pctsrf_sic)
287   
288!****************************************************************************************
289! Calculate fluxes at surface
290!
291!****************************************************************************************
292    cal = 0.
293    dif_grnd = 0.
294    beta = 1.0
295   
296
297    CALL calcul_fluxs(knon, is_sic, dtime, &
298         tsurf_cpl, p1lay, cal, beta, tq_cdrag, ps, &
299         precip_rain, precip_snow, snow, qsurf,  &
300         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
301         petAcoef, peqAcoef, petBcoef, peqBcoef, &
302         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
303
304    ! Calcultate the flux of u and v at surface
305    CALL calcul_wind_flux(knon, dtime, taux, tauy)
306   
307!****************************************************************************************
308! Flux ocean-atmosphere useful for "slab" ocean but here calculated only for printing
309! usage later in physiq 
310!
311!  IM: faire dependre le coefficient de conduction de la glace de mer
312!      de l'epaisseur de la glace de mer, dans l'hypothese ou le coeff.
313!      actuel correspond a 3m de glace de mer, cf. L.Li
314!
315!****************************************************************************************
316    tmp_flux_g(:) = 0.0
317    DO i = 1, knon
318       IF (cal(i) .GT. 1.0e-15 .AND. pctsrf_sic(knindex(i)) .GT. epsfra) &
319            tmp_flux_g(knindex(i)) = (tsurf_new(i)-t_grnd) * &
320            dif_grnd(i) * RCPD/cal(i)
321    ENDDO
322   
323!****************************************************************************************
324! Calculate fder : flux derivative (sensible and latente)
325!
326!****************************************************************************************
327    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
328   
329    iloc = MAXLOC(fder_new(1:klon))
330    IF (check .AND. fder_new(iloc(1))> 0.) THEN
331       WRITE(*,*)'**** Debug fder ****'
332       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
333       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
334            dflux_s(iloc(1)), dflux_l(iloc(1))
335    ENDIF
336
337!****************************************************************************************
338! Send and cumulate fields to the coupler
339!
340!****************************************************************************************
341
342    CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, &
343       pctsrf_in, lafin, rlon, rlat, &
344       swdown, sollw, fluxlat, fluxsens, &
345       precip_rain, precip_snow, evap, tsurf_new, fder_new, albedo, taux, tauy)
346 
347
348    alblw(1:knon) = alb_new(1:knon)   
349
350  END SUBROUTINE ocean_cpl_ice
351! 
352!****************************************************************************************
353!
354  SUBROUTINE ocean_cpl_get_vars(flux_o, flux_g)
355
356! This subroutine returns variables private in this module to an external
357! routine (physiq).
358
359    REAL, DIMENSION(klon), INTENT(OUT) :: flux_o
360    REAL, DIMENSION(klon), INTENT(OUT) :: flux_g
361
362! Set the output variables
363    flux_o(:) = tmp_flux_o(:)
364    flux_g(:) = tmp_flux_g(:)
365
366  END SUBROUTINE ocean_cpl_get_vars
367!
368!****************************************************************************************
369!
370END MODULE ocean_cpl_mod
Note: See TracBrowser for help on using the repository browser.