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

Last change on this file since 2435 was 2298, checked in by Laurent Fairhead, 10 years ago

Merged trunk changes -r2237:2291 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 Author Date Id Revision
File size: 12.8 KB
Line 
1!
2MODULE ocean_cpl_mod
3!
4! This module is used both for the sub-surface ocean and sea-ice for the case of a
5! coupled model configuration, ocean=couple.
6!
7
8  IMPLICIT NONE
9  PRIVATE
10
11  PUBLIC :: ocean_cpl_init, ocean_cpl_noice, ocean_cpl_ice
12
13!****************************************************************************************
14!
15CONTAINS
16!
17!****************************************************************************************
18!
19  SUBROUTINE ocean_cpl_init(dtime, rlon, rlat)
20!
21! Allocate fields for this module and initailize the module mod_cpl
22!
23    USE dimphy,           ONLY : klon
24    USE cpl_mod
25
26! Input arguments
27!*************************************************************************************
28    REAL, INTENT(IN)                  :: dtime
29    REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
30
31! Local variables
32!*************************************************************************************
33    INTEGER              :: error
34    CHARACTER (len = 80) :: abort_message
35    CHARACTER (len = 20) :: modname = 'ocean_cpl_init'
36
37! Initialize module cpl_init
38    CALL cpl_init(dtime, rlon, rlat)
39   
40  END SUBROUTINE ocean_cpl_init
41!
42!****************************************************************************************
43!
44  SUBROUTINE ocean_cpl_noice( &
45       swnet, lwnet, alb1, &
46       windsp, fder_old, &
47       itime, dtime, knon, knindex, &
48       p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, temp_air, spechum, &
49       AcoefH, AcoefQ, BcoefH, BcoefQ, &
50       AcoefU, AcoefV, BcoefU, BcoefV, &
51       ps, u1, v1, gustiness, &
52       radsol, snow, agesno, &
53       qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
54       tsurf_new, dflux_s, dflux_l)
55
56!
57! This subroutine treats the "open ocean", all grid points that are not entierly covered
58! by ice. The subroutine first receives fields from coupler, then some calculations at
59! surface is done and finally it sends some fields to the coupler.
60!
61    USE dimphy,           ONLY : klon
62    USE cpl_mod
63    USE calcul_fluxs_mod
64    USE indice_sol_mod
65
66    INCLUDE "YOMCST.h"
67    INCLUDE "clesphys.h"
68!   
69! Input arguments 
70!****************************************************************************************
71    INTEGER, INTENT(IN)                      :: itime, knon
72    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
73    REAL, INTENT(IN)                         :: dtime
74    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
75    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
76    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
77    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
78    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
79    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
80    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragq, cdragm
81    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
82    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
83    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
84    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
85    REAL, DIMENSION(klon), INTENT(IN)        :: ps
86    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
87
88! In/Output arguments
89!****************************************************************************************
90    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
91    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
92    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
93 
94! Output arguments
95!****************************************************************************************
96    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
97    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
98    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
99    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
100    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
101
102! Local variables
103!****************************************************************************************
104    INTEGER               :: i
105    INTEGER, DIMENSION(1) :: iloc
106    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
107    REAL, DIMENSION(klon) :: fder_new
108    REAL, DIMENSION(klon) :: tsurf_cpl
109    REAL, DIMENSION(klon) :: u0_cpl, v0_cpl
110    REAL, DIMENSION(klon) :: u1_lay, v1_lay
111    LOGICAL               :: check=.FALSE.
112
113! End definitions
114!****************************************************************************************
115
116    IF (check) WRITE(*,*)' Entering ocean_cpl_noice'
117
118!****************************************************************************************
119! Receive sea-surface temperature(tsurf_cpl) from coupler
120!
121!****************************************************************************************
122    CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl, u0_cpl, v0_cpl)
123
124!****************************************************************************************
125! Calculate fluxes at surface
126!
127!****************************************************************************************
128    cal = 0.
129    beta = 1.
130    dif_grnd = 0.
131    agesno(:) = 0.
132
133    DO i = 1, knon
134       u1_lay(i) = u1(i) - u0_cpl(i)
135       v1_lay(i) = v1(i) - v0_cpl(i)
136    END DO
137
138    CALL calcul_fluxs(knon, is_oce, dtime, &
139         tsurf_cpl, p1lay, cal, beta, cdragh, cdragq, ps, &
140         precip_rain, precip_snow, snow, qsurf,  &
141         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
142         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
143         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
144   
145! - Flux calculation at first modele level for U and V
146    CALL calcul_flux_wind(knon, dtime, &
147         u0_cpl, v0_cpl, u1, v1, gustiness, cdragm, &
148         AcoefU, AcoefV, BcoefU, BcoefV, &
149         p1lay, temp_air, &
150         flux_u1, flux_v1) 
151
152!****************************************************************************************
153! Calculate fder : flux derivative (sensible and latente)
154!
155!****************************************************************************************
156    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
157   
158    iloc = MAXLOC(fder_new(1:klon))
159    IF (check .AND. fder_new(iloc(1))> 0.) THEN
160       WRITE(*,*)'**** Debug fder****'
161       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
162       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
163            dflux_s(iloc(1)), dflux_l(iloc(1))
164    ENDIF
165
166!****************************************************************************************
167! Send and cumulate fields to the coupler
168!
169!****************************************************************************************
170
171    CALL cpl_send_ocean_fields(itime, knon, knindex, &
172         swnet, lwnet, fluxlat, fluxsens, &
173         precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1, windsp)
174   
175
176  END SUBROUTINE ocean_cpl_noice
177!
178!****************************************************************************************
179!
180  SUBROUTINE ocean_cpl_ice( &
181       rlon, rlat, swnet, lwnet, alb1, &
182       fder_old, &
183       itime, dtime, knon, knindex, &
184       lafin, &
185       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
186       AcoefH, AcoefQ, BcoefH, BcoefQ, &
187       AcoefU, AcoefV, BcoefU, BcoefV, &
188       ps, u1, v1, gustiness, pctsrf, &
189       radsol, snow, qsurf, &
190       alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
191       tsurf_new, dflux_s, dflux_l)
192!
193! This subroutine treats the ocean where there is ice. The subroutine first receives
194! fields from coupler, then some calculations at surface is done and finally sends
195! some fields to the coupler.
196!   
197    USE dimphy,           ONLY : klon
198    USE cpl_mod
199    USE calcul_fluxs_mod
200    USE indice_sol_mod
201
202    INCLUDE "YOMCST.h"
203    INCLUDE "clesphys.h"
204
205! Input arguments
206!****************************************************************************************
207    INTEGER, INTENT(IN)                      :: itime, knon
208    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
209    LOGICAL, INTENT(IN)                      :: lafin
210    REAL, INTENT(IN)                         :: dtime
211    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
212    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
213    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
214    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
215    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
216    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
217    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh, cdragm
218    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
219    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
220    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
221    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
222    REAL, DIMENSION(klon), INTENT(IN)        :: ps
223    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
224    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
225
226! In/output arguments
227!****************************************************************************************
228    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
229    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
230
231! Output arguments
232!****************************************************************************************
233    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
234    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
235    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
236    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
237    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
238    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
239
240! Local variables
241!****************************************************************************************
242    INTEGER                 :: i
243    INTEGER, DIMENSION(1)   :: iloc
244    LOGICAL                 :: check=.FALSE.
245    REAL, PARAMETER         :: t_grnd=271.35
246    REAL, DIMENSION(klon)   :: cal, beta, dif_grnd
247    REAL, DIMENSION(klon)   :: tsurf_cpl, fder_new
248    REAL, DIMENSION(klon)   :: alb_cpl
249    REAL, DIMENSION(klon)   :: u0, v0
250    REAL, DIMENSION(klon)   :: u1_lay, v1_lay
251
252! End definitions
253!****************************************************************************************
254   
255    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
256
257!****************************************************************************************
258! Receive ocean temperature(tsurf_cpl) and albedo(alb_new) from coupler
259!
260!****************************************************************************************
261
262    CALL cpl_receive_seaice_fields(knon, knindex, &
263         tsurf_cpl, alb_cpl, u0, v0)
264
265    alb1_new(1:knon) = alb_cpl(1:knon)
266    alb2_new(1:knon) = alb_cpl(1:knon)   
267
268   
269!****************************************************************************************
270! Calculate fluxes at surface
271!
272!****************************************************************************************
273    cal = 0.
274    dif_grnd = 0.
275    beta = 1.0
276   
277    DO i = 1, knon
278       u1_lay(i) = u1(i) - u0(i)
279       v1_lay(i) = v1(i) - v0(i)
280    END DO
281
282    CALL calcul_fluxs(knon, is_sic, dtime, &
283         tsurf_cpl, p1lay, cal, beta, cdragh, cdragh, ps, &
284         precip_rain, precip_snow, snow, qsurf,  &
285         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
286         f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
287         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
288
289
290! - Flux calculation at first modele level for U and V
291    CALL calcul_flux_wind(knon, dtime, &
292         u0, v0, u1, v1, gustiness, cdragm, &
293         AcoefU, AcoefV, BcoefU, BcoefV, &
294         p1lay, temp_air, &
295         flux_u1, flux_v1) 
296
297!****************************************************************************************
298! Calculate fder : flux derivative (sensible and latente)
299!
300!****************************************************************************************
301    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
302   
303    iloc = MAXLOC(fder_new(1:klon))
304    IF (check .AND. fder_new(iloc(1))> 0.) THEN
305       WRITE(*,*)'**** Debug fder ****'
306       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
307       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
308            dflux_s(iloc(1)), dflux_l(iloc(1))
309    ENDIF
310
311!****************************************************************************************
312! Send and cumulate fields to the coupler
313!
314!****************************************************************************************
315
316    CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, &
317       pctsrf, lafin, rlon, rlat, &
318       swnet, lwnet, fluxlat, fluxsens, &
319       precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1)
320 
321
322  END SUBROUTINE ocean_cpl_ice
323! 
324!****************************************************************************************
325!
326END MODULE ocean_cpl_mod
Note: See TracBrowser for help on using the repository browser.