Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/clmain.F
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/clmain.F	(revision 103)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/clmain.F	(revision 105)
@@ -102,4 +102,6 @@
       REAL sollw(klon), solsw(klon)
       REAL rugos(klon,nbsrf)
+C la nouvelle repartition des surfaces sortie de l'interface
+      REAL pctsrf_new(klon,nbsrf)
 cAA
       REAL zcoefh(klon,klev)
@@ -152,4 +154,8 @@
 cAA   INTEGER it
       INTEGER ni(klon), knon, j
+c Introduction d'une variable "pourcentage potentiel" pour tenir compte
+c des eventuelles apparitions et/ou disparitions de la glace de mer
+      REAL pctsrf_pot(klon,nbsrf)
+      
 c======================================================================
       REAL zx_alf1, zx_alf2 !valeur ambiante par extrapola.
@@ -215,4 +221,11 @@
 c Boucler sur toutes les sous-fractions du sol:
 c
+C Initialisation des "pourcentages potentiels". On considere ici qu'on 
+C peut avoir potentiellementdela glace sur tout le domaine oceanique 
+C (a affiner)
+
+      pctsrf_pot = pctsrf
+      pctsrf_pot(:,is_sic) = pctsrf(:,is_oce)
+
       DO 99999 nsrf = 1, nbsrf
 c
@@ -243,5 +256,8 @@
       knon = 0
       DO i = 1, klon
-      IF (pctsrf(i,nsrf).GT.epsfra) THEN
+
+C pour determiner le domaine a traiter on utilise les surfaces "potentielles"
+C  
+      IF (pctsrf_pot(i,nsrf).GT.epsfra) THEN
          knon = knon + 1
          ni(knon) = i
@@ -302,4 +318,13 @@
 c
 c
+c calculer la diffusion des vitesses "u" et "v"
+      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yu,ypaprs,ypplay,ydelp,
+     s            y_d_u,y_flux_u)
+      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yv,ypaprs,ypplay,ydelp,
+     s            y_d_v,y_flux_v)
+
+c pour le couplage
+      ytaux = y_flux_u(:,1)
+      ytauy = y_flux_v(:,1)
 c calculer la diffusion de "q" et de "h"
       CALL clqh(knon, dtime, nsrf, ni, pctsrf, rlon, rlat,
@@ -307,14 +332,8 @@
      e          ycoefh,yt,yq,yts,ypaprs,ypplay,ydelp,yrads,
      e          yevap,yalb, ysnow, yqsol, yrain_f, ysnow_f,
-     e          yfder, ytaux, ytauy,
-     e          ysollw, ysolsw,
+     e          yfder, ytaux, ytauy, ysollw, ysolsw,
+     s          pctsrf_new,
      s          y_d_t, y_d_q, y_d_ts, 
      s          y_flux_t, y_flux_q, y_dflux_t, y_dflux_q)
-c
-c calculer la diffusion des vitesses "u" et "v"
-      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yu,ypaprs,ypplay,ydelp,
-     s            y_d_u,y_flux_u)
-      CALL clvent(knon,dtime,yu1,yv1,ycoefm,yt,yv,ypaprs,ypplay,ydelp,
-     s            y_d_v,y_flux_v)
 c
 c calculer la longueur de rugosite sur ocean
@@ -430,5 +449,6 @@
      e                delp,radsol,evap,albedo,snow,qsol, 
      e                precip_rain, precip_snow, fder, taux, tauy,
-     e                lwdown, swdown,
+     e                lwdown, swdown, 
+     s                pctsrf_new,
      s                d_t, d_q, d_ts, flux_t, flux_q,dflux_s,dflux_l)
 
@@ -669,5 +689,5 @@
       petBcoef=zx_dh(:,1)
       peqBcoef=zx_dq(:,1)
-      coef1lay=coef(:,1)
+      tq_cdrag=coef(:,1)
       temp_air=t(:,1)
       spechum=q(:,1)
@@ -678,5 +698,4 @@
       hum_air = 0.
       ccanopy = 0.
-      tq_cdrag = 0.
 
       CALL interfsurf(itime, dtime, jour,
@@ -688,9 +707,8 @@
      . fder, taux, tauy,
      . albedo, snow, qsol,
-     . ts, p1lay, coef1lay, psref, radsol,
-     . ocean,
+     . ts, p1lay, psref, radsol,
+     . ocean,zmasq
      . evap, fluxsens, fluxlat, dflux_l, dflux_s,              
-     . tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new, 
-     . zmasq)
+     . tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new)
 
       flux_t(:,1) = fluxsens
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90	(revision 103)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/interface_surf.F90	(revision 105)
@@ -38,4 +38,5 @@
 ! run_off      ruissellement total
   real, allocatable, dimension(:),save    :: run_off
+#include "YOMCST.inc"
 
 
@@ -52,8 +53,8 @@
       & fder, taux, tauy, &
       & albedo, snow, qsol, &
-      & tsurf, p1lay, coef1lay, ps, radsol, &
-      & ocean, &
+      & tsurf, p1lay, ps, radsol, &
+      & ocean, zmasq, &
       & evap, fluxsens, fluxlat, dflux_l, dflux_s, &              
-      & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new, zmasq)
+      & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new)
 
 
@@ -103,5 +104,4 @@
 !   tsurf        temperature de surface
 !   p1lay        pression 1er niveau (milieu de couche)
-!   coef1lay     coefficient d'echange
 !   ps           pression au sol
 !   radsol       rayonnement net aus sol (LW + SW)
@@ -109,4 +109,5 @@
 !   fder         derivee des flux (pour le couplage)
 !   taux, tauy   tension de vents
+!   zmasq        masque terre/ocean
 !
 ! output:
@@ -120,5 +121,4 @@
 !   z0_new       surface roughness
 !   pctsrf_new   nouvelle repartition des surfaces
-!   zmasq        masque terre/ocean
 
   include 'indicesol.h'
@@ -144,5 +144,5 @@
   real, dimension(knon), intent(IN) :: precip_rain, precip_snow
   real, dimension(knon), intent(IN) :: lwdown, swnet, swdown, ps, albedo
-  real, dimension(knon), intent(IN) :: tsurf, p1lay, coef1lay
+  real, dimension(knon), intent(IN) :: tsurf, p1lay
   real, dimension(knon), intent(IN) :: radsol
   real, dimension(klon), intent(IN) :: zmasq
@@ -169,4 +169,5 @@
   integer              :: nexca !pas de temps couplage
   real, dimension(knon):: alb_ice
+  real, dimension(knon):: tsurf_temp
 
 #include "YOMCST.inc"
@@ -191,4 +192,11 @@
       call abort_gcm(modname,abort_message,1)
     endif
+    if ( is_oce > is_sic ) then
+      write(*,*)' *** Warning ***'
+      write(*,*)' Pour des raisons de sequencement dans le code'
+      write(*,*)' l''ocean doit etre traite avant la banquise'
+      write(*,*)' or is_oce = ',is_oce, '> is_sic = ',is_sic
+      abort_message='voir ci-dessus'
+      call abort_gcm(modname,abort_message,1)
   endif
   first_call = .false.
@@ -228,5 +236,5 @@
       cal = RCPD * capsol
       call calcul_fluxs( knon, nisurf, dtime, &
-     &   tsurf, p1lay, cal, beta, coef1lay, ps, &
+     &   tsurf, p1lay, cal, beta, tq_cdrag, ps, &
      &   precip_rain, precip_snow, snow, qsol,  &
      &   radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
@@ -247,5 +255,5 @@
      &  tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
      &  precip_rain, precip_snow, lwdown, swnet, swdown, &
-     &  tsurf, p1lay, coef1lay, ps, radsol, &
+     &  tsurf, p1lay, ps, radsol, &
      &  evap, fluxsens, fluxlat, &              
      &  tsol_rad, tsurf_new, alb_new, emis_new, z0_new, dflux_l, dflux_s)
@@ -271,6 +279,8 @@
       & ocean, nexca, debut, lafin, &
       & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, &
-      & fder, albedo, taux, tauy, &
+      & fder, albedo, taux, tauy, zmasq, &
       & tsurf_new, alb_new, alb_ice, pctsrf_new)
+
+      tsurf_temp = tsurf_new
 
 !    else if (ocean == 'slab  ') then
@@ -281,12 +291,14 @@
 !     &  debut, &
 !     &  tsurf_new, alb_new, z0_new, pctsrf_new)
+!
     endif
-!
+
     cal = 0.
     beta = 1.
     dif_grnd = 0.
 
+    endif
     call calcul_fluxs( knon, nisurf, dtime, &
-     &   tsurf, p1lay, cal, beta, coef1lay, ps, &
+     &   tsurf_temp, p1lay, cal, beta, tq_cdrag, ps, &
      &   precip_rain, precip_snow, snow, qsol,  &
      &   radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
@@ -307,14 +319,36 @@
 ! Surface "glace de mer" appel a l'interface avec l'ocean
 !
-!    call interfoce(nisurf, ocean)
-!
-
-    cal = calice
-    where (snow > 0.0) cal = calsno
-    beta = 1.0
-    dif_grnd = 1.0 / tau_gl
+!
+    if (ocean == 'couple') then
+      nexca = 0
+
+      call interfoce(itime, dtime, &
+      & klon, iim, jjm, nisurf, pctsrf, knon, knindex, rlon, rlat, &
+      & ocean, nexca, debut, lafin, &
+      & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, &
+      & fder, albedo, taux, tauy, zmasq, &
+      & tsurf_new, alb_new, alb_ice, pctsrf_new)
+
+      tsurf_temp = tsurf_new
+      cal = 0.
+      dif_grnd = 0.
+
+!    else if (ocean == 'slab  ') then
+!      call interfoce(nisurf)
+    else                              ! lecture conditions limites
+!      call interfoce(itime, dtime, jour, & 
+!     &  klon, nisurf, knon, knindex, &
+!     &  debut, &
+!     &  tsurf_new, alb_new, z0_new, pctsrf_new)endif
+
+      cal = calice
+      where (snow > 0.0) cal = calsno
+      beta = 1.0
+      dif_grnd = 1.0 / tau_gl
+      tsurf_temp = tsurf
+    endif
 
     call calcul_fluxs( knon, nisurf, dtime, &
-     &   tsurf, p1lay, cal, beta, coef1lay, ps, &
+     &   tsurf_temp, p1lay, cal, beta, tq_cdrag, ps, &
      &   precip_rain, precip_snow, snow, qsol,  &
      &   radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
@@ -338,5 +372,5 @@
 
     call calcul_fluxs( knon, nisurf, dtime, &
-     &   tsurf, p1lay, cal, beta, coef1lay, ps, &
+     &   tsurf, p1lay, cal, beta, tq_cdrag, ps, &
      &   precip_rain, precip_snow, snow, qsol,  &
      &   radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, &
@@ -386,5 +420,5 @@
      & tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
      & precip_rain, precip_snow, lwdown, swnet, swdown, &
-     & tsurf, p1lay, coef1lay, ps, radsol, &
+     & tsurf, p1lay, ps, radsol, &
      & evap, fluxsens, fluxlat, &              
      & tsol_rad, tsurf_new, alb_new, emis_new, z0_new, dflux_l, dflux_s)
@@ -427,5 +461,4 @@
 !   tsurf        temperature de surface
 !   p1lay        pression 1er niveau (milieu de couche)
-!   coef1lay     coefficient d'echange
 !   ps           pression au sol
 !   radsol       rayonnement net aus sol (LW + SW)
@@ -463,5 +496,5 @@
   real, dimension(knon), intent(IN) :: precip_rain, precip_snow
   real, dimension(knon), intent(IN) :: lwdown, swnet, swdown, ps
-  real, dimension(knon), intent(IN) :: tsurf, p1lay, coef1lay
+  real, dimension(knon), intent(IN) :: tsurf, p1lay
   real, dimension(knon), intent(IN) :: radsol
 ! Parametres de sortie
@@ -569,11 +602,20 @@
       & ocean, nexca, debut, lafin, &
       & swdown, lwdown, precip_rain, precip_snow, evap, tsurf, &
-      & fder, albsol, taux, tauy, &
+      & fder, albsol, taux, tauy, zmasq, &
       & tsurf_new, alb_new, alb_ice, pctsrf_new)
-
-
 
 ! Cette routine sert d'interface entre le modele atmospherique et un 
 ! coupleur avec un modele d'ocean 'complet' derriere
+!
+! Le modele de glace qu'il est prevu d'utiliser etant couple directement a 
+! l'ocean presentement, on va passer deux fois dans cette routine par pas de 
+! temps physique, une fois avec les points oceans et l'autre avec les points
+! glace. A chaque pas de temps de couplage, la lecture des champs provenant
+! du coupleur se fera "dans" l'ocean et l'ecriture des champs a envoyer
+! au coupleur "dans" la glace. Il faut donc des tableaux de travail "tampons"
+! dimensionnes sur toute la grille qui remplissent les champs sur les
+! domaines ocean/glace quand il le faut. Il est aussi necessaire que l'index
+! ocean soit traiter avant l'index glace (sinon tout intervertir)
+!
 !
 ! L. Fairhead 02/2000
@@ -605,4 +647,5 @@
 !   tauy         tension de vent en y
 !   nexca        frequence de couplage
+!   zmasq        masque terre/ocean
 !
 !
@@ -632,4 +675,5 @@
   real, dimension(knon), intent(IN) :: tsurf, fder, albsol, taux, tauy
   integer              :: nexca
+  real, dimension(klon), intent(IN) :: zmasq
 
   real, dimension(knon), intent(INOUT) :: evap
@@ -646,21 +690,31 @@
   logical              :: check = .true.
 ! variables pour moyenner les variables de couplage
-  real, allocatable, dimension(:),save :: cpl_sols, cpl_nsol, cpl_rain
-  real, allocatable, dimension(:),save :: cpl_snow, cpl_evap, cpl_tsol
-  real, allocatable, dimension(:),save :: cpl_fder, cpl_albe, cpl_taux
-  real, allocatable, dimension(:),save :: cpl_tauy, cpl_ruis
+  real, allocatable, dimension(:,:),save :: cpl_sols, cpl_nsol, cpl_rain
+  real, allocatable, dimension(:,:),save :: cpl_snow, cpl_evap, cpl_tsol
+  real, allocatable, dimension(:,:),save :: cpl_fder, cpl_albe, cpl_taux
+  real, allocatable, dimension(:,:),save :: cpl_tauy, cpl_rriv, cpl_rcoa
+! variables tampons avant le passage au coupleur
+  real, allocatable, dimension(:,:,:),save :: tmp_sols, tmp_nsol, tmp_rain
+  real, allocatable, dimension(:,:,:),save :: tmp_snow, tmp_evap, tmp_tsol
+  real, allocatable, dimension(:,:,:),save :: tmp_fder, tmp_albe, tmp_taux
+  real, allocatable, dimension(:,:,:),save :: tmp_tauy, tmp_rriv, tmp_rcoa
 ! variables a passer au coupleur
-  real, dimension(iim, jjm+1) :: wri_sols, wri_nsol, wri_rain
-  real, dimension(iim, jjm+1) :: wri_snow, wri_evap, wri_tsol
-  real, dimension(iim, jjm+1) :: wri_fder, wri_albe, wri_taux
-  real, dimension(iim, jjm+1) :: wri_tauy, wri_ruis
+  real, dimension(iim, jjm+1) :: wri_sol_ice, wri_sol_sea, wri_nsol_ice 
+  real, dimension(iim, jjm+1) :: wri_nsol_sea, wri_fder_ice, wri_evap_ice
+  real, dimension(iim, jjm+1) :: wri_evap_sea
+  real, dimension(iim, jjm+1) :: wri_rain, wri_snow, wri_taux
+  real, dimension(iim, jjm+1) :: wri_tauy, wri_rriv, wri_rcoa
 ! variables relues par le coupleur
-  real, dimension(iim, jjm+1) :: read_sst, read_sic
-  real, dimension(iim, jjm+1) :: read_alb_sst, read_alb_sic
+! read_sic = fraction de glace
+! read_sit = temperature de glace
+  real, allocatable, dimension(:,:),save :: read_sst, read_sic, read_sit
+  real, allocatable, dimension(:,:),save :: read_alb_sic
 ! variable tampon
   real, dimension(klon)       :: tamp
   real, dimension(knon)       :: tamp_sic
-
-
+  real, dimension(iim, jjm+1, 2) :: tamp_srf
+  integer, allocatable, dimension(:), save :: tamp_ind
+  real, allocatable, dimension(:,:),save :: tamp_zmasq
+  real, dimension(iim, jjm+1) :: deno
 !
 ! Initialisation
@@ -668,41 +722,37 @@
   if (debut) then
     sum_error = 0
-    allocate(cpl_sols(knon), stat = error)
-    sum_error = sum_error + error
-    allocate(cpl_nsol(knon), stat = error)
-    sum_error = sum_error + error
-    allocate(cpl_rain(knon), stat = error)
-    sum_error = sum_error + error
-    allocate(cpl_snow(knon), stat = error)
-    sum_error = sum_error + error
-    allocate(cpl_evap(knon), stat = error)
-    sum_error = sum_error + error
-    allocate(cpl_tsol(knon), stat = error)
-    sum_error = sum_error + error
-    allocate(cpl_fder(knon), stat = error)
-    sum_error = sum_error + error
-    allocate(cpl_albe(knon), stat = error)
-    sum_error = sum_error + error
-    allocate(cpl_taux(knon), stat = error)
-    sum_error = sum_error + error
-    allocate(cpl_tauy(knon), stat = error)
-    sum_error = sum_error + error
-    allocate(cpl_ruis(knon), stat = error)
-    sum_error = sum_error + error
+    allocate(cpl_sols(knon,2), stat = error); sum_error = sum_error + error
+    allocate(cpl_nsol(knon,2), stat = error); sum_error = sum_error + error
+    allocate(cpl_rain(knon,2), stat = error); sum_error = sum_error + error
+    allocate(cpl_snow(knon,2), stat = error); sum_error = sum_error + error
+    allocate(cpl_evap(knon,2), stat = error); sum_error = sum_error + error
+    allocate(cpl_tsol(knon,2), stat = error); sum_error = sum_error + error
+    allocate(cpl_fder(knon,2), stat = error); sum_error = sum_error + error
+    allocate(cpl_albe(knon,2), stat = error); sum_error = sum_error + error
+    allocate(cpl_taux(knon,2), stat = error); sum_error = sum_error + error
+    allocate(cpl_tauy(knon,2), stat = error); sum_error = sum_error + error
+    allocate(cpl_rcoa(knon,2), stat = error); sum_error = sum_error + error
+    allocate(cpl_rriv(knon,2), stat = error); sum_error = sum_error + error
+    allocate(read_sst(iim, jjm+1), stat = error); sum_error = sum_error + error
+    allocate(read_sic(iim, jjm+1), stat = error); sum_error = sum_error + error
+    allocate(read_sit(iim, jjm+1), stat = error); sum_error = sum_error + error
+    allocate(read_sit(iim, jjm+1), stat = error); sum_error = sum_error + error
+    allocate(read_alb_sic(iim, jjm+1), stat = error); sum_error = sum_error + error
+
     if (sum_error /= 0) then
       abort_message='Pb allocation variables couplees'
       call abort_gcm(modname,abort_message,1)
     endif
-    cpl_sols = 0.
-    cpl_nsol = 0.
-    cpl_rain = 0.
-    cpl_snow = 0.
-    cpl_evap = 0.
-    cpl_tsol = 0.
-    cpl_fder = 0.
-    cpl_albe = 0.
-    cpl_taux = 0.
-    cpl_tauy = 0.
-    cpl_ruis = 0.
+    cpl_sols = 0.; cpl_nsol = 0.; cpl_rain = 0.; cpl_snow = 0.
+    cpl_evap = 0.; cpl_tsol = 0.; cpl_fder = 0.; cpl_albe = 0.
+    cpl_taux = 0.; cpl_tauy = 0.; cpl_rriv = 0.; cpl_rcoa = 0.
+
+    sum_error = 0
+    allocate(tamp_ind(klon), stat = error); sum_error = sum_error + error
+    allocate(tamp_zmasq(iim, jjm+1), stat = error); sum_error = sum_error + error    
+    do ig = 1, klon
+      tamp_ind(ig) = ig
+    enddo
+    call gath2cpl(zmasq, tamp_zmasq, klon, klon, iim, jjm, tamp_ind)
 !
 ! initialisation couplage
@@ -712,10 +762,179 @@
 ! 1ere lecture champs ocean
 !
-    call fromcpl(itime,(jjm+1)*iim,                                          &
-     &        read_sst, read_sic, read_alb_sst, read_alb_sic)
+    if (nisurf == is_oce) then
+      call fromcpl(itime,(jjm+1)*iim,                                  &
+     &        read_sst, read_sic, read_sit, read_alb_sic)
+!
+! je voulais utiliser des where mais ca ne voulait pas compiler dans un 
+! if construct sur sun
+!
+      do j = 1, jjm + 1
+        do ig = 1, iim
+          if (abs(1. - read_sic(ig,j)) < 0.00001) then
+            read_sst(ig,j) = RTT - 1.8
+            read_sit(ig,j) = read_sit(ig,j) / read_sic(ig,j)
+            read_alb_sic(ig,j) = read_alb_sic(ig,j) / read_sic(ig,j)
+          else if (abs(read_sic(ig,j)) < 0.00001) then
+            read_sst(ig,j) = read_sst(ig,j) / (1. - read_sic(ig,j))
+            read_sit(ig,j) = read_sst(ig,j)
+            read_alb_sic(ig,j) =  0.6
+          else
+            read_sst(ig,j) = read_sst(ig,j) / (1. - read_sic(ig,j))
+            read_sit(ig,j) = read_sit(ig,j) / read_sic(ig,j)
+            read_alb_sic(ig,j) = read_alb_sic(ig,j) / read_sic(ig,j)
+          endif
+        enddo
+      enddo
+    endif
+
+  endif ! fin if (debut)
+
+! fichier restart et fichiers histoires
+
+! calcul des fluxs a passer
+
+  cpl_sols(:,nisurf) = cpl_sols(:,nisurf) + swdown      / FLOAT(nexca)
+  cpl_nsol(:,nisurf) = cpl_nsol(:,nisurf) + lwdown      / FLOAT(nexca)
+  cpl_rain(:,nisurf) = cpl_rain(:,nisurf) + precip_rain / FLOAT(nexca)
+  cpl_snow(:,nisurf) = cpl_snow(:,nisurf) + precip_snow / FLOAT(nexca)
+  cpl_evap(:,nisurf) = cpl_evap(:,nisurf) + evap        / FLOAT(nexca)
+  cpl_tsol(:,nisurf) = cpl_tsol(:,nisurf) + tsurf       / FLOAT(nexca)
+  cpl_fder(:,nisurf) = cpl_fder(:,nisurf) + fder        / FLOAT(nexca)
+  cpl_albe(:,nisurf) = cpl_albe(:,nisurf) + albsol      / FLOAT(nexca)
+  cpl_taux(:,nisurf) = cpl_taux(:,nisurf) + taux        / FLOAT(nexca)
+  cpl_tauy(:,nisurf) = cpl_tauy(:,nisurf) + tauy        / FLOAT(nexca)
+  cpl_rriv(:,nisurf) = cpl_rriv(:,nisurf) + run_off     / FLOAT(nexca)/dtime
+  cpl_rcoa(:,nisurf) = cpl_rcoa(:,nisurf) + run_off     / FLOAT(nexca)/dtime
+
+  if (mod(itime, nexca) == 0) then
+!
+! Mise sur la bonne grille des champs a passer au coupleur
+!
+! allocation memoire
+    sum_error = 0
+    allocate(tmp_sols(iim,jjm+1,2), stat=error); sum_error = sum_error + error
+    allocate(tmp_nsol(iim,jjm+1,2), stat=error); sum_error = sum_error + error
+    allocate(tmp_rain(iim,jjm+1,2), stat=error); sum_error = sum_error + error
+    allocate(tmp_snow(iim,jjm+1,2), stat=error); sum_error = sum_error + error
+    allocate(tmp_evap(iim,jjm+1,2), stat=error); sum_error = sum_error + error
+    allocate(tmp_tsol(iim,jjm+1,2), stat=error); sum_error = sum_error + error
+    allocate(tmp_fder(iim,jjm+1,2), stat=error); sum_error = sum_error + error
+    allocate(tmp_albe(iim,jjm+1,2), stat=error); sum_error = sum_error + error
+    allocate(tmp_taux(iim,jjm+1,2), stat=error); sum_error = sum_error + error
+    allocate(tmp_tauy(iim,jjm+1,2), stat=error); sum_error = sum_error + error
+    allocate(tmp_rriv(iim,jjm+1,2), stat=error); sum_error = sum_error + error
+    allocate(tmp_rcoa(iim,jjm+1,2), stat=error); sum_error = sum_error + error
+    if (sum_error /= 0) then
+      abort_message='Pb allocation variables couplees'
+      call abort_gcm(modname,abort_message,1)
+    endif
+
+    call gath2cpl(cpl_sols(1,nisurf), tmp_sols(1,1,nisurf), klon, knon,iim,jjm, knindex)
+    call gath2cpl(cpl_nsol(1,nisurf), tmp_nsol(1,1,nisurf), klon, knon,iim,jjm, knindex)
+    call gath2cpl(cpl_rain(1,nisurf), tmp_rain(1,1,nisurf), klon, knon,iim,jjm, knindex)
+    call gath2cpl(cpl_snow(1,nisurf), tmp_snow(1,1,nisurf), klon, knon,iim,jjm, knindex)
+    call gath2cpl(cpl_evap(1,nisurf), tmp_evap(1,1,nisurf), klon, knon,iim,jjm, knindex)
+    call gath2cpl(cpl_tsol(1,nisurf), tmp_tsol(1,1,nisurf), klon, knon,iim,jjm, knindex)
+    call gath2cpl(cpl_fder(1,nisurf), tmp_fder(1,1,nisurf), klon, knon,iim,jjm, knindex)
+    call gath2cpl(cpl_albe(1,nisurf), tmp_albe(1,1,nisurf), klon, knon,iim,jjm, knindex)
+    call gath2cpl(cpl_taux(1,nisurf), tmp_taux(1,1,nisurf), klon, knon,iim,jjm, knindex)
+    call gath2cpl(cpl_tauy(1,nisurf), tmp_tauy(1,1,nisurf), klon, knon,iim,jjm, knindex)
+    call gath2cpl(cpl_rriv(1,nisurf), tmp_rriv(1,1,nisurf), klon, knon,iim,jjm, knindex)
+    call gath2cpl(cpl_rcoa(1,nisurf), tmp_rcoa(1,1,nisurf), klon, knon,iim,jjm, knindex)
+!
+! Passage des champs au/du coupleur
+!
+! Si le domaine considere est l'ocean, on lit les champs venant du coupleur
+!
+    if (nisurf == is_oce) then
+      call fromcpl(itime,(jjm+1)*iim,                                  &
+     &        read_sst, read_sic, read_sit, read_alb_sic)
+      do j = 1, jjm + 1
+        do ig = 1, iim
+          if (abs(1. - read_sic(ig,j)) < 0.00001) then
+            read_sst(ig,j) = RTT - 1.8
+            read_sit(ig,j) = read_sit(ig,j) / read_sic(ig,j)
+            read_alb_sic(ig,j) = read_alb_sic(ig,j) / read_sic(ig,j)
+          else if (abs(read_sic(ig,j)) < 0.00001) then
+            read_sst(ig,j) = read_sst(ig,j) / (1. - read_sic(ig,j))
+            read_sit(ig,j) = read_sst(ig,j)
+            read_alb_sic(ig,j) =  0.6
+          else
+            read_sst(ig,j) = read_sst(ig,j) / (1. - read_sic(ig,j))
+            read_sit(ig,j) = read_sit(ig,j) / read_sic(ig,j)
+            read_alb_sic(ig,j) = read_alb_sic(ig,j) / read_sic(ig,j)
+          endif
+        enddo
+      enddo
+    endif 
+!
+! Si le domaine considere est la banquise, on envoie les champs au coupleur
+!
+    if (nisurf == is_sic) then
+      wri_rain = 0.; wri_snow = 0.; wri_rcoa = 0.; wri_rriv = 0. 
+      wri_taux = 0.; wri_tauy = 0.
+      call gath2cpl(pctsrf(1,is_oce), tamp_srf(1,1,1), klon, klon, iim, jjm, tamp_ind)
+      call gath2cpl(pctsrf(1,is_sic), tamp_srf(1,1,2), klon, klon, iim, jjm, tamp_ind)
+
+      wri_sol_ice = tmp_sols(:,:,2)
+      wri_sol_sea = tmp_sols(:,:,1)
+      wri_nsol_ice = tmp_nsol(:,:,2)
+      wri_nsol_sea = tmp_nsol(:,:,1)
+      wri_fder_ice = tmp_fder(:,:,2)
+      wri_evap_ice = tmp_evap(:,:,2)
+      wri_evap_sea = tmp_evap(:,:,1)
+      where (tamp_zmasq /= 1.)
+        deno =  tamp_srf(:,:,1) + tamp_srf(:,:,2)
+        wri_rain = tmp_rain(:,:,1) * tamp_srf(:,:,1) / deno +    &
+      &            tmp_rain(:,:,2) * tamp_srf(:,:,2) / deno
+        wri_snow = tmp_snow(:,:,1) * tamp_srf(:,:,1) / deno +    &
+      &            tmp_snow(:,:,2) * tamp_srf(:,:,2) / deno
+        wri_rriv = tmp_rriv(:,:,1) * tamp_srf(:,:,1) / deno +    &
+      &            tmp_rriv(:,:,2) * tamp_srf(:,:,2) / deno
+        wri_rcoa = tmp_rcoa(:,:,1) * tamp_srf(:,:,1) / deno +    &
+      &            tmp_rcoa(:,:,2) * tamp_srf(:,:,2) / deno
+        wri_taux = tmp_taux(:,:,1) * tamp_srf(:,:,1) / deno +    &
+      &            tmp_taux(:,:,2) * tamp_srf(:,:,2) / deno
+        wri_tauy = tmp_tauy(:,:,1) * tamp_srf(:,:,1) / deno +    &
+      &            tmp_tauy(:,:,2) * tamp_srf(:,:,2) / deno
+      endwhere
+
+      call intocpl(itime, (jjm+1)*iim, wri_sol_ice, wri_sol_sea, wri_nsol_ice,&
+      & wri_nsol_sea, wri_fder_ice, wri_evap_ice, wri_evap_sea, wri_rain, &
+      & wri_snow, wri_rcoa, wri_rriv, wri_taux, wri_tauy, wri_taux, wri_tauy, &
+      & lafin ) 
+      cpl_sols = 0.; cpl_nsol = 0.; cpl_rain = 0.; cpl_snow = 0.
+      cpl_evap = 0.; cpl_tsol = 0.; cpl_fder = 0.; cpl_albe = 0.
+      cpl_taux = 0.; cpl_tauy = 0.; cpl_rriv = 0.; cpl_rcoa = 0.
+!
+! deallocation memoire variables temporaires
+!
+      sum_error = 0
+      deallocate(tmp_sols, stat=error); sum_error = sum_error + error
+      deallocate(tmp_nsol, stat=error); sum_error = sum_error + error
+      deallocate(tmp_rain, stat=error); sum_error = sum_error + error
+      deallocate(tmp_snow, stat=error); sum_error = sum_error + error
+      deallocate(tmp_evap, stat=error); sum_error = sum_error + error
+      deallocate(tmp_fder, stat=error); sum_error = sum_error + error
+      deallocate(tmp_tsol, stat=error); sum_error = sum_error + error
+      deallocate(tmp_albe, stat=error); sum_error = sum_error + error
+      deallocate(tmp_taux, stat=error); sum_error = sum_error + error
+      deallocate(tmp_tauy, stat=error); sum_error = sum_error + error
+      deallocate(tmp_rriv, stat=error); sum_error = sum_error + error
+      deallocate(tmp_rcoa, stat=error); sum_error = sum_error + error
+      if (sum_error /= 0) then
+        abort_message='Pb deallocation variables couplees'
+        call abort_gcm(modname,abort_message,1)
+      endif
+
+    endif
+
+  endif            ! fin nexca
+!
+! on range les variables lues/sauvegardees dans les bonnes variables de sortie
+!
+  if (nisurf == is_oce) then
     call cpl2gath(read_sst, tsurf_new, klon, knon,iim,jjm, knindex)
     call cpl2gath(read_sic, tamp_sic , klon, knon,iim,jjm, knindex)
-    call cpl2gath(read_alb_sst, alb_new, klon, knon,iim,jjm, knindex)
-    call cpl2gath(read_alb_sic, alb_ice, klon, knon,iim,jjm, knindex)
 !
 ! transformer tamp_sic en pctsrf_new
@@ -729,71 +948,7 @@
       endif
     enddo
-
-  endif ! fin if (debut)
-
-! fichier restart et fichiers histoires
-
-! calcul des fluxs a passer
-
-  cpl_sols = cpl_sols + swdown      / FLOAT(nexca)
-  cpl_nsol = cpl_nsol + lwdown      / FLOAT(nexca)
-  cpl_rain = cpl_rain + precip_rain / FLOAT(nexca)
-  cpl_snow = cpl_snow + precip_snow / FLOAT(nexca)
-  cpl_evap = cpl_evap + evap        / FLOAT(nexca)
-  cpl_tsol = cpl_tsol + tsurf       / FLOAT(nexca)
-  cpl_fder = cpl_fder + fder        / FLOAT(nexca)
-  cpl_albe = cpl_albe + albsol      / FLOAT(nexca)
-  cpl_taux = cpl_taux + taux        / FLOAT(nexca)
-  cpl_tauy = cpl_tauy + tauy        / FLOAT(nexca)
-  cpl_ruis = cpl_ruis + run_off     / FLOAT(nexca)/dtime
-
-  if (mod(itime, nexca) == 0) then
-!
-! Mise sur la bonne grille des champs a passer au coupleur
-    call gath2cpl(cpl_sols, wri_sols, klon, knon,iim,jjm, knindex)
-    call gath2cpl(cpl_nsol, wri_nsol, klon, knon,iim,jjm, knindex)
-    call gath2cpl(cpl_rain, wri_rain, klon, knon,iim,jjm, knindex)
-    call gath2cpl(cpl_snow, wri_snow, klon, knon,iim,jjm, knindex)
-    call gath2cpl(cpl_evap, wri_evap, klon, knon,iim,jjm, knindex)
-    call gath2cpl(cpl_tsol, wri_tsol, klon, knon,iim,jjm, knindex)
-    call gath2cpl(cpl_fder, wri_fder, klon, knon,iim,jjm, knindex)
-    call gath2cpl(cpl_albe, wri_albe, klon, knon,iim,jjm, knindex)
-    call gath2cpl(cpl_taux, wri_taux, klon, knon,iim,jjm, knindex)
-    call gath2cpl(cpl_tauy, wri_tauy, klon, knon,iim,jjm, knindex)
-    call gath2cpl(cpl_ruis, wri_ruis, klon, knon,iim,jjm, knindex)
-!
-! Passage des champs au coupleur
-!
-    call intocpl(itime, iim, jjm , wri_sols, wri_nsol, wri_rain, wri_snow, &
-      & wri_evap, wri_tsol, wri_fder, wri_albe, wri_taux, wri_tauy,       &
-      & wri_ruis ) 
-    cpl_sols = 0.
-    cpl_nsol = 0.
-    cpl_rain = 0.
-    cpl_snow = 0.
-    cpl_evap = 0.
-    cpl_tsol = 0.
-    cpl_fder = 0.
-    cpl_albe = 0.
-    cpl_taux = 0.
-    cpl_tauy = 0.
-    cpl_ruis = 0.
-
-    call fromcpl(itime,(jjm+1)*iim,                                          &
-     &        read_sst, read_sic, read_alb_sst, read_alb_sic)
-    call cpl2gath(read_sst, tsurf_new, klon, knon,iim,jjm, knindex)
-    call cpl2gath(read_sic, tamp_sic , klon, knon,iim,jjm, knindex)
-    call cpl2gath(read_alb_sst, alb_new, klon, knon,iim,jjm, knindex)
-    call cpl2gath(read_alb_sic, alb_ice, klon, knon,iim,jjm, knindex)
-! transformer tamp_sic en pctsrf_new
-
-    do ig = 1, klon
-      IF (pctsrf(ig,is_oce) > epsfra .OR.            &
-     &             pctsrf(ig,is_sic) > epsfra) THEN
-            pctsrf_new(ig,is_oce) = pctsrf(ig,is_oce)    &
-     &                        - (tamp_sic(ig)-pctsrf(ig,is_sic))
-            pctsrf_new(ig,is_sic) = tamp_sic(ig)
-      endif
-    enddo
+  else if (nisurf == is_sic) then
+      call cpl2gath(read_sit, tsurf_new, klon, knon,iim,jjm, knindex)
+      call cpl2gath(read_alb_sic, alb_new, klon, knon,iim,jjm, knindex)
   endif
 
@@ -1278,5 +1433,5 @@
 !
     fonte_neige = (nisurf /= is_oce) .AND. &
-     & (snow(i) > 0. .OR. nisurf == is_sic .OR. nisurf == is_lic) &
+     & (snow(i) > epsfra .OR. nisurf == is_sic .OR. nisurf == is_lic) &
      & .AND. (tsurf_new(i) >= RTT)
     if (fonte_neige) tsurf_new(i) = RTT  
@@ -1453,4 +1608,5 @@
   real, dimension(klon)     :: tamp
 
+  tamp = 0.
   do i = 1, knon
     ig = knindex(i)
Index: LMDZ.3.3/branches/rel-LF/libf/phylmd/oasis.F
===================================================================
--- LMDZ.3.3/branches/rel-LF/libf/phylmd/oasis.F	(revision 103)
+++ LMDZ.3.3/branches/rel-LF/libf/phylmd/oasis.F	(revision 105)
@@ -1,15 +1,7 @@
-c
+C $Id$
 C****
-C               *****************
-C               * OASIS ROUTINE *
-C               * ------------- *
-C               *****************
 C
 C**** *INICMA*  - Initialize coupled mode communication for atmosphere
-C
-C     Purpose:
-C     -------
-C     Exchange process identifiers and timestep information
-C     between AGCM, OGCM and COUPLER.
+C                 and exchange some initial information with Oasis
 C
 C     Input:
@@ -17,22 +9,5 @@
 C       KASTP  : total number of timesteps in atmospheric model
 C       KEXCH  : frequency of exchange (in time steps)
-C       KSTEP  : timestep value (in seconds)
-C
-C     Method:
-C     ------
-C     Use named pipes(FIFO) to exchange process identifiers
-C     between the programs
-C
-C     Externals:
-C     ---------
-C     GETPID, MKNOD
-C
-C     Reference:
-C     ---------
-C     See Epicoa 0803 (1992)
-C
-C     Author:
-C     -------
-C     Laurent Terray  92-09-01
+C       KSTEP  : length of timestep (in seconds)
 C
 C     -----------------------------------------------------------
@@ -40,39 +15,33 @@
       SUBROUTINE inicma(kastp,kexch,kstep)
 c
+      INCLUDE 'param.h'
+c
       INTEGER kastp, kexch, kstep
-c
-      INTEGER ime
-      PARAMETER (ime = 1)
-
       INTEGER iparal(3)
-      INTEGER ifcpl, idt, info, imxtag, istep
-c
-#include "dimensions.h"
-#include "dimphy.h"
-#include "oasis.h"
-#include "clim.h"
-c
-c     Addition for SIPC CASE
-#include "param_sipc.h"
-#include "param_cou.h"
-#include "inc_sipc.h"
-#include "inc_cpl.h"
-      CHARACTER*9 clpoolnam 
-      INTEGER ipoolhandle, imrc, ipoolsize, index, jf
+      INTEGER ifcpl, idt, info, imxtag, istep, jf
+c
+      INCLUDE 'param_cou.h'
+      INCLUDE 'inc_cpl.h'
       CHARACTER*3 cljobnam      ! experiment name
       CHARACTER*6 clmodnam      ! model name
+c     EM: not used by Oasis2.4
+CEM      CHARACTER*6 clbid(2)      ! for CLIM_Init call (not used)
+CEM                                ! must be dimensioned by the number of models
+CEM      INTEGER nbid(2)           ! for CLIM_Init call (not used)
+CEM                                ! must be dimensioned by the number of models
       CHARACTER*5 cloasis       ! coupler name (Oasis)
-      INTEGER imess(4), imesso(4)
-      INTEGER getpid, mknod ! system functions
-      CHARACTER*80 clcmd
-      CHARACTER*8 pipnom, fldnom
-      INTEGER ierror, iretcode
-C
+      INTEGER imess(4)
+      INTEGER getpid            ! system functions
       INTEGER nuout
+CEM      LOGICAL llmodel
       PARAMETER (nuout = 6)
 c
-C
-c
-
+      INCLUDE 'clim.h'
+      INCLUDE 'mpiclim.h'
+c
+      INCLUDE 'oasis.h' ! contains the name of communication technique. Here
+                        ! cchan=CLIM only is possible.
+c			! ctype=MPI2
+c
 C     -----------------------------------------------------------
 C
@@ -87,284 +56,163 @@
       WRITE(nuout,*) ' '
 c
-c     1.2.1-Define the model name
-c
-      clmodnam = 'lmd.xx'       ! as $NBMODEL in namcouple
-c
-c     1.2.2-Define the coupler name
-c
-      cloasis = 'Oasis'        !  as in coupler
-c
-c
-c     1.3.1-Define symbolic name for fields exchanged from atmos to coupler,
+c     Define the model name
+c
+      clmodnam = 'toyatm'       ! as in $NBMODEL in Cpl/Nam/namcouple.tmp
+c
+c     Define the coupler name
+c
+      cloasis = 'Oasis'        !  always 'Oasis' as in the coupler
+c
+c
+c     Define symbolic name for fields exchanged from atmos to coupler,
 c         must be the same as (1) of the field  definition in namcouple:
 c
-      cl_writ(1)='CONSFTOT'
-      cl_writ(2)='COSHFTOT'
-      cl_writ(3)='COTOPRSU'
-      cl_writ(4)='COTFSHSU'
-      cl_writ(5)='CORUNCOA'
-      cl_writ(6)='CORIVFLU'
-      cl_writ(7)='COZOTAUX'
-      cl_writ(8)='COZOTAU2'
-      cl_writ(9)='COMETAUY'
-      cl_writ(10)='COMETAU2'
-c
-c     1.3.2-Define files name for fields exchanged from atmos to coupler,
+      cl_writ(1)='COSHFICE'
+      cl_writ(2)='COSHFOCE'
+      cl_writ(3)='CONSFICE'
+      cl_writ(4)='CONSFOCE'
+      cl_writ(5)='CODFLXDT'
+c      cl_writ(6)='COICTEMP'
+      cl_writ(6)='COTFSICE'
+      cl_writ(7)='COTFSOCE'
+      cl_writ(8)='COTOLPSU'
+      cl_writ(9)='COTOSPSU'
+      cl_writ(10)='CORUNCOA'
+      cl_writ(11)='CORIVFLU'
+      cl_writ(12)='COZOTAUX'
+      cl_writ(13)='COZOTAUV'
+      cl_writ(14)='COMETAUY'
+      cl_writ(15)='COMETAUU'
+c
+c     Define files name for fields exchanged from atmos to coupler,
 c         must be the same as (6) of the field  definition in namcouple:
 c
-      cl_f_writ(1)='atmflx'
-      cl_f_writ(2)='atmflx'
-      cl_f_writ(3)='atmflx'
-      cl_f_writ(4)='atmflx'
-      cl_f_writ(5)='atmflx'
-      cl_f_writ(6)='atmflx'
-      cl_f_writ(7)='atmtau'
-      cl_f_writ(8)='atmtau'
-      cl_f_writ(9)='atmtau'
-      cl_f_writ(10)='atmtau'
-c
-c
-c     1.4.1-Define symbolic name for fields exchanged from coupler to atmosphere,
+      cl_f_writ(1)='flxatmos'
+      cl_f_writ(2)='flxatmos'
+      cl_f_writ(3)='flxatmos'
+      cl_f_writ(4)='flxatmos'
+      cl_f_writ(5)='flxatmos'
+      cl_f_writ(6)='flxatmos'
+      cl_f_writ(7)='flxatmos'
+      cl_f_writ(8)='flxatmos'
+      cl_f_writ(9)='flxatmos'
+      cl_f_writ(10)='flxatmos'
+      cl_f_writ(11)='flxatmos'
+      cl_f_writ(12)='flxatmos'
+      cl_f_writ(13)='flxatmos'
+      cl_f_writ(14)='flxatmos'
+      cl_f_writ(15)='flxatmos'
+c      cl_f_writ(16)='flxatmos'
+c
+c
+c     Define symbolic name for fields exchanged from coupler to atmosphere,
 c         must be the same as (2) of the field  definition in namcouple:
 c
-      cl_read(1)='SISUTESU'
+      cl_read(1)='SISUTESW'
       cl_read(2)='SIICECOV'
-c
-c     1.4.2-Define files names for fields exchanged from coupler to atmosphere,
+      cl_read(3)='SIICEALW'
+      cl_read(4)='SIICTEMW'
+c
+c     Define files names for fields exchanged from coupler to atmosphere,
 c         must be the same as (7) of the field  definition in namcouple:
 c
-      cl_f_read(1)='atmsst'
-      cl_f_read(2)='atmice'
-c
-c     1.5-Define infos for sending to oasis
-c
-      imess(1) = kastp
-      imess(2) = kexch
-      imess(3) = kstep
-      imess(4) = getpid()
-
-c
-c
-      IF (cchan.eq.'PIPE') THEN 
-c
-          ierror=0
-c
-c
-          WRITE(nuout,*) ' '
-          WRITE(nuout,*) 'Making pipes for fields to receive from CPL'
-          WRITE(nuout,*) ' '
-c
-c loop to define pipes (ocean=CPL to atmos)
-c
-          DO jf=1, jpfldo2a
-            CALL PIPE_Model_Define(nuout, cl_read(jf), jpread, iretcode)
-            IF (iretcode.ne.0) ierror=ierror+1
-          END DO 
-c
-          WRITE(nuout,*) ' '
-          WRITE(nuout,*) 'Making pipes for fields to send to CPL'
-          WRITE(nuout,*) ' '
-c
-c loop to define pipes (atmos to ocean=CPL)
-c
-          DO jf=1, jpflda2o
-            CALL PIPE_Model_Define(nuout, cl_writ(jf), jpwrit, iretcode)
-            IF (iretcode.ne.0) ierror=ierror+1
-          END DO 
-c
-          IF (ierror.ne.0) THEN
-              WRITE (nuout,*) 'Error in pipes definitions'
-              WRITE (nuout,*) 'STOP inicma'
-              CALL abort
-          END IF 
-c
-          WRITE(nuout,*) ' '
-          WRITE(nuout,*) 'All pipes have been made'
-          WRITE(nuout,*) ' '
-c
-          WRITE(nuout,*) ' '
-          WRITE(nuout,*) 'Communication test between ATM and CPL'
-          WRITE(nuout,*) ' '
-          CALL flush(nuout)
-c
-          CALL PIPE_Model_Stepi(nuout, imess, ime, imesso, ierror)
-c
-          IF (ierror.ne.0) THEN
-              WRITE (nuout,*)
-     $            'Error in exchange first informations with Oasis' 
-              WRITE (nuout,*) 'STOP inicma'
-              CALL abort
-          END IF 
-c
-          WRITE(nuout,*) ' '
-          WRITE(nuout,*) 'Communication test between ATM and CPL is OK'
-          WRITE(nuout,*) ' total simulation time in oasis = ', imesso(1)
-          WRITE(nuout,*) ' total number of iterations is  = ', imesso(2)
-          WRITE(nuout,*) ' value of oasis timestep  is    = ', imesso(3)
-          WRITE(nuout,*) ' process id for oasis  is       = ', imesso(4)
-          WRITE(nuout,*) ' '
-          CALL flush(nuout)
-c
-      ELSE  IF (cchan.eq.'SIPC') THEN
-c
-c debug for more information
-c
-c          CALL SVIPC_debug(1)
-c  
-c
-c     1.1-Define the experiment name :
-c
-          cljobnam = 'IPC'      ! as $JOBNAM in namcouple
-c
-c         3-Attach to shared memory pool used to exchange initial infos 
-c
-          imrc = 0
-          CALL SIPC_Init_Model (cljobnam, clmodnam, 1, imrc)
-          IF (imrc .NE. 0) THEN 
-            WRITE (nuout,*)'   '
-            WRITE (nuout,*)'WARNING: Problem with attachement to', imrc 
-            WRITE (nuout,*)'         initial memory pool(s) in atmos'
-            WRITE (nuout,*)'   '
-            CALL ABORT('STOP in atmos')
-          ENDIF
-c
-c         4-Attach to pools used to exchange fields from atmos to coupler
-c
- 	  DO jf = 1, jpflda2o
-c
-C
-c           Pool name:
-            clpoolnam = 'P'//cl_writ(jf)
-C
-            CALL SIPC_Attach(clpoolnam, ipoolhandle)
-c     
-c           Resulting pool handle:
-            mpoolwrit(jf) = ipoolhandle  
-C
-            END DO 
-C
-c         5-Attach to pools used to exchange fields from coupler to atmos
-c
-          DO jf = 1, jpfldo2a
-c
-c           Pool name:
-            clpoolnam = 'P'//cl_read(jf)
-c
-            CALL SIPC_Attach(clpoolnam, ipoolhandle)
-c
-c           Resulting pool handle:
-            mpoolread(jf) = ipoolhandle  
-c
-          END DO 
-c
-c         6-Exchange of initial infos
-c
-c         Write data array isend to pool READ by Oasis
-c
-          imrc = 0
-          ipoolsize = 4*jpbyteint
-          CALL SVIPC_Write(mpoolinitr, imess, ipoolsize, imrc)
-C
-C         Find error if any
-C
-          IF (imrc .LT. 0) THEN
-              WRITE (nuout,*) '   '
-              WRITE (nuout,*) 'Problem in atmos in writing initial' 
-              WRITE (nuout,*) 'infos to the shared memory segment(s)'
-              WRITE (nuout,*) '   '
-          ELSE
-              WRITE (nuout,*) '   '
-              WRITE (nuout,*) 'Initial infos written in atmos'            
-              WRITE (nuout,*) 'to the shared memory segment(s)'
-              WRITE (nuout,*) '   '
-          ENDIF
-C
-C         Read data array irecv from pool written by Oasis
-C
-          imrc = 0
-          ipoolsize = 4*jpbyteint
-          CALL SVIPC_Read(mpoolinitw, imesso, ipoolsize, imrc)
-C
-C*        Find error if any
-C
-          IF (imrc .LT. 0) THEN
-              WRITE (nuout,*) '   '
-              WRITE (nuout,*) 'Problem in atmos in reading initial' 
-              WRITE (nuout,*) 'infos from the shared memory segment(s)'
-              WRITE (nuout,*) '   '
-          ELSE
-              WRITE (nuout,*) '   '
-              WRITE (nuout,*) 'Initial infos read by atmos'                
-              WRITE (nuout,*) 'from the shared memory segment(s)'
-              WRITE (nuout,*) '   '
-              WRITE(*,*) ' ntime, niter, nstep, Oasis pid:'
-              WRITE(*,*) imesso(1), imesso(2), imesso(3), imesso(4) 
-          ENDIF
-C
-C         Detach from shared memory segment(s)
-C
-          imrc = 0
-          CALL SVIPC_close(mpoolinitw, 0, imrc)
-C
-C         Find error if any
-C
-          IF (imrc .LT. 0) THEN
-              WRITE (nuout,*) 
-     $          'Problem in detaching from shared memory segment(s)'
-              WRITE (nuout,*)
-     $          'used by atmos to read initial infos' 
-          ENDIF
-c
-c
-      ELSE IF (cchan.eq.'CLIM') THEN
-
-c
-c     1.1-Define the experiment name :
+      cl_f_read(1)='sstatmos'
+      cl_f_read(2)='sstatmos'
+      cl_f_read(3)='sstatmos'
+      cl_f_read(4)='sstatmos'
+c
+c
+c     Define the number of processors involved in the coupling for
+c     Oasis (=1) and each model (as last two INTEGER on $CHATYPE line
+c     in the namcouple); they will be stored in a COMMON in mpiclim.h
+c     (used for CLIM/MPI2 only)
+      mpi_nproc(0)=1
+      mpi_nproc(1)=1
+      mpi_nproc(2)=1 
+c
+c     Define infos to be sent initially to oasis
+c
+      imess(1) = kastp      ! total number of timesteps in atmospheric model
+      imess(2) = kexch      ! period of exchange (in time steps)
+      imess(3) = kstep      ! length of atmospheric timestep (in seconds)
+      imess(4) = getpid()   ! PID of atmospheric model
+c
+c     Initialization and exchange of initial info in the CLIM technique
+c
+      IF (cchan.eq.'CLIM') THEN
+c
+c     Define the experiment name :
 c
           cljobnam = 'CLI'      ! as $JOBNAM in namcouple
-
-          OPEN ( UNIT = 7, FILE = 'trace', STATUS = 'unknown',
-     $          FORM = 'formatted')
+c
+c         Start the coupling 
+c         (see lib/clim/src/CLIM_Init for the definition of input parameters)
+c
+cEM          clbid(1)='      '
+cEM          clbid(2)='      '
+cEM          nbid(1)=0
+cEM          nbid(2)=0
+CEM          llmodel=.true.
+c
+c         Define the number of processors used by each model as in
+c         $CHATYPE line of namcouple (used for CLIM/MPI2 only) 
+          mpi_totproc(1)=1
+          mpi_totproc(2)=1
+c
+c         Define names of each model as in $NBMODEL line of namcouple
+c         (used for CLIM/MPI2 only)        
+          cmpi_modnam(1)='toyatm'
+          cmpi_modnam(2)='toyoce'
+c         Start the coupling 
+c
           CALL CLIM_Init ( cljobnam, clmodnam, 3, 7,
      *                 kastp, kexch, kstep,
      *                 5, 3600, 3600, info )
 c
-          IF (info.ne.clim_ok) THEN
+          IF (info.ne.CLIM_Ok) THEN
               WRITE ( nuout, *) ' inicma : pb init clim '
               WRITE ( nuout, *) ' error code is = ', info
-              CALL abort('STOP in inicma')
+              CALL halte('STOP in inicma')
             ELSE
               WRITE(nuout,*) 'inicma : init clim ok '
           ENDIF
 c
-          iparal ( clim_strategy ) = clim_serial
-          iparal ( clim_length   ) = iim*(jjm+1)
+c         For each coupling field, association of a port to its symbolic name
+c
+c         -Define the parallel decomposition associated to the port of each
+c          field; here no decomposition for all ports.
+          iparal ( clim_strategy ) = clim_serial 
+          iparal ( clim_length   ) = imjm
           iparal ( clim_offset   ) = 0
 c
-c loop to define messages (CPL=ocean to atmos)
-c
+c         -Loop on total number of coupler-to-atmosphere fields
+c         (see lib/clim/src/CLIM_Define for the definition of input parameters)
           DO jf=1, jpfldo2a
             CALL CLIM_Define (cl_read(jf), clim_in , clim_double, iparal
      $          , info )  
           END DO 
-
-c
-c loop to define messages (atmos to ocean=CPL)
-c
-          DO jf=1, jpflda2o
+c
+c         -Loop on total number of atmosphere-to-coupler fields 
+c         (see lib/clim/src/CLIM_Define for the definition of input parameters)
+          DO jf=1, jpflda2o1+jpflda2o2
             CALL CLIM_Define (cl_writ(jf), clim_out , clim_double,
      $          iparal, info )   
           END DO 
-
+c
           WRITE(nuout,*) 'inicma : clim_define ok '
+c
+c         -Join a pvm group, wait for other programs and broadcast usefull 
+c          informations to Oasis and to the ocean (see lib/clim/src/CLIM_Start)
           CALL CLIM_Start ( imxtag, info )
           IF (info.ne.clim_ok) THEN
               WRITE ( nuout, *) 'inicma : pb start clim '
               WRITE ( nuout, *) ' error code is = ', info
-              CALL abort('stop in inicma')
+              CALL halte('stop in inicma')
             ELSE
               WRITE ( nuout, *)  'inicma : start clim ok '
           ENDIF
 c
+c         -Get initial information from Oasis
+c          (see lib/clim/src/CLIM_Stepi)
           CALL CLIM_Stepi (cloasis, istep, ifcpl, idt, info)
           IF (info .NE. clim_ok) THEN
@@ -386,21 +234,17 @@
       END
 
-      SUBROUTINE fromcpl(kt, imjm, sst,sic, alb_sst, alb_sic )
+c $Id$
+      SUBROUTINE fromcpl(kt, imjm, sst, gla, tice, albedo)
+c ======================================================================
+c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine reads the SST 
+c and Sea-Ice provided by the coupler with the CLIM (PVM exchange messages)
+c technique. 
+c======================================================================
       IMPLICIT none
-c
-c Laurent Z.X Li (Feb. 10, 1997): It reads the SST and Sea-Ice
-c provided by the coupler. Of course, it waits until it receives
-c the signal from the corresponding pipes.
-c 3 techniques:
-c  - pipes and signals (only on Cray C90 and Cray J90)
-c  - CLIM (PVM exchange messages)
-c  - SVIPC shared memory segments and semaphores
-c
       INTEGER imjm, kt
       REAL sst(imjm)          ! sea-surface-temperature
-      REAL alb_sst(imjm)  ! open sea albedo
-      REAL sic(imjm)      ! sea ice cover
-      REAL alb_sic(imjm)  ! sea ice albedo
-
+      REAL gla(imjm)          ! sea-ice
+      REAL tice(imjm)          ! temp glace
+      REAL albedo(imjm)          ! albedo glace
 c
       INTEGER nuout             ! listing output unit
@@ -408,108 +252,35 @@
 c
       INTEGER nuread, ios, iflag, icpliter
-      CHARACTER*8 pipnom        ! name for the pipe
-      CHARACTER*8 fldnom        ! name for the field
-      CHARACTER*8 filnom        ! name for the data file
-
       INTEGER info, jf
-
-c
-#include "oasis.h"
-#include "clim.h"
-c
-#include "param_cou.h"
-c
-#include "inc_sipc.h"
-#include "inc_cpl.h"
-c
-c     Addition for SIPC CASE
-      INTEGER index
-      CHARACTER*3 cmodinf       ! Header or not
-      CHARACTER*3 cljobnam_r    ! Experiment name in the field brick, if any 
-      INTEGER infos(3)          ! infos in the field brick, if any
+c
+      INCLUDE 'clim.h'
+c
+      INCLUDE 'oasis.h'
+      INCLUDE 'param_cou.h'
+c
+      INCLUDE 'inc_cpl.h'
 c
 c
       WRITE (nuout,*) ' '
-      WRITE (nuout,*) 'Fromcpl: Read fields from CPL, kt=',kt
+      WRITE (nuout,*) 'Fromcpl: Reading fields from CPL, kt=',kt
       WRITE (nuout,*) ' '
       CALL flush (nuout)
 
-      IF (cchan.eq.'PIPE') THEN 
-c
-c UNIT number for fields
-c
-          nuread = 99
-c
-c exchanges from ocean=CPL to atmosphere
+
+      IF (cchan.eq.'CLIM') THEN 
+
+c
+c     -Get interpolated oceanic fields from Oasis
 c
           DO jf=1,jpfldo2a
-            CALL PIPE_Model_Recv(cl_read(jf), icpliter, nuout)
-            OPEN (nuread, FILE=cl_f_read(jf), FORM='UNFORMATTED')
-            IF (jf.eq.1)
-     $          CALL locread(cl_read(jf), sst, imjm, nuread, iflag,
-     $          nuout)
-            IF (jf.eq.2)
-     $          CALL locread(cl_read(jf), sic, imjm, nuread, iflag,
-     $          nuout)
-            IF (jf.eq.3)
-     $          CALL locread(cl_read(jf), alb_sst, imjm, nuread, iflag,
-     $          nuout)
-            IF (jf.eq.4)
-     $          CALL locread(cl_read(jf), alb_sic, imjm, nuread, iflag,
-     $          nuout)
-            CLOSE (nuread)
-          END DO 
-
-c
-      ELSE IF (cchan.eq.'SIPC') THEN 
-c
-c         Define IF a header must be encapsulated within the field brick :
-          cmodinf = 'NOT'                 ! as $MODINFO in namcouple  
-c 
-c         reading of input field sea-surface-temperature SISUTESU
-c
-c
-c         Index of sst in total number of fields jpfldo2a: 
-          index = 1
-c
-          CALL SIPC_Read_Model(index, imjm, cmodinf, 
-     $              cljobnam_r,infos, sst)
-c
-c         reading of input field sea-ice SIICECOV
-c
-c
-c         Index of sea-ice in total number of fields jpfldo2a: 
-          index = 2
-c
-          CALL SIPC_Read_Model(index, imjm, cmodinf, 
-     $              cljobnam_r,infos, sic)
-c         Index of open sea albedo in total number of fields jpfldo2a: 
-          index = 3
-c
-          CALL SIPC_Read_Model(index, imjm, cmodinf, 
-     $              cljobnam_r,infos, alb_sst)
-c         Index of sea-ice albedo in total number of fields jpfldo2a: 
-          index = 4
-c
-          CALL SIPC_Read_Model(index, imjm, cmodinf, 
-     $              cljobnam_r,infos, alb_sic)
-c
-c
-      ELSE IF (cchan.eq.'CLIM') THEN 
-
-c
-c exchanges from ocean=CPL to atmosphere
-c
-        DO jf=1,jpfldo2a
-          IF (jf.eq.1) CALL CLIM_Import (cl_read(jf) , kt, sst, info)
-          IF (jf.eq.2) CALL CLIM_Import (cl_read(jf) , kt, sic, info)
-         IF (jf.eq.3) CALL CLIM_Import (cl_read(jf) , kt, alb_sst, info)
-         IF (jf.eq.4) CALL CLIM_Import (cl_read(jf) , kt, alb_sic, info)
-          IF ( info .NE. CLIM_Ok) THEN
+            IF (jf.eq.1) CALL CLIM_Import (cl_read(jf) , kt, sst, info)
+            IF (jf.eq.2) CALL CLIM_Import (cl_read(jf) , kt, gla, info)
+            IF (jf.eq.3) CALL CLIM_Import (cl_read(jf), kt,albedo, info)
+            IF (jf.eq.4) CALL CLIM_Import (cl_read(jf) , kt, tice, info)
+            IF ( info .NE. CLIM_Ok) THEN
                 WRITE(nuout,*)'Pb in reading ', cl_read(jf), jf
                 WRITE(nuout,*)'Couplage kt is = ',kt
                 WRITE(nuout,*)'CLIM error code is = ', info
-                WRITE(nuout,*)'STOP in Fromcpl'
-                STOP 'Fromcpl'
+                CALL halte('STOP in fromcpl.F')
             ENDIF
           END DO 
@@ -520,32 +291,33 @@
       END
 
-
-      SUBROUTINE intocpl(kt,imjm,
-     .                   fsol, fnsol,
-     .                   rain, snow, evap, ruisoce, ruisriv,
-     .                   taux, tauy, last)
+c $Id$
+      SUBROUTINE intocpl(kt, imjm, fsolice, fsolwat, fnsolice, fnsolwat,
+     $    fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff,
+     $    tauxu, tauxv, tauyv, tauyu, last) 
+c ======================================================================
+c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine provides the 
+c atmospheric coupling fields to the coupler with the CLIM (PVM exchange 
+c messages) technique. 
+c IF last time step, writes output fields to binary files.
+c ======================================================================
       IMPLICIT NONE
-c
-c Laurent Z.X Li (Feb. 10, 1997): It provides several fields to the
-c coupler. Of course, it sends a message to the corresponding pipes
-c after the writting.
-c 3 techniques : pipes
-c                clim
-c                svipc
-c IF last time step WRITE output files anway
-c
-#include "oasis.h"
-
       INTEGER kt, imjm
 c
-      REAL fsol(imjm)
-      REAL fnsol(imjm)
-      REAL rain(imjm)
-      REAL snow(imjm)
-      REAL evap(imjm)
-      REAL ruisoce(imjm)
-      REAL ruisriv(imjm)
-      REAL taux(imjm)
-      REAL tauy(imjm)
+      REAL fsolice(imjm)
+      REAL fsolwat(imjm)
+      REAL fnsolice(imjm)
+      REAL fnsolwat(imjm)
+      REAL fnsicedt(imjm)
+      REAL ictemp(imjm)
+      REAL evice(imjm)
+      REAL evwat(imjm)
+      REAL lpre(imjm)
+      REAL spre(imjm)
+      REAL dirunoff(imjm)
+      REAL rivrunoff(imjm)
+      REAL tauxu(imjm)
+      REAL tauxv(imjm)
+      REAL tauyu(imjm)
+      REAL tauyv(imjm)
       LOGICAL last
 c
@@ -553,23 +325,9 @@
       PARAMETER (nuout = 6)
 c
-c Additions for SVIPC
-c
-      INTEGER index
-      INTEGER infos(3)
-      CHARACTER*3 cmodinf       ! Header or not
-      CHARACTER*3 cljobnam      ! experiment name
-c
-#include "clim.h"
-c
-#include "param_cou.h"
-c
-#include "inc_sipc.h"
-#include "inc_cpl.h"
-c
-C
-      INTEGER nuwrit, ios
-      CHARACTER*8 pipnom
-      CHARACTER*8 fldnom
-      CHARACTER*6 file_name(jpmaxfld)
+      INCLUDE 'clim.h'
+      INCLUDE 'param_cou.h'
+      INCLUDE 'inc_cpl.h'
+c
+      CHARACTER*8 file_name(jpmaxfld)
       INTEGER max_file
       INTEGER file_unit_max, file_unit(jpmaxfld),
@@ -579,38 +337,37 @@
       LOGICAL trouve
 c
+      INCLUDE 'oasis.h'
 c
       icstep=kt 
 c
       WRITE(nuout,*) ' '
-      WRITE(nuout,*) 'Intocpl: send fields to CPL, kt= ', kt
+      WRITE(nuout,*) 'Intocpl: sending fields to CPL, kt= ', kt
       WRITE(nuout,*) ' '
 
-      IF (last.or.(cchan.eq.'PIPE')) THEN 
-c
-c
-c WRITE fields for coupler with pipe technique or for last time step
-c
-c         initialisation
+      IF (last) THEN 
+c
+c     -WRITE fields to binary files for coupler restart at last time step
+c
+c         -initialisation and files opening
 c
           max_file=1
           file_unit_max=99
-c keeps first file name
+c         -keeps first file name
           file_name(max_file)=cl_f_writ(max_file)
-c keeps first file unit
+c         -keeps first file unit
           file_unit(max_file)=file_unit_max
-c decrements file unit maximum
+c         -decrements file unit maximum
           file_unit_max=file_unit_max-1
-c keeps file unit for field
+c         -keeps file unit for field
           file_unit_field(1)=file_unit(max_file)
 c
-c different files names counter
-c
-          
-          DO jf= 2, jpflda2o
+c         -different files names counter
+c
+          DO jf= 2, jpflda2o1 + jpflda2o2
             trouve=.false.
             DO jn= 1, max_file
               IF (.not.trouve) THEN
                   IF (cl_f_writ(jf).EQ.file_name(jn)) THEN
-c keep file unit for field
+c                 -keep file unit for field
                       file_unit_field(jf)=file_unit(jn)
                       trouve=.true.
@@ -619,66 +376,84 @@
             END DO 
             IF (.not.trouve) then
-c increment the number of different files
+c           -increment the number of different files
                 max_file=max_file+1
-c keep file name
+c           -keep file name
                 file_name(max_file)=cl_f_writ(jf)
-c keep file unit for file
+c           -keep file unit for file
                 file_unit(max_file)=file_unit_max
-c keep file unit for field
+c           -keep file unit for field
                 file_unit_field(jf)=file_unit(max_file)
-c decrement unit maximum number from 99 to 98, ...
+c           -decrement unit maximum number from 99 to 98, ...
                 file_unit_max=file_unit_max-1
             END IF 
           END DO 
-          
+c          
           DO jn=1, max_file 
             OPEN (file_unit(jn), FILE=file_name(jn), FORM='UNFORMATTED')
-          END DO 
-          
-          DO jf=1, jpflda2o
+          END DO
+c 
+c         WRITE fields to files          
+          DO jf=1, jpflda2o1 + jpflda2o2
             IF (jf.eq.1)
-     $          CALL locwrite(cl_writ(jf),fnsol, imjm,
+     $          CALL locwrite(cl_writ(jf),fsolice, imjm,
      $          file_unit_field(jf), ierror, nuout) 
             IF (jf.eq.2)
-     $          CALL locwrite(cl_writ(jf),fsol, imjm,
+     $          CALL locwrite(cl_writ(jf),fsolwat, imjm,
      $          file_unit_field(jf), ierror, nuout) 
             IF (jf.eq.3)
-     $          CALL locwrite(cl_writ(jf),rain, imjm,
+     $          CALL locwrite(cl_writ(jf),fnsolice, imjm,
      $          file_unit_field(jf), ierror, nuout) 
             IF (jf.eq.4)
-     $          CALL locwrite(cl_writ(jf),evap, imjm,
+     $          CALL locwrite(cl_writ(jf),fnsolwat, imjm,
      $          file_unit_field(jf), ierror, nuout) 
             IF (jf.eq.5)
-     $          CALL locwrite(cl_writ(jf),ruisoce, imjm,
+     $          CALL locwrite(cl_writ(jf),fnsicedt, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+c            IF (jf.eq.6)
+c     $          CALL locwrite(cl_writ(jf),ictemp, imjm,
+c     $          file_unit_field(jf), ierror, nuout) 
+            IF (jf.eq.6)
+     $          CALL locwrite(cl_writ(jf),evice, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+            IF (jf.eq.7)
+     $          CALL locwrite(cl_writ(jf),evwat, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+            IF (jf.eq.8)
+     $          CALL locwrite(cl_writ(jf),lpre, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+            IF (jf.eq.9)
+     $          CALL locwrite(cl_writ(jf),spre, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+            IF (jf.eq.10)
+     $          CALL locwrite(cl_writ(jf),dirunoff, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+            IF (jf.eq.11)
+     $          CALL locwrite(cl_writ(jf),rivrunoff, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+            IF (jf.eq.12)
+     $          CALL locwrite(cl_writ(jf),tauxu, imjm,
      $          file_unit_field(jf),ierror, nuout) 
-            IF (jf.eq.6)
-     $          CALL locwrite(cl_writ(jf),ruisriv, imjm,
+            IF (jf.eq.13)
+     $          CALL locwrite(cl_writ(jf),tauxv, imjm,
      $          file_unit_field(jf),ierror, nuout) 
-            IF (jf.eq.7)
-     $          CALL locwrite(cl_writ(jf),taux, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.8)
-     $          CALL locwrite(cl_writ(jf),taux, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.9)
-     $          CALL locwrite(cl_writ(jf),tauy, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-            IF (jf.eq.10)
-     $          CALL locwrite(cl_writ(jf),tauy, imjm,
-     $          file_unit_field(jf), ierror, nuout) 
-          END DO 
-C
-C simulate a FLUSH
+            IF (jf.eq.14)
+     $          CALL locwrite(cl_writ(jf),tauyv, imjm,
+     $          file_unit_field(jf),ierror, nuout) 
+            IF (jf.eq.15)
+     $          CALL locwrite(cl_writ(jf),tauyu, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+          END DO 
+C
+C         -simulate a FLUSH
 C
           DO jn=1, max_file 
             CLOSE (file_unit(jn))
           END DO 
-c
-c 
-c
+C
+C
           IF(cchan.eq.'CLIM') THEN 
-c
-c inform PVM daemon, I have finished
-c
+C
+C         -inform PVM daemon that message exchange is finished
+C
               CALL CLIM_Quit (CLIM_ContPvm, info)
               IF (info .NE. CLIM_Ok) THEN
@@ -687,250 +462,41 @@
      $                info
               ENDIF
-              
           END IF 
+          RETURN    
+      END IF 
+C
+      IF(cchan.eq.'CLIM') THEN 
+C
+C     -Give atmospheric fields to Oasis
+C 
+          DO jn=1, jpflda2o1 + jpflda2o2
+C            
+          IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, fsolice, info)
+          IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, fsolwat, info)
+          IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, fnsolice, info)
+          IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, fnsolwat, info)
+          IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, fnsicedt, info)
+c          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, ictemp, info)
+          IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, evice, info)
+          IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, evwat, info)
+          IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, lpre, info)
+          IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, spre, info)
+          IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn),kt,dirunoff, info)
+          IF (jn.eq.11) CALL CLIM_Export(cl_writ(jn),kt,rivrunoff,info)
+          IF (jn.eq.12) CALL CLIM_Export(cl_writ(jn), kt, tauxu, info)
+          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxv, info)
+          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauyv, info)
+          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauyu, info)
           
-      END IF 
-      
-c
-c IF last we have finished
-c
-      IF (last) RETURN 
-      
-      IF (cchan.eq.'PIPE') THEN 
-c
-c Send message to pipes for CPL=ocean
-c
-          DO jf=1, jpflda2o
-            CALL PIPE_Model_Send(cl_writ(jf), kt, nuout)
-          END DO 
-c
-c 
-c
-      ELSE  IF(cchan.eq.'SIPC') THEN 
-c
-c         Define IF a header must be encapsulated within the field brick :
-          cmodinf = 'NOT'                 ! as $MODINFO in namcouple  
-c
-c         IF cmodinf = 'YES', define encapsulated infos to be exchanged
-c		  infos(1) = initial date
-c		  infos(2) = timestep
-c		  infos(3) = actual time
-c
-c         Writing of output field non solar heat flux CONSFTOT
-c
-c         Index of non solar heat flux in total number of fields jpflda2o: 
-          index = 1
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos,fnsol)
-c
-c
-c         Writing of output field solar heat flux COSHFTOT
-c
-c         Index of solar heat flux in total number of fields jpflda2o: 
-          index = 2
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos,fsol)
-c
-c         Writing of output field rain COTOPRSU
-c
-c         Index of rain in total number of fields jpflda2o: 
-          index = 3
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos, rain)
-c
-c         Writing of output field evap COTFSHSU
-c
-c         Index of evap in total number of fields jpflda2o: 
-          index = 4
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos, evap)
-c
-c         Writing of output field ruisoce CORUNCOA
-c
-c         Index of ruisoce in total number of fields jpflda2o: 
-          index = 5
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos, ruisoce)
-c
-c
-c         Writing of output field ruisriv CORIVFLU
-c
-c         Index of ruisriv in total number of fields jpflda2o: 
-          index = 6
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos, ruisriv)
-c
-c
-c         Writing of output field zonal wind stress COZOTAUX
-c
-c         Index of runoff in total number of fields jpflda2o: 
-          index = 7
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos, taux)
-c
-c         Writing of output field meridional wind stress COMETAUY
-c
-c         Index of runoff in total number of fields jpflda2o: 
-          index = 8
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos, taux)
-c
-c
-c         Writing of output field zonal wind stress COMETAU2 (at v point)
-c
-c         Index of runoff in total number of fields jpflda2o: 
-          index = 9
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos, tauy)
-c
-c         Writing of output field meridional wind stress COMETAU2
-c
-c         Index of runoff in total number of fields jpflda2o: 
-          index = 10
-c   
-          CALL SIPC_Write_Model(index, imjm, cmodinf,
-     $                          cljobnam,infos, tauy)
-c
-c
-      ELSE IF(cchan.eq.'CLIM') THEN 
-          
-          DO jn=1, jpflda2o
-            
-            IF (jn.eq.1) CALL CLIM_Export(cl_writ(jn), kt, fnsol, info)
-            IF (jn.eq.2) CALL CLIM_Export(cl_writ(jn), kt, fsol, info)
-            IF (jn.eq.3) CALL CLIM_Export(cl_writ(jn), kt, rain, info)
-            IF (jn.eq.4) CALL CLIM_Export(cl_writ(jn), kt, evap, info)
-            IF (jn.eq.5) CALL CLIM_Export(cl_writ(jn), kt, ruisoce, info
-     $          )
-            IF (jn.eq.6) CALL CLIM_Export(cl_writ(jn), kt, ruisriv, info
-     $          )
-            IF (jn.eq.7) CALL CLIM_Export(cl_writ(jn), kt, taux, info)
-            IF (jn.eq.8) CALL CLIM_Export(cl_writ(jn), kt, taux, info)
-            IF (jn.eq.9) CALL CLIM_Export(cl_writ(jn), kt, tauy, info)
-            IF (jn.eq.10) CALL CLIM_Export(cl_writ(jn), kt, tauy, info)
-            
             IF (info .NE. CLIM_Ok) THEN
                 WRITE (nuout,*) 'STEP : Pb giving ',cl_writ(jn), ':',jn
                 WRITE (nuout,*) ' at timestep = ', icstep,'kt = ',kt
                 WRITE (nuout,*) 'Clim error code is = ',info
-                WRITE (nuout,*) 'STOP in intocpl '
-                CALL abort(' intocpl ')
+                CALL halte('STOP in intocpl ')
             ENDIF
-            
-          END DO 
-          
+          END DO 
       ENDIF 
-c
+C
       RETURN
       END
 
-      SUBROUTINE locread
-      print *, 'Attention dans oasis.F, locread est non defini'
-      RETURN
-      END
-
-      SUBROUTINE locwrite
-      print *, 'Attention dans oasis.F, locwrite est non defini'
-      RETURN
-      END
-
-      SUBROUTINE pipe_model_define
-      print*,'Attention dans oasis.F, pipe_model_define est non defini'
-      RETURN
-      END
-
-      SUBROUTINE pipe_model_stepi
-      print*,'Attention dans oasis.F, pipe_model_stepi est non defini'
-      RETURN
-      END
-
-      SUBROUTINE pipe_model_recv
-      print *, 'Attention dans oasis.F, pipe_model_recv est non defini'
-      RETURN
-      END
-
-      SUBROUTINE pipe_model_send
-      print *, 'Attention dans oasis.F, pipe_model_send est non defini'
-      RETURN
-      END
-
-
-      SUBROUTINE sipc_init_model
-      print *, 'Attention dans oasis.F, sipc_init_model est non defini'
-      RETURN
-      END
-
-      SUBROUTINE svipc_write
-      print *, 'Attention dans oasis.F, svipc_write est non defini'
-      RETURN
-      END
-
-      SUBROUTINE clim_export
-      print *, 'Attention dans oasis.F, clim_export est non defini'
-      RETURN
-      END
-
-      SUBROUTINE clim_init
-      print *, 'Attention dans oasis.F, clim_init est non defini'
-      RETURN
-      END
-
-      SUBROUTINE sipc_write_model
-      print *, 'Attention dans oasis.F, sipc_write_model est non defini'
-      RETURN
-      END
-
-      SUBROUTINE clim_start
-      print *, 'Attention dans oasis.F, clim_start est non defini'
-      RETURN
-      END
-
-      SUBROUTINE clim_define
-      print *, 'Attention dans oasis.F, clim_define est non defini'
-      RETURN
-      END
-
-      SUBROUTINE sipc_attach
-      print *, 'Attention dans oasis.F, sipc_attach est non defini'
-      RETURN
-      END
-
-      SUBROUTINE clim_import
-      print *, 'Attention dans oasis.F, clim_import est non defini'
-      RETURN
-      END
-
-      SUBROUTINE svipc_read
-      print *, 'Attention dans oasis.F, svipc_read est non defini'
-      RETURN
-      END
-
-      SUBROUTINE clim_stepi
-      print *, 'Attention dans oasis.F, clim_stepi est non defini'
-      RETURN
-      END
-
-      SUBROUTINE sipc_read_model
-      print *, 'Attention dans oasis.F, sipc_read_model est non defini'
-      RETURN
-      END
-
-      SUBROUTINE svipc_close
-      print *, 'Attention dans oasis.F, svipc_close est non defini'
-      RETURN
-      END
-
-      SUBROUTINE clim_quit
-      print *, 'Attention dans oasis.F, clim_quit est non defini'
-      RETURN
-      END
-
