Index: LMDZ.3.3/trunk/libf/phylmd/inc_cpl.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/inc_cpl.h	(revision 13)
+++ LMDZ.3.3/trunk/libf/phylmd/inc_cpl.h	(revision 13)
@@ -0,0 +1,16 @@
+C
+C -- inc_cpl.h  
+C    **********
+C@
+C@  Contents : variables describing field restart file names 
+C@  --------
+C@
+C@ -- cl_write/cl_read  : for fields to write/READ
+C@ -- cl_f_write/cl_f_read  : for fields to write/read
+C@
+C     -------------------------------------------------------------------
+C
+      CHARACTER*8 cl_writ(jpmaxfld), cl_read(jpmaxfld)
+      CHARACTER*8 cl_f_writ(jpmaxfld), cl_f_read(jpmaxfld)
+      COMMON / comcpl / cl_writ, cl_read, cl_f_writ, cl_f_read
+C     -------------------------------------------------------------------
Index: LMDZ.3.3/trunk/libf/phylmd/inc_sipc.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/inc_sipc.h	(revision 13)
+++ LMDZ.3.3/trunk/libf/phylmd/inc_sipc.h	(revision 13)
@@ -0,0 +1,23 @@
+C
+C -- inc_sipc.h   97-08-11   Version 2.0   Author: S&A
+C    **********
+C@
+C@  Contents : variables describing pools formed of shared memory segments 
+C@  --------
+C@
+C@ -- mpoolinit(r/w) : handles associated to model pools for passing initial info
+C@
+C@ -- mpoolwrit : handles associated to pools used to pass fields exchanged 
+C@               from model to coupler (see libsipc/SIPC_Write_Model.f)
+C@
+C@ -- mpoolread : handles associated to pools used to pass fields exchanged
+C@               from model to coupler (see libsipc/SIPC_Read_Model.f) 
+C@ 
+C     -------------------------------------------------------------------
+C
+      INTEGER  mpoolinitr
+      INTEGER  mpoolinitw
+      INTEGER  mpoolwrit(jpflda2o)
+      INTEGER  mpoolread(jpfldo2a)
+      COMMON / compool / mpoolinitr, mpoolinitw, mpoolwrit, mpoolread
+C     -------------------------------------------------------------------
Index: LMDZ.3.3/trunk/libf/phylmd/oasis.F
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/oasis.F	(revision 2)
+++ LMDZ.3.3/trunk/libf/phylmd/oasis.F	(revision 13)
@@ -1,9 +1,2 @@
-      SUBROUTINE inicma(kastp,kexch,kstep)
-      IMPLICIT none
-c
-      INTEGER kastp, kexch, kstep
-c
-      INTEGER ime
-      PARAMETER (ime = 1)
 c
 C****
@@ -45,10 +38,14 @@
 C     -----------------------------------------------------------
 C
-      INTEGER imess(4)
-      INTEGER getpid, mknod ! system functions
-      CHARACTER*80 clcmd
-      CHARACTER*8 pipnom, fldnom
-      INTEGER ierror
-C
+      SUBROUTINE inicma(kastp,kexch,kstep)
+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"
@@ -56,11 +53,26 @@
 #include "clim.h"
 c
-      INTEGER iparal(3)
-      INTEGER istep, ifcpl, idt, info, imxtag
-c
-      INTEGER mode, iret, isize
+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
+      CHARACTER*3 cljobnam      ! experiment name
+      CHARACTER*6 clmodnam      ! model name
+      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 nuout
       PARAMETER (nuout = 6)
+c
+C
+c
+
 C     -----------------------------------------------------------
 C
@@ -75,765 +87,421 @@
       WRITE(nuout,*) ' '
 c
-      IF (cchain.EQ."PIPE") THEN
-c
-      WRITE(nuout,*) " "
-      WRITE(nuout,*) "Making pipes for fields to receive from CPL"
-      WRITE(nuout,*) " "
-c
-c zxli(le17fev97): je ne comprends pas pourquoi il faut
-c                  avoir 2 noms pour un seul pipe
-c
-      pipnom = "SISUTESU"
-      fldnom = "Sisutesu"
-#ifdef CRAY
-      clcmd = "assign -s unblocked -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "SIALBEDO"
-      fldnom = "Sialbedo"
-#ifdef CRAY
-      clcmd = "assign -s unblocked -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "SIICECOV"
-      fldnom = "Siicecov"
-#ifdef CRAY
-      clcmd = "assign -s unblocked -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "SIICEALB"
-      fldnom = "Siicealb"
-#ifdef CRAY
-      clcmd = "assign -s unblocked -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      WRITE(nuout,*) " "
-      WRITE(nuout,*) "Making pipes for fields to send to CPL"
-      WRITE(nuout,*) " "
-c
-      pipnom = "CONSFTOT"
-      fldnom = "Consftot"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COSSTSST"
-      fldnom = "Cosstsst"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "CODFLXDT"
-      fldnom = "Codflxdt"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COSHFTOT"
-      fldnom = "Coshftot"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COALBSUR"
-      fldnom = "Coalbsur"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COTOSPSU"
-      fldnom = "Cotospsu"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COTOLPSU"
-      fldnom = "Cotolpsu"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COTFSHSU"
-      fldnom = "Cotfshsu"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "CORUNCOA"
-      fldnom = "Coruncoa"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "CORIVFLU"
-      fldnom = "Corivflu"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COZOTAUX"
-      fldnom = "Cozotaux"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COMETAUY"
-      fldnom = "Cometauy"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COZOTAU2"
-      fldnom = "Cozotau2"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      pipnom = "COMETAU2"
-      fldnom = "Cometau2"
-#ifdef CRAY
-      clcmd = "assign -s u -a "//pipnom//" f:"//fldnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-      WRITE(nuout,'(a80)') clcmd
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-      WRITE(nuout,'(a80)') clcmd
-#endif
-c
-      WRITE(nuout,*) " "
-      WRITE(nuout,*) "All pipes have been made"
-      WRITE(nuout,*) " "
-      CALL flush(nuout)
-c
-      WRITE(nuout,*) " "
-      WRITE(nuout,*) "Communication test between ATM and CPL"
-      WRITE(nuout,*) " "
-c
-      WRITE (pipnom,'(a6,i2.2)') "Preadm", ime
-#ifdef CRAY
-      clcmd = "assign -s u f:"//pipnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-#endif
-      WRITE(nuout,'(a80)') clcmd
+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         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,
+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,
+c         must be the same as (2) of the field  definition in namcouple:
+c
+      cl_read(1)='SISUTESU'
+      cl_read(2)='SIICECOV'
+c
+c     1.4.2-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()
-#ifdef CRAY
-      WRITE (pipnom) imess ! send message to pipe
-#else
-      iret=0
-      isize=4
-      CALL pipwrite(pipnom, imess, isize, iret)
-#endif
-      WRITE(nuout,*) "Msg sent to pipe "//pipnom
-      CALL flush(nuout)
-c
-      WRITE (pipnom,'(a6,i2.2)') "Pwritm", ime
-#ifdef CRAY
-      clcmd = "assign -s unblocked f:"//pipnom
-      CALL assign(clcmd, ierror)
-      ierror = mknod (pipnom, 4480, 0)
-#else
-      clcmd = "CALL makepipe("//pipnom//",...,...)"
-      mode = o'010600'
-      iret = 0
-      CALL makepipe(pipnom, mode, iret)
-#endif
-      WRITE(nuout,'(a80)') clcmd
-c
-      WRITE(nuout,*) "Waiting for the pipe "//pipnom
-      CALL flush(nuout)
-#ifdef CRAY
-      READ (pipnom) imess ! read message from pipe
-#else
-      isize=1
-      iret =0
-      CALL pipread(pipnom,imess,isize,iret)
-#endif
-c
-      WRITE(nuout,*) " "
-      WRITE(nuout,*) "Communication test between ATM and CPL is OK"
-      WRITE(nuout,*) " total simulation time in oasis = ", imess(1)
-      WRITE(nuout,*) " total number of iterations is  = ", imess(2)
-      WRITE(nuout,*) " value of oasis timestep  is    = ", imess(3)
-      WRITE(nuout,*) " process id for oasis  is       = ", imess(4)
-      WRITE(nuout,*) " "
-      CALL flush(nuout)
-c
-      ELSE ! cchain.EQ."CLIM"
-c
-      CALL CLIM_Init ( 'CLI', 'lmd.xx', 3, 7,
+
+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 :
+c
+          cljobnam = 'CLI'      ! as $JOBNAM in namcouple
+
+          OPEN ( UNIT = 7, FILE = 'trace', STATUS = 'unknown',
+     $          FORM = 'formatted')
+          CALL CLIM_Init ( cljobnam, clmodnam, 3, 7,
      *                 kastp, kexch, kstep,
-     *                 5, 1200, 300, info )
-      IF (info.EQ.CLIM_Ok) THEN
-         WRITE(nuout,*) "inicma: CLIM_Init OK"
-      ELSE
-         WRITE(nuout,*) "inicma: CLIM_Init erreur:", info
-         CALL ABORT("STOP in inicma")
-      ENDIF
-c
-      iparal ( CLIM_Strategy ) = CLIM_Serial
-      iparal ( CLIM_Length   ) = iim*(jjm+1)
-      iparal ( CLIM_Offset   ) = 0
-c
-      CALL CLIM_Define ('SISUTESU', CLIM_In , CLIM_Double, iparal, info)
-      CALL CLIM_Define ('SIALBEDO', CLIM_In , CLIM_Double, iparal, info)
-      CALL CLIM_Define ('SIICECOV', CLIM_In , CLIM_Double, iparal, info)
-      CALL CLIM_Define ('SIICEALB', CLIM_In , CLIM_Double, iparal, info)
-c
-      CALL CLIM_Define ('CONSFTOT', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COSSTSST', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('CODFLXDT', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COSHFTOT', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COALBSUR', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COTOSPSU', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COTOLPSU', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COTFSHSU', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('CORUNCOA', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('CORIVFLU', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COZOTAUX', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COMETAUY', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COZOTAU2', CLIM_Out , CLIM_Double, iparal,info)
-      CALL CLIM_Define ('COMETAU2', CLIM_Out , CLIM_Double, iparal,info)
-      WRITE(nuout,*) 'inicma : CLIM_Define ok '
-c
-      CALL CLIM_Start ( imxtag, info )
-      IF (info.NE.CLIM_Ok) THEN
-          WRITE (nuout,*) "inicma: CLIM_Start pb. ", info
-          CALL ABORT("STOP in inicma")
-      ELSE
-          WRITE (nuout,*)  "inicma: CLIM_Start OK"
-      ENDIF
-c
-      CALL CLIM_Stepi ("oasis", istep, ifcpl, idt, info)
-      IF (info .NE. CLIM_Ok) THEN
-          WRITE (nuout,*) "inicma: CLIM_Stepi pb. ", info
-          CALL ABORT("STOP in inicma")
-      ELSE
-          WRITE (nuout,*) "inicma: CLIM_Stepi OK"
-          WRITE (nuout,*) " number of tstep in oasis ", istep
-          WRITE (nuout,*) " exchange frequency in oasis ", ifcpl
-          WRITE (nuout,*) " length of tstep in oasis ", idt
-      ENDIF
-c
-      ENDIF
-c
+     *                 5, 3600, 3600, info )
+c
+          IF (info.ne.clim_ok) THEN
+              WRITE ( nuout, *) ' inicma : pb init clim '
+              WRITE ( nuout, *) ' error code is = ', info
+              CALL abort('STOP in inicma')
+            ELSE
+              WRITE(nuout,*) 'inicma : init clim ok '
+          ENDIF
+c
+          iparal ( clim_strategy ) = clim_serial
+          iparal ( clim_length   ) = iim*(jjm+1)
+          iparal ( clim_offset   ) = 0
+c
+c loop to define messages (CPL=ocean to atmos)
+c
+          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
+            CALL CLIM_Define (cl_writ(jf), clim_out , clim_double,
+     $          iparal, info )   
+          END DO 
+
+          WRITE(nuout,*) 'inicma : clim_define ok '
+          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')
+            ELSE
+              WRITE ( nuout, *)  'inicma : start clim ok '
+          ENDIF
+c
+          CALL CLIM_Stepi (cloasis, istep, ifcpl, idt, info)
+          IF (info .NE. clim_ok) THEN
+              WRITE ( UNIT = nuout, FMT = *)
+     $            ' warning : problem in getting step info ',
+     $            'from oasis '
+              WRITE (UNIT = nuout, FMT = *)
+     $            ' =======   error code number = ', info
+            ELSE
+              WRITE (UNIT = nuout, FMT = *)
+     $            ' got step information from oasis '
+          ENDIF
+          WRITE ( nuout, *) ' number of tstep in oasis ', istep
+          WRITE ( nuout, *) ' exchange frequency in oasis ', ifcpl
+          WRITE ( nuout, *) ' length of tstep in oasis ', idt
+      ENDIF 
+
       RETURN
       END
-      SUBROUTINE fromcpl(jour, imjm, sst, sic, alb_sst, alb_sic)
+
+      SUBROUTINE fromcpl(kt, imjm, sst, gla)
       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 in the case of utilizing
-c the pipe technique.
-c
-      INTEGER imjm, jour
-      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
-c
-      INTEGER nuout   ! listing output unit
+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 gla(imjm)          ! sea-ice
+c
+      INTEGER nuout             ! listing output unit
       PARAMETER (nuout=6)
 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
+      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"
-      INTEGER info, jktm1
-      INTEGER iret, isize
-c
-      WRITE (nuout,*) " "
-      WRITE (nuout,*) "Fromcpl: Read fields from CPL"
-      WRITE (nuout,*) " "
+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
+c
+      WRITE (nuout,*) ' '
+      WRITE (nuout,*) 'Fromcpl: Read fields from CPL, kt=',kt
+      WRITE (nuout,*) ' '
       CALL flush (nuout)
-c
-      IF (cchain.EQ."PIPE") THEN
-c
-c sea-surface-temperature:
-c
-      pipnom = "Sisutesu"
-      fldnom = "SISUTESU"
-      filnom = "atmsst"
-      WRITE (nuout,*) "Waiting for the pipe "//pipnom
-      CALL flush (nuout)
-#ifdef CRAY
-      READ (pipnom) icpliter
-#else
-      iret = 0
-      isize = 1
-      CALL pipread(pipnom, icpliter, isize, iret)
-#endif
-      WRITE (nuout,*) "Ready to read "//fldnom//" from "//filnom
-      CALL flush (nuout)
-      nuread = 99
-      OPEN(nuread, FILE=filnom, FORM='unformatted', IOSTAT=ios)
-      IF (ios .NE. 0) THEN
-          WRITE(nuout,*) "Error while connecting "//filnom, nuread
-          CALL flush (nuout)
-          CALL ABORT("STOP in Fromcpl")
-      ENDIF
-      REWIND (UNIT = nuread)
-      WRITE(nuout,*) "Reading "//fldnom//" from "//filnom
-      CALL flush (nuout)
-      CALL locread(fldnom, sst, imjm, nuread, iflag)
-      IF (iflag .NE. 0) THEN
-          WRITE(nuout,*) "Pb in reading "//fldnom//" from "//filnom
-          WRITE(nuout,*) "jour, iflag = ", jour, iflag
-          CALL flush (nuout)
-          CALL ABORT('STOP in Fromcpl')
-      ENDIF
-      CLOSE(nuread)
-      WRITE(nuout,*) "Succesful for reading "//fldnom
-      CALL flush (nuout)
-c
-c open sea albedo:
-c
-      pipnom = "Sialbedo"
-      fldnom = "SIALBEDO"
-      filnom = "atmice"
-      WRITE (nuout,*) "Waiting for the pipe "//pipnom
-      CALL flush (nuout)
-#ifdef CRAY
-      READ (pipnom) icpliter
-#else
-      iret = 0
-      isize = 1
-      CALL pipread(pipnom, icpliter, isize, iret)
-#endif
-      WRITE (nuout,*) "Ready to read "//fldnom//" from "//filnom
-      CALL flush (nuout)
-      nuread = 99
-      OPEN(nuread, FILE=filnom, FORM='unformatted', IOSTAT=ios)
-      IF (ios .NE. 0) THEN
-          WRITE(nuout,*) "Error while connecting "//filnom, nuread
-          CALL flush (nuout)
-          CALL ABORT("STOP in Fromcpl")
-      ENDIF
-      REWIND (UNIT = nuread)
-      WRITE(nuout,*) "Reading "//fldnom//" from "//filnom
-      CALL flush (nuout)
-      CALL locread(fldnom, alb_sst, imjm, nuread, iflag)
-      IF (iflag .NE. 0) THEN
-          WRITE(nuout,*) "Pb in reading "//fldnom//" from "//filnom
-          WRITE(nuout,*) "jour, iflag = ", jour, iflag
-          CALL flush (nuout)
-          CALL ABORT('STOP in Fromcpl')
-      ENDIF
-      CLOSE(nuread)
-      WRITE(nuout,*) "Succesful for reading "//fldnom
-      CALL flush (nuout)
-c
-c sea-ice cover:
-c
-      pipnom = "Siicecov"
-      fldnom = "SIICECOV"
-      filnom = "atmice"
-      WRITE (nuout,*) "Waiting for the pipe "//pipnom
-      CALL flush (nuout)
-#ifdef CRAY
-      READ (pipnom) icpliter
-#else
-      iret = 0
-      isize = 1
-      CALL pipread(pipnom, icpliter, isize, iret)
-#endif
-      WRITE (nuout,*) "Ready to read "//fldnom//" from "//filnom
-      CALL flush (nuout)
-      nuread = 99
-      OPEN(nuread, FILE=filnom, FORM='unformatted', IOSTAT=ios)
-      IF (ios .NE. 0) THEN
-          WRITE(nuout,*) "Error while connecting "//filnom, nuread
-          CALL flush (nuout)
-          CALL ABORT("STOP in Fromcpl")
-      ENDIF
-      REWIND (UNIT = nuread)
-      WRITE(nuout,*) "Reading "//fldnom//" from "//filnom
-      CALL flush (nuout)
-      CALL locread(fldnom, sic, imjm, nuread, iflag)
-      IF (iflag .NE. 0) THEN
-          WRITE(nuout,*) "Pb in reading "//fldnom//" from "//filnom
-          WRITE(nuout,*) "jour, iflag = ", jour, iflag
-          CALL flush (nuout)
-          CALL ABORT('STOP in Fromcpl')
-      ENDIF
-      CLOSE(nuread)
-      WRITE(nuout,*) "Succesful for reading "//fldnom
-      CALL flush (nuout)
-c
-c sea-ice albedo:
-c
-      pipnom = "Siicealb"
-      fldnom = "SIICEALB"
-      filnom = "atmice"
-      WRITE (nuout,*) "Waiting for the pipe "//pipnom
-      CALL flush (nuout)
-#ifdef CRAY
-      READ (pipnom) icpliter
-#else
-      iret = 0
-      isize = 1
-      CALL pipread(pipnom, icpliter, isize, iret)
-#endif
-      WRITE (nuout,*) "Ready to read "//fldnom//" from "//filnom
-      CALL flush (nuout)
-      nuread = 99
-      OPEN(nuread, FILE=filnom, FORM='unformatted', IOSTAT=ios)
-      IF (ios .NE. 0) THEN
-          WRITE(nuout,*) "Error while connecting "//filnom, nuread
-          CALL flush (nuout)
-          CALL ABORT("STOP in Fromcpl")
-      ENDIF
-      REWIND (UNIT = nuread)
-      WRITE(nuout,*) "Reading "//fldnom//" from "//filnom
-      CALL flush (nuout)
-      CALL locread(fldnom, alb_sic, imjm, nuread, iflag)
-      IF (iflag .NE. 0) THEN
-          WRITE(nuout,*) "Pb in reading "//fldnom//" from "//filnom
-          WRITE(nuout,*) "jour, iflag = ", jour, iflag
-          CALL flush (nuout)
-          CALL ABORT('STOP in Fromcpl')
-      ENDIF
-      CLOSE(nuread)
-      WRITE(nuout,*) "Succesful for reading "//fldnom
-      CALL flush (nuout)
-c
-      ELSE ! cchain.EQ."CLIM"
-c
-      jktm1=jour-1
-c
-      CALL CLIM_Import ('SISUTESU', jktm1, sst, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE(nuout,*)'Pb in reading ', 'SISUTESU'
-         WRITE(nuout,*)'Atmosphere jour is = ',jour
-         WRITE(nuout,*)'Couplage kt is = ',jktm1
-         WRITE(nuout,*)'CLIM error code is = ', info
-         WRITE(nuout,*)'STOP in Fromcpl'
-         CALL abort
-      ENDIF
-c
-      CALL CLIM_Import ('SIALBEDO', jktm1, alb_sst, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE(nuout,*)'Pb in reading ', 'SIALBEDO'
-         WRITE(nuout,*)'Atmosphere jour is = ',jour
-         WRITE(nuout,*)'Couplage kt is = ',jktm1
-         WRITE(nuout,*)'CLIM error code is = ', info
-         WRITE(nuout,*)'STOP in Fromcpl'
-         CALL abort
-      ENDIF
-c
-      CALL CLIM_Import ('SIICECOV', jktm1, sic, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE(nuout,*)'Pb in reading ', 'SIICECOV'
-         WRITE(nuout,*)'Atmosphere jour is = ',jour
-         WRITE(nuout,*)'Couplage kt is = ',jktm1
-         WRITE(nuout,*)'CLIM error code is = ', info
-         WRITE(nuout,*)'STOP in Fromcpl'
-         CALL abort
-      ENDIF
-c
-      CALL CLIM_Import ('SIICEALB', jktm1, alb_sic, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE(nuout,*)'Pb in reading ', 'SIICEALB'
-         WRITE(nuout,*)'Atmosphere jour is = ',jour
-         WRITE(nuout,*)'Couplage kt is = ',jktm1
-         WRITE(nuout,*)'CLIM error code is = ', info
-         WRITE(nuout,*)'STOP in Fromcpl'
-         CALL abort
-      ENDIF
-c
-      ENDIF ! fin de test sur cchain
+
+      IF (cchan.eq.'PIPE') THEN 
+c
+c UNIT number for fields
+c
+          nuread = 99
+c
+c exchanges from ocean=CPL to atmosphere
+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), gla, 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, gla)
+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, gla, 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'
+            ENDIF
+          END DO 
+
+      ENDIF 
 c
       RETURN
       END
 
-      SUBROUTINE locread (cdfldn, pfield, kdimax, knulre, kflgre)
-      IMPLICIT none
-      INTEGER kdimax, knulre, kflgre
-C****
-C               *****************************
-C               * OASIS ROUTINE  -  LEVEL 0 *
-C               * -------------     ------- *
-C               *****************************
-C
-C**** *locread*  - Read binary field on unit knulre
-C
-C     Purpose:
-C     -------
-C     Find string cdfldn on unit knulre and read array pfield
-C
-C**   Interface:
-C     ---------
-C       *CALL*  *locread (cdfldn, pfield, kdimax, knulre, kflgre)*
-C
-C     Input:
-C     -----
-C                cdfldn : character string locator
-C                kdimax : dimension of field to be read 
-C                knulre : logical unit to be read 
-C
-C     Output:
-C     ------
-C                pfield : field array (real 1D)
-C                kflgre : error status flag
-C
-C     Workspace:
-C     ---------
-C     None
-C
-C     Externals:
-C     ---------
-C     None
-C
-C     Reference:
-C     ---------
-C     See OASIS manual (1995) 
-C
-C     History:
-C     -------
-C       Version   Programmer     Date      Description
-C       -------   ----------     ----      -----------  
-C       2.0       L. Terray      95/09/01  created
-C
-C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-C
-C* ---------------------------- Include files ---------------------------
-C
-C
-C* ---------------------------- Argument declarations -------------------
-C
-      REAL pfield(kdimax)
-      CHARACTER*8 cdfldn
-C
-C* ---------------------------- Local declarations ----------------------
-C
-      CHARACTER*8 clecfl
-      INTEGER nulou
-c
-      nulou = 6
-C
-C* ---------------------------- Poema verses ----------------------------
-C
-C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-C
-C*    1. Initialization
-C        --------------
-C
-c     WRITE (UNIT = nulou,FMT = *) ' '
-c     WRITE (UNIT = nulou,FMT = *) ' '
-c     WRITE (UNIT = nulou,FMT = *) 
-c    $    '           ROUTINE locread  -  Level 0'
-c     WRITE (UNIT = nulou,FMT = *) 
-c    $    '           ***************     *******'
-c     WRITE (UNIT = nulou,FMT = *) ' '
-c     WRITE (UNIT = nulou,FMT = 1001) knulre
-c     WRITE (UNIT = nulou,FMT = *) ' '
-C
-C* Formats
-C
- 1001 FORMAT(5X,' Read binary file connected to unit = ',I3)
-C
-C     2. Find field in file
-C        ------------------
-C
-      REWIND knulre
- 200  CONTINUE
-C* Find string
-      READ (UNIT = knulre, ERR = 210, END = 210) clecfl
-      IF (clecfl .NE. cdfldn) GO TO  200
-C* Read associated field
-      READ (UNIT = knulre, ERR = 210, END = 210) pfield
-C* Reading done and ok
-      kflgre = 0
-      GO TO 220
-C* Problem in reading
- 210  kflgre = 1
- 220  CONTINUE
-C
-C
-C*    3. End of routine
-C        --------------
-C
-c     WRITE (UNIT = nulou,FMT = *) 
-c    $    '          --------- End of routine locread ---------'
-c     WRITE (UNIT = nulou,FMT = *) ' '
-c     CALL FLUSH (nulou)
-      RETURN
-      END
-
-
-      SUBROUTINE intocpl(itau,imjm,
+
+      SUBROUTINE intocpl(kt,imjm,
      .                   fsol, fnsol,
      .                   rain, snow, evap, ruisoce, ruisriv,
-     .                   tsol, fder, albe,
-     .                   taux, tauy)
+     .                   taux, tauy, last)
       IMPLICIT NONE
 c
@@ -841,6 +509,12 @@
 c coupler. Of course, it sends a message to the corresponding pipes
 c after the writting.
-c
-      INTEGER itau, imjm
+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)
@@ -851,458 +525,290 @@
       REAL ruisoce(imjm)
       REAL ruisriv(imjm)
-      REAL tsol(imjm)
-      REAL fder(imjm)
-      REAL albe(imjm)
       REAL taux(imjm)
       REAL tauy(imjm)
+      LOGICAL last
 c
       INTEGER nuout
       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*8 filnom
-c
-c
-#include "oasis.h"
-#include "clim.h"
-      INTEGER info
-      INTEGER isize, iret
-c
-      WRITE(nuout,*) " "
-      WRITE(nuout,*) "Intocpl: send fields to CPL, itau= ", itau
-      WRITE(nuout,*) " "
-c
-      IF (cchain.EQ."PIPE") THEN
-c
-      nuwrit = 99
-      filnom = "atmflx"
-      OPEN(nuwrit, FILE=filnom, FORM="unformatted", IOSTAT=ios)
-      IF (ios .NE. 0) THEN
-          WRITE(6,*) "Error while connecting "//filnom
-          CALL ABORT('STOP in intocpl')
-      ENDIF
-      REWIND ( UNIT = nuwrit)
-c
-      WRITE(nuout,*) " "
-      WRITE(nuout,*) "Writting fields to "//filnom, nuwrit
-      WRITE(nuout,*) " "
-      CALL flush(nuout)
-C
-C            ecriture CONSFTOT (flux non solaire)
-C
-      fldnom = "CONSFTOT"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) fnsol
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C           ecriture COSHFTOT (solaire)
-C
-      fldnom = "COSHFTOT"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) fsol
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C           ecriture COTOLPSU (precipitation liquide)
-C
-      fldnom = "COTOLPSU"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) rain
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C           ecriture COTOSPSU (precipitation solide)
-C
-      fldnom = "COTOSPSU"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) snow
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C           ecriture COTFSHSU (evaporation)
-C
-      fldnom = "COTFSHSU"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) evap
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C           ecriture COSSTSST (temperature du sol)
-C
-      fldnom = "COSSTSST"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) tsol
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C           ecriture CODFLXDT (derivee du flux non-solaire)
-C
-      fldnom = "CODFLXDT"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) fder
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C           ecriture COALBSUR (albedo moyen)
-C
-      fldnom = "COALBSUR"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) albe
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C           ecriture CORUNCOA (runoff DIRECT)
-C
-      fldnom = "CORUNCOA"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) ruisoce
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C           ecriture river runoff 'CORIVFLU'
-C
-      fldnom = "CORIVFLU"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) ruisriv
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-c
-      CLOSE(UNIT = nuwrit)
+      CHARACTER*6 file_name(jpmaxfld)
+      INTEGER max_file
+      INTEGER file_unit_max, file_unit(jpmaxfld),
+     $    file_unit_field(jpmaxfld) 
+
+      INTEGER icstep, info, jn, jf, ierror
+      LOGICAL trouve
+c
+c
+      icstep=kt 
+c
+      WRITE(nuout,*) ' '
+      WRITE(nuout,*) 'Intocpl: send 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
+c
+          max_file=1
+          file_unit_max=99
+c keeps first file name
+          file_name(max_file)=cl_f_writ(max_file)
+c keeps first file unit
+          file_unit(max_file)=file_unit_max
+c decrements file unit maximum
+          file_unit_max=file_unit_max-1
+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
+            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
+                      file_unit_field(jf)=file_unit(jn)
+                      trouve=.true.
+                  END IF 
+              END IF 
+            END DO 
+            IF (.not.trouve) then
+c increment the number of different files
+                max_file=max_file+1
+c keep file name
+                file_name(max_file)=cl_f_writ(jf)
+c keep file unit for file
+                file_unit(max_file)=file_unit_max
+c keep file unit for field
+                file_unit_field(jf)=file_unit(max_file)
+c decrement unit maximum number from 99 to 98, ...
+                file_unit_max=file_unit_max-1
+            END IF 
+          END DO 
+          
+          DO jn=1, max_file 
+            OPEN (file_unit(jn), FILE=file_name(jn), FORM='UNFORMATTED')
+          END DO 
+          
+          DO jf=1, jpflda2o
+            IF (jf.eq.1)
+     $          CALL locwrite(cl_writ(jf),fnsol, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+            IF (jf.eq.2)
+     $          CALL locwrite(cl_writ(jf),fsol, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+            IF (jf.eq.3)
+     $          CALL locwrite(cl_writ(jf),rain, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+            IF (jf.eq.4)
+     $          CALL locwrite(cl_writ(jf),evap, imjm,
+     $          file_unit_field(jf), ierror, nuout) 
+            IF (jf.eq.5)
+     $          CALL locwrite(cl_writ(jf),ruisoce, imjm,
+     $          file_unit_field(jf),ierror, nuout) 
+            IF (jf.eq.6)
+     $          CALL locwrite(cl_writ(jf),ruisriv, 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
 C
-      OPEN(nuwrit, FILE=filnom, FORM='unformatted')
-      CLOSE(UNIT = nuwrit)
-C
-C Send message to pipes:
-c
-      pipnom = 'Consftot'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Coshftot'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Cotolpsu'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Cotospsu'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Cotfshsu'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Cosstsst'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Codflxdt'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Coalbsur'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Coruncoa'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Corivflu'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-C
-C Send wind stresses to coupler
-c
-      nuwrit = 99
-      filnom = "atmtau"
-      OPEN(nuwrit, FILE=filnom, FORM="unformatted", IOSTAT=ios)
-      IF (ios .NE. 0) THEN
-          WRITE(6,*) "Error while connecting "//filnom
-          CALL ABORT('STOP in intocpl')
-      ENDIF
-      REWIND ( UNIT = nuwrit)
-c
-      WRITE(nuout,*) " "
-      WRITE(nuout,*) "Writting fields to "//filnom, nuwrit
-      WRITE(nuout,*) " "
-C
-C ecriture COZOTAUX
-c
-      fldnom = "COZOTAUX"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) taux
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-c
-      fldnom = "COZOTAU2"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) taux
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-C
-C ecriture COMETAUY
-C
-      fldnom = "COMETAUY"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) tauy
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-c
-      fldnom = "COMETAU2"
-      WRITE(UNIT = nuwrit) fldnom, 'LMD7246T00000000OAS DA  '
-      WRITE(UNIT = nuwrit) tauy
-      WRITE(nuout,*) fldnom//" recorded to "//filnom, nuwrit
-c
-      CLOSE(UNIT = nuwrit)
-C
-C simulate a FLUSH
-C
-      OPEN(nuwrit, FILE=filnom, FORM='unformatted')
-      CLOSE(UNIT = nuwrit)
-c
-c Send message to pipes:
-c
-      pipnom = 'Cozotaux'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Cozotau2'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Cometauy'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      pipnom = 'Cometau2'
-#ifdef CRAY
-      WRITE(pipnom) itau
-#else
-      isize=1
-      iret=0
-      CALL pipwrite(pipnom,itau,isize,iret)
-#endif
-      WRITE(nuout,*) "Message sent to pipe "//pipnom
-c
-      ELSE ! cchain.EQ."CLIM"
-c
-      CALL CLIM_Export("CONSFTOT", itau, fnsol, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export fnsol pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COSHFTOT", itau, fsol, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export fsol pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COTOLPSU", itau, rain, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export rain pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COTOSPSU", itau, snow, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export snow pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COTFSHSU", itau, evap, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export evap pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COSSTSST", itau, tsol, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export tsol pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("CODFLXDT", itau, fder, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export fder pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COALBSUR", itau, albe, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export fder pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("CORUNCOA", itau, ruisoce, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export ruisoce pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("CORIVFLU", itau, ruisriv, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export ruisriv pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COZOTAUX", itau, taux, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export taux pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COZOTAU2", itau, taux, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export taux pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COMETAUY", itau, tauy, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export tauy pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      CALL CLIM_Export("COMETAU2", itau, tauy, info)
-      IF (info .NE. CLIM_Ok) THEN
-         WRITE (nuout,*) "intocpl: CLIM_Export tauy pb. ", info
-         CALL ABORT("STOP in intocpl")
-      ENDIF
-c
-      ENDIF
+          DO jn=1, max_file 
+            CLOSE (file_unit(jn))
+          END DO 
+c
+c 
+c
+          IF(cchan.eq.'CLIM') THEN 
+c
+c inform PVM daemon, I have finished
+c
+              CALL CLIM_Quit (CLIM_ContPvm, info)
+              IF (info .NE. CLIM_Ok) THEN
+                  WRITE (6, *) 
+     $                'An error occured while leaving CLIM. Error = ',
+     $                info
+              ENDIF
+              
+          END IF 
+          
+      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 ')
+            ENDIF
+            
+          END DO 
+          
+      ENDIF 
 c
       RETURN
       END
-      SUBROUTINE quitcpl
-      IMPLICIT none
-c
-c Sortir du coupleur
-c
-      INTEGER nuout   ! listing output unit
-      PARAMETER (nuout=6)
-c
-#include "oasis.h"
-#include "clim.h"
-      INTEGER info
-c
-      IF (cchain.EQ."PIPE") THEN
-c
-         WRITE(nuout,*)"On sort du coupleur sans rien faire"
-c
-      ELSE ! cchain.EQ."CLIM"
-c
-         CALL CLIM_Quit(CLIM_StopPvm,info)
-         IF (info.NE.CLIM_Ok) THEN
-            WRITE(nuout,*)"Erreur pour quiter coupleur:",info
-         ENDIF
-c
-      ENDIF
-c
-      RETURN
-      END
-
-
-      SUBROUTINE makepipe
-      PRINT*, "rien"
-      END
-      SUBROUTINE pipwrite
-      PRINT*, "rien"
-      END
-      SUBROUTINE pipread
-      PRINT*, "rien"
-      END
-      SUBROUTINE CLIM_Init
-      PRINT*, "rien"
-      END
-      SUBROUTINE CLIM_Define
-      PRINT*, "rien"
-      END
-      SUBROUTINE CLIM_Start
-      PRINT*, "rien"
-      END
-      SUBROUTINE CLIM_Stepi
-      PRINT*, "rien"
-      END
-      SUBROUTINE CLIM_Import
-      PRINT*, "rien"
-      END
-      SUBROUTINE CLIM_Export
-      PRINT*, "rien"
-      END
-      SUBROUTINE CLIM_quit
-      PRINT*, "rien"
-      END
+
Index: LMDZ.3.3/trunk/libf/phylmd/oasis.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/oasis.h	(revision 2)
+++ LMDZ.3.3/trunk/libf/phylmd/oasis.h	(revision 13)
@@ -2,5 +2,8 @@
       PARAMETER (ok_oasis = .FALSE.)
 c
-      CHARACTER*8 cchain
-      PARAMETER (cchain="PIPE")
-c      PARAMETER (cchain="CLIM")
+      CHARACTER*4 cchan
+      PARAMETER (cchan="PIPE")
+c      PARAMETER (cchan="CLIM")
+
+      INTEGER jpmaxfld
+      PARAMETER(jpmaxfld = 20)
Index: LMDZ.3.3/trunk/libf/phylmd/param_cou.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/param_cou.h	(revision 13)
+++ LMDZ.3.3/trunk/libf/phylmd/param_cou.h	(revision 13)
@@ -0,0 +1,11 @@
+C
+C -- param_cou.h
+C
+	INTEGER jpflda2o
+	PARAMETER(jpflda2o = 1)          ! Number of fields exchanged from
+                                         ! atmosphere to ocean
+C
+	INTEGER jpfldo2a
+	PARAMETER(jpfldo2a = 1)          ! Number of fields exchanged from
+                                         ! ocean to atmosphere
+C
Index: LMDZ.3.3/trunk/libf/phylmd/param_sipc.h
===================================================================
--- LMDZ.3.3/trunk/libf/phylmd/param_sipc.h	(revision 13)
+++ LMDZ.3.3/trunk/libf/phylmd/param_sipc.h	(revision 13)
@@ -0,0 +1,21 @@
+C@
+C@ -- param_sipc.h
+C@
+C@ -- jpbyteint : number of bytes per integer
+C@
+C@ -- jpbyterea : number of bytes per real
+C@
+C@ -- jpbytecha : number of bytes per character
+C@
+	INTEGER jpbyteint,jpbyterea, jpbytecha  
+        PARAMETER (jpbyteint = 4)
+	PARAMETER (jpbyterea = 4)
+	PARAMETER (jpbytecha = 1)
+C@
+C@ -- jptest :  The models will test during 2*jptest seconds if the file 
+C@              DUMMY_SIPC has been created by OASIS, signaling that the
+C@              SHM pools are opened. After, they will abort.
+C@
+        INTEGER jptest
+        PARAMETER(jptest = 100)      
+
