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

Last change on this file since 5403 was 5394, checked in by evignon, 7 days ago

ecriture de certaines declarations sur plusieurs lignes par souci de clarté

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