source: branches/DEV_r1879_FCM/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90 @ 2160

MODULE cpl_oasis3
   !!======================================================================
   !!                    ***  MODULE cpl_oasis  ***
   !! Coupled O/A : coupled ocean-atmosphere case using OASIS3 V. prism_2_4
   !!               special case: NEMO OPA/LIM coupled to ECHAM5
   !!=====================================================================
   !! History :   
   !!   9.0  !  04-06  (R. Redler, NEC Laboratories Europe, St Augustin, Germany) Original code
   !!   " "  !  04-11  (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Kiel, Germany) revision
   !!   " "  !  04-11  (V. Gayler, MPI M&D) Grid writing
   !!   " "  !  05-08  (R. Redler, W. Park) frld initialization, paral(2) revision
   !!   " "  !  05-09  (R. Redler) extended to allow for communication over root only
   !!   " "  !  06-01  (W. Park) modification of physical part
   !!   " "  !  06-02  (R. Redler, W. Park) buffer array fix for root exchange
   !!----------------------------------------------------------------------
#if defined key_oasis3
   !!----------------------------------------------------------------------
   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3
   !!----------------------------------------------------------------------
   !!----------------------------------------------------------------------
   !!   cpl_prism_init     : initialization of coupled mode communication
   !!   cpl_prism_define   : definition of grid and fields
   !!   cpl_prism_snd     : snd out fields in coupled mode
   !!   cpl_prism_rcv     : receive fields in coupled mode
   !!   cpl_prism_finalize : finalize the coupled mode communication
   !!----------------------------------------------------------------------
   USE mod_prism_proto              ! OASIS3 prism module
   USE mod_prism_def_partition_proto! OASIS3 prism module for partitioning
   USE mod_prism_put_proto          ! OASIS3 prism module for snding
   USE mod_prism_get_proto          ! OASIS3 prism module for receiving
   USE par_oce                      ! ocean parameters
   USE dom_oce                      ! ocean space and time domain
   USE in_out_manager               ! I/O manager
   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
   IMPLICIT NONE
   PRIVATE
!
   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE.   ! coupled flag
   INTEGER, PUBLIC            :: OASIS_Rcv  = 1    ! return code if received field
   INTEGER, PUBLIC            :: OASIS_idle = 0    ! return code if nothing done by oasis
   INTEGER                    :: ncomp_id          ! id returned by prism_init_comp
   INTEGER                    :: nerror            ! return error code

   INTEGER, PARAMETER :: nmaxfld=40    ! Maximum number of coupling fields
   
   TYPE, PUBLIC ::   FLD_CPL            ! Type for coupling field information
      LOGICAL            ::   laction   ! To be coupled or not
      CHARACTER(len = 8) ::   clname    ! Name of the coupling field   
      CHARACTER(len = 1) ::   clgrid    ! Grid type  
      REAL(wp)           ::   nsgn      ! Control of the sign change
      INTEGER            ::   nid       ! Id of the field
   END TYPE FLD_CPL

   TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd   ! Coupling fields

   REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld  ! Temporary buffer for receiving

   !! Routine accessibility
   PUBLIC cpl_prism_init
   PUBLIC cpl_prism_define
   PUBLIC cpl_prism_snd
   PUBLIC cpl_prism_rcv
   PUBLIC cpl_prism_finalize

   !!----------------------------------------------------------------------
   !!   OPA 9.0 , LOCEAN-IPSL (2006) 
   !! $Header$ 
   !! Software governed by the CeCILL licence  (NEMOGCM/License_CeCILL.txt)
   !!----------------------------------------------------------------------

CONTAINS

   SUBROUTINE cpl_prism_init (kl_comm) 

      !!-------------------------------------------------------------------
      !!             ***  ROUTINE cpl_prism_init  ***
      !!
      !! ** Purpose :   Initialize coupled mode communication for ocean
      !!    exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
      !!
      !! ** Method  :   OASIS3 MPI communication 
      !!--------------------------------------------------------------------
      INTEGER, INTENT(   OUT )   :: kl_comm       ! local communicator of the model
      !!--------------------------------------------------------------------

      ! WARNING: No write in numout in this routine
      !============================================

      !------------------------------------------------------------------
      ! 1st Initialize the PRISM system for the application
      !------------------------------------------------------------------
      CALL prism_init_comp_proto ( ncomp_id, 'oceanx', nerror )
      IF ( nerror /= PRISM_Ok ) &
         CALL prism_abort_proto (ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp_proto')

      !------------------------------------------------------------------
      ! 3rd Get an MPI communicator for OPA local communication
      !------------------------------------------------------------------

      CALL prism_get_localcomm_proto ( kl_comm, nerror )
      IF ( nerror /= PRISM_Ok ) &
         CALL prism_abort_proto (ncomp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' )

   END SUBROUTINE cpl_prism_init


   SUBROUTINE cpl_prism_define (krcv, ksnd)

      !!-------------------------------------------------------------------
      !!             ***  ROUTINE cpl_prism_define  ***
      !!
      !! ** Purpose :   Define grid and field information for ocean
      !!    exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
      !!
      !! ** Method  :   OASIS3 MPI communication 
      !!--------------------------------------------------------------------
      INTEGER, INTENT( IN    )   :: krcv, ksnd     ! Number of received and sent coupling fields
      !
      INTEGER                    :: id_part
      INTEGER                    :: paral(5)       ! OASIS3 box partition
      INTEGER                    :: ishape(2,2)    ! shape of arrays passed to PSMILe
      INTEGER                    :: ji             ! local loop indicees
      !!
      !!--------------------------------------------------------------------

      IF(lwp) WRITE(numout,*)
      IF(lwp) WRITE(numout,*) 'cpl_prism_define : initialization in coupled ocean/atmosphere case'
      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
      IF(lwp) WRITE(numout,*)

      !
      ! ... Define the shape for the area that excludes the halo
      !     For serial configuration (key_mpp_mpi not being active)
      !     nl* is set to the global values 1 and jp*glo.
      !
      ishape(:,1) = (/ 1, nlei-nldi+1 /)
      ishape(:,2) = (/ 1, nlej-nldj+1 /)
      !
      ! ... Allocate memory for data exchange
      !
      ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror)
      IF (nerror > 0) THEN
         CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld')
         RETURN
      ENDIF
      !
      ! -----------------------------------------------------------------
      ! ... Define the partition 
      ! -----------------------------------------------------------------
      
      paral(1) = 2                                              ! box partitioning
      paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1)   ! NEMO lower left corner global offset    
      paral(3) = nlei-nldi+1                                    ! local extent in i 
      paral(4) = nlej-nldj+1                                    ! local extent in j
      paral(5) = jpiglo                                         ! global extent in x
      
      IF( ln_ctl ) THEN
         WRITE(numout,*) ' multiexchg: paral (1:5)', paral
         WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj
         WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp
         WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp
      ENDIF
      
      CALL prism_def_partition_proto ( id_part, paral, nerror )
      !
      ! ... Announce send variables. 
      !
      DO ji = 1, ksnd
         IF ( ssnd(ji)%laction ) THEN 
            CALL prism_def_var_proto (ssnd(ji)%nid, ssnd(ji)%clname, id_part, (/ 2, 0/),  &
               &                      PRISM_Out   , ishape   , PRISM_REAL, nerror)
            IF ( nerror /= PRISM_Ok ) THEN
               WRITE(numout,*) 'Failed to define transient ', ji, TRIM(ssnd(ji)%clname)
               CALL prism_abort_proto ( ssnd(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var')
            ENDIF
         ENDIF
      END DO
      !
      ! ... Announce received variables. 
      !
      DO ji = 1, krcv
         IF ( srcv(ji)%laction ) THEN 
            CALL prism_def_var_proto ( srcv(ji)%nid, srcv(ji)%clname, id_part, (/ 2, 0/),   &
               &                      PRISM_In    , ishape   , PRISM_REAL, nerror)
            IF ( nerror /= PRISM_Ok ) THEN
               WRITE(numout,*) 'Failed to define transient ', ji, TRIM(srcv(ji)%clname)
               CALL prism_abort_proto ( srcv(ji)%nid, 'cpl_prism_define', 'Failure in prism_def_var')
            ENDIF
         ENDIF
      END DO
      
      !------------------------------------------------------------------
      ! End of definition phase
      !------------------------------------------------------------------
      
      CALL prism_enddef_proto(nerror)
      IF ( nerror /= PRISM_Ok )   CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef')
      
   END SUBROUTINE cpl_prism_define
   
   
   SUBROUTINE cpl_prism_snd( kid, kstep, pdata, kinfo )

      !!---------------------------------------------------------------------
      !!              ***  ROUTINE cpl_prism_snd  ***
      !!
      !! ** Purpose : - At each coupling time-step,this routine sends fields
      !!      like sst or ice cover to the coupler or remote application.
      !!----------------------------------------------------------------------
      !! * Arguments
      !!
      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array
      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS3 info argument
      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds
      REAL(wp), DIMENSION(jpi,jpj), INTENT( IN    )   :: pdata
      !!
      !!
      !!--------------------------------------------------------------------
      !
      ! snd data to OASIS3
      !
      CALL prism_put_proto ( ssnd(kid)%nid, kstep, pdata(nldi:nlei, nldj:nlej), kinfo )
      
      IF ( ln_ctl ) THEN        
         IF ( kinfo == PRISM_Sent     .OR. kinfo == PRISM_ToRest .OR.   &
            & kinfo == PRISM_SentOut  .OR. kinfo == PRISM_ToRestOut ) THEN
            WRITE(numout,*) '****************'
            WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname
            WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid
            WRITE(numout,*) 'prism_put_proto:  kstep ', kstep
            WRITE(numout,*) 'prism_put_proto:   info ', kinfo
            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
            WRITE(numout,*) '****************'
        ENDIF
     ENDIF
    END SUBROUTINE cpl_prism_snd


   SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo )

      !!---------------------------------------------------------------------
      !!              ***  ROUTINE cpl_prism_rcv  ***
      !!
      !! ** Purpose : - At each coupling time-step,this routine receives fields
      !!      like stresses and fluxes from the coupler or remote application.
      !!----------------------------------------------------------------------
      INTEGER,                      INTENT( IN    )   :: kid       ! variable intex in the array
      INTEGER,                      INTENT( IN    )   :: kstep     ! ocean time-step in seconds
      REAL(wp), DIMENSION(jpi,jpj), INTENT( INOUT )   :: pdata     ! IN to keep the value if nothing is done
      INTEGER,                      INTENT(   OUT )   :: kinfo     ! OASIS3 info argument
      !!
      LOGICAL                :: llaction
      !!--------------------------------------------------------------------
      !
      ! receive local data from OASIS3 on every process
      !
      CALL prism_get_proto ( srcv(kid)%nid, kstep, exfld, kinfo )         

      llaction = .false.
      IF( kinfo == PRISM_Recvd   .OR. kinfo == PRISM_FromRest .OR.   &
          kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut )   llaction = .TRUE.

      IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid

      IF ( llaction ) THEN

         kinfo = OASIS_Rcv
         pdata(nldi:nlei, nldj:nlej) = exfld(:,:)
         
         !--- Fill the overlap areas and extra hallows (mpp)
         !--- check periodicity conditions (all cases)
         CALL lbc_lnk( pdata, srcv(kid)%clgrid, srcv(kid)%nsgn )   
         
         IF ( ln_ctl ) THEN        
            WRITE(numout,*) '****************'
            WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname
            WRITE(numout,*) 'prism_get_proto: ivarid '  , srcv(kid)%nid
            WRITE(numout,*) 'prism_get_proto:   kstep', kstep
            WRITE(numout,*) 'prism_get_proto:   info ', kinfo
            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
            WRITE(numout,*) '****************'
         ENDIF
      
      ELSE
         kinfo = OASIS_idle     
      ENDIF

   END SUBROUTINE cpl_prism_rcv


   SUBROUTINE cpl_prism_finalize

      !!---------------------------------------------------------------------
      !!              ***  ROUTINE cpl_prism_finalize  ***
      !!
      !! ** Purpose : - Finalizes the coupling. If MPI_init has not been
      !!      called explicitly before cpl_prism_init it will also close
      !!      MPI communication.
      !!----------------------------------------------------------------------

      DEALLOCATE(exfld)
      CALL prism_terminate_proto ( nerror )         

   END SUBROUTINE cpl_prism_finalize

#else

   !!----------------------------------------------------------------------
   !!   Default case                                Forced Ocean/Atmosphere
   !!----------------------------------------------------------------------
   !!   Empty module
   !!----------------------------------------------------------------------
   USE in_out_manager               ! I/O manager
   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE.   !: coupled flag
   PUBLIC cpl_prism_init
   PUBLIC cpl_prism_finalize

CONTAINS

   SUBROUTINE cpl_prism_init (kl_comm) 
      INTEGER, INTENT(   OUT )   :: kl_comm       ! local communicator of the model
      kl_comm = -1
      WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...'
   END SUBROUTINE cpl_prism_init

   SUBROUTINE cpl_prism_finalize
      WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...'
   END SUBROUTINE cpl_prism_finalize

#endif

END MODULE cpl_oasis3