source: LMDZ6/branches/LMDZ-INCA-Dyn/libf/phylmd/cpl_mod.F90 @ 4270

Last change on this file since 4270 was 3790, checked in by oboucher, 4 years ago

correct cell_area2D in the case of a rectangulat lat-lon grid for singularity at south and north poles
without this correction the calving flux sent to the coupler is not correct

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