c
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
C     Input:
C     -----
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
C     -----------------------------------------------------------
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"
#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
      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
C*    1. Initializations
C        ---------------
C
      WRITE(nuout,*) ' '
      WRITE(nuout,*) ' '
      WRITE(nuout,*) ' ROUTINE INICMA'
      WRITE(nuout,*) ' **************'
      WRITE(nuout,*) ' '
      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         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()

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, 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(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.
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

      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
c
      WRITE (nuout,*) ' '
      WRITE (nuout,*) 'Fromcpl: Read 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
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 intocpl(kt,imjm,
     .                   fsol, fnsol,
     .                   rain, snow, evap, ruisoce, ruisriv,
     .                   taux, tauy, last)
      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)
      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*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
          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 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 clim_stepi
      print *, 'Attention dans oasis.F, clim_stepi est non defini'
      RETURN
      END

      SUBROUTINE clim_start
      print *, 'Attention dans oasis.F, clim_start est non defini'
      RETURN
      END

      SUBROUTINE clim_import
      print *, 'Attention dans oasis.F, clim_import 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 clim_define
      print *, 'Attention dans oasis.F, clim_define est non defini'
      RETURN
      END

      SUBROUTINE clim_quit
      print *, 'Attention dans oasis.F, clim_quit est non defini'
      RETURN
      END

      SUBROUTINE svipc_write
      print *, 'Attention dans oasis.F, svipc_write est non defini'
      RETURN
      END

      SUBROUTINE svipc_close
      print *, 'Attention dans oasis.F, svipc_close est non defini'
      RETURN
      END

      SUBROUTINE svipc_read
      print *, 'Attention dans oasis.F, svipc_read est non defini'
      RETURN
      END

      SUBROUTINE quitcpl
      print *, 'Attention dans oasis.F, quitcpl est non defini'
      RETURN
      END

      SUBROUTINE sipc_write_model
      print *, 'Attention dans oasis.F, sipc_write_model est non defini'
      RETURN
      END

      SUBROUTINE sipc_attach
      print *, 'Attention dans oasis.F, sipc_attach est non defini'
      RETURN
      END

      SUBROUTINE sipc_init_model
      print *, 'Attention dans oasis.F, sipc_init_model est non defini'
      RETURN
      END

      SUBROUTINE sipc_read_model
      print *, 'Attention dans oasis.F, sipc_read_model est non defini'
      RETURN
      END