!
! $Header$
!
C $Id: oasis.true 524 2004-05-19 12:53:04Z oboucher $
C****
C
C**** *INICMA*  - Initialize coupled mode communication for atmosphere
C                 and exchange some initial information with Oasis
C
C     Input:
C     -----
C       KASTP  : total number of timesteps in atmospheric model
C       KEXCH  : frequency of exchange (in time steps)
C       KSTEP  : length of timestep (in seconds)
C
C     -----------------------------------------------------------
C
      SUBROUTINE inicma(kastp,kexch,kstep,imjm)
c
c     INCLUDE "param.h"
c
      INTEGER kastp, kexch, kstep,imjm
      INTEGER iparal(3)
      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)
      INTEGER getpid            ! system functions
      INTEGER nuout
CEM      LOGICAL llmodel
      PARAMETER (nuout = 6)
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
C*    1. Initializations
C        ---------------
C
      WRITE(nuout,*) ' '
      WRITE(nuout,*) ' '
      WRITE(nuout,*) ' ROUTINE INICMA'
      WRITE(nuout,*) ' **************'
      WRITE(nuout,*) ' '
      WRITE(nuout,*) ' '
c
c     Define the model name
c
      clmodnam = 'lmdz.x'       ! 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)='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)='COCALVIN'
c$$$      cl_writ(13)='COZOTAUX'
c$$$      cl_writ(14)='COZOTAUV'
c$$$      cl_writ(15)='COMETAUY'
c$$$      cl_writ(16)='COMETAUU'
      cl_writ(13)='COTAUXXU'
      cl_writ(14)='COTAUYYU'
      cl_writ(15)='COTAUZZU'
      cl_writ(16)='COTAUXXV'
      cl_writ(17)='COTAUYYV'
      cl_writ(18)='COTAUZZV'
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)='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'
      cl_f_writ(16)='flxatmos'
      cl_f_writ(17)='flxatmos'
      cl_f_writ(18)='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)='SISUTESW'
      cl_read(2)='SIICECOV'
      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)='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
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)='lmdz.x'
          cmpi_modnam(2)='opa.xx'
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
              WRITE ( nuout, *) ' inicma : pb init clim '
              WRITE ( nuout, *) ' error code is = ', info
              CALL halte('STOP in inicma')
            ELSE
              WRITE(nuout,*) 'inicma : init clim ok '
          ENDIF
c
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 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 )  
            WRITE(nuout,*) 'inicma : clim define done for ',jf
     $          ,cl_read(jf) 
          END DO 
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 )   
            WRITE(nuout,*) 'inicma : clim define done for ',jf
     $          ,cl_writ(jf) 
          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 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
              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

c $Id: oasis.true 524 2004-05-19 12:53:04Z oboucher $
      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
      INTEGER imjm, kt
      REAL sst(imjm)          ! sea-surface-temperature
      REAL gla(imjm)          ! sea-ice
      REAL tice(imjm)          ! temp glace
      REAL albedo(imjm)          ! albedo glace
c
      INTEGER nuout             ! listing output unit
      PARAMETER (nuout=6)
c
      INTEGER nuread, ios, iflag, icpliter
      INTEGER info, jf
c
#include "clim.h"
c
#include "oasis.h"
#include "param_cou.h"
c
#include "inc_cpl.h"
c
c
      WRITE (nuout,*) ' '
      WRITE (nuout,*) 'Fromcpl: Reading fields from CPL, kt=',kt
      WRITE (nuout,*) ' '
      CALL flush (nuout)


      IF (cchan.eq.'CLIM') THEN 

c
c     -Get interpolated oceanic fields from Oasis
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 (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
                CALL halte('STOP in fromcpl.F')
            ENDIF
          END DO 

      ENDIF 
c
      RETURN
      END

c $Id: oasis.true 524 2004-05-19 12:53:04Z oboucher $
      SUBROUTINE intocpl(kt, imjm, fsolice, fsolwat, fnsolice, fnsolwat,
     $    fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff, 
     $    calving, tauxx_u, tauyy_u, tauzz_u, tauxx_v, tauyy_v, tauzz_v
     $    , 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
      INTEGER kt, imjm
c
      REAL fsolice(imjm)
      REAL fsolwat(imjm)
      REAL fnsolwat(imjm)
      REAL fnsolice(imjm) 
      REAL fnsicedt(imjm) 
      REAL evice(imjm)
      REAL evwat(imjm)
      REAL lpre(imjm)
      REAL spre(imjm)
      REAL dirunoff(imjm)
      REAL rivrunoff(imjm)
      REAL calving(imjm)
c$$$      REAL tauxu(imjm)
c$$$      REAL tauxv(imjm)
c$$$      REAL tauyu(imjm)
c$$$      REAL tauyv(imjm)
      REAL tauxx_u(imjm)
      REAL tauxx_v(imjm)
      REAL tauyy_u(imjm)
      REAL tauyy_v(imjm)
      REAL tauzz_u(imjm)
      REAL tauzz_v(imjm)
      LOGICAL last
c
      INTEGER nuout
      PARAMETER (nuout = 6)
c
#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),
     $    file_unit_field(jpmaxfld) 

      INTEGER icstep, info, jn, jf, ierror
      LOGICAL trouve
c
#include "oasis.h"
c
      icstep=kt 
c
      WRITE(nuout,*) ' '
      WRITE(nuout,*) 'Intocpl: sending fields to CPL, kt= ', kt
      WRITE(nuout,*) 'last  ', last
      WRITE(nuout,*)

      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
          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, 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
                      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 
c          
          DO jn=1, max_file 
            OPEN (file_unit(jn), FILE=file_name(jn), FORM='UNFORMATTED')
            WRITE(*,*) 'Opening FILE ', file_unit(jn), ' '
     $          , file_name(jn) 
            REWIND(file_unit(jn))
          END DO
c 
c         WRITE fields to files          
          DO jf=1, jpflda2o1 + jpflda2o2
            IF (jf.eq.1)
     $          CALL locwrite(cl_writ(jf),fsolice, imjm,
     $          file_unit_field(jf), ierror) 
            IF (jf.eq.2)
     $          CALL locwrite(cl_writ(jf),fsolwat, imjm,
     $          file_unit_field(jf), ierror) 
            IF (jf.eq.3)
     $          CALL locwrite(cl_writ(jf),fnsolice, imjm,
     $          file_unit_field(jf), ierror) 
            IF (jf.eq.4)
     $          CALL locwrite(cl_writ(jf),fnsolwat, imjm,
     $          file_unit_field(jf), ierror) 
            IF (jf.eq.5)
     $          CALL locwrite(cl_writ(jf),fnsicedt, imjm,
     $          file_unit_field(jf), ierror) 
c            IF (jf.eq.6)
c     $          CALL locwrite(cl_writ(jf),ictemp, imjm,
c     $          file_unit_field(jf), ierror) 
            IF (jf.eq.6)
     $          CALL locwrite(cl_writ(jf),evice, imjm,
     $          file_unit_field(jf), ierror) 
            IF (jf.eq.7)
     $          CALL locwrite(cl_writ(jf),evwat, imjm,
     $          file_unit_field(jf), ierror) 
            IF (jf.eq.8)
     $          CALL locwrite(cl_writ(jf),lpre, imjm,
     $          file_unit_field(jf), ierror) 
            IF (jf.eq.9)
     $          CALL locwrite(cl_writ(jf),spre, imjm,
     $          file_unit_field(jf), ierror) 
            IF (jf.eq.10)
     $          CALL locwrite(cl_writ(jf),dirunoff, imjm,
     $          file_unit_field(jf), ierror) 
            IF (jf.eq.11)
     $          CALL locwrite(cl_writ(jf),rivrunoff, imjm,
     $          file_unit_field(jf), ierror) 
            IF (jf.eq.12)
     $          CALL locwrite(cl_writ(jf),calving, imjm,
     $          file_unit_field(jf), ierror) 
c$$$            IF (jf.eq.13)
c$$$     $          CALL locwrite(cl_writ(jf),tauxu, imjm,
c$$$     $          file_unit_field(jf),ierror) 
c$$$            IF (jf.eq.1')
c$$$     $          CALL locwrite(cl_writ(jf),tauxv, imjm,
c$$$     $          file_unit_field(jf),ierror) 
c$$$            IF (jf.eq.15)
c$$$     $          CALL locwrite(cl_writ(jf),tauyv, imjm,
c$$$     $          file_unit_field(jf),ierror) 
c$$$            IF (jf.eq.16)
c$$$     $          CALL locwrite(cl_writ(jf),tauyu, imjm,
c$$$     $          file_unit_field(jf), ierror) 
            IF (jf.eq.13)
     $          CALL locwrite(cl_writ(jf),tauxx_u, imjm,
     $          file_unit_field(jf),ierror)
            IF (jf.eq.14)
     $          CALL locwrite(cl_writ(jf),tauyy_u, imjm,
     $          file_unit_field(jf),ierror)
            IF (jf.eq.15)
     $          CALL locwrite(cl_writ(jf),tauzz_u, imjm,
     $          file_unit_field(jf),ierror)
            IF (jf.eq.16)
     $          CALL locwrite(cl_writ(jf),tauxx_v, imjm,
     $          file_unit_field(jf),ierror)
            IF (jf.eq.17)
     $          CALL locwrite(cl_writ(jf),tauyy_v, imjm,
     $          file_unit_field(jf),ierror)
            IF (jf.eq.18)
     $          CALL locwrite(cl_writ(jf),tauzz_v, imjm,
     $          file_unit_field(jf),ierror)
          END DO 
C
C         -simulate a FLUSH
C
          DO jn=1, max_file 
            CLOSE (file_unit(jn))
          END DO 
C
C
          IF(cchan.eq.'CLIM') THEN 
C
C         -inform PVM daemon that message exchange is 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 
          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,calving,info)
c$$$          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxu, info)
c$$$          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauxv, info)
c$$$          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauyv, info)
c$$$          IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauyu, info)
          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxx_u, info)
          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauyy_u, info)
          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauzz_u, info)
          IF (jn.eq.16) CALL CLIM_Export(cl_writ(jn), kt, tauxx_v, info)
          IF (jn.eq.17) CALL CLIM_Export(cl_writ(jn), kt, tauyy_v, info)
          IF (jn.eq.18) CALL CLIM_Export(cl_writ(jn), kt, tauzz_v, 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
                CALL halte('STOP in intocpl ')
            ENDIF
          END DO 
      ENDIF 
C
      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 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