source: LMDZ6/trunk/libf/phylmd/cpl_mod.F90 @ 4350

Last change on this file since 4350 was 4283, checked in by jghattas, 2 years ago

Added landice_opt=2 : Treat continental land ice fractions in ORCHIDEE => pctsrf(:,is_lic) = 0.0 in LMDZ.

For this option, some more variables are needed from ORCHIDEE. Therfor change in the interface LMDZ-ORCHIDEE in surf_land_orchidee_mod is done. Previous interface is moved to surf_land_orchidee_nolic_mod.f90. To compile with previous interface, cpp key ORCHIDEE_NOLIC is added. Previous interface is compiled with argument orchidee2.1 in makelmdz and makelmdz_fcm.

At the same time, when the interface was changed, the variable yrmu0(coszang) was added in the call to intersurf_initialize_gathered. This is needed in ORCHIDEE to better initialize the model.

Modifications done by Etienne Vignon and Josefine Ghattas

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