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

Last change on this file since 1098 was 1067, checked in by Laurent Fairhead, 16 years ago
  • Modifications lie au premier niveau du modele pour la diffusion turbulent

du vent.

  • Preparation pour un couplage des courrant oceaniques.

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