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

Last change on this file since 1006 was 996, checked in by lsce, 16 years ago
  • Modifications liées au calcul des nouveau sous-fractions
  • Nettoyage de ocean slab : il reste uniquement la version avec glace de mer forcé
  • Nouveaux variables pour distiguer la version et type d'ocean : type_ocean=force/slab/couple, version_ocean=opa8/nemo pour couplé ou version_ocean=sicOBS pour slab

JG
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 11.7 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
[996]18  PUBLIC :: ocean_cpl_init, ocean_cpl_noice, ocean_cpl_ice
[782]19
20!****************************************************************************************
21!
22CONTAINS
23!
24!****************************************************************************************
25!
26  SUBROUTINE ocean_cpl_init(dtime, rlon, rlat)
27!
28! Allocate fields for this module and initailize the module mod_cpl
29!
30! Input arguments
31!*************************************************************************************
32    REAL, INTENT(IN)                  :: dtime
33    REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
34
35! Local variables
36!*************************************************************************************
37    INTEGER              :: error
38    CHARACTER (len = 80) :: abort_message
39    CHARACTER (len = 20) :: modname = 'ocean_cpl_init'
40
41! Initialize module cpl_init
42    CALL cpl_init(dtime, rlon, rlat)
43   
44  END SUBROUTINE ocean_cpl_init
45!
46!****************************************************************************************
47!
48  SUBROUTINE ocean_cpl_noice( &
[888]49       swnet, lwnet, alb1, &
[782]50       windsp, &
51       fder_old, &
52       itime, dtime, knon, knindex, &
53       p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, &
54       petAcoef, peqAcoef, petBcoef, peqBcoef, &
[996]55       ps, u1_lay, v1_lay, &
[888]56       radsol, snow, agesno, &
57       qsurf, evap, fluxsens, fluxlat, &
[996]58       tsurf_new, dflux_s, dflux_l)
[782]59!
60! This subroutine treats the "open ocean", all grid points that are not entierly covered
61! by ice. The subroutine first receives fields from coupler, then some calculations at
62! surface is done and finally it sends some fields to the coupler.
63!
[793]64    INCLUDE "indicesol.h"
65    INCLUDE "YOMCST.h"
[782]66!   
67! Input arguments 
68!****************************************************************************************
69    INTEGER, INTENT(IN)                      :: itime, knon
70    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
71    REAL, INTENT(IN)                         :: dtime
[888]72    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
73    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
74    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
[782]75    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
76    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
77    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
78    REAL, DIMENSION(klon), INTENT(IN)        :: tq_cdrag
79    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
80    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
81    REAL, DIMENSION(klon), INTENT(IN)        :: petAcoef, peqAcoef
82    REAL, DIMENSION(klon), INTENT(IN)        :: petBcoef, peqBcoef
83    REAL, DIMENSION(klon), INTENT(IN)        :: ps
84    REAL, DIMENSION(klon), INTENT(IN)        :: u1_lay, v1_lay
85
86! In/Output arguments
87!****************************************************************************************
88    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
89    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
90    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
91 
92! Output arguments
93!****************************************************************************************
94    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
95    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
96    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
97    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
98
99! Local variables
100!****************************************************************************************
101    INTEGER               :: i
102    INTEGER, DIMENSION(1) :: iloc
103    REAL, DIMENSION(klon) :: cal, beta, dif_grnd
104    REAL, DIMENSION(klon) :: fder_new
105    REAL, DIMENSION(klon) :: tsurf_cpl
106    REAL, DIMENSION(klon) :: taux, tauy
107    LOGICAL               :: check=.FALSE.
108
109! End definitions
110!****************************************************************************************
111
112    IF (check) WRITE(*,*)' Entering ocean_cpl_noice'
113
114!****************************************************************************************
[996]115! Receive sea-surface temperature(tsurf_cpl) from coupler
[782]116!
117!****************************************************************************************
[996]118    CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl)
[782]119
120!****************************************************************************************
121! Calculate fluxes at surface
122!
123!****************************************************************************************
124    cal = 0.
125    beta = 1.
126    dif_grnd = 0.
127    agesno(:) = 0.
128   
129    CALL calcul_fluxs(knon, is_oce, dtime, &
130         tsurf_cpl, p1lay, cal, beta, tq_cdrag, ps, &
131         precip_rain, precip_snow, snow, qsurf,  &
132         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
133         petAcoef, peqAcoef, petBcoef, peqBcoef, &
134         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
135   
136    ! Calcultate the flux of u and v at surface
[803]137    CALL calcul_wind_flux(knon, dtime, taux, tauy)
138   
[782]139
140!****************************************************************************************
141! Calculate fder : flux derivative (sensible and latente)
142!
143!****************************************************************************************
144    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
145   
146    iloc = MAXLOC(fder_new(1:klon))
147    IF (check .AND. fder_new(iloc(1))> 0.) THEN
148       WRITE(*,*)'**** Debug fder****'
149       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
150       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
151            dflux_s(iloc(1)), dflux_l(iloc(1))
152    ENDIF
153
154!****************************************************************************************
155! Send and cumulate fields to the coupler
156!
157!****************************************************************************************
158
159    CALL cpl_send_ocean_fields(itime, knon, knindex, &
[888]160         swnet, lwnet, fluxlat, fluxsens, &
161         precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, taux, tauy, windsp)
[782]162   
163
164  END SUBROUTINE ocean_cpl_noice
165!
166!****************************************************************************************
167!
168  SUBROUTINE ocean_cpl_ice( &
[888]169       rlon, rlat, swnet, lwnet, alb1, &
[782]170       fder_old, &
171       itime, dtime, knon, knindex, &
172       lafin, &
173       p1lay, tq_cdrag, precip_rain, precip_snow, temp_air, spechum, &
174       petAcoef, peqAcoef, petBcoef, peqBcoef, &
[996]175       ps, u1_lay, v1_lay, pctsrf, &
[782]176       radsol, snow, qsurf, &
[888]177       alb1_new, alb2_new, evap, fluxsens, fluxlat, &
[996]178       tsurf_new, dflux_s, dflux_l)
[782]179!
180! This subroutine treats the ocean where there is ice. The subroutine first receives
181! fields from coupler, then some calculations at surface is done and finally sends
182! some fields to the coupler.
183!   
[793]184    INCLUDE "indicesol.h"
185    INCLUDE "YOMCST.h"
[782]186
187! Input arguments
188!****************************************************************************************
189    INTEGER, INTENT(IN)                      :: itime, knon
190    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
191    LOGICAL, INTENT(IN)                      :: lafin
192    REAL, INTENT(IN)                         :: dtime
193    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
[888]194    REAL, DIMENSION(klon), INTENT(IN)        :: swnet
195    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet
196    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
[782]197    REAL, DIMENSION(klon), INTENT(IN)        :: fder_old
198    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
199    REAL, DIMENSION(klon), INTENT(IN)        :: tq_cdrag
200    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
201    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
202    REAL, DIMENSION(klon), INTENT(IN)        :: petAcoef, peqAcoef
203    REAL, DIMENSION(klon), INTENT(IN)        :: petBcoef, peqBcoef
204    REAL, DIMENSION(klon), INTENT(IN)        :: ps
205    REAL, DIMENSION(klon), INTENT(IN)        :: u1_lay, v1_lay
[996]206    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
[782]207
208! In/output arguments
209!****************************************************************************************
210    REAL, DIMENSION(klon), INTENT(INOUT)     :: radsol
211    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
212
213! Output arguments
214!****************************************************************************************
215    REAL, DIMENSION(klon), INTENT(OUT)       :: qsurf
[888]216    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new, alb2_new
[782]217    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
[888]218    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
[782]219    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
220
221! Local variables
222!****************************************************************************************
223    INTEGER                 :: i
224    INTEGER, DIMENSION(1)   :: iloc
225    LOGICAL                 :: check=.FALSE.
226    REAL, PARAMETER         :: t_grnd=271.35
227    REAL, DIMENSION(klon)   :: cal, beta, dif_grnd
228    REAL, DIMENSION(klon)   :: tsurf_cpl, fder_new
229    REAL, DIMENSION(klon)   :: taux, tauy
[888]230    REAL, DIMENSION(klon)   :: alb_cpl
[782]231
232! End definitions
233!****************************************************************************************
234   
235    IF (check) WRITE(*,*)'Entering surface_seaice, knon=',knon
236
237!****************************************************************************************
[996]238! Receive ocean temperature(tsurf_cpl) and albedo(alb_new) from coupler
[782]239!
240!****************************************************************************************
241
242    CALL cpl_receive_seaice_fields(knon, knindex, &
[996]243         tsurf_cpl, alb_cpl)
[888]244
245    alb1_new(1:knon) = alb_cpl(1:knon)
246    alb2_new(1:knon) = alb_cpl(1:knon)   
247
[782]248   
249!****************************************************************************************
250! Calculate fluxes at surface
251!
252!****************************************************************************************
253    cal = 0.
254    dif_grnd = 0.
255    beta = 1.0
256   
257
258    CALL calcul_fluxs(knon, is_sic, dtime, &
259         tsurf_cpl, p1lay, cal, beta, tq_cdrag, ps, &
260         precip_rain, precip_snow, snow, qsurf,  &
261         radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
262         petAcoef, peqAcoef, petBcoef, peqBcoef, &
263         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
264
265    ! Calcultate the flux of u and v at surface
[803]266    CALL calcul_wind_flux(knon, dtime, taux, tauy)
267   
[996]268   
[782]269!****************************************************************************************
270! Calculate fder : flux derivative (sensible and latente)
271!
272!****************************************************************************************
273    fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
274   
275    iloc = MAXLOC(fder_new(1:klon))
276    IF (check .AND. fder_new(iloc(1))> 0.) THEN
277       WRITE(*,*)'**** Debug fder ****'
278       WRITE(*,*)'max fder(',iloc(1),') = ',fder_new(iloc(1))
279       WRITE(*,*)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
280            dflux_s(iloc(1)), dflux_l(iloc(1))
281    ENDIF
282
283!****************************************************************************************
284! Send and cumulate fields to the coupler
285!
286!****************************************************************************************
287
288    CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, &
[996]289       pctsrf, lafin, rlon, rlat, &
[888]290       swnet, lwnet, fluxlat, fluxsens, &
291       precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, taux, tauy)
[782]292 
293
294  END SUBROUTINE ocean_cpl_ice
295! 
296!****************************************************************************************
297!
298END MODULE ocean_cpl_mod
Note: See TracBrowser for help on using the repository browser.