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

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

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