source: LMDZ6/branches/DYNAMICO-conv-GC/libf/phylmd/cpl_mod.F90 @ 3405

Last change on this file since 3405 was 3055, checked in by Laurent Fairhead, 7 years ago

Ongoing update

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