MODULE trdvor
  USE oce
  USE dom_oce
  USE trd_oce
  USE zdf_oce
  USE sbc_oce
  USE phycst
  USE ldfdyn
  USE dianam
  USE zdfmxl
  USE in_out_manager
  USE ioipsl
  USE lbclnk
  USE lib_mpp
  IMPLICIT NONE
  PRIVATE
  INTERFACE trd_vor_zint
    MODULE PROCEDURE trd_vor_zint_2d, trd_vor_zint_3d
  END INTERFACE
  PUBLIC :: trd_vor
  PUBLIC :: trd_vor_init
  PUBLIC :: trd_vor_alloc
  INTEGER :: nh_t, nmoydpvor, nidvor, nhoridvor, ndimvor1, icount
  INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndexvor1
  INTEGER :: ndebug
  REAL(KIND = wp), SAVE, ALLOCATABLE, DIMENSION(:, :) :: vor_avr
  REAL(KIND = wp), SAVE, ALLOCATABLE, DIMENSION(:, :) :: vor_avrb
  REAL(KIND = wp), SAVE, ALLOCATABLE, DIMENSION(:, :) :: vor_avrbb
  REAL(KIND = wp), SAVE, ALLOCATABLE, DIMENSION(:, :) :: vor_avrbn
  REAL(KIND = wp), SAVE, ALLOCATABLE, DIMENSION(:, :) :: rotot
  REAL(KIND = wp), SAVE, ALLOCATABLE, DIMENSION(:, :) :: vor_avrtot
  REAL(KIND = wp), SAVE, ALLOCATABLE, DIMENSION(:, :) :: vor_avrres
  REAL(KIND = wp), SAVE, ALLOCATABLE, DIMENSION(:, :, :) :: vortrd
  CHARACTER(LEN = 12) :: cvort
  CONTAINS
  INTEGER FUNCTION trd_vor_alloc()
    ALLOCATE(vor_avr(jpi, jpj), vor_avrb(jpi, jpj), vor_avrbb(jpi, jpj), vor_avrbn(jpi, jpj), rotot(jpi, jpj), vor_avrtot(jpi, jpj), vor_avrres(jpi, jpj), vortrd(jpi, jpj, jpltot_vor), ndexvor1(jpi * jpj), STAT = trd_vor_alloc)
    IF (lk_mpp) CALL mpp_sum(trd_vor_alloc)
    IF (trd_vor_alloc /= 0) CALL ctl_warn('trd_vor_alloc: failed to allocate arrays')
  END FUNCTION trd_vor_alloc
  SUBROUTINE trd_vor(putrd, pvtrd, ktrd, kt)
    REAL(KIND = wp), DIMENSION(:, :, :), INTENT(INOUT) :: putrd, pvtrd
    INTEGER, INTENT(IN   ) :: ktrd
    INTEGER, INTENT(IN   ) :: kt
    INTEGER :: ji, jj
    REAL(KIND = wp), DIMENSION(jpi, jpj) :: ztswu, ztswv
    SELECT CASE (ktrd)
    CASE (jpdyn_hpg)
      CALL trd_vor_zint(putrd, pvtrd, jpvor_prg)
    CASE (jpdyn_keg)
      CALL trd_vor_zint(putrd, pvtrd, jpvor_keg)
    CASE (jpdyn_rvo)
      CALL trd_vor_zint(putrd, pvtrd, jpvor_rvo)
    CASE (jpdyn_pvo)
      CALL trd_vor_zint(putrd, pvtrd, jpvor_pvo)
    CASE (jpdyn_ldf)
      CALL trd_vor_zint(putrd, pvtrd, jpvor_ldf)
    CASE (jpdyn_zad)
      CALL trd_vor_zint(putrd, pvtrd, jpvor_zad)
    CASE (jpdyn_spg)
      CALL trd_vor_zint(putrd, pvtrd, jpvor_spg)
    CASE (jpdyn_zdf)
      !$ACC KERNELS
      ztswu(:, :) = 0.E0
      ztswv(:, :) = 0.E0
      DO jj = 2, jpjm1
        DO ji = 2, jpim1
          ztswu(ji, jj) = 0.5 * (utau_b(ji, jj) + utau(ji, jj)) / (e3u_n(ji, jj, 1) * rau0)
          ztswv(ji, jj) = 0.5 * (vtau_b(ji, jj) + vtau(ji, jj)) / (e3v_n(ji, jj, 1) * rau0)
        END DO
      END DO
      !$ACC END KERNELS
      CALL trd_vor_zint(putrd, pvtrd, jpvor_zdf)
      CALL trd_vor_zint(ztswu, ztswv, jpvor_swf)
    CASE (jpdyn_bfr)
      CALL trd_vor_zint(putrd, pvtrd, jpvor_bfr)
    CASE (jpdyn_atf)
      CALL trd_vor_iom(kt)
    END SELECT
  END SUBROUTINE trd_vor
  SUBROUTINE trd_vor_zint_2d(putrdvor, pvtrdvor, ktrd)
    INTEGER, INTENT(IN   ) :: ktrd
    REAL(KIND = wp), DIMENSION(jpi, jpj), INTENT(INOUT) :: putrdvor
    REAL(KIND = wp), DIMENSION(jpi, jpj), INTENT(INOUT) :: pvtrdvor
    INTEGER :: ji, jj
    INTEGER :: ikbu, ikbv
    REAL(KIND = wp), DIMENSION(jpi, jpj) :: zudpvor, zvdpvor
    !$ACC KERNELS
    zudpvor(:, :) = 0._wp
    zvdpvor(:, :) = 0._wp
    !$ACC END KERNELS
    CALL lbc_lnk_multi(putrdvor, 'U', - 1., pvtrdvor, 'V', - 1.)
    SELECT CASE (ktrd)
    CASE (jpvor_bfr)
      !$ACC KERNELS
      DO jj = 2, jpjm1
        DO ji = 2, jpim1
          ikbu = mbkv(ji, jj)
          ikbv = mbkv(ji, jj)
          zudpvor(ji, jj) = putrdvor(ji, jj) * e3u_n(ji, jj, ikbu) * e1u(ji, jj) * umask(ji, jj, ikbu)
          zvdpvor(ji, jj) = pvtrdvor(ji, jj) * e3v_n(ji, jj, ikbv) * e2v(ji, jj) * vmask(ji, jj, ikbv)
        END DO
      END DO
      !$ACC END KERNELS
    CASE (jpvor_swf)
      !$ACC KERNELS
      zudpvor(:, :) = putrdvor(:, :) * e3u_n(:, :, 1) * e1u(:, :) * umask(:, :, 1)
      zvdpvor(:, :) = pvtrdvor(:, :) * e3v_n(:, :, 1) * e2v(:, :) * vmask(:, :, 1)
      !$ACC END KERNELS
    END SELECT
    !$ACC KERNELS
    zudpvor(:, :) = zudpvor(:, :) * r1_hu_n(:, :)
    zvdpvor(:, :) = zvdpvor(:, :) * r1_hv_n(:, :)
    DO ji = 1, jpim1
      DO jj = 1, jpjm1
        vortrd(ji, jj, ktrd) = (zvdpvor(ji + 1, jj) - zvdpvor(ji, jj) - (zudpvor(ji, jj + 1) - zudpvor(ji, jj))) / (e1f(ji, jj) * e2f(ji, jj))
      END DO
    END DO
    vortrd(:, :, ktrd) = vortrd(:, :, ktrd) * fmask(:, :, 1)
    !$ACC END KERNELS
    IF (ndebug /= 0) THEN
      IF (lwp) WRITE(numout, FMT = *) ' debuging trd_vor_zint: I done'
      CALL FLUSH(numout)
    END IF
  END SUBROUTINE trd_vor_zint_2d
  SUBROUTINE trd_vor_zint_3d(putrdvor, pvtrdvor, ktrd)
    INTEGER, INTENT(IN   ) :: ktrd
    REAL(KIND = wp), DIMENSION(jpi, jpj, jpk), INTENT(INOUT) :: putrdvor
    REAL(KIND = wp), DIMENSION(jpi, jpj, jpk), INTENT(INOUT) :: pvtrdvor
    INTEGER :: ji, jj, jk
    REAL(KIND = wp), DIMENSION(jpi, jpj) :: zubet, zvbet
    REAL(KIND = wp), DIMENSION(jpi, jpj) :: zudpvor, zvdpvor
    !$ACC KERNELS
    zubet(:, :) = 0._wp
    zvbet(:, :) = 0._wp
    zudpvor(:, :) = 0._wp
    zvdpvor(:, :) = 0._wp
    !$ACC END KERNELS
    CALL lbc_lnk_multi(putrdvor, 'U', - 1., pvtrdvor, 'V', - 1.)
    !$ACC KERNELS
    DO jk = 1, jpk
      zudpvor(:, :) = zudpvor(:, :) + putrdvor(:, :, jk) * e3u_n(:, :, jk) * e1u(:, :) * umask(:, :, jk)
      zvdpvor(:, :) = zvdpvor(:, :) + pvtrdvor(:, :, jk) * e3v_n(:, :, jk) * e2v(:, :) * vmask(:, :, jk)
    END DO
    !$ACC END KERNELS
    IF (ktrd == jpvor_pvo) THEN
      !$ACC KERNELS
      zubet(:, :) = zudpvor(:, :)
      zvbet(:, :) = zvdpvor(:, :)
      DO ji = 1, jpim1
        DO jj = 1, jpjm1
          vortrd(ji, jj, jpvor_bev) = (zvbet(ji + 1, jj) - zvbet(ji, jj) - (zubet(ji, jj + 1) - zubet(ji, jj))) / (e1f(ji, jj) * e2f(ji, jj))
        END DO
      END DO
      vortrd(:, :, jpvor_bev) = vortrd(:, :, jpvor_bev) * r1_hu_n(:, :) * fmask(:, :, 1)
      !$ACC END KERNELS
    END IF
    !$ACC KERNELS
    zudpvor(:, :) = zudpvor(:, :) * r1_hu_n(:, :)
    zvdpvor(:, :) = zvdpvor(:, :) * r1_hv_n(:, :)
    DO ji = 1, jpim1
      DO jj = 1, jpjm1
        vortrd(ji, jj, ktrd) = (zvdpvor(ji + 1, jj) - zvdpvor(ji, jj) - (zudpvor(ji, jj + 1) - zudpvor(ji, jj))) / (e1f(ji, jj) * e2f(ji, jj))
      END DO
    END DO
    vortrd(:, :, ktrd) = vortrd(:, :, ktrd) * fmask(:, :, 1)
    !$ACC END KERNELS
    IF (ndebug /= 0) THEN
      IF (lwp) WRITE(numout, FMT = *) ' debuging trd_vor_zint: I done'
      CALL FLUSH(numout)
    END IF
  END SUBROUTINE trd_vor_zint_3d
  SUBROUTINE trd_vor_iom(kt)
    INTEGER, INTENT(IN   ) :: kt
    INTEGER :: ji, jj, jk, jl
    INTEGER :: it, itmod
    REAL(KIND = wp) :: zmean
    REAL(KIND = wp), DIMENSION(jpi, jpj) :: zun, zvn
    IF (kt > nit000) vor_avrb(:, :) = vor_avr(:, :)
    !$ACC KERNELS
    vor_avr(:, :) = 0._wp
    zun(:, :) = 0._wp
    zvn(:, :) = 0._wp
    vor_avrtot(:, :) = 0._wp
    vor_avrres(:, :) = 0._wp
    DO jk = 1, jpk - 1
      zun(:, :) = zun(:, :) + e1u(:, :) * un(:, :, jk) * e3u_n(:, :, jk)
      zvn(:, :) = zvn(:, :) + e2v(:, :) * vn(:, :, jk) * e3v_n(:, :, jk)
    END DO
    zun(:, :) = zun(:, :) * r1_hu_n(:, :)
    zvn(:, :) = zvn(:, :) * r1_hv_n(:, :)
    DO ji = 1, jpim1
      DO jj = 1, jpjm1
        vor_avr(ji, jj) = ((zvn(ji + 1, jj) - zvn(ji, jj)) - (zun(ji, jj + 1) - zun(ji, jj))) / (e1f(ji, jj) * e2f(ji, jj)) * fmask(ji, jj, 1)
      END DO
    END DO
    !$ACC END KERNELS
    IF (kt == nit000 + 1) THEN
      !$ACC KERNELS
      vor_avrbb(:, :) = vor_avrb(:, :)
      vor_avrbn(:, :) = vor_avr(:, :)
      !$ACC END KERNELS
    END IF
    IF (kt >= nit000 + 2) THEN
      nmoydpvor = nmoydpvor + 1
      DO jl = 1, jpltot_vor
        IF (jl /= 9) THEN
          !$ACC KERNELS
          rotot(:, :) = rotot(:, :) + vortrd(:, :, jl)
          !$ACC END KERNELS
        END IF
      END DO
    END IF
    it = kt
    itmod = kt - nit000 + 1
    IF (MOD(it, nn_trd) == 0) THEN
      zmean = 1._wp / (REAL(nmoydpvor, wp) * 2._wp * rdt)
      !$ACC KERNELS
      vor_avrtot(:, :) = (vor_avr(:, :) - vor_avrbn(:, :) + vor_avrb(:, :) - vor_avrbb(:, :)) * zmean
      !$ACC END KERNELS
      zmean = 1._wp / REAL(nmoydpvor, wp)
      !$ACC KERNELS
      vor_avrres(:, :) = vor_avrtot(:, :) - rotot(:, :) / zmean
      !$ACC END KERNELS
      CALL lbc_lnk_multi(vor_avrtot, 'F', 1., vor_avrres, 'F', 1.)
      !$ACC KERNELS
      vor_avrbb(:, :) = vor_avrb(:, :)
      vor_avrbn(:, :) = vor_avr(:, :)
      nmoydpvor = 0
      !$ACC END KERNELS
    END IF
    IF (kt >= nit000 + 1) THEN
      IF (lwp .AND. MOD(itmod, nn_trd) == 0) THEN
        WRITE(numout, FMT = *) ''
        WRITE(numout, FMT = *) 'trd_vor : write trends in the NetCDF file at kt = ', kt
        WRITE(numout, FMT = *) '~~~~~~~  '
      END IF
      CALL histwrite(nidvor, "sovortPh", it, vortrd(:, :, jpvor_prg), ndimvor1, ndexvor1)
      CALL histwrite(nidvor, "sovortEk", it, vortrd(:, :, jpvor_keg), ndimvor1, ndexvor1)
      CALL histwrite(nidvor, "sovozeta", it, vortrd(:, :, jpvor_rvo), ndimvor1, ndexvor1)
      CALL histwrite(nidvor, "sovortif", it, vortrd(:, :, jpvor_pvo), ndimvor1, ndexvor1)
      CALL histwrite(nidvor, "sovodifl", it, vortrd(:, :, jpvor_ldf), ndimvor1, ndexvor1)
      CALL histwrite(nidvor, "sovoadvv", it, vortrd(:, :, jpvor_zad), ndimvor1, ndexvor1)
      CALL histwrite(nidvor, "sovodifv", it, vortrd(:, :, jpvor_zdf), ndimvor1, ndexvor1)
      CALL histwrite(nidvor, "sovortPs", it, vortrd(:, :, jpvor_spg), ndimvor1, ndexvor1)
      CALL histwrite(nidvor, "sovortbv", it, vortrd(:, :, jpvor_bev), ndimvor1, ndexvor1)
      CALL histwrite(nidvor, "sovowind", it, vortrd(:, :, jpvor_swf), ndimvor1, ndexvor1)
      CALL histwrite(nidvor, "sovobfri", it, vortrd(:, :, jpvor_bfr), ndimvor1, ndexvor1)
      CALL histwrite(nidvor, "1st_mbre", it, vor_avrtot, ndimvor1, ndexvor1)
      CALL histwrite(nidvor, "sovorgap", it, vor_avrres, ndimvor1, ndexvor1)
      IF (ndebug /= 0) THEN
        WRITE(numout, FMT = *) ' debuging trd_vor: III.4 done'
        CALL FLUSH(numout)
      END IF
    END IF
    IF (MOD(it, nn_trd) == 0) rotot(:, :) = 0
    IF (kt == nitend) CALL histclo(nidvor)
  END SUBROUTINE trd_vor_iom
  SUBROUTINE trd_vor_init
    REAL(KIND = wp) :: zjulian, zsto, zout
    CHARACTER(LEN = 40) :: clhstnam
    CHARACTER(LEN = 40) :: clop
    cvort = 'averaged-vor'
    ndebug = 0
    IF (lwp) THEN
      WRITE(numout, FMT = *) ' '
      WRITE(numout, FMT = *) ' trd_vor_init: vorticity trends'
      WRITE(numout, FMT = *) ' ~~~~~~~~~~~~'
      WRITE(numout, FMT = *) ' '
      WRITE(numout, FMT = *) '               ##########################################################################'
      WRITE(numout, FMT = *) '                CAUTION: The interpretation of the vorticity trends is'
      WRITE(numout, FMT = *) '                not obvious, please contact Anne-Marie TREGUIER at: treguier@ifremer.fr '
      WRITE(numout, FMT = *) '               ##########################################################################'
      WRITE(numout, FMT = *) ' '
    END IF
    IF (trd_vor_alloc() /= 0) CALL ctl_stop('STOP', 'trd_vor_init : unable to allocate trdvor arrays')
    !$ACC KERNELS
    nmoydpvor = 0
    rotot(:, :) = 0
    vor_avrtot(:, :) = 0
    vor_avrres(:, :) = 0
    !$ACC END KERNELS
    IF (ndebug /= 0) THEN
      WRITE(numout, FMT = *) ' debuging trd_vor_init: I. done'
      CALL FLUSH(numout)
    END IF
    IF (ln_mskland) THEN
      clop = "only(x)"
    ELSE
      clop = "x"
    END IF
    zsto = rdt
    clop = "ave(" // TRIM(clop) // ")"
    zout = nn_trd * rdt
    IF (lwp) WRITE(numout, FMT = *) '               netCDF initialization'
    CALL ymds2ju(nyear, nmonth, nday, rdt, zjulian)
    zjulian = zjulian - adatrj
    IF (lwp) WRITE(numout, FMT = *) ' '
    IF (lwp) WRITE(numout, FMT = *) '               Date 0 used :', nit000, ' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday, 'Julian day : ', zjulian
    CALL dia_nam(clhstnam, nn_trd, 'vort')
    IF (lwp) WRITE(numout, FMT = *) ' Name of NETCDF file ', clhstnam
    CALL histbeg(clhstnam, jpi, glamf, jpj, gphif, 1, jpi, 1, jpj, nit000 - 1, zjulian, rdt, nh_t, nidvor, domain_id = nidom, snc4chunks = snc4set)
    CALL wheneq(jpi * jpj, fmask, 1, 1., ndexvor1, ndimvor1)
    CALL histdef(nidvor, "sovortPh", cvort // "grad Ph", "s-2", jpi, jpj, nh_t, 1, 1, 1, - 99, 32, clop, zsto, zout)
    CALL histdef(nidvor, "sovortEk", cvort // "Energy", "s-2", jpi, jpj, nh_t, 1, 1, 1, - 99, 32, clop, zsto, zout)
    CALL histdef(nidvor, "sovozeta", cvort // "rel vorticity", "s-2", jpi, jpj, nh_t, 1, 1, 1, - 99, 32, clop, zsto, zout)
    CALL histdef(nidvor, "sovortif", cvort // "coriolis", "s-2", jpi, jpj, nh_t, 1, 1, 1, - 99, 32, clop, zsto, zout)
    CALL histdef(nidvor, "sovodifl", cvort // "lat diff ", "s-2", jpi, jpj, nh_t, 1, 1, 1, - 99, 32, clop, zsto, zout)
    CALL histdef(nidvor, "sovoadvv", cvort // "vert adv", "s-2", jpi, jpj, nh_t, 1, 1, 1, - 99, 32, clop, zsto, zout)
    CALL histdef(nidvor, "sovodifv", cvort // "vert diff", "s-2", jpi, jpj, nh_t, 1, 1, 1, - 99, 32, clop, zsto, zout)
    CALL histdef(nidvor, "sovortPs", cvort // "grad Ps", "s-2", jpi, jpj, nh_t, 1, 1, 1, - 99, 32, clop, zsto, zout)
    CALL histdef(nidvor, "sovortbv", cvort // "Beta V", "s-2", jpi, jpj, nh_t, 1, 1, 1, - 99, 32, clop, zsto, zout)
    CALL histdef(nidvor, "sovowind", cvort // "wind stress", "s-2", jpi, jpj, nh_t, 1, 1, 1, - 99, 32, clop, zsto, zout)
    CALL histdef(nidvor, "sovobfri", cvort // "bottom friction", "s-2", jpi, jpj, nh_t, 1, 1, 1, - 99, 32, clop, zsto, zout)
    CALL histdef(nidvor, "1st_mbre", cvort // "1st mbre", "s-2", jpi, jpj, nh_t, 1, 1, 1, - 99, 32, clop, zsto, zout)
    CALL histdef(nidvor, "sovorgap", cvort // "gap", "s-2", jpi, jpj, nh_t, 1, 1, 1, - 99, 32, clop, zsto, zout)
    CALL histend(nidvor, snc4set)
    IF (ndebug /= 0) THEN
      WRITE(numout, FMT = *) ' debuging trd_vor_init: II. done'
      CALL FLUSH(numout)
    END IF
  END SUBROUTINE trd_vor_init
END MODULE trdvor


!===============================================================================
! Copyright 2010-2016 Intel Corporation All Rights Reserved.
!
! The source code,  information  and material  ("Material") contained  herein is
! owned by Intel Corporation or its  suppliers or licensors,  and  title to such
! Material remains with Intel  Corporation or its  suppliers or  licensors.  The
! Material  contains  proprietary  information  of  Intel or  its suppliers  and
! licensors.  The Material is protected by  worldwide copyright  laws and treaty
! provisions.  No part  of  the  Material   may  be  used,  copied,  reproduced,
! modified, published,  uploaded, posted, transmitted,  distributed or disclosed
! in any way without Intel's prior express written permission.  No license under
! any patent,  copyright or other  intellectual property rights  in the Material
! is granted to  or  conferred  upon  you,  either   expressly,  by implication,
! inducement,  estoppel  or  otherwise.  Any  license   under such  intellectual
! property rights must be express and approved by Intel in writing.
!
! Unless otherwise agreed by Intel in writing,  you may not remove or alter this
! notice or  any  other  notice   embedded  in  Materials  by  Intel  or Intel's
! suppliers or licensors in any way.
!===============================================================================

!  Content:
!   Intel(R) Math Kernel Library (MKL) FORTRAN 95 interface for service routines
!*******************************************************************************

MODULE MKL_SERVICE

    IMPLICIT NONE

    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_DOMAIN_ALL  = 0
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_DOMAIN_BLAS = 1
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_DOMAIN_FFT  = 2
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_DOMAIN_VML  = 3
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_DOMAIN_PARDISO = 4

    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_DYNAMIC_TRUE  = 1
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_DYNAMIC_FALSE = 0

    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_ENABLE_SSE4_2 = 0
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_ENABLE_AVX = 1
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_ENABLE_AVX2 = 2
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_ENABLE_AVX512_MIC = 3
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_ENABLE_AVX512 = 4

    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_INTERFACE_LP64  = Z"00000000"
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_INTERFACE_ILP64 = Z"00000001"
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_INTERFACE_GNU   = Z"00000002"
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_THREADING_INTEL = 0
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_THREADING_SEQUENTIAL = 1
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_THREADING_PGI = 2
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_THREADING_GNU = 3
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_THREADING_TBB = 4

    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_BRANCH         = 1
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_ALL            = -1
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_OFF            = 0
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_UNSET_ALL      = 0
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_BRANCH_OFF     = 1
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_AUTO           = 2
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_COMPATIBLE     = 3
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_SSE2           = 4
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_SSSE3          = 6
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_SSE4_1         = 7
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_SSE4_2         = 8
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_AVX            = 9
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_AVX2           = 10
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_AVX512_MIC     = 11
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_AVX512         = 12

    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_SUCCESS                 =  0
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_ERR_INVALID_SETTINGS    = -1
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_ERR_INVALID_INPUT       = -2
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_ERR_UNSUPPORTED_BRANCH  = -3
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_ERR_UNKNOWN_BRANCH      = -4
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_ERR_MODE_CHANGE_FAILURE = -8

    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_PEAK_MEM_DISABLE        =  0
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_PEAK_MEM_ENABLE         =  1
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_PEAK_MEM_RESET          = -1
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_PEAK_MEM                =  2
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_MEM_MCDRAM              =  1

    INTERFACE
      SUBROUTINE MKL_GET_VERSION_STRING(BUF)
      CHARACTER*(*), INTENT(OUT) :: BUF
      END
    END INTERFACE

    INTERFACE
      DOUBLE PRECISION FUNCTION MKL_GET_CPU_FREQUENCY()
      END
    END INTERFACE

    INTERFACE
      DOUBLE PRECISION FUNCTION MKL_GET_MAX_CPU_FREQUENCY()
      END
    END INTERFACE

    INTERFACE
      DOUBLE PRECISION FUNCTION MKL_GET_CLOCKS_FREQUENCY()
      END
    END INTERFACE

    INTERFACE
      SUBROUTINE MKL_GET_CPU_CLOCKS(CPU_CLOCKS)
      INTEGER(8), INTENT(OUT) ::  CPU_CLOCKS
      END
    END INTERFACE

! Threading control functions

    INTERFACE
      INTEGER(4) FUNCTION MKL_GET_MAX_THREADS()
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_DOMAIN_GET_MAX_THREADS(DOMAIN)
      INTEGER(4), INTENT(IN) :: DOMAIN
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION  MKL_SET_NUM_THREADS_LOCAL(NTHRS)
      INTEGER(4), INTENT(IN) :: NTHRS
      END
    END INTERFACE

    INTERFACE
      SUBROUTINE MKL_SET_NUM_THREADS(NTHRS)
      INTEGER(4), INTENT(IN) :: NTHRS
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_DOMAIN_SET_NUM_THREADS(NTHRS,DOMAIN)
      INTEGER(4), INTENT(IN) :: NTHRS
      INTEGER(4), INTENT(IN) :: DOMAIN
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_GET_DYNAMIC()
      END
    END INTERFACE

    INTERFACE
      SUBROUTINE MKL_SET_DYNAMIC(MKL_DYNAMIC)
      INTEGER(4), INTENT(IN) :: MKL_DYNAMIC
      END
    END INTERFACE

! MKL Memory functions

    INTERFACE
      FUNCTION MKL_MALLOC(SIZE,ALIGN)
      USE ISO_C_BINDING
      INTEGER(KIND=C_INTPTR_T) MKL_MALLOC
      INTEGER(KIND=C_SIZE_T)   SIZE
      INTEGER(4) ALIGN
      END FUNCTION MKL_MALLOC
    END INTERFACE

    INTERFACE
      FUNCTION MKL_CALLOC(NUM,SIZE,ALIGN)
      USE ISO_C_BINDING
      INTEGER(KIND=C_INTPTR_T) MKL_CALLOC
      INTEGER(KIND=C_SIZE_T)   NUM,SIZE
      INTEGER(4) ALIGN
      END FUNCTION MKL_CALLOC
    END INTERFACE

    INTERFACE
      FUNCTION MKL_REALLOC(PTR,SIZE)
      USE ISO_C_BINDING
      INTEGER(KIND=C_INTPTR_T) MKL_REALLOC,PTR
      INTEGER(KIND=C_SIZE_T)   SIZE
      END FUNCTION MKL_REALLOC
    END INTERFACE

    INTERFACE
      SUBROUTINE MKL_FREE(PTR)
      USE ISO_C_BINDING
      INTEGER(KIND=C_INTPTR_T) PTR
      END SUBROUTINE MKL_FREE
    END INTERFACE

    INTERFACE
      INTEGER(8) FUNCTION MKL_MEM_STAT(N_BUFF)
      INTEGER(4), INTENT(OUT) :: N_BUFF
      END
    END INTERFACE

    INTERFACE
      INTEGER(8) FUNCTION MKL_PEAK_MEM_USAGE(RESET)
      INTEGER(4), INTENT(IN) :: RESET
      END
    END INTERFACE

    INTERFACE
      SUBROUTINE MKL_FREE_BUFFERS()
      END
    END INTERFACE

    INTERFACE
      SUBROUTINE MKL_THREAD_FREE_BUFFERS()
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_DISABLE_FAST_MM()
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_SET_MEMORY_LIMIT(MEM_TYPE,LIMIT)
      USE ISO_C_BINDING
      INTEGER(4), INTENT(IN) :: MEM_TYPE
      INTEGER(KIND=C_SIZE_T), INTENT(IN) :: LIMIT
      END
    END INTERFACE

! MKL Progress routine

    INTERFACE
      FUNCTION MKL_PROGRESS( THREAD, STEP, STAGE )
      INTEGER(4), INTENT(IN)    :: THREAD,STEP
      CHARACTER*(*), INTENT(IN) :: STAGE
      INTEGER          MKL_PROGRESS
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_ENABLE_INSTRUCTIONS(TYPE)
      INTEGER(4), INTENT(IN) :: TYPE
      END
    END INTERFACE

! MKL layer routines

    INTERFACE
      INTEGER(4) FUNCTION MKL_SET_INTERFACE_LAYER(MKL_INTERFACE)
      INTEGER(4), INTENT(IN) :: MKL_INTERFACE
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_SET_THREADING_LAYER(MKL_THREADING)
      INTEGER(4), INTENT(IN) :: MKL_THREADING
      END
    END INTERFACE

! MKL CBWR routines

    INTERFACE
      INTEGER(4) FUNCTION MKL_CBWR_GET(MKL_CBWR)
      INTEGER(4), INTENT(IN) :: MKL_CBWR
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_CBWR_SET(MKL_CBWR)
      INTEGER(4), INTENT(IN) :: MKL_CBWR
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_CBWR_GET_AUTO_BRANCH()
      END
    END INTERFACE

! MKL MIC service routines

    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_TARGET_NONE = 0
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_TARGET_HOST = 1
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_TARGET_MIC  = 2

    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_MIC_DEFAULT_TARGET_TYPE   = 2
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_MIC_DEFAULT_TARGET_NUMBER = 0

    DOUBLE PRECISION, PARAMETER, PUBLIC :: MKL_MIC_AUTO_WORKDIVISION = -1.0
    DOUBLE PRECISION, PARAMETER, PUBLIC :: MKL_MPI_PPN = -1.0

    INTERFACE
      INTEGER(4) FUNCTION MKL_MIC_ENABLE()
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_MIC_DISABLE()
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_MIC_GET_DEVICE_COUNT()
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_MIC_GET_WORKDIVISION(TARGET_TYPE, TARGET_NUMBER, WD)
      INTEGER(4),       INTENT(IN)  :: TARGET_TYPE, TARGET_NUMBER
      DOUBLE PRECISION, INTENT(OUT) :: WD
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_MIC_SET_WORKDIVISION(TARGET_TYPE, TARGET_NUMBER, WD)
      INTEGER(4),       INTENT(IN)  :: TARGET_TYPE, TARGET_NUMBER
      DOUBLE PRECISION, INTENT(IN)  :: WD
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_MIC_SET_MAX_MEMORY(TARGET_TYPE, TARGET_NUMBER, MEM)
      INTEGER(4),       INTENT(IN)  :: TARGET_TYPE, TARGET_NUMBER
      INTEGER(8),       INTENT(IN)  :: MEM
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_MIC_FREE_MEMORY(TARGET_TYPE, TARGET_NUMBER)
      INTEGER(4),       INTENT(IN)  :: TARGET_TYPE, TARGET_NUMBER
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_MIC_SET_OFFLOAD_REPORT(ENABLED)
      INTEGER(4),       INTENT(IN)  :: ENABLED
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_MIC_SET_DEVICE_NUM_THREADS(TARGET_TYPE, TARGET_NUMBER, NUM_THREADS)
      INTEGER(4),       INTENT(IN)  :: TARGET_TYPE, TARGET_NUMBER, NUM_THREADS
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_MIC_GET_RESOURCE_LIMIT(FRACTION)
      DOUBLE PRECISION, INTENT(OUT) :: FRACTION
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_MIC_SET_RESOURCE_LIMIT(FRACTION)
      DOUBLE PRECISION, INTENT(IN)  :: FRACTION
      END
    END INTERFACE

    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_MIC_DEFAULT_FLAGS = 0
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_MIC_DISABLE_HOST_FALLBACK  = 1

    INTERFACE
      INTEGER(4) FUNCTION MKL_MIC_GET_FLAGS()
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_MIC_SET_FLAGS(FLAG)
      INTEGER(4), INTENT(IN)  :: FLAG
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_MIC_GET_MEMINFO(TARGET_TYPE, TARGET_NUMBER, TOTALMEM, FREEMEM)
      INTEGER(4),       INTENT(IN)  :: TARGET_TYPE, TARGET_NUMBER
      INTEGER(4),       INTENT(OUT) :: TOTALMEM
      INTEGER(4),       INTENT(OUT) :: FREEMEM
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_MIC_GET_CPUINFO(TARGET_TYPE, TARGET_NUMBER, NCORES, NTHREADS, FREQ)
      INTEGER(4),       INTENT(IN)  :: TARGET_TYPE, TARGET_NUMBER
      INTEGER(4),       INTENT(OUT) :: NCORES
      INTEGER(4),       INTENT(OUT) :: NTHREADS
      DOUBLE PRECISION, INTENT(OUT) :: FREQ
      END
    END INTERFACE

    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_MIC_SUCCESS           = 0
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_MIC_NOT_IMPL          = 1
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_MIC_HOST_FALLBACK     = 2
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_MIC_DISABLED          = 3
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_MIC_FAILED            = -1
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_MIC_HOST_FALLBACK_DISABLED = -2

    INTERFACE
      INTEGER(4) FUNCTION MKL_MIC_GET_STATUS()
      END
    END INTERFACE

    INTERFACE
      SUBROUTINE MKL_MIC_CLEAR_STATUS()
      END
    END INTERFACE

    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_MIC_REGISTRATION_DISABLE = 0
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_MIC_REGISTRATION_ENABLE  = 1

    INTERFACE
      SUBROUTINE MKL_MIC_REGISTER_MEMORY(ENABLE)
      INTEGER(4),        INTENT(IN) :: ENABLE
      END SUBROUTINE
    END INTERFACE

    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_BLACS_CUSTOM = 0
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_BLACS_MSMPI = 1
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_BLACS_INTELMPI = 2
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_BLACS_MPICH2 = 3

    INTERFACE
      INTEGER(4) FUNCTION MKL_SET_MPI(VENDOR, CUSTOM_LIBRARY_NAME)
      INTEGER(4), INTENT(IN) :: VENDOR
      CHARACTER*(*) :: CUSTOM_LIBRARY_NAME
      END
    END INTERFACE

! MKL verbose function

    INTERFACE
      INTEGER(4) FUNCTION MKL_VERBOSE(ENABLE)
      INTEGER(4), INTENT(IN) :: ENABLE
      END
    END INTERFACE

    INTERFACE
      INTEGER(4) FUNCTION MKL_SET_ENV_MODE(MODE)
      INTEGER(4), INTENT(IN) :: MODE
      END
    END INTERFACE

! Obsolete names and routines
    INTEGER (KIND=4), PARAMETER, PUBLIC :: MKL_CBWR_SSE3           = 5

!*******************************************************************************

END MODULE MKL_SERVICE