source: LMDZ6/branches/Ocean_skin/libf/phylmd/cpl_mod.F90 @ 3628

Last change on this file since 3628 was 3628, checked in by lguez, 4 years ago

If the ocean skin parameterization is working actively
(activate_ocean_skin == 2) and we are coupled to the ocean then send
ocean-air interface salinity to the ocean. New dummy argument s_int
of procedures ocean_cpl_noice and cpl_send_ocean_fields. We can
only send interface salinity from the previous time-step since
communication with the ocean is before the call to bulk_flux. So make
s_int a state variable: move s_int from phys_output_var_mod to
phys_state_var_mod. Still, we only read s_int from startphy,
define it before the call to surf_ocean and write it to restartphy
if activate_ocean_skin == 2 and type_ocean == 'couple'. In
procedure pbl_surface, for clarity, move the definition of output
variables t_int, dter, dser, tkt, tks, rf, taur to missing_val to
after the call to surf_ocean, with the definition of s_int,
ds_ns, dt_ns to missing_val. This does not change anything for
t_int, dter, dser, tkt, tks, rf, taur. In pbl_surface_newfrac, we
choose to set s_int to 35 for an appearing ocean point, this is
questionable. In surf_ocean, change the intent of s_int from out
to inout.

  • 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:keywords set to Author Date Id Revision
File size: 64.5 KB
RevLine 
[782]1!
2MODULE cpl_mod
3!
4! This module excahanges and transforms all fields that should be recieved or sent to
5! coupler. The transformation of the fields are done from the grid 1D-array in phylmd
6! to the regular 2D grid accepted by the coupler. Cumulation of the fields for each
7! timestep is done in here.
8!
9! Each type of surface that recevie fields from the coupler have a subroutine named
10! cpl_receive_XXX_fields and each surface that have fields to be sent to the coupler
11! have a subroutine named cpl_send_XXX_fields.
12!
13!*************************************************************************************
14
15! Use statements
16!*************************************************************************************
[836]17  USE dimphy, ONLY : klon
[782]18  USE mod_phys_lmdz_para
19  USE ioipsl
20  USE iophy
21
22! The module oasis is always used. Without the cpp key CPP_COUPLE only the parameters
23! in the module are compiled and not the subroutines.
24  USE oasis
25  USE write_field_phy
[2344]26  USE time_phylmdz_mod, ONLY: day_step_phy
[782]27 
28! Global attributes
29!*************************************************************************************
30  IMPLICIT NONE
31  PRIVATE
32
[996]33  ! All subroutine are public except cpl_send_all
34  PUBLIC :: cpl_init, cpl_receive_frac, cpl_receive_ocean_fields, cpl_receive_seaice_fields, &
[782]35       cpl_send_ocean_fields, cpl_send_seaice_fields, cpl_send_land_fields, &
36       cpl_send_landice_fields, gath2cpl
37 
38
39! Declaration of module variables
40!*************************************************************************************
41! variable for coupling period
[1279]42  INTEGER, SAVE :: nexca
[782]43  !$OMP THREADPRIVATE(nexca)
44
45! variables for cumulating fields during a coupling periode :
46  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_sols, cpl_nsol, cpl_rain
47  !$OMP THREADPRIVATE(cpl_sols,cpl_nsol,cpl_rain)
48  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_snow, cpl_evap, cpl_tsol
49  !$OMP THREADPRIVATE(cpl_snow,cpl_evap,cpl_tsol)
[3627]50
[3628]51  REAL, ALLOCATABLE, SAVE:: cpl_t_int(:), cpl_s_int(:)
52  !$OMP THREADPRIVATE(cpl_t_int, cpl_s_int)
[3627]53 
[1279]54  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_fder, cpl_albe, cpl_taux, cpl_tauy
55  !$OMP THREADPRIVATE(cpl_fder,cpl_albe,cpl_taux,cpl_tauy)
[782]56  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_windsp
57  !$OMP THREADPRIVATE(cpl_windsp)
[2872]58  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_sens_rain, cpl_sens_snow
59  !$OMP THREADPRIVATE(cpl_sens_rain, cpl_sens_snow)
[1279]60  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_taumod
61  !$OMP THREADPRIVATE(cpl_taumod)
62  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_atm_co2
63  !$OMP THREADPRIVATE(cpl_atm_co2)
[782]64  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_rriv2D, cpl_rcoa2D, cpl_rlic2D
65  !$OMP THREADPRIVATE(cpl_rriv2D,cpl_rcoa2D,cpl_rlic2D)
66
67! variables read from coupler :
68  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: read_sst     ! sea surface temperature
69  !$OMP THREADPRIVATE(read_sst)
70  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: read_sit     ! sea ice temperature
71  !$OMP THREADPRIVATE(read_sit)
[3627]72
73  REAL, ALLOCATABLE, SAVE:: read_sss(:, :)
74  ! bulk salinity of the surface layer of the ocean, in ppt
75  !$OMP THREADPRIVATE(read_sss)
76
[782]77  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: read_sic     ! sea ice fraction
78  !$OMP THREADPRIVATE(read_sic)
79  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: read_alb_sic ! albedo at sea ice
80  !$OMP THREADPRIVATE(read_alb_sic)
[1067]81  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: read_u0, read_v0 ! ocean surface current
82  !$OMP THREADPRIVATE(read_u0,read_v0)
[1279]83  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: read_co2     ! ocean co2 flux
84  !$OMP THREADPRIVATE(read_co2)
[782]85  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE  :: unity
86  !$OMP THREADPRIVATE(unity)
87  INTEGER, SAVE                             :: nidct, nidcs
88  !$OMP THREADPRIVATE(nidct,nidcs)
89
90! variables to be sent to the coupler
91  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_sols2D, cpl_nsol2D, cpl_rain2D
92  !$OMP THREADPRIVATE(cpl_sols2D, cpl_nsol2D, cpl_rain2D)
93  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_snow2D, cpl_evap2D, cpl_tsol2D
94  !$OMP THREADPRIVATE(cpl_snow2D, cpl_evap2D, cpl_tsol2D)
[3627]95
[3628]96  REAL, ALLOCATABLE, SAVE:: cpl_t_int_2D(:,:), cpl_s_int_2D(:,:)
97  !$OMP THREADPRIVATE(cpl_t_int_2D, cpl_s_int_2D)
[3627]98
[782]99  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_fder2D, cpl_albe2D
100  !$OMP THREADPRIVATE(cpl_fder2D, cpl_albe2D)
101  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_taux2D, cpl_tauy2D
102  !$OMP THREADPRIVATE(cpl_taux2D, cpl_tauy2D)
[1279]103  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_taumod2D
104  !$OMP THREADPRIVATE(cpl_taumod2D)
[782]105  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_windsp2D
106  !$OMP THREADPRIVATE(cpl_windsp2D)
[2872]107  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE   :: cpl_sens_rain2D, cpl_sens_snow2D
108  !$OMP THREADPRIVATE(cpl_sens_rain2D, cpl_sens_snow2D)
[1279]109  REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: cpl_atm_co22D
110  !$OMP THREADPRIVATE(cpl_atm_co22D)
[1001]111
[3605]112!!!!!!!!!! variable for calving
113  INTEGER, PARAMETER :: nb_zone_calving = 3
114  REAL,ALLOCATABLE, DIMENSION(:,:,:),SAVE :: area_calving
115  !$OMP THREADPRIVATE(area_calving)
116  REAL,ALLOCATABLE, DIMENSION(:,:),SAVE :: cell_area2D
117  !$OMP THREADPRIVATE(cell_area2D)
118  INTEGER, SAVE :: ind_calving(nb_zone_calving)
119  !$OMP THREADPRIVATE(ind_calving)
120
121  LOGICAL,SAVE :: cpl_old_calving
122  !$OMP THREADPRIVATE(cpl_old_calving)
123 
[782]124CONTAINS
125!
126!************************************************************************************
127!
128  SUBROUTINE cpl_init(dtime, rlon, rlat)
[1279]129    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_ocn_day
[1454]130    USE surface_data
[1785]131    USE indice_sol_mod
[3605]132    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid1dTo2d_glo, klon_glo, grid_type, unstructured, regular_lonlat
[2344]133    USE time_phylmdz_mod, ONLY: annee_ref, day_ini, itau_phy, itaufin_phy
[2311]134    USE print_control_mod, ONLY: lunout
[3605]135    USE geometry_mod, ONLY : longitude_deg, latitude_deg, ind_cell_glo, cell_area
136    USE ioipsl_getin_p_mod, ONLY: getin_p
[3627]137    use config_ocean_skin_m, only: activate_ocean_skin
[782]138
139! Input arguments
140!*************************************************************************************
141    REAL, INTENT(IN)                  :: dtime
142    REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
143
144! Local variables
145!*************************************************************************************
146    INTEGER                           :: error, sum_error, ig, i
147    INTEGER                           :: jf, nhoridct
148    INTEGER                           :: nhoridcs
149    INTEGER                           :: idtime
150    INTEGER                           :: idayref
151    INTEGER                           :: npas ! only for OASIS2
152    REAL                              :: zjulian
[2344]153    REAL, DIMENSION(nbp_lon,nbp_lat)  :: zx_lon, zx_lat
[782]154    CHARACTER(len = 20)               :: modname = 'cpl_init'
155    CHARACTER(len = 80)               :: abort_message
156    CHARACTER(len=80)                 :: clintocplnam, clfromcplnam
[3605]157    REAL, DIMENSION(klon_mpi)         :: rlon_mpi, rlat_mpi, cell_area_mpi
158    INTEGER, DIMENSION(klon_mpi)           :: ind_cell_glo_mpi
159    REAL, DIMENSION(nbp_lon,jj_nb)         :: lon2D, lat2D
160    INTEGER :: mask_calving(nbp_lon,jj_nb,nb_zone_calving)
161    REAL :: pos
[782]162
[3605]163!***************************************
164! Use old calving or not (default new calving method)
165! New calving method should be used with DYNAMICO and when using new coupling
166! weights.
167    cpl_old_calving=.FALSE.
168    CALL getin_p("cpl_old_calving",cpl_old_calving)
169
170
[782]171!*************************************************************************************
172! Calculate coupling period
173!
174!*************************************************************************************
175     
[2344]176    npas = itaufin_phy
[2075]177!    nexca = 86400 / dtime
178    nexca = t_coupl / dtime
[782]179    WRITE(lunout,*)' ##### Ocean couple #####'
180    WRITE(lunout,*)' Valeurs des pas de temps'
181    WRITE(lunout,*)' npas = ', npas
182    WRITE(lunout,*)' nexca = ', nexca
183   
184!*************************************************************************************
185! Allocate variables
186!
187!*************************************************************************************
188    error = 0
189    sum_error = 0
190
191    ALLOCATE(unity(klon), stat = error)
192    sum_error = sum_error + error
193    ALLOCATE(cpl_sols(klon,2), stat = error)
194    sum_error = sum_error + error
195    ALLOCATE(cpl_nsol(klon,2), stat = error)
196    sum_error = sum_error + error
197    ALLOCATE(cpl_rain(klon,2), stat = error)
198    sum_error = sum_error + error
199    ALLOCATE(cpl_snow(klon,2), stat = error)
200    sum_error = sum_error + error
201    ALLOCATE(cpl_evap(klon,2), stat = error)
202    sum_error = sum_error + error
203    ALLOCATE(cpl_tsol(klon,2), stat = error)
204    sum_error = sum_error + error
205    ALLOCATE(cpl_fder(klon,2), stat = error)
206    sum_error = sum_error + error
207    ALLOCATE(cpl_albe(klon,2), stat = error)
208    sum_error = sum_error + error
209    ALLOCATE(cpl_taux(klon,2), stat = error)
210    sum_error = sum_error + error
[1279]211    ALLOCATE(cpl_tauy(klon,2), stat = error)
212    sum_error = sum_error + error
[782]213    ALLOCATE(cpl_windsp(klon,2), stat = error)
214    sum_error = sum_error + error
[2545]215    ALLOCATE(cpl_taumod(klon,2), stat = error)
[782]216    sum_error = sum_error + error
[2872]217    ALLOCATE(cpl_sens_rain(klon,2), stat = error)
218    sum_error = sum_error + error
219    ALLOCATE(cpl_sens_snow(klon,2), stat = error)
220    sum_error = sum_error + error
[2344]221    ALLOCATE(cpl_rriv2D(nbp_lon,jj_nb), stat=error)
[782]222    sum_error = sum_error + error
[2344]223    ALLOCATE(cpl_rcoa2D(nbp_lon,jj_nb), stat=error)
[782]224    sum_error = sum_error + error
[2344]225    ALLOCATE(cpl_rlic2D(nbp_lon,jj_nb), stat=error)
[782]226    sum_error = sum_error + error
[2344]227    ALLOCATE(read_sst(nbp_lon, jj_nb), stat = error)
[782]228    sum_error = sum_error + error
[2344]229    ALLOCATE(read_sic(nbp_lon, jj_nb), stat = error)
[782]230    sum_error = sum_error + error
[2344]231    ALLOCATE(read_sit(nbp_lon, jj_nb), stat = error)
[782]232    sum_error = sum_error + error
[3627]233
234    if (activate_ocean_skin >= 1) then
235       ALLOCATE(read_sss(nbp_lon, jj_nb), stat = error)
236       sum_error = sum_error + error
237   
238       if (activate_ocean_skin == 2) then
[3628]239          ALLOCATE(cpl_t_int(klon), cpl_s_int(klon), stat = error)
[3627]240          sum_error = sum_error + error
241       end if
242    end if
243
[2344]244    ALLOCATE(read_alb_sic(nbp_lon, jj_nb), stat = error)
[782]245    sum_error = sum_error + error
[2344]246    ALLOCATE(read_u0(nbp_lon, jj_nb), stat = error)
[1067]247    sum_error = sum_error + error
[2344]248    ALLOCATE(read_v0(nbp_lon, jj_nb), stat = error)
[1067]249    sum_error = sum_error + error
250
[1279]251    IF (carbon_cycle_cpl) THEN
[2344]252       ALLOCATE(read_co2(nbp_lon, jj_nb), stat = error)
[1279]253       sum_error = sum_error + error
254       ALLOCATE(cpl_atm_co2(klon,2), stat = error)
255       sum_error = sum_error + error
256
257! Allocate variable in carbon_cycle_mod
[3605]258       IF (.NOT.ALLOCATED(fco2_ocn_day)) ALLOCATE(fco2_ocn_day(klon), stat = error)
[1279]259       sum_error = sum_error + error
[3605]260    ENDIF
[1279]261
[3605]262! calving initialization
263    ALLOCATE(area_calving(nbp_lon, jj_nb, nb_zone_calving), stat = error)
264    sum_error = sum_error + error
265    ALLOCATE(cell_area2D(nbp_lon, jj_nb), stat = error)   
266    sum_error = sum_error + error
267
268
269    CALL gather_omp(longitude_deg,rlon_mpi)
270    CALL gather_omp(latitude_deg,rlat_mpi)
271    CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi)
272    CALL gather_omp(cell_area,cell_area_mpi)
273     
274    IF (is_omp_master) THEN
275      CALL Grid1DTo2D_mpi(rlon_mpi,lon2D)
276      CALL Grid1DTo2D_mpi(rlat_mpi,lat2D)
277      CALL Grid1DTo2D_mpi(cell_area_mpi,cell_area2D)
278      mask_calving(:,:,:) = 0
279      WHERE ( lat2D >= 40) mask_calving(:,:,1) = 1
280      WHERE ( lat2D < 40 .AND. lat2D > -50) mask_calving(:,:,2) = 1
281      WHERE ( lat2D <= -50) mask_calving(:,:,3) = 1
282   
283   
284      DO i=1,nb_zone_calving
285        area_calving(:,:,i)=mask_calving(:,:,i)*cell_area2D(:,:)
286        pos=1
287        IF (i>1) pos = 1 + ((nbp_lon*nbp_lat-1)*(i-1))/(nb_zone_calving-1)
288     
289        ind_calving(i)=0
290        IF (grid_type==unstructured) THEN
291
292          DO ig=1,klon_mpi
293            IF (ind_cell_glo_mpi(ig)==pos) ind_calving(i)=ig
294          ENDDO
295
296        ELSE IF (grid_type==regular_lonlat) THEN
297          IF ((ij_begin<=pos .AND. ij_end>=pos) .OR. (ij_begin<=pos .AND. is_south_pole_dyn )) THEN
298            ind_calving(i)=pos-(jj_begin-1)*nbp_lon
299          ENDIF
300        ENDIF
301     
302      ENDDO
303    ENDIF
304   
305           
[782]306    IF (sum_error /= 0) THEN
307       abort_message='Pb allocation variables couplees'
[2311]308       CALL abort_physic(modname,abort_message,1)
[782]309    ENDIF
310!*************************************************************************************
311! Initialize the allocated varaibles
312!
313!*************************************************************************************
314    DO ig = 1, klon
315       unity(ig) = ig
316    ENDDO
317
318!*************************************************************************************
319! Initialize coupling
320!
321!*************************************************************************************
322    idtime = INT(dtime)
323#ifdef CPP_COUPLE
324    CALL inicma
325#endif
326
327!*************************************************************************************
328! initialize NetCDF output
329!
330!*************************************************************************************
331    IF (is_sequential) THEN
332       idayref = day_ini
333       CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
[3605]334       CALL grid1dTo2d_glo(rlon,zx_lon)
[2344]335       DO i = 1, nbp_lon
[782]336          zx_lon(i,1) = rlon(i+1)
[2344]337          zx_lon(i,nbp_lat) = rlon(i+1)
[782]338       ENDDO
[3605]339       CALL grid1dTo2d_glo(rlat,zx_lat)
[782]340       clintocplnam="cpl_atm_tauflx"
[2344]341       CALL histbeg(clintocplnam,nbp_lon,zx_lon(:,1),nbp_lat,zx_lat(1,:),&
342            1,nbp_lon,1,nbp_lat, itau_phy,zjulian,dtime,nhoridct,nidct)
[782]343! no vertical axis
344       CALL histdef(nidct, 'tauxe','tauxe', &
[2344]345            "-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
[782]346       CALL histdef(nidct, 'tauyn','tauyn', &
[2344]347            "-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
[782]348       CALL histdef(nidct, 'tmp_lon','tmp_lon', &
[2344]349            "-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
[782]350       CALL histdef(nidct, 'tmp_lat','tmp_lat', &
[2344]351            "-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
[1279]352       DO jf=1,maxsend
353         IF (infosend(i)%action) THEN
354             CALL histdef(nidct, infosend(i)%name ,infosend(i)%name , &
[2344]355                "-",nbp_lon,nbp_lat,nhoridct,1,1,1,-99,32,"inst",dtime,dtime)
[1279]356         ENDIF
[3605]357       ENDDO
[782]358       CALL histend(nidct)
359       CALL histsync(nidct)
360       
361       clfromcplnam="cpl_atm_sst"
[2344]362       CALL histbeg(clfromcplnam,nbp_lon,zx_lon(:,1),nbp_lat,zx_lat(1,:),1,nbp_lon,1,nbp_lat, &
[782]363            0,zjulian,dtime,nhoridcs,nidcs)
364! no vertical axis
[1279]365       DO jf=1,maxrecv
366         IF (inforecv(i)%action) THEN
367             CALL histdef(nidcs,inforecv(i)%name ,inforecv(i)%name , &
[2344]368                "-",nbp_lon,nbp_lat,nhoridcs,1,1,1,-99,32,"inst",dtime,dtime)
[1279]369         ENDIF
[3605]370       ENDDO
[782]371       CALL histend(nidcs)
372       CALL histsync(nidcs)
373
374    ENDIF    ! is_sequential
375   
[1454]376
377!*************************************************************************************
378! compatibility test
379!
380!*************************************************************************************
381    IF (carbon_cycle_cpl .AND. version_ocean=='opa8') THEN
382       abort_message='carbon_cycle_cpl does not work with opa8'
[2311]383       CALL abort_physic(modname,abort_message,1)
[3605]384    ENDIF
[1454]385
[782]386  END SUBROUTINE cpl_init
387 
388!
389!*************************************************************************************
390!
[996]391 
392  SUBROUTINE cpl_receive_frac(itime, dtime, pctsrf, is_modified)
393! This subroutine receives from coupler for both ocean and seaice
[782]394! 4 fields : read_sst, read_sic, read_sit and read_alb_sic.
[996]395! The new sea-ice-land-landice fraction is returned. The others fields
396! are stored in this module.
397    USE surface_data
[2399]398    USE geometry_mod, ONLY : longitude_deg, latitude_deg
[1279]399    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
[1785]400    USE indice_sol_mod
[2344]401    USE time_phylmdz_mod, ONLY: start_time, itau_phy
402    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
[3627]403    use config_ocean_skin_m, only: activate_ocean_skin
[1785]404
[793]405    INCLUDE "YOMCST.h"
[782]406
[996]407! Arguments
[782]408!************************************************************************************
[996]409    INTEGER, INTENT(IN)                        :: itime
410    REAL, INTENT(IN)                           :: dtime
411    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: pctsrf
412    LOGICAL, INTENT(OUT)                       :: is_modified
[782]413
414! Local variables
415!************************************************************************************
[996]416    INTEGER                                 :: j, i, time_sec
[782]417    INTEGER                                 :: itau_w
[2344]418    INTEGER, DIMENSION(nbp_lon*nbp_lat)     :: ndexcs
[996]419    CHARACTER(len = 20)                     :: modname = 'cpl_receive_frac'
[782]420    CHARACTER(len = 80)                     :: abort_message
421    REAL, DIMENSION(klon)                   :: read_sic1D
[2344]422    REAL, DIMENSION(nbp_lon,jj_nb,maxrecv)      :: tab_read_flds
[996]423    REAL, DIMENSION(klon,nbsrf)             :: pctsrf_old
[1067]424    REAL, DIMENSION(klon_mpi)               :: rlon_mpi, rlat_mpi
[2344]425    REAL, DIMENSION(nbp_lon,jj_nb)             :: tmp_lon, tmp_lat
426    REAL, DIMENSION(nbp_lon,jj_nb)             :: tmp_r0
[782]427
428!*************************************************************************************
429! Start calculation
430! Get fields from coupler
431!
432!*************************************************************************************
433
[996]434    is_modified=.FALSE.
435
[1279]436! Check if right moment to receive from coupler
[996]437    IF (MOD(itime, nexca) == 1) THEN
438       is_modified=.TRUE.
439 
440       time_sec=(itime-1)*dtime
[782]441#ifdef CPP_COUPLE
[987]442!$OMP MASTER
[1010]443    CALL fromcpl(time_sec, tab_read_flds)
[987]444!$OMP END MASTER
[782]445#endif
446   
447! NetCDF output of received fields
[996]448       IF (is_sequential) THEN
449          ndexcs(:) = 0
[2344]450          itau_w = itau_phy + itime + start_time * day_step_phy
[1279]451          DO i = 1, maxrecv
452            IF (inforecv(i)%action) THEN
[2344]453                CALL histwrite(nidcs,inforecv(i)%name,itau_w,tab_read_flds(:,:,i),nbp_lon*(nbp_lat),ndexcs)
[1279]454            ENDIF
[3605]455          ENDDO
[996]456       ENDIF
[782]457
[1001]458
[996]459! Save each field in a 2D array.
[987]460!$OMP MASTER
[1279]461       read_sst(:,:)     = tab_read_flds(:,:,idr_sisutw)  ! Sea surface temperature
462       read_sic(:,:)     = tab_read_flds(:,:,idr_icecov)  ! Sea ice concentration
463       read_alb_sic(:,:) = tab_read_flds(:,:,idr_icealw)  ! Albedo at sea ice
464       read_sit(:,:)     = tab_read_flds(:,:,idr_icetem)  ! Sea ice temperature
[3627]465       if (activate_ocean_skin >= 1) read_sss(:,:) = tab_read_flds(:,:,idr_sss)
[996]466!$OMP END MASTER
[987]467
[1067]468       IF (cpl_current) THEN
469
470! Transform the longitudes and latitudes on 2D arrays
[2399]471          CALL gather_omp(longitude_deg,rlon_mpi)
472          CALL gather_omp(latitude_deg,rlat_mpi)
[1067]473!$OMP MASTER
474          CALL Grid1DTo2D_mpi(rlon_mpi,tmp_lon)
475          CALL Grid1DTo2D_mpi(rlat_mpi,tmp_lat)
476
477! Transform the currents from cartesian to spheric coordinates
478! tmp_r0 should be zero
[2344]479          CALL geo2atm(nbp_lon, jj_nb, tab_read_flds(:,:,idr_curenx), &
[1279]480             tab_read_flds(:,:,idr_cureny), tab_read_flds(:,:,idr_curenz), &
[1067]481               tmp_lon, tmp_lat, &
482               read_u0(:,:), read_v0(:,:), tmp_r0(:,:))
483!$OMP END MASTER
[1146]484
[1279]485      ELSE
[1067]486          read_u0(:,:) = 0.
487          read_v0(:,:) = 0.
[1279]488      ENDIF
489
490       IF (carbon_cycle_cpl) THEN
491!$OMP MASTER
492           read_co2(:,:) = tab_read_flds(:,:,idr_oceco2) ! CO2 flux
493!$OMP END MASTER
[1067]494       ENDIF
495
[782]496!*************************************************************************************
[996]497!  Transform seaice fraction (read_sic : ocean-seaice mask) into global
498!  fraction (pctsrf : ocean-seaice-land-landice mask)
[782]499!
500!*************************************************************************************
[996]501       CALL cpl2gath(read_sic, read_sic1D, klon, unity)
502
503       pctsrf_old(:,:) = pctsrf(:,:)
504       DO i = 1, klon
505          ! treatment only of points with ocean and/or seaice
[1279]506          ! old land-ocean mask can not be changed
[996]507          IF (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic) > 0.) THEN
508             pctsrf(i,is_sic) = (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic)) &
509                  * read_sic1D(i)
510             pctsrf(i,is_oce) = (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic)) &
511                  - pctsrf(i,is_sic)
[782]512          ENDIF
513       ENDDO
[987]514
[3605]515    ENDIF ! if time to receive
[782]516
[996]517  END SUBROUTINE cpl_receive_frac
[782]518
519!
520!*************************************************************************************
521!
[996]522
[3627]523  SUBROUTINE cpl_receive_ocean_fields(knon, knindex, tsurf_new, u0_new, &
524       v0_new, sss)
[782]525!
[996]526! This routine returns the field for the ocean that has been read from the coupler
527! (done earlier with cpl_receive_frac). The field is the temperature.
528! The temperature is transformed into 1D array with valid points from index 1 to knon.
[782]529!
[1279]530    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_ocn_day
[1785]531    USE indice_sol_mod
[3627]532    use config_ocean_skin_m, only: activate_ocean_skin
[782]533
534! Input arguments
535!*************************************************************************************
536    INTEGER, INTENT(IN)                     :: knon
537    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
538
539! Output arguments
540!*************************************************************************************
541    REAL, DIMENSION(klon), INTENT(OUT)      :: tsurf_new
[3627]542
543    REAL, INTENT(OUT):: sss(:) ! (klon)
544    ! bulk salinity of the surface layer of the ocean, in ppt
545
[1067]546    REAL, DIMENSION(klon), INTENT(OUT)      :: u0_new
547    REAL, DIMENSION(klon), INTENT(OUT)      :: v0_new
[782]548
[996]549! Local variables
[782]550!*************************************************************************************
[1279]551    INTEGER                  :: i
552    INTEGER, DIMENSION(klon) :: index
553    REAL, DIMENSION(klon)    :: sic_new
[782]554
555!*************************************************************************************
556! Transform read_sst into compressed 1D variable tsurf_new
557!
558!*************************************************************************************
559    CALL cpl2gath(read_sst, tsurf_new, knon, knindex)
[3627]560    if (activate_ocean_skin >= 1) CALL cpl2gath(read_sss, sss, knon, knindex)
[996]561    CALL cpl2gath(read_sic, sic_new, knon, knindex)
[1067]562    CALL cpl2gath(read_u0, u0_new, knon, knindex)
563    CALL cpl2gath(read_v0, v0_new, knon, knindex)
[782]564
[996]565!*************************************************************************************
[1279]566! Transform read_co2 into uncompressed 1D variable fco2_ocn_day added directly in
567! the module carbon_cycle_mod
568!
569!*************************************************************************************
570    IF (carbon_cycle_cpl) THEN
571       DO i=1,klon
572          index(i)=i
[3605]573       ENDDO
[1279]574       CALL cpl2gath(read_co2, fco2_ocn_day, klon, index)
[3605]575    ENDIF
[1279]576
577!*************************************************************************************
[996]578! The fields received from the coupler have to be weighted with the fraction of ocean
579! in relation to the total sea-ice+ocean
580!
581!*************************************************************************************
582    DO i=1, knon
583       tsurf_new(i) = tsurf_new(i)/(1. - sic_new(i))
[3605]584    ENDDO
[782]585
586  END SUBROUTINE cpl_receive_ocean_fields
[996]587
[782]588!
589!*************************************************************************************
590!
[996]591
[782]592  SUBROUTINE cpl_receive_seaice_fields(knon, knindex, &
[1146]593       tsurf_new, alb_new, u0_new, v0_new)
[782]594!
595! This routine returns the fields for the seaice that have been read from the coupler
[996]596! (done earlier with cpl_receive_frac). These fields are the temperature and
[782]597! albedo at sea ice surface and fraction of sea ice.
[996]598! The fields are transformed into 1D arrays with valid points from index 1 to knon.
[782]599!
600
601! Input arguments
602!*************************************************************************************
603    INTEGER, INTENT(IN)                     :: knon
604    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
605
606! Output arguments
607!*************************************************************************************
608    REAL, DIMENSION(klon), INTENT(OUT)      :: tsurf_new
609    REAL, DIMENSION(klon), INTENT(OUT)      :: alb_new
[1146]610    REAL, DIMENSION(klon), INTENT(OUT)      :: u0_new
611    REAL, DIMENSION(klon), INTENT(OUT)      :: v0_new
[782]612
[996]613! Local variables
614!*************************************************************************************
615    INTEGER               :: i
616    REAL, DIMENSION(klon) :: sic_new
[782]617
618!*************************************************************************************
619! Transform fields read from coupler from 2D into compressed 1D variables
620!
621!*************************************************************************************
622    CALL cpl2gath(read_sit, tsurf_new, knon, knindex)
623    CALL cpl2gath(read_alb_sic, alb_new, knon, knindex)
[996]624    CALL cpl2gath(read_sic, sic_new, knon, knindex)
[1146]625    CALL cpl2gath(read_u0, u0_new, knon, knindex)
626    CALL cpl2gath(read_v0, v0_new, knon, knindex)
[782]627
[996]628!*************************************************************************************
629! The fields received from the coupler have to be weighted with the sea-ice
630! concentration (in relation to the total sea-ice + ocean).
631!
632!*************************************************************************************
633    DO i= 1, knon
634       tsurf_new(i) = tsurf_new(i) / sic_new(i)
635       alb_new(i)   = alb_new(i)   / sic_new(i)
[3605]636    ENDDO
[996]637
[782]638  END SUBROUTINE cpl_receive_seaice_fields
639
640!
641!*************************************************************************************
642!
643
644  SUBROUTINE cpl_send_ocean_fields(itime, knon, knindex, &
645       swdown, lwdown, fluxlat, fluxsens, &
[2872]646       precip_rain, precip_snow, evap, tsurf, fder, albsol, taux, tauy, windsp,&
[3628]647       sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, t_int, s_int)
[3627]648
649    ! This subroutine cumulates some fields for each time-step during
650    ! a coupling period. At last time-step in a coupling period the
651    ! fields are transformed to the grid accepted by the coupler. No
652    ! sending to the coupler will be done from here (it is done in
653    ! cpl_send_seaice_fields). Crucial hypothesis is that the surface
654    ! fractions do not change between coupling time-steps.
655
[1279]656    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send
[1785]657    USE indice_sol_mod
[2344]658    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
[3627]659    use config_ocean_skin_m, only: activate_ocean_skin
[782]660
661! Input arguments
662!*************************************************************************************
663    INTEGER, INTENT(IN)                     :: itime
664    INTEGER, INTENT(IN)                     :: knon
665    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
666    REAL, DIMENSION(klon), INTENT(IN)       :: swdown, lwdown
667    REAL, DIMENSION(klon), INTENT(IN)       :: fluxlat, fluxsens
668    REAL, DIMENSION(klon), INTENT(IN)       :: precip_rain, precip_snow
669    REAL, DIMENSION(klon), INTENT(IN)       :: evap, tsurf, fder, albsol
670    REAL, DIMENSION(klon), INTENT(IN)       :: taux, tauy, windsp
[2872]671    REAL, DIMENSION(klon), INTENT(IN)       :: sens_prec_liq, sens_prec_sol
672    REAL, DIMENSION(klon), INTENT(IN)       :: lat_prec_liq, lat_prec_sol
[3627]673    real, intent(in):: t_int(:) ! (klon) ocean-air interface temperature, in K
[3628]674    real, intent(in):: s_int(:) ! (knon) ocean-air interface salinity, in ppt
[782]675
676! Local variables
677!*************************************************************************************
678    INTEGER                                 :: cpl_index, ig
679    INTEGER                                 :: error, sum_error
680    CHARACTER(len = 25)                     :: modname = 'cpl_send_ocean_fields'
681    CHARACTER(len = 80)                     :: abort_message
682
683!*************************************************************************************
684! Start calculation
685! The ocean points are saved with second array index=1
686!
687!*************************************************************************************
688    cpl_index = 1
689
690!*************************************************************************************
691! Reset fields to zero in the beginning of a new coupling period
692!
693!*************************************************************************************
694    IF (MOD(itime, nexca) == 1) THEN
[996]695       cpl_sols(1:knon,cpl_index) = 0.0
696       cpl_nsol(1:knon,cpl_index) = 0.0
697       cpl_rain(1:knon,cpl_index) = 0.0
698       cpl_snow(1:knon,cpl_index) = 0.0
699       cpl_evap(1:knon,cpl_index) = 0.0
700       cpl_tsol(1:knon,cpl_index) = 0.0
701       cpl_fder(1:knon,cpl_index) = 0.0
702       cpl_albe(1:knon,cpl_index) = 0.0
703       cpl_taux(1:knon,cpl_index) = 0.0
704       cpl_tauy(1:knon,cpl_index) = 0.0
705       cpl_windsp(1:knon,cpl_index) = 0.0
[2872]706       cpl_sens_rain(1:knon,cpl_index) = 0.0
707       cpl_sens_snow(1:knon,cpl_index) = 0.0
[1279]708       cpl_taumod(1:knon,cpl_index) = 0.0
709       IF (carbon_cycle_cpl) cpl_atm_co2(1:knon,cpl_index) = 0.0
[3628]710
711       if (activate_ocean_skin == 2) then
712          cpl_t_int(:knon) = 0.
713          cpl_s_int = 0.
714       end if
[782]715    ENDIF
716       
717!*************************************************************************************
718! Cumulate at each time-step
719!
720!*************************************************************************************   
721    DO ig = 1, knon
722       cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) + &
[1403]723            swdown(ig)      / REAL(nexca)
[782]724       cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) + &
[1403]725            (lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / REAL(nexca)
[782]726       cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) + &
[1403]727            precip_rain(ig) / REAL(nexca)
[782]728       cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) + &
[1403]729            precip_snow(ig) / REAL(nexca)
[782]730       cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) + &
[1403]731            evap(ig)        / REAL(nexca)
[782]732       cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) + &
[1403]733            tsurf(ig)       / REAL(nexca)
[782]734       cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) + &
[1403]735            fder(ig)        / REAL(nexca)
[782]736       cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) + &
[1403]737            albsol(ig)      / REAL(nexca)
[782]738       cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) + &
[1403]739            taux(ig)        / REAL(nexca)
[782]740       cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) + &
[1403]741            tauy(ig)        / REAL(nexca)     
[782]742       cpl_windsp(ig,cpl_index) = cpl_windsp(ig,cpl_index) + &
[1403]743            windsp(ig)      / REAL(nexca)
[2872]744       cpl_sens_rain(ig,cpl_index) = cpl_sens_rain(ig,cpl_index) + &
745            sens_prec_liq(ig)      / REAL(nexca)
746       cpl_sens_snow(ig,cpl_index) = cpl_sens_snow(ig,cpl_index) + &
747            sens_prec_sol(ig)      / REAL(nexca)
[1279]748       cpl_taumod(ig,cpl_index) =   cpl_taumod(ig,cpl_index) + &
[1403]749          SQRT ( taux(ig)*taux(ig)+tauy(ig)*tauy(ig) ) / REAL (nexca)
[782]750
[1279]751       IF (carbon_cycle_cpl) THEN
752          cpl_atm_co2(ig,cpl_index) = cpl_atm_co2(ig,cpl_index) + &
[1403]753               co2_send(knindex(ig))/ REAL(nexca)
[3605]754!!---OB: this is correct but why knindex ??
755       ENDIF
[3627]756
[3628]757       if (activate_ocean_skin == 2) then
758          cpl_t_int(ig) = cpl_t_int(ig) + t_int(ig) / REAL(nexca)
759          cpl_s_int(ig) = cpl_s_int(ig) + s_int(ig) / REAL(nexca)
760       end if
[1279]761     ENDDO
762
[782]763!*************************************************************************************
764! If the time-step corresponds to the end of coupling period the
765! fields are transformed to the 2D grid.
766! No sending to the coupler (it is done from cpl_send_seaice_fields).
767!
768!*************************************************************************************
769    IF (MOD(itime, nexca) == 0) THEN
770
771       IF (.NOT. ALLOCATED(cpl_sols2D)) THEN
772          sum_error = 0
[2344]773          ALLOCATE(cpl_sols2D(nbp_lon,jj_nb,2), stat=error)
[782]774          sum_error = sum_error + error
[2344]775          ALLOCATE(cpl_nsol2D(nbp_lon,jj_nb,2), stat=error)
[782]776          sum_error = sum_error + error
[2344]777          ALLOCATE(cpl_rain2D(nbp_lon,jj_nb,2), stat=error)
[782]778          sum_error = sum_error + error
[2344]779          ALLOCATE(cpl_snow2D(nbp_lon,jj_nb,2), stat=error)
[782]780          sum_error = sum_error + error
[2344]781          ALLOCATE(cpl_evap2D(nbp_lon,jj_nb,2), stat=error)
[782]782          sum_error = sum_error + error
[2344]783          ALLOCATE(cpl_tsol2D(nbp_lon,jj_nb,2), stat=error)
[782]784          sum_error = sum_error + error
[2344]785          ALLOCATE(cpl_fder2D(nbp_lon,jj_nb,2), stat=error)
[782]786          sum_error = sum_error + error
[2344]787          ALLOCATE(cpl_albe2D(nbp_lon,jj_nb,2), stat=error)
[782]788          sum_error = sum_error + error
[2344]789          ALLOCATE(cpl_taux2D(nbp_lon,jj_nb,2), stat=error)
[782]790          sum_error = sum_error + error
[2344]791          ALLOCATE(cpl_tauy2D(nbp_lon,jj_nb,2), stat=error)
[782]792          sum_error = sum_error + error
[2344]793          ALLOCATE(cpl_windsp2D(nbp_lon,jj_nb), stat=error)
[782]794          sum_error = sum_error + error
[2872]795          ALLOCATE(cpl_sens_rain2D(nbp_lon,jj_nb,2), stat=error)
796          sum_error = sum_error + error
797          ALLOCATE(cpl_sens_snow2D(nbp_lon,jj_nb,2), stat=error)
798          sum_error = sum_error + error
[2344]799          ALLOCATE(cpl_taumod2D(nbp_lon,jj_nb,2), stat=error)
[1279]800          sum_error = sum_error + error
[782]801         
[1279]802          IF (carbon_cycle_cpl) THEN
[2344]803             ALLOCATE(cpl_atm_co22D(nbp_lon,jj_nb), stat=error)
[1279]804             sum_error = sum_error + error
[3605]805          ENDIF
[1279]806
[3627]807          if (activate_ocean_skin == 2) then
[3628]808             ALLOCATE(cpl_t_int_2D(nbp_lon, jj_nb), &
809                  cpl_s_int_2D(nbp_lon, jj_nb), stat = error)
[3627]810             sum_error = sum_error + error
811          end if
812
[782]813          IF (sum_error /= 0) THEN
814             abort_message='Pb allocation variables couplees pour l''ecriture'
[2311]815             CALL abort_physic(modname,abort_message,1)
[782]816          ENDIF
817       ENDIF
818       
819
[1146]820       CALL gath2cpl(cpl_sols(:,cpl_index), cpl_sols2D(:,:,cpl_index), &
[782]821            knon, knindex)
822
[1146]823       CALL gath2cpl(cpl_nsol(:,cpl_index), cpl_nsol2D(:,:,cpl_index), &
[782]824            knon, knindex)
825
[1146]826       CALL gath2cpl(cpl_rain(:,cpl_index), cpl_rain2D(:,:,cpl_index), &
[782]827            knon, knindex)
828
[1146]829       CALL gath2cpl(cpl_snow(:,cpl_index), cpl_snow2D(:,:,cpl_index), &
[782]830            knon, knindex)
831
[1146]832       CALL gath2cpl(cpl_evap(:,cpl_index), cpl_evap2D(:,:,cpl_index), &
[782]833            knon, knindex)
834
835! cpl_tsol2D(:,:,:) not used!
[1146]836       CALL gath2cpl(cpl_tsol(:,cpl_index), cpl_tsol2D(:,:, cpl_index), &
[782]837            knon, knindex)
838
839! cpl_fder2D(:,:,1) not used, only cpl_fder(:,:,2)!
[1146]840       CALL gath2cpl(cpl_fder(:,cpl_index), cpl_fder2D(:,:,cpl_index), &
[782]841            knon, knindex)
842
843! cpl_albe2D(:,:,:) not used!
[1146]844       CALL gath2cpl(cpl_albe(:,cpl_index), cpl_albe2D(:,:,cpl_index), &
[782]845            knon, knindex)
846
[1146]847       CALL gath2cpl(cpl_taux(:,cpl_index), cpl_taux2D(:,:,cpl_index), &
[782]848            knon, knindex)
849
[1146]850       CALL gath2cpl(cpl_tauy(:,cpl_index), cpl_tauy2D(:,:,cpl_index), &
[782]851            knon, knindex)
852
[1146]853       CALL gath2cpl(cpl_windsp(:,cpl_index), cpl_windsp2D(:,:), &
[782]854            knon, knindex)
855
[2872]856       CALL gath2cpl(cpl_sens_rain(:,cpl_index), cpl_sens_rain2D(:,:,cpl_index), &
857            knon, knindex)
858
859       CALL gath2cpl(cpl_sens_snow(:,cpl_index), cpl_sens_snow2D(:,:,cpl_index), &
860            knon, knindex)
861
[1279]862       CALL gath2cpl(cpl_taumod(:,cpl_index), cpl_taumod2D(:,:,cpl_index), &
863            knon, knindex)
[782]864
[1279]865       IF (carbon_cycle_cpl) &
866            CALL gath2cpl(cpl_atm_co2(:,cpl_index), cpl_atm_co22D(:,:), knon, knindex)
[3628]867       if (activate_ocean_skin == 2) then
868          CALL gath2cpl(cpl_t_int, cpl_t_int_2D, knon, knindex)
869          CALL gath2cpl(cpl_s_int, cpl_s_int_2D, knon, knindex)
870       end if
[3627]871    ENDIF
[1279]872
[782]873  END SUBROUTINE cpl_send_ocean_fields
874
875!
876!*************************************************************************************
877!
878
879  SUBROUTINE cpl_send_seaice_fields(itime, dtime, knon, knindex, &
880       pctsrf, lafin, rlon, rlat, &
881       swdown, lwdown, fluxlat, fluxsens, &
[2872]882       precip_rain, precip_snow, evap, tsurf, fder, albsol, taux, tauy,&
883       sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
[782]884!
885! This subroutine cumulates some fields for each time-step during a coupling
886! period. At last time-step in a coupling period the fields are transformed to the
887! grid accepted by the coupler. All fields for all types of surfaces are sent to
888! the coupler.
889!
[1279]890    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
[1785]891    USE indice_sol_mod
[2344]892    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
[782]893
894! Input arguments
895!*************************************************************************************
896    INTEGER, INTENT(IN)                     :: itime
897    INTEGER, INTENT(IN)                     :: knon
898    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
899    REAL, INTENT(IN)                        :: dtime
900    REAL, DIMENSION(klon), INTENT(IN)       :: rlon, rlat
901    REAL, DIMENSION(klon), INTENT(IN)       :: swdown, lwdown
902    REAL, DIMENSION(klon), INTENT(IN)       :: fluxlat, fluxsens
903    REAL, DIMENSION(klon), INTENT(IN)       :: precip_rain, precip_snow
904    REAL, DIMENSION(klon), INTENT(IN)       :: evap, tsurf, fder
905    REAL, DIMENSION(klon), INTENT(IN)       :: albsol, taux, tauy
906    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
[2872]907    REAL, DIMENSION(klon), INTENT(IN)       :: sens_prec_liq, sens_prec_sol
908    REAL, DIMENSION(klon), INTENT(IN)       :: lat_prec_liq, lat_prec_sol
[782]909    LOGICAL, INTENT(IN)                     :: lafin
910
911! Local variables
912!*************************************************************************************
913    INTEGER                                 :: cpl_index, ig
914    INTEGER                                 :: error, sum_error
915    CHARACTER(len = 25)                     :: modname = 'cpl_send_seaice_fields'
916    CHARACTER(len = 80)                     :: abort_message
[1146]917    REAL, DIMENSION(klon)                   :: cpl_fder_tmp
[782]918
919!*************************************************************************************
920! Start calulation
921! The sea-ice points are saved with second array index=2
922!
923!*************************************************************************************
924    cpl_index = 2
925
926!*************************************************************************************
927! Reset fields to zero in the beginning of a new coupling period
928!
929!*************************************************************************************
930    IF (MOD(itime, nexca) == 1) THEN
[996]931       cpl_sols(1:knon,cpl_index) = 0.0
932       cpl_nsol(1:knon,cpl_index) = 0.0
933       cpl_rain(1:knon,cpl_index) = 0.0
934       cpl_snow(1:knon,cpl_index) = 0.0
935       cpl_evap(1:knon,cpl_index) = 0.0
936       cpl_tsol(1:knon,cpl_index) = 0.0
937       cpl_fder(1:knon,cpl_index) = 0.0
938       cpl_albe(1:knon,cpl_index) = 0.0
939       cpl_taux(1:knon,cpl_index) = 0.0
940       cpl_tauy(1:knon,cpl_index) = 0.0
[2872]941       cpl_sens_rain(1:knon,cpl_index) = 0.0
942       cpl_sens_snow(1:knon,cpl_index) = 0.0
[1279]943       cpl_taumod(1:knon,cpl_index) = 0.0
[782]944    ENDIF
945       
946!*************************************************************************************
947! Cumulate at each time-step
948!
949!*************************************************************************************   
950    DO ig = 1, knon
951       cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) + &
[1403]952            swdown(ig)      / REAL(nexca)
[782]953       cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) + &
[1403]954            (lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / REAL(nexca)
[782]955       cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) + &
[1403]956            precip_rain(ig) / REAL(nexca)
[782]957       cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) + &
[1403]958            precip_snow(ig) / REAL(nexca)
[782]959       cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) + &
[1403]960            evap(ig)        / REAL(nexca)
[782]961       cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) + &
[1403]962            tsurf(ig)       / REAL(nexca)
[782]963       cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) + &
[1403]964            fder(ig)        / REAL(nexca)
[782]965       cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) + &
[1403]966            albsol(ig)      / REAL(nexca)
[782]967       cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) + &
[1403]968            taux(ig)        / REAL(nexca)
[782]969       cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) + &
[1403]970            tauy(ig)        / REAL(nexca)     
[2872]971       cpl_sens_rain(ig,cpl_index) = cpl_sens_rain(ig,cpl_index) + &
972            sens_prec_liq(ig)      / REAL(nexca)
973       cpl_sens_snow(ig,cpl_index) = cpl_sens_snow(ig,cpl_index) + &
974            sens_prec_sol(ig)      / REAL(nexca)
[1279]975       cpl_taumod(ig,cpl_index) = cpl_taumod(ig,cpl_index) + &
[1403]976            SQRT ( taux(ig)*taux(ig)+tauy(ig)*tauy(ig) ) / REAL(nexca)
[782]977    ENDDO
978
979!*************************************************************************************
980! If the time-step corresponds to the end of coupling period the
981! fields are transformed to the 2D grid and all fields are sent to coupler.
982!
983!*************************************************************************************
984    IF (MOD(itime, nexca) == 0) THEN
985       IF (.NOT. ALLOCATED(cpl_sols2D)) THEN
986          sum_error = 0
[2344]987          ALLOCATE(cpl_sols2D(nbp_lon,jj_nb,2), stat=error)
[782]988          sum_error = sum_error + error
[2344]989          ALLOCATE(cpl_nsol2D(nbp_lon,jj_nb,2), stat=error)
[782]990          sum_error = sum_error + error
[2344]991          ALLOCATE(cpl_rain2D(nbp_lon,jj_nb,2), stat=error)
[782]992          sum_error = sum_error + error
[2344]993          ALLOCATE(cpl_snow2D(nbp_lon,jj_nb,2), stat=error)
[782]994          sum_error = sum_error + error
[2344]995          ALLOCATE(cpl_evap2D(nbp_lon,jj_nb,2), stat=error)
[782]996          sum_error = sum_error + error
[2344]997          ALLOCATE(cpl_tsol2D(nbp_lon,jj_nb,2), stat=error)
[782]998          sum_error = sum_error + error
[2344]999          ALLOCATE(cpl_fder2D(nbp_lon,jj_nb,2), stat=error)
[782]1000          sum_error = sum_error + error
[2344]1001          ALLOCATE(cpl_albe2D(nbp_lon,jj_nb,2), stat=error)
[782]1002          sum_error = sum_error + error
[2344]1003          ALLOCATE(cpl_taux2D(nbp_lon,jj_nb,2), stat=error)
[782]1004          sum_error = sum_error + error
[2344]1005          ALLOCATE(cpl_tauy2D(nbp_lon,jj_nb,2), stat=error)
[782]1006          sum_error = sum_error + error
[2344]1007          ALLOCATE(cpl_windsp2D(nbp_lon,jj_nb), stat=error)
[782]1008          sum_error = sum_error + error
[2872]1009          ALLOCATE(cpl_sens_rain2D(nbp_lon,jj_nb,2), stat=error)
1010          sum_error = sum_error + error
1011          ALLOCATE(cpl_sens_snow2D(nbp_lon,jj_nb,2), stat=error)
1012          sum_error = sum_error + error
[2344]1013          ALLOCATE(cpl_taumod2D(nbp_lon,jj_nb,2), stat=error)
[1279]1014          sum_error = sum_error + error
1015
1016          IF (carbon_cycle_cpl) THEN
[2344]1017             ALLOCATE(cpl_atm_co22D(nbp_lon,jj_nb), stat=error)
[1279]1018             sum_error = sum_error + error
[3605]1019          ENDIF
[1279]1020
[782]1021          IF (sum_error /= 0) THEN
1022             abort_message='Pb allocation variables couplees pour l''ecriture'
[2311]1023             CALL abort_physic(modname,abort_message,1)
[782]1024          ENDIF
1025       ENDIF
1026
[1146]1027       CALL gath2cpl(cpl_sols(:,cpl_index), cpl_sols2D(:,:,cpl_index), &
[782]1028            knon, knindex)
1029
[1146]1030       CALL gath2cpl(cpl_nsol(:,cpl_index), cpl_nsol2D(:,:,cpl_index), &
[782]1031            knon, knindex)
1032
[1146]1033       CALL gath2cpl(cpl_rain(:,cpl_index), cpl_rain2D(:,:,cpl_index), &
[782]1034            knon, knindex)
1035
[1146]1036       CALL gath2cpl(cpl_snow(:,cpl_index), cpl_snow2D(:,:,cpl_index), &
[782]1037            knon, knindex)
1038
[1146]1039       CALL gath2cpl(cpl_evap(:,cpl_index), cpl_evap2D(:,:,cpl_index), &
[782]1040            knon, knindex)
1041
1042! cpl_tsol2D(:,:,:) not used!
[1146]1043       CALL gath2cpl(cpl_tsol(:,cpl_index), cpl_tsol2D(:,:, cpl_index), &
[782]1044            knon, knindex)
1045
[1146]1046       ! Set default value and decompress before gath2cpl
1047       cpl_fder_tmp(:) = -20.
1048       DO ig = 1, knon
1049          cpl_fder_tmp(knindex(ig))=cpl_fder(ig,cpl_index)
[3605]1050       ENDDO
[1146]1051       CALL gath2cpl(cpl_fder_tmp(:), cpl_fder2D(:,:,cpl_index), &
1052            klon, unity)
[782]1053
1054! cpl_albe2D(:,:,:) not used!
[1146]1055       CALL gath2cpl(cpl_albe(:,cpl_index), cpl_albe2D(:,:,cpl_index), &
[782]1056            knon, knindex)
1057
[1146]1058       CALL gath2cpl(cpl_taux(:,cpl_index), cpl_taux2D(:,:,cpl_index), &
[782]1059            knon, knindex)
1060
[1146]1061       CALL gath2cpl(cpl_tauy(:,cpl_index), cpl_tauy2D(:,:,cpl_index), &
[782]1062            knon, knindex)
1063
[2872]1064       CALL gath2cpl(cpl_sens_rain(:,cpl_index), cpl_sens_rain2D(:,:,cpl_index), &
1065            knon, knindex)
1066
1067       CALL gath2cpl(cpl_sens_snow(:,cpl_index), cpl_sens_snow2D(:,:,cpl_index), &
1068            knon, knindex)
1069
[1279]1070       CALL gath2cpl(cpl_taumod(:,cpl_index), cpl_taumod2D(:,:,cpl_index), &
1071            knon, knindex)
1072
[782]1073       ! Send all fields
1074       CALL cpl_send_all(itime, dtime, pctsrf, lafin, rlon, rlat)
1075    ENDIF
1076
1077  END SUBROUTINE cpl_send_seaice_fields
1078
1079!
1080!*************************************************************************************
1081!
1082
1083  SUBROUTINE cpl_send_land_fields(itime, knon, knindex, rriv_in, rcoa_in)
1084!
1085! This subroutine cumulates some fields for each time-step during a coupling
1086! period. At last time-step in a coupling period the fields are transformed to the
1087! grid accepted by the coupler. No sending to the coupler will be done from here
1088! (it is done in cpl_send_seaice_fields).
1089!
[2344]1090    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
[782]1091
1092! Input arguments
1093!*************************************************************************************
1094    INTEGER, INTENT(IN)                       :: itime
1095    INTEGER, INTENT(IN)                       :: knon
1096    INTEGER, DIMENSION(klon), INTENT(IN)      :: knindex
1097    REAL, DIMENSION(klon), INTENT(IN)         :: rriv_in
1098    REAL, DIMENSION(klon), INTENT(IN)         :: rcoa_in
1099
1100! Local variables
1101!*************************************************************************************
[2344]1102    REAL, DIMENSION(nbp_lon,jj_nb)             :: rriv2D
1103    REAL, DIMENSION(nbp_lon,jj_nb)             :: rcoa2D
[782]1104
1105!*************************************************************************************
1106! Rearrange fields in 2D variables
1107! First initialize to zero to avoid unvalid points causing problems
1108!
1109!*************************************************************************************
[987]1110!$OMP MASTER
[782]1111    rriv2D(:,:) = 0.0
1112    rcoa2D(:,:) = 0.0
[987]1113!$OMP END MASTER
[782]1114    CALL gath2cpl(rriv_in, rriv2D, knon, knindex)
1115    CALL gath2cpl(rcoa_in, rcoa2D, knon, knindex)
1116
1117!*************************************************************************************
1118! Reset cumulated fields to zero in the beginning of a new coupling period
1119!
1120!*************************************************************************************
1121    IF (MOD(itime, nexca) == 1) THEN
[987]1122!$OMP MASTER
[782]1123       cpl_rriv2D(:,:) = 0.0
1124       cpl_rcoa2D(:,:) = 0.0
[987]1125!$OMP END MASTER
[782]1126    ENDIF
1127
1128!*************************************************************************************
1129! Cumulate : Following fields should be cumulated at each time-step
1130!
1131!*************************************************************************************   
[987]1132!$OMP MASTER
[1403]1133    cpl_rriv2D(:,:) = cpl_rriv2D(:,:) + rriv2D(:,:) / REAL(nexca)
1134    cpl_rcoa2D(:,:) = cpl_rcoa2D(:,:) + rcoa2D(:,:) / REAL(nexca)
[987]1135!$OMP END MASTER
[782]1136
1137  END SUBROUTINE cpl_send_land_fields
1138
1139!
1140!*************************************************************************************
1141!
1142
1143  SUBROUTINE cpl_send_landice_fields(itime, knon, knindex, rlic_in)
1144! This subroutine cumulates the field for melting ice for each time-step
1145! during a coupling period. This routine will not send to coupler. Sending
1146! will be done in cpl_send_seaice_fields.
1147!
[1279]1148
[2344]1149    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
[996]1150
[782]1151! Input varibales
1152!*************************************************************************************
1153    INTEGER, INTENT(IN)                       :: itime
1154    INTEGER, INTENT(IN)                       :: knon
1155    INTEGER, DIMENSION(klon), INTENT(IN)      :: knindex
1156    REAL, DIMENSION(klon), INTENT(IN)         :: rlic_in
1157
1158! Local varibales
1159!*************************************************************************************
[2344]1160    REAL, DIMENSION(nbp_lon,jj_nb)             :: rlic2D
[782]1161
1162!*************************************************************************************
1163! Rearrange field in a 2D variable
1164! First initialize to zero to avoid unvalid points causing problems
1165!
1166!*************************************************************************************
[987]1167!$OMP MASTER
[782]1168    rlic2D(:,:) = 0.0
[987]1169!$OMP END MASTER
[782]1170    CALL gath2cpl(rlic_in, rlic2D, knon, knindex)
1171
1172!*************************************************************************************
1173! Reset field to zero in the beginning of a new coupling period
1174!
1175!*************************************************************************************
1176    IF (MOD(itime, nexca) == 1) THEN
[987]1177!$OMP MASTER
[782]1178       cpl_rlic2D(:,:) = 0.0
[987]1179!$OMP END MASTER
[782]1180    ENDIF
1181
1182!*************************************************************************************
1183! Cumulate : Melting ice should be cumulated at each time-step
1184!
1185!*************************************************************************************   
[987]1186!$OMP MASTER
[1403]1187    cpl_rlic2D(:,:) = cpl_rlic2D(:,:) + rlic2D(:,:) / REAL(nexca)
[987]1188!$OMP END MASTER
[782]1189
1190  END SUBROUTINE cpl_send_landice_fields
1191
1192!
1193!*************************************************************************************
1194!
1195
1196  SUBROUTINE cpl_send_all(itime, dtime, pctsrf, lafin, rlon, rlat)
1197! This routine will send fields for all different surfaces to the coupler.
1198! This subroutine should be executed after calculations by the last surface(sea-ice),
1199! all calculations at the different surfaces have to be done before.
1200!   
[996]1201    USE surface_data
[1279]1202    USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
[1785]1203    USE indice_sol_mod
[2344]1204    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
1205    USE time_phylmdz_mod, ONLY: start_time, itau_phy
[3627]1206    use config_ocean_skin_m, only: activate_ocean_skin
[782]1207! Some includes
[2344]1208!   
[782]1209! Input arguments
1210!*************************************************************************************
1211    INTEGER, INTENT(IN)                                  :: itime
1212    REAL, INTENT(IN)                                     :: dtime
1213    REAL, DIMENSION(klon), INTENT(IN)                    :: rlon, rlat
1214    REAL, DIMENSION(klon,nbsrf), INTENT(IN)              :: pctsrf
1215    LOGICAL, INTENT(IN)                                  :: lafin
1216   
1217! Local variables
1218!*************************************************************************************
[3605]1219    INTEGER                                              :: error, sum_error, i,j,k
[782]1220    INTEGER                                              :: itau_w
[996]1221    INTEGER                                              :: time_sec
[2344]1222    INTEGER, DIMENSION(nbp_lon*(nbp_lat))                      :: ndexct
[782]1223    REAL                                                 :: Up, Down
[2344]1224    REAL, DIMENSION(nbp_lon, jj_nb)                          :: tmp_lon, tmp_lat
1225    REAL, DIMENSION(nbp_lon, jj_nb, 4)                       :: pctsrf2D
1226    REAL, DIMENSION(nbp_lon, jj_nb)                          :: deno
[782]1227    CHARACTER(len = 20)                                  :: modname = 'cpl_send_all'
1228    CHARACTER(len = 80)                                  :: abort_message
1229   
1230! Variables with fields to coupler
[2344]1231    REAL, DIMENSION(nbp_lon, jj_nb)                          :: tmp_taux
1232    REAL, DIMENSION(nbp_lon, jj_nb)                          :: tmp_tauy
1233    REAL, DIMENSION(nbp_lon, jj_nb)                          :: tmp_calv
[782]1234! Table with all fields to send to coupler
[2344]1235    REAL, DIMENSION(nbp_lon, jj_nb, maxsend)                 :: tab_flds
[3605]1236    REAL, DIMENSION(klon_mpi)                                :: rlon_mpi, rlat_mpi
1237    REAL  :: calving(nb_zone_calving)
1238    REAL  :: calving_glo(nb_zone_calving)
1239   
[1001]1240#ifdef CPP_MPI
[782]1241    INCLUDE 'mpif.h'
1242    INTEGER, DIMENSION(MPI_STATUS_SIZE)                  :: status
1243#endif
1244
1245! End definitions
1246!*************************************************************************************
1247   
1248
1249
1250!*************************************************************************************
1251! All fields are stored in a table tab_flds(:,:,:)
[1146]1252! First store the fields which are already on the right format
[782]1253!
1254!*************************************************************************************
[987]1255!$OMP MASTER
[1279]1256    tab_flds(:,:,ids_windsp) = cpl_windsp2D(:,:)
1257    tab_flds(:,:,ids_shfice) = cpl_sols2D(:,:,2)
1258    tab_flds(:,:,ids_nsfice) = cpl_nsol2D(:,:,2)
1259    tab_flds(:,:,ids_dflxdt) = cpl_fder2D(:,:,2)
[2872]1260    tab_flds(:,:,ids_qraioc) = cpl_sens_rain2D(:,:,1)
1261    tab_flds(:,:,ids_qsnooc) = cpl_sens_snow2D(:,:,1)
1262    tab_flds(:,:,ids_qraiic) = cpl_sens_rain2D(:,:,2)
1263    tab_flds(:,:,ids_qsnoic) = cpl_sens_snow2D(:,:,2)
[3628]1264
1265    if (activate_ocean_skin == 2) then
1266       tab_flds(:, :, ids_t_int) = cpl_t_int_2D
1267       tab_flds(:, :, ids_s_int) = cpl_s_int_2D
1268    end if
[1146]1269   
[996]1270    IF (version_ocean=='nemo') THEN
[3605]1271       tab_flds(:,:,ids_liqrun) = (cpl_rriv2D(:,:) + cpl_rcoa2D(:,:))
[1279]1272       IF (carbon_cycle_cpl) tab_flds(:,:,ids_atmco2)=cpl_atm_co22D(:,:)
[996]1273    ELSE IF (version_ocean=='opa8') THEN
[1279]1274       tab_flds(:,:,ids_shfoce) = cpl_sols2D(:,:,1)
1275       tab_flds(:,:,ids_nsfoce) = cpl_nsol2D(:,:,1)
1276       tab_flds(:,:,ids_icevap) = cpl_evap2D(:,:,2)
1277       tab_flds(:,:,ids_ocevap) = cpl_evap2D(:,:,1)
1278       tab_flds(:,:,ids_runcoa) = cpl_rcoa2D(:,:)
1279       tab_flds(:,:,ids_rivflu) = cpl_rriv2D(:,:)
[3605]1280    ENDIF
[1146]1281
[782]1282!*************************************************************************************
1283! Transform the fraction of sub-surfaces from 1D to 2D array
1284!
1285!*************************************************************************************
1286    pctsrf2D(:,:,:) = 0.
[987]1287!$OMP END MASTER
[782]1288    CALL gath2cpl(pctsrf(:,is_oce), pctsrf2D(:,:,is_oce), klon, unity)
1289    CALL gath2cpl(pctsrf(:,is_sic), pctsrf2D(:,:,is_sic), klon, unity)
1290    CALL gath2cpl(pctsrf(:,is_lic), pctsrf2D(:,:,is_lic), klon, unity)
1291
1292!*************************************************************************************
1293! Calculate the average calving per latitude
1294! Store calving in tab_flds(:,:,19)
1295!
1296!*************************************************************************************     
[987]1297    IF (is_omp_root) THEN
1298
[3605]1299      IF (cpl_old_calving) THEN   ! use old calving
1300
1301        DO j = 1, jj_nb
1302           tmp_calv(:,j) = DOT_PRODUCT (cpl_rlic2D(1:nbp_lon,j), &
1303                pctsrf2D(1:nbp_lon,j,is_lic)) / REAL(nbp_lon)
1304        ENDDO
[782]1305   
[1001]1306   
[3605]1307        IF (is_parallel) THEN
1308           IF (.NOT. is_north_pole_dyn) THEN
[1001]1309#ifdef CPP_MPI
[3605]1310              CALL MPI_RECV(Up,1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,status,error)
1311              CALL MPI_SEND(tmp_calv(1,1),1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,error)
[782]1312#endif
[3605]1313           ENDIF
[1001]1314       
[3605]1315           IF (.NOT. is_south_pole_dyn) THEN
[1001]1316#ifdef CPP_MPI
[3605]1317              CALL MPI_SEND(tmp_calv(1,jj_nb),1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,error)
1318              CALL MPI_RECV(down,1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,status,error)
[782]1319#endif
[3605]1320           ENDIF
[996]1321         
[3605]1322           IF (.NOT. is_north_pole_dyn .AND. ii_begin /=1) THEN
1323              Up=Up+tmp_calv(nbp_lon,1)
1324              tmp_calv(:,1)=Up
1325           ENDIF
1326           
1327           IF (.NOT. is_south_pole_dyn .AND. ii_end /= nbp_lon) THEN
1328              Down=Down+tmp_calv(1,jj_nb)
1329              tmp_calv(:,jj_nb)=Down
1330           ENDIF
1331        ENDIF
1332        tab_flds(:,:,ids_calvin) = tmp_calv(:,:)
1333
1334      ELSE
1335         ! cpl_old_calving=FALSE
1336         ! To be used with new method for calculation of coupling weights
1337         DO k=1,nb_zone_calving
1338            calving(k)=0
1339            DO j = 1, jj_nb
1340               calving(k)= calving(k)+DOT_PRODUCT(cpl_rlic2D(:,j)*area_calving(:,j,k),pctsrf2D(:,j,is_lic))
1341            ENDDO
1342         ENDDO
[996]1343         
[3605]1344#ifdef CPP_MPI
1345         CALL MPI_ALLREDUCE(calving, calving_glo, nb_zone_calving, MPI_REAL_LMDZ, MPI_SUM, COMM_LMDZ_PHY, error)
1346#endif
1347         
1348         tab_flds(:,:,ids_calvin) = 0
1349         DO k=1,nb_zone_calving
1350            IF (ind_calving(k)>0 ) THEN
1351               j=(ind_calving(k)-1)/nbp_lon + 1
1352               i=MOD(ind_calving(k)-1,nbp_lon)+1
1353               tab_flds(i,j,ids_calvin) = calving_glo(k)
1354            ENDIF
1355         ENDDO
1356         
[987]1357      ENDIF
[996]1358     
[782]1359!*************************************************************************************
1360! Calculate total flux for snow, rain and wind with weighted addition using the
1361! fractions of ocean and seaice.
1362!
1363!*************************************************************************************   
[996]1364       ! fraction oce+seaice
1365       deno =  pctsrf2D(:,:,is_oce) + pctsrf2D(:,:,is_sic)
[836]1366
[996]1367       IF (version_ocean=='nemo') THEN
[1279]1368          tab_flds(:,:,ids_shftot)  = 0.0
1369          tab_flds(:,:,ids_nsftot) = 0.0
1370          tab_flds(:,:,ids_totrai) = 0.0
1371          tab_flds(:,:,ids_totsno) = 0.0
1372          tab_flds(:,:,ids_toteva) = 0.0
1373          tab_flds(:,:,ids_taumod) = 0.0
[1146]1374 
[996]1375          tmp_taux(:,:)    = 0.0
1376          tmp_tauy(:,:)    = 0.0
1377          ! For all valid grid cells containing some fraction of ocean or sea-ice
1378          WHERE ( deno(:,:) /= 0 )
1379             tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
1380                  cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1381             tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
1382                  cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
[1279]1383
1384             tab_flds(:,:,ids_shftot) = cpl_sols2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
[1146]1385                  cpl_sols2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
[1279]1386             tab_flds(:,:,ids_nsftot) = cpl_nsol2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
[1146]1387                  cpl_nsol2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
[1279]1388             tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
[1146]1389                  cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
[1279]1390             tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
[1146]1391                  cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
[1279]1392             tab_flds(:,:,ids_toteva) = cpl_evap2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
[1146]1393                  cpl_evap2D(:,:,2)  * pctsrf2D(:,:,is_sic) / deno(:,:)
[1279]1394             tab_flds(:,:,ids_taumod) = cpl_taumod2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
1395                  cpl_taumod2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1396             
[1146]1397         ENDWHERE
1398
[1279]1399          tab_flds(:,:,ids_icevap) = cpl_evap2D(:,:,2)
[996]1400         
1401       ELSE IF (version_ocean=='opa8') THEN
[1146]1402          ! Store fields for rain and snow in tab_flds(:,:,15) and tab_flds(:,:,16)
[1279]1403          tab_flds(:,:,ids_totrai) = 0.0
1404          tab_flds(:,:,ids_totsno) = 0.0
[996]1405          tmp_taux(:,:)    = 0.0
1406          tmp_tauy(:,:)    = 0.0
1407          ! For all valid grid cells containing some fraction of ocean or sea-ice
1408          WHERE ( deno(:,:) /= 0 )
[1279]1409             tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
[996]1410                  cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
[1279]1411             tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
[996]1412                  cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1413             
1414             tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
1415                  cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1416             tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
1417                  cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1418          ENDWHERE
[3605]1419       ENDIF
[987]1420
[996]1421    ENDIF ! is_omp_root
1422 
[782]1423!*************************************************************************************
1424! Transform the wind components from local atmospheric 2D coordinates to geocentric
1425! 3D coordinates.
1426! Store the resulting wind components in tab_flds(:,:,1:6)
1427!*************************************************************************************
1428
1429! Transform the longitudes and latitudes on 2D arrays
[1001]1430   
[987]1431    CALL gather_omp(rlon,rlon_mpi)
1432    CALL gather_omp(rlat,rlat_mpi)
1433!$OMP MASTER
1434    CALL Grid1DTo2D_mpi(rlon_mpi,tmp_lon)
1435    CALL Grid1DTo2D_mpi(rlat_mpi,tmp_lat)
1436!$OMP END MASTER   
1437
[782]1438    IF (is_sequential) THEN
[2429]1439       IF (is_north_pole_dyn) tmp_lon(:,1)     = tmp_lon(:,2)
1440       IF (is_south_pole_dyn) tmp_lon(:,nbp_lat) = tmp_lon(:,nbp_lat-1)
[782]1441    ENDIF
1442     
1443! NetCDF output of the wind before transformation of coordinate system
1444    IF (is_sequential) THEN
1445       ndexct(:) = 0
[2344]1446       itau_w = itau_phy + itime + start_time * day_step_phy
1447       CALL histwrite(nidct,'tauxe',itau_w,tmp_taux,nbp_lon*(nbp_lat),ndexct)
1448       CALL histwrite(nidct,'tauyn',itau_w,tmp_tauy,nbp_lon*(nbp_lat),ndexct)
1449       CALL histwrite(nidct,'tmp_lon',itau_w,tmp_lon,nbp_lon*(nbp_lat),ndexct)
1450       CALL histwrite(nidct,'tmp_lat',itau_w,tmp_lat,nbp_lon*(nbp_lat),ndexct)
[782]1451    ENDIF
1452
[1067]1453! Transform the wind from spherical atmospheric 2D coordinates to geocentric
1454! cartesian 3D coordinates
[987]1455!$OMP MASTER
[2344]1456    CALL atm2geo (nbp_lon, jj_nb, tmp_taux, tmp_tauy, tmp_lon, tmp_lat, &
[1279]1457         tab_flds(:,:,ids_tauxxu), tab_flds(:,:,ids_tauyyu), tab_flds(:,:,ids_tauzzu) )
[782]1458   
[1279]1459    tab_flds(:,:,ids_tauxxv)  = tab_flds(:,:,ids_tauxxu)
1460    tab_flds(:,:,ids_tauyyv)  = tab_flds(:,:,ids_tauyyu)
1461    tab_flds(:,:,ids_tauzzv)  = tab_flds(:,:,ids_tauzzu)
[987]1462!$OMP END MASTER
[782]1463
1464!*************************************************************************************
1465! NetCDF output of all fields just before sending to coupler.
1466!
1467!*************************************************************************************
1468    IF (is_sequential) THEN
[1279]1469        DO j=1,maxsend
1470          IF (infosend(j)%action) CALL histwrite(nidct,infosend(j)%name, itau_w, &
[2344]1471             tab_flds(:,:,j),nbp_lon*(nbp_lat),ndexct)
[1279]1472        ENDDO
[782]1473    ENDIF
1474!*************************************************************************************
1475! Send the table of all fields
1476!
1477!*************************************************************************************
[996]1478    time_sec=(itime-1)*dtime
[782]1479#ifdef CPP_COUPLE
[987]1480!$OMP MASTER
[1010]1481    CALL intocpl(time_sec, lafin, tab_flds(:,:,:))
[987]1482!$OMP END MASTER
[782]1483#endif
1484
1485!*************************************************************************************
1486! Finish with some dellocate
1487!
1488!************************************************************************************* 
1489    sum_error=0
1490    DEALLOCATE(cpl_sols2D, cpl_nsol2D, cpl_rain2D, cpl_snow2D, stat=error )
1491    sum_error = sum_error + error
1492    DEALLOCATE(cpl_evap2D, cpl_tsol2D, cpl_fder2D, cpl_albe2D, stat=error )
1493    sum_error = sum_error + error
[1279]1494    DEALLOCATE(cpl_taux2D, cpl_tauy2D, cpl_windsp2D, cpl_taumod2D, stat=error )
[782]1495    sum_error = sum_error + error
[2872]1496    DEALLOCATE(cpl_sens_rain2D, cpl_sens_snow2D, stat=error)
1497    sum_error = sum_error + error
1498
[1279]1499   
1500    IF (carbon_cycle_cpl) THEN
1501       DEALLOCATE(cpl_atm_co22D, stat=error )
1502       sum_error = sum_error + error
[3605]1503    ENDIF
[1279]1504
[3628]1505    if (activate_ocean_skin == 2) deallocate(cpl_t_int_2d, cpl_s_int_2d)
[3627]1506
[782]1507    IF (sum_error /= 0) THEN
1508       abort_message='Pb in deallocation of cpl_xxxx2D coupling variables'
[2311]1509       CALL abort_physic(modname,abort_message,1)
[782]1510    ENDIF
1511   
1512  END SUBROUTINE cpl_send_all
1513!
1514!*************************************************************************************
1515!
1516  SUBROUTINE cpl2gath(champ_in, champ_out, knon, knindex)
[1001]1517  USE mod_phys_lmdz_para
[1279]1518! Cette routine transforme un champs de la grille 2D recu du coupleur sur la grille
1519! 'gathered' (la grille physiq comprime).
[782]1520!
1521!
1522! input:         
[1279]1523!   champ_in     champ sur la grille 2D
[782]1524!   knon         nombre de points dans le domaine a traiter
1525!   knindex      index des points de la surface a traiter
1526!
1527! output:
[1279]1528!   champ_out    champ sur la grille 'gatherd'
[782]1529!
[2344]1530    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
[782]1531
1532! Input
1533    INTEGER, INTENT(IN)                       :: knon
[2344]1534    REAL, DIMENSION(nbp_lon,jj_nb), INTENT(IN)    :: champ_in
[782]1535    INTEGER, DIMENSION(klon), INTENT(IN)      :: knindex
1536
1537! Output
[987]1538    REAL, DIMENSION(klon_mpi), INTENT(OUT)        :: champ_out
[782]1539
1540! Local
1541    INTEGER                                   :: i, ig
[987]1542    REAL, DIMENSION(klon_mpi)                 :: temp_mpi
1543    REAL, DIMENSION(klon)                     :: temp_omp
[782]1544
1545!*************************************************************************************
1546!
[1001]1547   
1548
[2344]1549! Transform from 2 dimensions (nbp_lon,jj_nb) to 1 dimension (klon)
[987]1550!$OMP MASTER
1551    CALL Grid2Dto1D_mpi(champ_in,temp_mpi)
1552!$OMP END MASTER
[782]1553
[987]1554    CALL scatter_omp(temp_mpi,temp_omp)
1555   
[782]1556! Compress from klon to knon
1557    DO i = 1, knon
1558       ig = knindex(i)
[987]1559       champ_out(i) = temp_omp(ig)
[782]1560    ENDDO
[1001]1561
[782]1562  END SUBROUTINE cpl2gath
1563!
1564!*************************************************************************************
1565!
1566  SUBROUTINE gath2cpl(champ_in, champ_out, knon, knindex)
[987]1567  USE mod_phys_lmdz_para
[782]1568! Cette routine ecrit un champ 'gathered' sur la grille 2D pour le passer
1569! au coupleur.
1570!
1571! input:         
1572!   champ_in     champ sur la grille gathere       
1573!   knon         nombre de points dans le domaine a traiter
1574!   knindex      index des points de la surface a traiter
1575!
1576! output:
1577!   champ_out    champ sur la grille 2D
1578!
[2344]1579    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
[782]1580   
1581! Input arguments
1582!*************************************************************************************
1583    INTEGER, INTENT(IN)                    :: knon
1584    REAL, DIMENSION(klon), INTENT(IN)      :: champ_in
1585    INTEGER, DIMENSION(klon), INTENT(IN)   :: knindex
1586
1587! Output arguments
1588!*************************************************************************************
[2344]1589    REAL, DIMENSION(nbp_lon,jj_nb), INTENT(OUT) :: champ_out
[782]1590
1591! Local variables
1592!*************************************************************************************
1593    INTEGER                                :: i, ig
[987]1594    REAL, DIMENSION(klon)                  :: temp_omp
1595    REAL, DIMENSION(klon_mpi)              :: temp_mpi
[782]1596!*************************************************************************************
1597
1598! Decompress from knon to klon
[987]1599    temp_omp = 0.
[782]1600    DO i = 1, knon
1601       ig = knindex(i)
[987]1602       temp_omp(ig) = champ_in(i)
[782]1603    ENDDO
1604
[2344]1605! Transform from 1 dimension (klon) to 2 dimensions (nbp_lon,jj_nb)
[987]1606    CALL gather_omp(temp_omp,temp_mpi)
1607
1608!$OMP MASTER   
1609    CALL Grid1Dto2D_mpi(temp_mpi,champ_out)
[782]1610   
[2429]1611    IF (is_north_pole_dyn) champ_out(:,1)=temp_mpi(1)
1612    IF (is_south_pole_dyn) champ_out(:,jj_nb)=temp_mpi(klon)
[987]1613!$OMP END MASTER
[782]1614   
1615  END SUBROUTINE gath2cpl
1616!
1617!*************************************************************************************
1618!
1619END MODULE cpl_mod
1620
Note: See TracBrowser for help on using the repository browser.