source: LMDZ.3.3/trunk/libf/phylmd/oasis.true @ 2168

C $Id: oasis.true 129 2000-09-13 09:35:40Z lguez $
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)='COZOTAUX'
      cl_writ(13)='COZOTAUV'
      cl_writ(14)='COMETAUY'
      cl_writ(15)='COMETAUU'
c
c     Define files name for fields exchanged from atmos to coupler,
c         must be the same as (6) of the field  definition in namcouple:
c
      cl_f_writ(1)='flxatmos'
      cl_f_writ(2)='flxatmos'
      cl_f_writ(3)='flxatmos'
      cl_f_writ(4)='flxatmos'
      cl_f_writ(5)='flxatmos'
      cl_f_writ(6)='flxatmos'
      cl_f_writ(7)='flxatmos'
      cl_f_writ(8)='flxatmos'
      cl_f_writ(9)='flxatmos'
      cl_f_writ(10)='flxatmos'
      cl_f_writ(11)='flxatmos'
      cl_f_writ(12)='flxatmos'
      cl_f_writ(13)='flxatmos'
      cl_f_writ(14)='flxatmos'
      cl_f_writ(15)='flxatmos'
c      cl_f_writ(16)='flxatmos'
c
c
c     Define symbolic name for fields exchanged from coupler to atmosphere,
c         must be the same as (2) of the field  definition in namcouple:
c
      cl_read(1)='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)='oce.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 )  
          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 )   
          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 129 2000-09-13 09:35:40Z lguez $
      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 129 2000-09-13 09:35:40Z lguez $
      SUBROUTINE intocpl(kt, imjm, fsolice, fsolwat, fnsolice, fnsolwat,
     $    fnsicedt, evice, evwat, lpre, spre, dirunoff, rivrunoff,
     $    tauxu, tauxv, tauyv, tauyu, last) 
c ======================================================================
c S. Valcke (02/99) adapted From L.Z.X Li: this subroutine provides the 
c atmospheric coupling fields to the coupler with the CLIM (PVM exchange 
c messages) technique. 
c IF last time step, writes output fields to binary files.
c ======================================================================
      IMPLICIT NONE
      INTEGER kt, imjm
c
      REAL fsolice(imjm)
      REAL fsolwat(imjm)
      REAL fnsolice(imjm)
      REAL fnsolwat(imjm)
      REAL fnsicedt(imjm)
      REAL ictemp(imjm)
      REAL evice(imjm)
      REAL evwat(imjm)
      REAL lpre(imjm)
      REAL spre(imjm)
      REAL dirunoff(imjm)
      REAL rivrunoff(imjm)
      REAL tauxu(imjm)
      REAL tauxv(imjm)
      REAL tauyu(imjm)
      REAL tauyv(imjm)
      LOGICAL last
c
      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,*) ' '

      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')
          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, nuout) 
            IF (jf.eq.2)
     $          CALL locwrite(cl_writ(jf),fsolwat, imjm,
     $          file_unit_field(jf), ierror, nuout) 
            IF (jf.eq.3)
     $          CALL locwrite(cl_writ(jf),fnsolice, imjm,
     $          file_unit_field(jf), ierror, nuout) 
            IF (jf.eq.4)
     $          CALL locwrite(cl_writ(jf),fnsolwat, imjm,
     $          file_unit_field(jf), ierror, nuout) 
            IF (jf.eq.5)
     $          CALL locwrite(cl_writ(jf),fnsicedt, imjm,
     $          file_unit_field(jf), ierror, nuout) 
c            IF (jf.eq.6)
c     $          CALL locwrite(cl_writ(jf),ictemp, imjm,
c     $          file_unit_field(jf), ierror, nuout) 
            IF (jf.eq.6)
     $          CALL locwrite(cl_writ(jf),evice, imjm,
     $          file_unit_field(jf), ierror, nuout) 
            IF (jf.eq.7)
     $          CALL locwrite(cl_writ(jf),evwat, imjm,
     $          file_unit_field(jf), ierror, nuout) 
            IF (jf.eq.8)
     $          CALL locwrite(cl_writ(jf),lpre, imjm,
     $          file_unit_field(jf), ierror, nuout) 
            IF (jf.eq.9)
     $          CALL locwrite(cl_writ(jf),spre, imjm,
     $          file_unit_field(jf), ierror, nuout) 
            IF (jf.eq.10)
     $          CALL locwrite(cl_writ(jf),dirunoff, imjm,
     $          file_unit_field(jf), ierror, nuout) 
            IF (jf.eq.11)
     $          CALL locwrite(cl_writ(jf),rivrunoff, imjm,
     $          file_unit_field(jf), ierror, nuout) 
            IF (jf.eq.12)
     $          CALL locwrite(cl_writ(jf),tauxu, imjm,
     $          file_unit_field(jf),ierror, nuout) 
            IF (jf.eq.13)
     $          CALL locwrite(cl_writ(jf),tauxv, imjm,
     $          file_unit_field(jf),ierror, nuout) 
            IF (jf.eq.14)
     $          CALL locwrite(cl_writ(jf),tauyv, imjm,
     $          file_unit_field(jf),ierror, nuout) 
            IF (jf.eq.15)
     $          CALL locwrite(cl_writ(jf),tauyu, imjm,
     $          file_unit_field(jf), ierror, nuout) 
          END DO 
C
C         -simulate a FLUSH
C
          DO jn=1, max_file 
            CLOSE (file_unit(jn))
          END DO 
C
C
          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, tauxu, info)
          IF (jn.eq.13) CALL CLIM_Export(cl_writ(jn), kt, tauxv, info)
          IF (jn.eq.14) CALL CLIM_Export(cl_writ(jn), kt, tauyv, info)
          IF (jn.eq.15) CALL CLIM_Export(cl_writ(jn), kt, tauyu, info)
          
            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