MODULE dynvor
  USE oce
  USE dom_oce
  USE dommsk
  USE dynadv
  USE trd_oce
  USE trddyn
  USE sbcwave
  USE sbc_oce, ONLY: ln_stcor
  USE lbclnk
  USE prtctl
  USE in_out_manager
  USE lib_mpp
  USE timing
  IMPLICIT NONE
  PRIVATE
  PUBLIC :: dyn_vor
  PUBLIC :: dyn_vor_init
  LOGICAL, PUBLIC :: ln_dynvor_ens
  LOGICAL, PUBLIC :: ln_dynvor_ene
  LOGICAL, PUBLIC :: ln_dynvor_enT
  LOGICAL, PUBLIC :: ln_dynvor_eeT
  LOGICAL, PUBLIC :: ln_dynvor_een
  INTEGER, PUBLIC :: nn_een_e3f
  LOGICAL, PUBLIC :: ln_dynvor_mix
  LOGICAL, PUBLIC :: ln_dynvor_msk
  INTEGER, PUBLIC :: nvor_scheme
  INTEGER, PUBLIC, PARAMETER :: np_ENS = 0
  INTEGER, PUBLIC, PARAMETER :: np_ENE = 1
  INTEGER, PUBLIC, PARAMETER :: np_ENT = 2
  INTEGER, PUBLIC, PARAMETER :: np_EET = 3
  INTEGER, PUBLIC, PARAMETER :: np_EEN = 4
  INTEGER, PUBLIC, PARAMETER :: np_MIX = 5
  INTEGER :: ncor, nrvm, ntot
  INTEGER, PUBLIC, PARAMETER :: np_COR = 1
  INTEGER, PUBLIC, PARAMETER :: np_RVO = 2
  INTEGER, PUBLIC, PARAMETER :: np_MET = 3
  INTEGER, PUBLIC, PARAMETER :: np_CRV = 4
  INTEGER, PUBLIC, PARAMETER :: np_CME = 5
  REAL(KIND = wp), ALLOCATABLE, DIMENSION(:, :) :: di_e2u_2
  REAL(KIND = wp), ALLOCATABLE, DIMENSION(:, :) :: dj_e1v_2
  REAL(KIND = wp), ALLOCATABLE, DIMENSION(:, :) :: di_e2v_2e1e2f
  REAL(KIND = wp), ALLOCATABLE, DIMENSION(:, :) :: dj_e1u_2e1e2f
  REAL(KIND = wp) :: r1_4 = 0.250_wp
  REAL(KIND = wp) :: r1_8 = 0.125_wp
  REAL(KIND = wp) :: r1_12 = 1._wp / 12._wp
  CONTAINS
  SUBROUTINE dyn_vor(kt)
    INTEGER, INTENT( IN ) :: kt
    REAL(KIND = wp), ALLOCATABLE, DIMENSION(:, :, :) :: ztrdu, ztrdv
    IF (ln_timing) CALL timing_start('dyn_vor')
    IF (l_trddyn) THEN
      ALLOCATE(ztrdu(jpi, jpj, jpk), ztrdv(jpi, jpj, jpk))
      !$ACC KERNELS
      ztrdu(:, :, :) = ua(:, :, :)
      ztrdv(:, :, :) = va(:, :, :)
      !$ACC END KERNELS
      SELECT CASE (nvor_scheme)
      CASE (np_ens)
        CALL vor_ens(kt, ncor, un, vn, ua, va)
        IF (ln_stcor) CALL vor_ens(kt, ncor, usd, vsd, ua, va)
      CASE (np_ene, np_mix)
        CALL vor_ene(kt, ncor, un, vn, ua, va)
        IF (ln_stcor) CALL vor_ene(kt, ncor, usd, vsd, ua, va)
      CASE (np_ent)
        CALL vor_ent(kt, ncor, un, vn, ua, va)
        IF (ln_stcor) CALL vor_enT(kt, ncor, usd, vsd, ua, va)
      CASE (np_eet)
        CALL vor_eet(kt, ncor, un, vn, ua, va)
        IF (ln_stcor) CALL vor_eeT(kt, ncor, usd, vsd, ua, va)
      CASE (np_een)
        CALL vor_een(kt, ncor, un, vn, ua, va)
        IF (ln_stcor) CALL vor_een(kt, ncor, usd, vsd, ua, va)
      END SELECT
      !$ACC KERNELS
      ztrdu(:, :, :) = ua(:, :, :) - ztrdu(:, :, :)
      ztrdv(:, :, :) = va(:, :, :) - ztrdv(:, :, :)
      !$ACC END KERNELS
      CALL trd_dyn(ztrdu, ztrdv, jpdyn_pvo, kt)
      IF (n_dynadv /= np_LIN_dyn) THEN
        !$ACC KERNELS
        ztrdu(:, :, :) = ua(:, :, :)
        ztrdv(:, :, :) = va(:, :, :)
        !$ACC END KERNELS
        SELECT CASE (nvor_scheme)
        CASE (np_ent)
          CALL vor_ent(kt, nrvm, un, vn, ua, va)
        CASE (np_eet)
          CALL vor_eet(kt, nrvm, un, vn, ua, va)
        CASE (np_ene)
          CALL vor_ene(kt, nrvm, un, vn, ua, va)
        CASE (np_ens, np_mix)
          CALL vor_ens(kt, nrvm, un, vn, ua, va)
        CASE (np_een)
          CALL vor_een(kt, nrvm, un, vn, ua, va)
        END SELECT
        !$ACC KERNELS
        ztrdu(:, :, :) = ua(:, :, :) - ztrdu(:, :, :)
        ztrdv(:, :, :) = va(:, :, :) - ztrdv(:, :, :)
        !$ACC END KERNELS
        CALL trd_dyn(ztrdu, ztrdv, jpdyn_rvo, kt)
      END IF
      DEALLOCATE(ztrdu, ztrdv)
    ELSE
      SELECT CASE (nvor_scheme)
      CASE (np_ENT)
        CALL vor_enT(kt, ntot, un, vn, ua, va)
        IF (ln_stcor) CALL vor_enT(kt, ncor, usd, vsd, ua, va)
      CASE (np_EET)
        CALL vor_eeT(kt, ntot, un, vn, ua, va)
        IF (ln_stcor) CALL vor_eeT(kt, ncor, usd, vsd, ua, va)
      CASE (np_ENE)
        CALL vor_ene(kt, ntot, un, vn, ua, va)
        IF (ln_stcor) CALL vor_ene(kt, ncor, usd, vsd, ua, va)
      CASE (np_ENS)
        CALL vor_ens(kt, ntot, un, vn, ua, va)
        IF (ln_stcor) CALL vor_ens(kt, ncor, usd, vsd, ua, va)
      CASE (np_MIX)
        CALL vor_ens(kt, nrvm, un, vn, ua, va)
        CALL vor_ene(kt, ncor, un, vn, ua, va)
        IF (ln_stcor) CALL vor_ene(kt, ncor, usd, vsd, ua, va)
      CASE (np_EEN)
        CALL vor_een(kt, ntot, un, vn, ua, va)
        IF (ln_stcor) CALL vor_een(kt, ncor, usd, vsd, ua, va)
      END SELECT
    END IF
    IF (ln_ctl) CALL prt_ctl(tab3d_1 = ua, clinfo1 = ' vor  - Ua: ', mask1 = umask, tab3d_2 = va, clinfo2 = ' Va: ', mask2 = vmask, clinfo3 = 'dyn')
    IF (ln_timing) CALL timing_stop('dyn_vor')
  END SUBROUTINE dyn_vor
  SUBROUTINE vor_enT(kt, kvor, pu, pv, pu_rhs, pv_rhs)
    INTEGER, INTENT(IN   ) :: kt
    INTEGER, INTENT(IN   ) :: kvor
    REAL(KIND = wp), DIMENSION(jpi, jpj, jpk), INTENT(INOUT) :: pu, pv
    REAL(KIND = wp), DIMENSION(jpi, jpj, jpk), INTENT(INOUT) :: pu_rhs, pv_rhs
    INTEGER :: ji, jj, jk
    REAL(KIND = wp) :: zx1, zy1, zx2, zy2
    REAL(KIND = wp), DIMENSION(jpi, jpj) :: zwx, zwy, zwz, zwt
    IF (kt == nit000) THEN
      IF (lwp) WRITE(numout, FMT = *)
      IF (lwp) WRITE(numout, FMT = *) 'dyn:vor_enT : vorticity term: t-point energy conserving scheme'
      IF (lwp) WRITE(numout, FMT = *) '~~~~~~~~~~~'
    END IF
    DO jk = 1, jpkm1
      SELECT CASE (kvor)
      CASE (np_COR)
        !$ACC KERNELS
        zwt(:, :) = ff_t(:, :) * e1e2t(:, :) * e3t_n(:, :, jk)
        !$ACC END KERNELS
      CASE (np_RVO)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = (e2v(ji + 1, jj) * pv(ji + 1, jj, jk) - e2v(ji, jj) * pv(ji, jj, jk) - e1u(ji, jj + 1) * pu(ji, jj + 1, jk) + e1u(ji, jj) * pu(ji, jj, jk)) * r1_e1e2f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
        IF (ln_dynvor_msk) THEN
          !$ACC KERNELS
          DO jj = 1, jpjm1
            DO ji = 1, jpim1
              zwz(ji, jj) = zwz(ji, jj) * fmask(ji, jj, jk)
            END DO
          END DO
          !$ACC END KERNELS
        END IF
        CALL lbc_lnk(zwz, 'F', 1.)
        !$ACC KERNELS
        DO jj = 2, jpj
          DO ji = 2, jpi
            zwt(ji, jj) = r1_4 * (zwz(ji - 1, jj) + zwz(ji, jj) + zwz(ji - 1, jj - 1) + zwz(ji, jj - 1)) * e1e2t(ji, jj) * e3t_n(ji, jj, jk)
          END DO
        END DO
        !$ACC END KERNELS
      CASE (np_MET)
        !$ACC KERNELS
        DO jj = 2, jpj
          DO ji = 2, jpi
            zwt(ji, jj) = ((pv(ji, jj, jk) + pv(ji, jj - 1, jk)) * di_e2u_2(ji, jj) - (pu(ji, jj, jk) + pu(ji - 1, jj, jk)) * dj_e1v_2(ji, jj)) * e3t_n(ji, jj, jk)
          END DO
        END DO
        !$ACC END KERNELS
      CASE (np_CRV)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = (e2v(ji + 1, jj) * pv(ji + 1, jj, jk) - e2v(ji, jj) * pv(ji, jj, jk) - e1u(ji, jj + 1) * pu(ji, jj + 1, jk) + e1u(ji, jj) * pu(ji, jj, jk)) * r1_e1e2f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
        IF (ln_dynvor_msk) THEN
          !$ACC KERNELS
          DO jj = 1, jpjm1
            DO ji = 1, jpim1
              zwz(ji, jj) = zwz(ji, jj) * fmask(ji, jj, jk)
            END DO
          END DO
          !$ACC END KERNELS
        END IF
        CALL lbc_lnk(zwz, 'F', 1.)
        !$ACC KERNELS
        DO jj = 2, jpj
          DO ji = 2, jpi
            zwt(ji, jj) = (ff_t(ji, jj) + r1_4 * (zwz(ji - 1, jj) + zwz(ji, jj) + zwz(ji - 1, jj - 1) + zwz(ji, jj - 1))) * e1e2t(ji, jj) * e3t_n(ji, jj, jk)
          END DO
        END DO
        !$ACC END KERNELS
      CASE (np_CME)
        !$ACC KERNELS
        DO jj = 2, jpj
          DO ji = 2, jpi
            zwt(ji, jj) = (ff_t(ji, jj) * e1e2t(ji, jj) + (pv(ji, jj, jk) + pv(ji, jj - 1, jk)) * di_e2u_2(ji, jj) - (pu(ji, jj, jk) + pu(ji - 1, jj, jk)) * dj_e1v_2(ji, jj)) * e3t_n(ji, jj, jk)
          END DO
        END DO
        !$ACC END KERNELS
      CASE DEFAULT
        CALL ctl_stop('STOP', 'dyn_vor: wrong value for kvor')
      END SELECT
      !$ACC KERNELS
      DO jj = 2, jpjm1
        DO ji = 2, jpim1
          pu_rhs(ji, jj, jk) = pu_rhs(ji, jj, jk) + r1_4 * r1_e1e2u(ji, jj) / e3u_n(ji, jj, jk) * (zwt(ji + 1, jj) * (pv(ji + 1, jj, jk) + pv(ji + 1, jj - 1, jk)) + zwt(ji, jj) * (pv(ji, jj, jk) + pv(ji, jj - 1, jk)))
          pv_rhs(ji, jj, jk) = pv_rhs(ji, jj, jk) - r1_4 * r1_e1e2v(ji, jj) / e3v_n(ji, jj, jk) * (zwt(ji, jj + 1) * (pu(ji, jj + 1, jk) + pu(ji - 1, jj + 1, jk)) + zwt(ji, jj) * (pu(ji, jj, jk) + pu(ji - 1, jj, jk)))
        END DO
      END DO
      !$ACC END KERNELS
    END DO
  END SUBROUTINE vor_enT
  SUBROUTINE vor_ene(kt, kvor, pun, pvn, pua, pva)
    INTEGER, INTENT(IN   ) :: kt
    INTEGER, INTENT(IN   ) :: kvor
    REAL(KIND = wp), DIMENSION(jpi, jpj, jpk), INTENT(INOUT) :: pun, pvn
    REAL(KIND = wp), DIMENSION(jpi, jpj, jpk), INTENT(INOUT) :: pua, pva
    INTEGER :: ji, jj, jk
    REAL(KIND = wp) :: zx1, zy1, zx2, zy2
    REAL(KIND = wp), DIMENSION(jpi, jpj) :: zwx, zwy, zwz
    IF (kt == nit000) THEN
      IF (lwp) WRITE(numout, FMT = *)
      IF (lwp) WRITE(numout, FMT = *) 'dyn:vor_ene : vorticity term: energy conserving scheme'
      IF (lwp) WRITE(numout, FMT = *) '~~~~~~~~~~~'
    END IF
    DO jk = 1, jpkm1
      SELECT CASE (kvor)
      CASE (np_COR)
        !$ACC KERNELS
        zwz(:, :) = ff_f(:, :)
        !$ACC END KERNELS
      CASE (np_RVO)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = (e2v(ji + 1, jj) * pvn(ji + 1, jj, jk) - e2v(ji, jj) * pvn(ji, jj, jk) - e1u(ji, jj + 1) * pun(ji, jj + 1, jk) + e1u(ji, jj) * pun(ji, jj, jk)) * r1_e1e2f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
      CASE (np_MET)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = (pvn(ji + 1, jj, jk) + pvn(ji, jj, jk)) * di_e2v_2e1e2f(ji, jj) - (pun(ji, jj + 1, jk) + pun(ji, jj, jk)) * dj_e1u_2e1e2f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
      CASE (np_CRV)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = ff_f(ji, jj) + (e2v(ji + 1, jj) * pvn(ji + 1, jj, jk) - e2v(ji, jj) * pvn(ji, jj, jk) - e1u(ji, jj + 1) * pun(ji, jj + 1, jk) + e1u(ji, jj) * pun(ji, jj, jk)) * r1_e1e2f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
      CASE (np_CME)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = ff_f(ji, jj) + (pvn(ji + 1, jj, jk) + pvn(ji, jj, jk)) * di_e2v_2e1e2f(ji, jj) - (pun(ji, jj + 1, jk) + pun(ji, jj, jk)) * dj_e1u_2e1e2f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
      CASE DEFAULT
        CALL ctl_stop('STOP', 'dyn_vor: wrong value for kvor')
      END SELECT
      IF (ln_dynvor_msk) THEN
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = zwz(ji, jj) * fmask(ji, jj, jk)
          END DO
        END DO
        !$ACC END KERNELS
      END IF
      IF (ln_sco) THEN
        !$ACC KERNELS
        zwz(:, :) = zwz(:, :) / e3f_n(:, :, jk)
        zwx(:, :) = e2u(:, :) * e3u_n(:, :, jk) * pun(:, :, jk)
        zwy(:, :) = e1v(:, :) * e3v_n(:, :, jk) * pvn(:, :, jk)
        !$ACC END KERNELS
      ELSE
        !$ACC KERNELS
        zwx(:, :) = e2u(:, :) * pun(:, :, jk)
        zwy(:, :) = e1v(:, :) * pvn(:, :, jk)
        !$ACC END KERNELS
      END IF
      !$ACC KERNELS
      DO jj = 2, jpjm1
        DO ji = 2, jpim1
          zy1 = zwy(ji, jj - 1) + zwy(ji + 1, jj - 1)
          zy2 = zwy(ji, jj) + zwy(ji + 1, jj)
          zx1 = zwx(ji - 1, jj) + zwx(ji - 1, jj + 1)
          zx2 = zwx(ji, jj) + zwx(ji, jj + 1)
          pua(ji, jj, jk) = pua(ji, jj, jk) + r1_4 * r1_e1u(ji, jj) * (zwz(ji, jj - 1) * zy1 + zwz(ji, jj) * zy2)
          pva(ji, jj, jk) = pva(ji, jj, jk) - r1_4 * r1_e2v(ji, jj) * (zwz(ji - 1, jj) * zx1 + zwz(ji, jj) * zx2)
        END DO
      END DO
      !$ACC END KERNELS
    END DO
  END SUBROUTINE vor_ene
  SUBROUTINE vor_ens(kt, kvor, pun, pvn, pua, pva)
    INTEGER, INTENT(IN   ) :: kt
    INTEGER, INTENT(IN   ) :: kvor
    REAL(KIND = wp), DIMENSION(jpi, jpj, jpk), INTENT(INOUT) :: pun, pvn
    REAL(KIND = wp), DIMENSION(jpi, jpj, jpk), INTENT(INOUT) :: pua, pva
    INTEGER :: ji, jj, jk
    REAL(KIND = wp) :: zuav, zvau
    REAL(KIND = wp), DIMENSION(jpi, jpj) :: zwx, zwy, zwz, zww
    IF (kt == nit000) THEN
      IF (lwp) WRITE(numout, FMT = *)
      IF (lwp) WRITE(numout, FMT = *) 'dyn:vor_ens : vorticity term: enstrophy conserving scheme'
      IF (lwp) WRITE(numout, FMT = *) '~~~~~~~~~~~'
    END IF
    DO jk = 1, jpkm1
      SELECT CASE (kvor)
      CASE (np_COR)
        !$ACC KERNELS
        zwz(:, :) = ff_f(:, :)
        !$ACC END KERNELS
      CASE (np_RVO)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = (e2v(ji + 1, jj) * pvn(ji + 1, jj, jk) - e2v(ji, jj) * pvn(ji, jj, jk) - e1u(ji, jj + 1) * pun(ji, jj + 1, jk) + e1u(ji, jj) * pun(ji, jj, jk)) * r1_e1e2f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
      CASE (np_MET)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = (pvn(ji + 1, jj, jk) + pvn(ji, jj, jk)) * di_e2v_2e1e2f(ji, jj) - (pun(ji, jj + 1, jk) + pun(ji, jj, jk)) * dj_e1u_2e1e2f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
      CASE (np_CRV)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = ff_f(ji, jj) + (e2v(ji + 1, jj) * pvn(ji + 1, jj, jk) - e2v(ji, jj) * pvn(ji, jj, jk) - e1u(ji, jj + 1) * pun(ji, jj + 1, jk) + e1u(ji, jj) * pun(ji, jj, jk)) * r1_e1e2f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
      CASE (np_CME)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = ff_f(ji, jj) + (pvn(ji + 1, jj, jk) + pvn(ji, jj, jk)) * di_e2v_2e1e2f(ji, jj) - (pun(ji, jj + 1, jk) + pun(ji, jj, jk)) * dj_e1u_2e1e2f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
      CASE DEFAULT
        CALL ctl_stop('STOP', 'dyn_vor: wrong value for kvor')
      END SELECT
      IF (ln_dynvor_msk) THEN
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = zwz(ji, jj) * fmask(ji, jj, jk)
          END DO
        END DO
        !$ACC END KERNELS
      END IF
      IF (ln_sco) THEN
        !$ACC KERNELS
        zwz(:, :) = zwz(:, :) / e3f_n(:, :, jk)
        zwx(:, :) = e2u(:, :) * e3u_n(:, :, jk) * pun(:, :, jk)
        zwy(:, :) = e1v(:, :) * e3v_n(:, :, jk) * pvn(:, :, jk)
        !$ACC END KERNELS
      ELSE
        !$ACC KERNELS
        zwx(:, :) = e2u(:, :) * pun(:, :, jk)
        zwy(:, :) = e1v(:, :) * pvn(:, :, jk)
        !$ACC END KERNELS
      END IF
      !$ACC KERNELS
      DO jj = 2, jpjm1
        DO ji = 2, jpim1
          zuav = r1_8 * r1_e1u(ji, jj) * (zwy(ji, jj - 1) + zwy(ji + 1, jj - 1) + zwy(ji, jj) + zwy(ji + 1, jj))
          zvau = - r1_8 * r1_e2v(ji, jj) * (zwx(ji - 1, jj) + zwx(ji - 1, jj + 1) + zwx(ji, jj) + zwx(ji, jj + 1))
          pua(ji, jj, jk) = pua(ji, jj, jk) + zuav * (zwz(ji, jj - 1) + zwz(ji, jj))
          pva(ji, jj, jk) = pva(ji, jj, jk) + zvau * (zwz(ji - 1, jj) + zwz(ji, jj))
        END DO
      END DO
      !$ACC END KERNELS
    END DO
  END SUBROUTINE vor_ens
  SUBROUTINE vor_een(kt, kvor, pun, pvn, pua, pva)
    INTEGER, INTENT(IN   ) :: kt
    INTEGER, INTENT(IN   ) :: kvor
    REAL(KIND = wp), DIMENSION(jpi, jpj, jpk), INTENT(INOUT) :: pun, pvn
    REAL(KIND = wp), DIMENSION(jpi, jpj, jpk), INTENT(INOUT) :: pua, pva
    INTEGER :: ji, jj, jk
    INTEGER :: ierr
    REAL(KIND = wp) :: zua, zva
    REAL(KIND = wp) :: zmsk, ze3f
    REAL(KIND = wp), DIMENSION(jpi, jpj) :: zwx, zwy, zwz, z1_e3f
    REAL(KIND = wp), DIMENSION(jpi, jpj) :: ztnw, ztne, ztsw, ztse
    IF (kt == nit000) THEN
      IF (lwp) WRITE(numout, FMT = *)
      IF (lwp) WRITE(numout, FMT = *) 'dyn:vor_een : vorticity term: energy and enstrophy conserving scheme'
      IF (lwp) WRITE(numout, FMT = *) '~~~~~~~~~~~'
    END IF
    DO jk = 1, jpkm1
      SELECT CASE (nn_een_e3f)
      CASE (0)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            ze3f = (e3t_n(ji, jj + 1, jk) * tmask(ji, jj + 1, jk) + e3t_n(ji + 1, jj + 1, jk) * tmask(ji + 1, jj + 1, jk) + e3t_n(ji, jj, jk) * tmask(ji, jj, jk) + e3t_n(ji + 1, jj, jk) * tmask(ji + 1, jj, jk))
            IF (ze3f /= 0._wp) THEN
              z1_e3f(ji, jj) = 4._wp / ze3f
            ELSE
              z1_e3f(ji, jj) = 0._wp
            END IF
          END DO
        END DO
        !$ACC END KERNELS
      CASE (1)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            ze3f = (e3t_n(ji, jj + 1, jk) * tmask(ji, jj + 1, jk) + e3t_n(ji + 1, jj + 1, jk) * tmask(ji + 1, jj + 1, jk) + e3t_n(ji, jj, jk) * tmask(ji, jj, jk) + e3t_n(ji + 1, jj, jk) * tmask(ji + 1, jj, jk))
            zmsk = (tmask(ji, jj + 1, jk) + tmask(ji + 1, jj + 1, jk) + tmask(ji, jj, jk) + tmask(ji + 1, jj, jk))
            IF (ze3f /= 0._wp) THEN
              z1_e3f(ji, jj) = zmsk / ze3f
            ELSE
              z1_e3f(ji, jj) = 0._wp
            END IF
          END DO
        END DO
        !$ACC END KERNELS
      END SELECT
      SELECT CASE (kvor)
      CASE (np_COR)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = ff_f(ji, jj) * z1_e3f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
      CASE (np_RVO)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = (e2v(ji + 1, jj) * pvn(ji + 1, jj, jk) - e2v(ji, jj) * pvn(ji, jj, jk) - e1u(ji, jj + 1) * pun(ji, jj + 1, jk) + e1u(ji, jj) * pun(ji, jj, jk)) * r1_e1e2f(ji, jj) * z1_e3f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
      CASE (np_MET)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = ((pvn(ji + 1, jj, jk) + pvn(ji, jj, jk)) * di_e2v_2e1e2f(ji, jj) - (pun(ji, jj + 1, jk) + pun(ji, jj, jk)) * dj_e1u_2e1e2f(ji, jj)) * z1_e3f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
      CASE (np_CRV)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = (ff_f(ji, jj) + (e2v(ji + 1, jj) * pvn(ji + 1, jj, jk) - e2v(ji, jj) * pvn(ji, jj, jk) - e1u(ji, jj + 1) * pun(ji, jj + 1, jk) + e1u(ji, jj) * pun(ji, jj, jk)) * r1_e1e2f(ji, jj)) * z1_e3f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
      CASE (np_CME)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = (ff_f(ji, jj) + (pvn(ji + 1, jj, jk) + pvn(ji, jj, jk)) * di_e2v_2e1e2f(ji, jj) - (pun(ji, jj + 1, jk) + pun(ji, jj, jk)) * dj_e1u_2e1e2f(ji, jj)) * z1_e3f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
      CASE DEFAULT
        CALL ctl_stop('STOP', 'dyn_vor: wrong value for kvor')
      END SELECT
      IF (ln_dynvor_msk) THEN
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = zwz(ji, jj) * fmask(ji, jj, jk)
          END DO
        END DO
        !$ACC END KERNELS
      END IF
      CALL lbc_lnk(zwz, 'F', 1.)
      !$ACC KERNELS
      zwx(:, :) = e2u(:, :) * e3u_n(:, :, jk) * pun(:, :, jk)
      zwy(:, :) = e1v(:, :) * e3v_n(:, :, jk) * pvn(:, :, jk)
      jj = 2
      ztne(1, :) = 0
      ztnw(1, :) = 0
      ztse(1, :) = 0
      ztsw(1, :) = 0
      DO ji = 2, jpi
        ztne(ji, jj) = zwz(ji - 1, jj) + zwz(ji, jj) + zwz(ji, jj - 1)
        ztnw(ji, jj) = zwz(ji - 1, jj - 1) + zwz(ji - 1, jj) + zwz(ji, jj)
        ztse(ji, jj) = zwz(ji, jj) + zwz(ji, jj - 1) + zwz(ji - 1, jj - 1)
        ztsw(ji, jj) = zwz(ji, jj - 1) + zwz(ji - 1, jj - 1) + zwz(ji - 1, jj)
      END DO
      DO jj = 3, jpj
        DO ji = 2, jpi
          ztne(ji, jj) = zwz(ji - 1, jj) + zwz(ji, jj) + zwz(ji, jj - 1)
          ztnw(ji, jj) = zwz(ji - 1, jj - 1) + zwz(ji - 1, jj) + zwz(ji, jj)
          ztse(ji, jj) = zwz(ji, jj) + zwz(ji, jj - 1) + zwz(ji - 1, jj - 1)
          ztsw(ji, jj) = zwz(ji, jj - 1) + zwz(ji - 1, jj - 1) + zwz(ji - 1, jj)
        END DO
      END DO
      DO jj = 2, jpjm1
        DO ji = 2, jpim1
          zua = + r1_12 * r1_e1u(ji, jj) * (ztne(ji, jj) * zwy(ji, jj) + ztnw(ji + 1, jj) * zwy(ji + 1, jj) + ztse(ji, jj) * zwy(ji, jj - 1) + ztsw(ji + 1, jj) * zwy(ji + 1, jj - 1))
          zva = - r1_12 * r1_e2v(ji, jj) * (ztsw(ji, jj + 1) * zwx(ji - 1, jj + 1) + ztse(ji, jj + 1) * zwx(ji, jj + 1) + ztnw(ji, jj) * zwx(ji - 1, jj) + ztne(ji, jj) * zwx(ji, jj))
          pua(ji, jj, jk) = pua(ji, jj, jk) + zua
          pva(ji, jj, jk) = pva(ji, jj, jk) + zva
        END DO
      END DO
      !$ACC END KERNELS
    END DO
  END SUBROUTINE vor_een
  SUBROUTINE vor_eeT(kt, kvor, pun, pvn, pua, pva)
    INTEGER, INTENT(IN   ) :: kt
    INTEGER, INTENT(IN   ) :: kvor
    REAL(KIND = wp), DIMENSION(jpi, jpj, jpk), INTENT(INOUT) :: pun, pvn
    REAL(KIND = wp), DIMENSION(jpi, jpj, jpk), INTENT(INOUT) :: pua, pva
    INTEGER :: ji, jj, jk
    INTEGER :: ierr
    REAL(KIND = wp) :: zua, zva
    REAL(KIND = wp) :: zmsk, z1_e3t
    REAL(KIND = wp), DIMENSION(jpi, jpj) :: zwx, zwy, zwz
    REAL(KIND = wp), DIMENSION(jpi, jpj) :: ztnw, ztne, ztsw, ztse
    IF (kt == nit000) THEN
      IF (lwp) WRITE(numout, FMT = *)
      IF (lwp) WRITE(numout, FMT = *) 'dyn:vor_een : vorticity term: energy and enstrophy conserving scheme'
      IF (lwp) WRITE(numout, FMT = *) '~~~~~~~~~~~'
    END IF
    DO jk = 1, jpkm1
      SELECT CASE (kvor)
      CASE (np_COR)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = ff_f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
      CASE (np_RVO)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = (e2v(ji + 1, jj) * pvn(ji + 1, jj, jk) - e2v(ji, jj) * pvn(ji, jj, jk) - e1u(ji, jj + 1) * pun(ji, jj + 1, jk) + e1u(ji, jj) * pun(ji, jj, jk)) * r1_e1e2f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
      CASE (np_MET)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = (pvn(ji + 1, jj, jk) + pvn(ji, jj, jk)) * di_e2v_2e1e2f(ji, jj) - (pun(ji, jj + 1, jk) + pun(ji, jj, jk)) * dj_e1u_2e1e2f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
      CASE (np_CRV)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = (ff_f(ji, jj) + (e2v(ji + 1, jj) * pvn(ji + 1, jj, jk) - e2v(ji, jj) * pvn(ji, jj, jk) - e1u(ji, jj + 1) * pun(ji, jj + 1, jk) + e1u(ji, jj) * pun(ji, jj, jk)) * r1_e1e2f(ji, jj))
          END DO
        END DO
        !$ACC END KERNELS
      CASE (np_CME)
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = ff_f(ji, jj) + (pvn(ji + 1, jj, jk) + pvn(ji, jj, jk)) * di_e2v_2e1e2f(ji, jj) - (pun(ji, jj + 1, jk) + pun(ji, jj, jk)) * dj_e1u_2e1e2f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
      CASE DEFAULT
        CALL ctl_stop('STOP', 'dyn_vor: wrong value for kvor')
      END SELECT
      IF (ln_dynvor_msk) THEN
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            zwz(ji, jj) = zwz(ji, jj) * fmask(ji, jj, jk)
          END DO
        END DO
        !$ACC END KERNELS
      END IF
      CALL lbc_lnk(zwz, 'F', 1.)
      !$ACC KERNELS
      zwx(:, :) = e2u(:, :) * e3u_n(:, :, jk) * pun(:, :, jk)
      zwy(:, :) = e1v(:, :) * e3v_n(:, :, jk) * pvn(:, :, jk)
      jj = 2
      ztne(1, :) = 0
      ztnw(1, :) = 0
      ztse(1, :) = 0
      ztsw(1, :) = 0
      DO ji = 2, jpi
        z1_e3t = 1._wp / e3t_n(ji, jj, jk)
        ztne(ji, jj) = (zwz(ji - 1, jj) + zwz(ji, jj) + zwz(ji, jj - 1)) * z1_e3t
        ztnw(ji, jj) = (zwz(ji - 1, jj - 1) + zwz(ji - 1, jj) + zwz(ji, jj)) * z1_e3t
        ztse(ji, jj) = (zwz(ji, jj) + zwz(ji, jj - 1) + zwz(ji - 1, jj - 1)) * z1_e3t
        ztsw(ji, jj) = (zwz(ji, jj - 1) + zwz(ji - 1, jj - 1) + zwz(ji - 1, jj)) * z1_e3t
      END DO
      DO jj = 3, jpj
        DO ji = 2, jpi
          z1_e3t = 1._wp / e3t_n(ji, jj, jk)
          ztne(ji, jj) = (zwz(ji - 1, jj) + zwz(ji, jj) + zwz(ji, jj - 1)) * z1_e3t
          ztnw(ji, jj) = (zwz(ji - 1, jj - 1) + zwz(ji - 1, jj) + zwz(ji, jj)) * z1_e3t
          ztse(ji, jj) = (zwz(ji, jj) + zwz(ji, jj - 1) + zwz(ji - 1, jj - 1)) * z1_e3t
          ztsw(ji, jj) = (zwz(ji, jj - 1) + zwz(ji - 1, jj - 1) + zwz(ji - 1, jj)) * z1_e3t
        END DO
      END DO
      DO jj = 2, jpjm1
        DO ji = 2, jpim1
          zua = + r1_12 * r1_e1u(ji, jj) * (ztne(ji, jj) * zwy(ji, jj) + ztnw(ji + 1, jj) * zwy(ji + 1, jj) + ztse(ji, jj) * zwy(ji, jj - 1) + ztsw(ji + 1, jj) * zwy(ji + 1, jj - 1))
          zva = - r1_12 * r1_e2v(ji, jj) * (ztsw(ji, jj + 1) * zwx(ji - 1, jj + 1) + ztse(ji, jj + 1) * zwx(ji, jj + 1) + ztnw(ji, jj) * zwx(ji - 1, jj) + ztne(ji, jj) * zwx(ji, jj))
          pua(ji, jj, jk) = pua(ji, jj, jk) + zua
          pva(ji, jj, jk) = pva(ji, jj, jk) + zva
        END DO
      END DO
      !$ACC END KERNELS
    END DO
  END SUBROUTINE vor_eeT
  SUBROUTINE dyn_vor_init
    INTEGER :: ji, jj, jk
    INTEGER :: ioptio, ios
    NAMELIST /namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_enT, ln_dynvor_eeT, ln_dynvor_een, nn_een_e3f, ln_dynvor_mix, ln_dynvor_msk
    IF (lwp) THEN
      WRITE(numout, FMT = *)
      WRITE(numout, FMT = *) 'dyn_vor_init : vorticity term : read namelist and control the consistency'
      WRITE(numout, FMT = *) '~~~~~~~~~~~~'
    END IF
    REWIND(UNIT = numnam_ref)
    READ(numnam_ref, namdyn_vor, IOSTAT = ios, ERR = 901)
901 IF (ios /= 0) CALL ctl_nam(ios, 'namdyn_vor in reference namelist', lwp)
    REWIND(UNIT = numnam_cfg)
    READ(numnam_cfg, namdyn_vor, IOSTAT = ios, ERR = 902)
902 IF (ios > 0) CALL ctl_nam(ios, 'namdyn_vor in configuration namelist', lwp)
    IF (lwm) WRITE(numond, namdyn_vor)
    IF (lwp) THEN
      WRITE(numout, FMT = *) '   Namelist namdyn_vor : choice of the vorticity term scheme'
      WRITE(numout, FMT = *) '      enstrophy conserving scheme                    ln_dynvor_ens = ', ln_dynvor_ens
      WRITE(numout, FMT = *) '      f-point energy conserving scheme               ln_dynvor_ene = ', ln_dynvor_ene
      WRITE(numout, FMT = *) '      t-point energy conserving scheme               ln_dynvor_enT = ', ln_dynvor_enT
      WRITE(numout, FMT = *) '      energy conserving scheme  (een using e3t)      ln_dynvor_eeT = ', ln_dynvor_eeT
      WRITE(numout, FMT = *) '      enstrophy and energy conserving scheme         ln_dynvor_een = ', ln_dynvor_een
      WRITE(numout, FMT = *) '         e3f = averaging /4 (=0) or /sum(tmask) (=1)    nn_een_e3f = ', nn_een_e3f
      WRITE(numout, FMT = *) '      mixed enstrophy/energy conserving scheme       ln_dynvor_mix = ', ln_dynvor_mix
      WRITE(numout, FMT = *) '      masked (=T) or unmasked(=F) vorticity          ln_dynvor_msk = ', ln_dynvor_msk
    END IF
    IF (ln_dynvor_msk) CALL ctl_stop('dyn_vor_init:   masked vorticity is not currently not available')
    IF (lwp) WRITE(numout, FMT = *)
    IF (lwp) WRITE(numout, FMT = *) '      change fmask value in the angles (T)           ln_vorlat = ', ln_vorlat
    IF (ln_vorlat .AND. (ln_dynvor_ene .OR. ln_dynvor_ens .OR. ln_dynvor_mix)) THEN
      !$ACC KERNELS
      DO jk = 1, jpk
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            IF (tmask(ji, jj + 1, jk) + tmask(ji + 1, jj + 1, jk) + tmask(ji, jj, jk) + tmask(ji + 1, jj + 1, jk) == 3._wp) fmask(ji, jj, jk) = 1._wp
          END DO
        END DO
      END DO
      !$ACC END KERNELS
      CALL lbc_lnk(fmask, 'F', 1._wp)
    END IF
    ioptio = 0
    IF (ln_dynvor_ens) THEN
      ioptio = ioptio + 1
      nvor_scheme = np_ens
    END IF
    IF (ln_dynvor_ene) THEN
      ioptio = ioptio + 1
      nvor_scheme = np_ene
    END IF
    IF (ln_dynvor_ent) THEN
      ioptio = ioptio + 1
      nvor_scheme = np_ent
    END IF
    IF (ln_dynvor_eet) THEN
      ioptio = ioptio + 1
      nvor_scheme = np_eet
    END IF
    IF (ln_dynvor_een) THEN
      ioptio = ioptio + 1
      nvor_scheme = np_een
    END IF
    IF (ln_dynvor_mix) THEN
      ioptio = ioptio + 1
      nvor_scheme = np_mix
    END IF
    IF (ioptio /= 1) CALL ctl_stop(' use ONE and ONLY one vorticity scheme')
    IF (lwp) WRITE(numout, FMT = *)
    ncor = np_COR
    SELECT CASE (n_dynadv)
    CASE (np_LIN_dyn)
      IF (lwp) WRITE(numout, FMT = *) '   ==>>>   linear dynamics : total vorticity = Coriolis'
      nrvm = np_COR
      ntot = np_COR
    CASE (np_VEC_c2)
      IF (lwp) WRITE(numout, FMT = *) '   ==>>>   vector form dynamics : total vorticity = Coriolis + relative vorticity'
      nrvm = np_RVO
      ntot = np_CRV
    CASE (np_FLX_c2, np_FLX_ubs)
      IF (lwp) WRITE(numout, FMT = *) '   ==>>>   flux form dynamics : total vorticity = Coriolis + metric term'
      nrvm = np_MET
      ntot = np_CME
      SELECT CASE (nvor_scheme)
      CASE (np_ENT)
        ALLOCATE(di_e2u_2(jpi, jpj), dj_e1v_2(jpi, jpj))
        !$ACC KERNELS
        DO jj = 2, jpjm1
          DO ji = 2, jpim1
            di_e2u_2(ji, jj) = (e2u(ji, jj) - e2u(ji - 1, jj)) * 0.5_wp
            dj_e1v_2(ji, jj) = (e1v(ji, jj) - e1v(ji, jj - 1)) * 0.5_wp
          END DO
        END DO
        !$ACC END KERNELS
        CALL lbc_lnk_multi(di_e2u_2, 'T', - 1., dj_e1v_2, 'T', - 1.)
      CASE DEFAULT
        ALLOCATE(di_e2v_2e1e2f(jpi, jpj), dj_e1u_2e1e2f(jpi, jpj))
        !$ACC KERNELS
        DO jj = 1, jpjm1
          DO ji = 1, jpim1
            di_e2v_2e1e2f(ji, jj) = (e2v(ji + 1, jj) - e2v(ji, jj)) * 0.5 * r1_e1e2f(ji, jj)
            dj_e1u_2e1e2f(ji, jj) = (e1u(ji, jj + 1) - e1u(ji, jj)) * 0.5 * r1_e1e2f(ji, jj)
          END DO
        END DO
        !$ACC END KERNELS
        CALL lbc_lnk_multi(di_e2v_2e1e2f, 'F', - 1., dj_e1u_2e1e2f, 'F', - 1.)
      END SELECT
    END SELECT
    IF (lwp) THEN
      WRITE(numout, FMT = *)
      SELECT CASE (nvor_scheme)
      CASE (np_ens)
        WRITE(numout, FMT = *) '   ==>>>   enstrophy conserving scheme (ENS)'
      CASE (np_ene)
        WRITE(numout, FMT = *) '   ==>>>   energy conserving scheme (Coriolis at F-points) (ENE)'
      CASE (np_ent)
        WRITE(numout, FMT = *) '   ==>>>   energy conserving scheme (Coriolis at T-points) (ENT)'
      CASE (np_eet)
        WRITE(numout, FMT = *) '   ==>>>   energy conserving scheme (EEN scheme using e3t) (EET)'
      CASE (np_een)
        WRITE(numout, FMT = *) '   ==>>>   energy and enstrophy conserving scheme (EEN)'
      CASE (np_mix)
        WRITE(numout, FMT = *) '   ==>>>   mixed enstrophy/energy conserving scheme (MIX)'
      END SELECT
    END IF
  END SUBROUTINE dyn_vor_init
END MODULE dynvor


!==================================================================================================
!!
!> @brief       Satellite macro model representation
!> @author      Vitali Braun (VB)
!> @author      Christopher Kebschull (CHK)
!!
!> @date

!!
VB:  13.03.2013 (initial design)

!!
VB:  04.06.2013 (code optimization)

!!
VB:  26.01.2013 (added oriented surfaces)

!!
VB:  31.03.2015 (added ESH feature)

!!
CHK: 13.11.2015 (updated to use libslam)

!!
VB:  15.05.2016 (updated to have only statements for all use statements)

!!
CHK: 04.01.2018 (created Satellite_class)
!!

!!
!> @details     This module contains type definitions and routines required for the representation
!!              of the satellite's oriented surfaces. It always holds the current orientation of
!!              all surfaces and performs an update as soon as one of the update functions is called,
!!              as long as the surfaces are rotating.
!!
!!              \par Includes
!!
!!

!!
 neptune_error_handling.f90

!!
 slam_io.f90

!!
 slam_math.f90

!!
 slam_reduction.f90

!!
 solarsystem.f90

!!
 slam_types.f90

!!

!!
!> @copyright   Institute of Space Systems / TU Braunschweig
!!
!> @anchor      satellite
!!
!!------------------------------------------------------------------------------------------------
module satellite

  use neptune_error_handling, only: E_NEGATIVE_MASS, E_MAX_SURFACES, E_INVALID_SATELLITE, &
                                    E_UNDEFINED_SATELLITE, setNeptuneError
  use slam_error_handling,    only: isControlled, hasToReturn, WARNING, FATAL, hasFailed, &
                                    E_ID_MATCH, E_ANGLE_OUT_OF_RANGE, checkIn, checkOut
  use slam_io,                only: cdelimit, SEQUENTIAL, IN_FORMATTED, LOG_AND_STDOUT, openFile, message, nxtbuf
  use slam_math,              only: pi, halfPi, mag, deg2rad, eps9, cross, undefined, redang
  use slam_reduction_class,   only: Reduction_type
  use solarsystem,            only: Solarsystem_class, ID_SUN, getBodyPosition
  use slam_types,             only: dp

  implicit none

  private

  !** Flags
  integer, parameter, public :: MODE_CANNON_BALL = 0    ! Cannon ball mode (spherical)
  integer, parameter, public :: MODE_ORIENTED    = 1    ! Oriented surface mode

  integer, parameter, public :: ORIENT_SPHERE = 0  ! Sphere flag (no orientation required)
  integer, parameter, public :: ORIENT_EARTH  = 1  ! Earth oriented surface flag
  integer, parameter, public :: ORIENT_SUN    = 2  ! Sun oriented surface flag
  integer, parameter, public :: ORIENT_SPACE  = 3  ! Inertial oriented surface flag

  integer, parameter, public :: ID_ATMOSPHERE = 1 !> ID which shall be used if hasChangedSatellite() is called for atmosphere perturbations
  integer, parameter, public :: ID_SRP        = 2 !> ID which shall be used if hasChangedSatellite() is called for SRP perturbations
  integer, parameter, public :: ID_ALBEDO     = 3 !> ID which shall be used if hasChangedSatellite() is called for Albedo perturbations

  !** parameters
  integer, parameter, public :: MAX_SURFACES = 30   ! maximum number of surfaces which can be defined

  !** surfaces
  !-------------------------------------------------------------------------------
  type surface_t

    integer                :: id            ! surface identifier (0 = not specified)
    integer                :: orientation   ! surface orientation
    real(dp)               :: area          ! surface area in km**2
    real(dp), dimension(2) :: normal_angle  ! normal unit vector of the area described by two angles in radians
                                            !  1 = Right ascension, Azimuth or Sun incidence angle
                                            !  2 = Declination or Elevation
    real(dp), dimension(3) :: normal_GCRF   ! normal unit vector in GCRF
    real(dp)               :: reflSpec      ! spectral reflectivity coefficient
    real(dp)               :: reflDiff      ! diffuse reflectivity coefficient
    real(dp)               :: esh           ! equivalent solar hours of surface / h

  end type
  !-------------------------------------------------------------------------------

  !** macro-model of a satellite
  !-------------------------------------------------------------------------------
  type, public :: Satellite_class

    logical                                      :: eshFlag                     ! if true, the Equivalent Solar Hours are computed for the individual surfaces
    logical                                      :: cannon_ball_mode            ! becomes true if any of the specified surfaces has the Sphere flag set (ORIENT_SPHERE = 0)

    !** Input file
    character(len=512)                           :: csurfile                    ! surfaces definition file

    integer                                      :: nsurfaces                   ! number of different surfaces for a satellite
    logical                                      :: multiOriented               ! flag indicating that there are Earth- AND Sun-oriented surfaces
    real(dp)                                     :: cdrag                       ! drag coefficient of the satellite
    real(dp)                                     :: mass                        ! object mass
    real(dp)                                     :: mjd                         ! epoch for which data is valid (negative as long as no epoch is available)
    type(surface_t),dimension(MAX_SURFACES)      :: surface                     ! surfaces
    logical                                      :: isSet                       ! initialization flag

    logical, dimension(3)                        :: hasChanged                  ! indicator as soon as satellite properties change, e.g. mass, drag coefficient, etc.
                                                                                ! the array supports a flag for atmosphere (=1), SRP (=2) and albedo (=3) perturbations as all of them will
                                                                                ! access the data supported by the satellite type

    logical                                      :: first_ESH                   ! for initialization
    logical                                      :: first_orientation           ! for initialization
    real(dp)                                     :: startMJD                    ! first MJD required to sum up time
    real(dp), dimension(30)                      :: lastMJD                     ! MJD in last call for any surface - necessary to sum only in forward direction

    contains

        !** getter
        procedure :: getESH
        procedure :: getESHFlag
        procedure :: getObjectBallisticCoefficient
        procedure :: getObjectCrossSection
        procedure :: getObjectDragCoefficient
        procedure :: getObjectMass
        procedure :: getOrientationMode
        procedure :: getSurfaceDefinitionFileName
        procedure :: getSurfaceNormal
        procedure :: getSurfaceNumber
        procedure :: getSurfaceArea
        procedure :: getSurfaceSpecRefl
        procedure :: getSurfaceDiffRefl
        procedure :: hasChangedSatellite

        !** setter
        procedure :: resetObject
        procedure :: setObjectMass
        procedure :: setSurfaceDefinitionFileName

        procedure :: initObject
        procedure :: readSurfaceDefinitionFile
        procedure :: updateESH

        procedure, private  :: updateOrientation

    end type Satellite_class

    ! Constructor
    interface Satellite_class
        module procedure constructor
    end interface Satellite_class

contains

    ! ====================================================================
    !!
    !>  @brief      Constructor that should be used to initialize variables.
    !!
    !!  @author     Christopher Kebschull
    !!  @date

    !!
ChK: 24.12.2017 (initial implementation)

    !!

    !!  @anchor     constructor
    !!
    ! --------------------------------------------------------------------
    type(Satellite_class) function constructor()
        constructor%eshFlag             = .false.                               ! if true, the Equivalent Solar Hours are computed for the individual surfaces
        constructor%cannon_ball_mode    = .false.                               ! becomes true if any of the specified surfaces has the Sphere flag set (ORIENT_SPHERE = 0)
        constructor%csurfile            = 'neptune.srf'                         ! surfaces definition file
        constructor%multiOriented       = .false.                               ! flag indicating that there are Earth- AND Sun-oriented surfaces
        constructor%mjd                 = -1.d0                                 ! epoch for which data is valid (negative as long as no epoch is available)
        constructor%isSet               = .false.
        constructor%nsurfaces           = 1
        constructor%first_esh           = .true.
        constructor%first_orientation   = .true.

        constructor%surface(:)%id   = 0
        constructor%surface(:)%esh  = 0.0

    end function constructor

!=============================================================================
!
!> @anchor      initObject
!!
!> @brief       Initialise the object
!> @author      Vitali Braun
!!
!> @param[in]   obj   object of type satellit_t, which initializes the module variable 'object'
!!
!> @date

!!
 07.11.2013 (initial design)

!!

!!
!-----------------------------------------------------------------------------
  subroutine initObject(this)

    class(Satellite_class)      :: this

    character(len=*), parameter :: csubid = 'initObject'
    character(len=255)          :: cmess

    integer                     :: i    ! loop counter

    if(isControlled()) then
      if(hasToReturn()) return
      call checkIn(csubid)
    end if

    if(this%isSet) then   ! initialization already done -> re-initialize!

      call this%resetObject()

    end if

    !=============================================
    !
    ! Check values for validity
    !
    !--------------------------------------

    !** mass and drag coefficient
    if(this%mass <= 0.d0) then
      cmess = "Satellite's mass negative or zero."
      call setNeptuneError(E_NEGATIVE_MASS, FATAL, (/cmess/))
      return

    else if(this%cdrag <= 0.d0) then

      cmess = "Satellite's drag coefficient is negative or zero."
      call setNeptuneError(E_INVALID_SATELLITE, FATAL, (/cmess/))
      return

    end if

    !** for all surfaces, check that values are >= 0 and sum of Crs + Crd <= 1, also angles can have limits, e.g. 90° for declination/elevation
    do i=1,this%nsurfaces

      if(this%surface(i)%area < 0.d0) then

        write(cmess,'(a,i3)') "Area is negative for surface #", this%surface(i)%id
        call setNeptuneError(E_INVALID_SATELLITE, FATAL, (/cmess/))
        return

      else if(this%surface(i)%reflSpec + this%surface(i)%reflDiff > 1.d0) then

        cmess = "Sum of specular and diffuse reflectivity > 1."
        call setNeptuneError(E_INVALID_SATELLITE, FATAL, (/cmess/))
        return

      else if(this%surface(i)%orientation /= ORIENT_SPHERE .and. &
              this%surface(i)%orientation /= ORIENT_EARTH  .and. &
              this%surface(i)%orientation /= ORIENT_SUN    .and. &
              this%surface(i)%orientation /= ORIENT_SPACE)  then

        write(cmess,'(a,i2,a)') "Unsupported orientation mode: '", this%surface(i)%orientation, "'."
        call setNeptuneError(E_INVALID_SATELLITE, FATAL, (/cmess/))
        return

      else if(abs(this%surface(i)%normal_angle(2)) > halfPi) then

        write(cmess,'(a,i2)') " Elevation can not be higher than +-90 deg. Set to '+90 deg'."
        call setNeptuneError(E_ANGLE_OUT_OF_RANGE, WARNING, (/cmess/))

        this%surface(i)%normal_angle(2) = halfPi

      end if

    end do

    !** correct area to km**2
    this%surface%area = this%surface%area*1.d-6 ! in km**2

    if(any(this%surface%orientation == ORIENT_SPHERE)) then

      this%cannon_ball_mode = .true.   ! a spherical shape is assumed.

    else if(any(this%surface%orientation == ORIENT_EARTH) .and. any(this%surface%orientation == ORIENT_SUN)) then

      this%multiOriented = .true.   ! e.g. if Earth oriented satellite with solar arrays is simulated

    end if

    this%hasChanged = .true.   ! new data available for all accessing modules
    this%isSet      = .true.   ! initialized object is available

    if(isControlled()) then
      call checkOut(csubid)
    end if

    return

  end subroutine initObject

!=============================================================================
!
!> @anchor      getESH
!!
!> @brief       Returns the ESH for a surface
!> @author      Vitali Braun
!!
!> @param[in]   id_in    Surface ID
!!
!> @return      Equivalent solar hours / h
!!
!> @date

!!
 31.03.2015 (initial design)

!!

!!
!-----------------------------------------------------------------------------
  real(dp) function getESH(this,id_in)

    class(Satellite_class)  :: this
    integer, intent(in)     :: id_in

    getESH = this%surface(max(min(this%nsurfaces,id_in),0))%esh

    return

  end function getESH

!=============================================================================
!
!> @anchor      getESHFlag
!!
!> @brief       Returns the ESH flag
!> @author      Vitali Braun
!!
!> @return      .true. when the ESH is calculated
!!
!> @date

!!
 31.03.2015 (initial design)

!!

!!
!-----------------------------------------------------------------------------
  logical function getESHFlag(this)

    class(Satellite_class)  :: this
    getESHFlag = this%eshFlag
    return

  end function getESHFlag

!===================================================================================
!
!> @anchor      updateESH
!!
!> @brief       Update the current counters of the ESH for the individual surfaces
!> @author      Vitali Braun
!!
!> @param[in]   timeMJD   Current datetime / MJD
!> @param[in]   cosinc    Solar incidence angle / deg
!> @param[in]   id        Surface ID
!!
!> @date

!!
 31.03.2015 (initial design)

!!

!!
!-----------------------------------------------------------------------------
  subroutine updateESH(this, timeMJD, id, cosinc)

    class(Satellite_class)  :: this
    real(dp), intent(in)    :: timeMJD
    real(dp), intent(in)    :: cosinc
    integer,  intent(in)    :: id

    character(len=*), parameter :: csubid = 'updateESH'

    if(isControlled()) then
      if(hasToReturn()) return
      call checkIn(csubid)
    end if

    if(this%first_esh) then
      this%startMJD    = timeMJD
      this%lastMJD(:)  = timeMJD
      this%first_esh   = .false.
    end if

    !** do nothing and leave if MJD is less than last MJD
    if(timeMJD <= this%lastMJD(id)) then
      if(isControlled()) call checkOut(csubid)
      return
    end if

    if(this%isSet) then
      this%surface(id)%esh = this%surface(id)%esh + max(cosinc,0.d0)*(timeMJD - this%lastMJD(id))*24.d0 ! in hours
      this%lastMJD(id) = timeMJD
    end if

    if(isControlled()) call checkOut(csubid)
    return

  end subroutine updateESH

!=============================================================================
!
!> @anchor      getObjectMass
!!
!> @brief       Returns the mass of the object
!> @author      Vitali Braun
!!
!> @return      mass / kg
!!
!> @date

!!
 07.11.2013 (initial design)

!!

!!
!-----------------------------------------------------------------------------
  real(dp) function getObjectMass(this)

    class(Satellite_class)      :: this
    character(len=*), parameter :: csubid = 'getObjectMass'

    getObjectMass = undefined

    if(isControlled()) then
      if(hasToReturn()) return
      call checkIn(csubid)
    end if

    if(.not. this%isSet) then
      call setNeptuneError(E_UNDEFINED_SATELLITE, FATAL)
      return
    end if

    getObjectMass = this%mass

    if(isControlled()) then
      call checkOut(csubid)
    end if

  end function getObjectMass

!=============================================================================
!
!> @anchor      getObjectDragCoefficient
!!
!> @brief       Returns the drag coefficient of the object
!> @author      Vitali Braun
!!
!> @date

!!
 27.01.2014 (initial design)

!!

!!
!-----------------------------------------------------------------------------
  real(dp) function getObjectDragCoefficient(this)

    class(Satellite_class)      :: this
    character(len=*), parameter :: csubid = 'getObjectDragCoefficient'

    getObjectDragCoefficient = undefined

    if(isControlled()) then
      if(hasToReturn()) return
      call checkIn(csubid)
    end if

    if(.not. this%isSet) then
      call setNeptuneError(E_UNDEFINED_SATELLITE, FATAL)
      return
    end if

    getObjectDragCoefficient = this%cdrag

    if(isControlled()) then
      call checkOut(csubid)
    end if

  end function getObjectDragCoefficient

!=============================================================================
!
!> @anchor      getSurfaceNumber
!!
!> @brief       Returns the number of surfaces
!> @author      Vitali Braun
!!
!> @return      number of surfaces
!!
!> @date

!!
 27.01.2014 (initial design)

!!

!!
!-----------------------------------------------------------------------------
  integer function getSurfaceNumber(this)

    class(Satellite_class)      :: this
    character(len=*), parameter :: csubid = 'getSurfaceNumber'

    getSurfaceNumber = -1

    if(isControlled()) then
      if(hasToReturn()) return
      call checkIn(csubid)
    end if

    if(.not. this%isSet) then
      call setNeptuneError(E_UNDEFINED_SATELLITE, FATAL)
      return
    end if

    getSurfaceNumber = this%nsurfaces

    if(isControlled()) then
      call checkOut(csubid)
    end if

  end function getSurfaceNumber
!=============================================================================
!
!> @anchor      getSurfaceNormal
!!
!> @brief       Returns the normal vector for a requested surface
!> @author      Vitali Braun
!!
!> @param[in]   id          ID of surface
!> @param[in]   time_mjd    MJD for vector orientation
!> @param[in]   r           radius vector in GCRF
!> @param[in]   v           velocity vector in GCRF
!!
!> @return      normal vector
!!
!> @date

!!
 28.01.2014 (initial design)

!!

!!
!-----------------------------------------------------------------------------
  function getSurfaceNormal(this, solarsystem_model, reduction, id, time_mjd, r, v)

    real(dp), dimension(3)                  :: getSurfaceNormal
    class(Satellite_class)                  :: this
    type(Solarsystem_class),intent(inout)   :: solarsystem_model
    type(Reduction_type),intent(inout)     :: reduction
    real(dp),               intent(in)      :: time_mjd
    real(dp), dimension(3), intent(in)      :: r
    real(dp), dimension(3), intent(in)      :: v
    integer,                intent(in)      :: id

    character(len=*), parameter :: csubid = 'getSurfaceNormal'
    integer                     :: i
    logical                     :: found

    if(isControlled()) then
      if(hasToReturn()) return
      call checkIn(csubid)
    end if

    found = .false.

    if(.not. this%isSet) then
      call setNeptuneError(E_UNDEFINED_SATELLITE, FATAL)
      return
    end if

    do i=1,this%nsurfaces

      if(id == this%surface(i)%id) then

        !** perform an update
        call this%updateOrientation(solarsystem_model,reduction,time_mjd, r, v)

        getSurfaceNormal(:) = this%surface(i)%normal_GCRF(:)
        found = .true.
        exit

      end if

    end do

    if(.not. found) then
      call setNeptuneError(E_ID_MATCH, FATAL)
      getSurfaceNormal = 0.d0
      return
    end if

    if(isControlled()) then
      call checkOut(csubid)
    end if

  end function getSurfaceNormal

!=============================================================================
!
!> @anchor      getSurfaceSpecRefl
!!
!> @brief       Returns the specular reflectivity for requested surface.
!> @author      Vitali Braun
!!
!> @param[in]   id    Surface id
!!
!> @return      specular reflectivity
!!
!> @date

!!
 28.01.2014 (initial design)

!!

!!
!-----------------------------------------------------------------------------
  real(dp) function getSurfaceSpecRefl(this,id)

    class(Satellite_class)  :: this
    integer, intent(in)     :: id

    character(len=*), parameter :: csubid = 'getSurfaceSpecRefl'
    integer :: i    ! counter
    logical :: found

    getSurfaceSpecRefl = undefined
    found = .false.

    if(isControlled()) then
      if(hasToReturn()) return
      call checkIn(csubid)
    end if

    if(.not. this%isSet) then
      call setNeptuneError(E_UNDEFINED_SATELLITE, FATAL)
      return
    end if

    do i=1,this%nsurfaces
      if(id == this%surface(i)%id) then
        getSurfaceSpecRefl = this%surface(i)%reflSpec
        found = .true.
        exit
      end if

    end do

    if(.not. found) then
      call setNeptuneError(E_ID_MATCH, FATAL)
      getSurfaceSpecRefl = -1.d0
      return
    end if

    if(isControlled()) then
      call checkOut(csubid)
    end if

    return

  end function getSurfaceSpecRefl

!=============================================================================
!
!> @anchor      getSurfaceDiffRefl
!!
!> @brief       Returns the diffuse reflectivity for requested surface.
!> @author      Vitali Braun
!!
!> @param[in]   id    Surface id
!!
!> @return      diffuse reflectivity
!!
!> @date

!!
 28.01.2014 (initial design)

!!

!!
!-----------------------------------------------------------------------------
  real(dp) function getSurfaceDiffRefl(this,id)

    class(Satellite_class)  :: this
    integer, intent(in)     :: id

    character(len=*), parameter :: csubid = 'getSurfaceDiffRefl'
    integer :: i    ! counter
    logical :: found = .false.

    getSurfaceDiffRefl = undefined

    if(isControlled()) then
      if(hasToReturn()) return
      call checkIn(csubid)
    end if

    if(.not. this%isSet) then
      call setNeptuneError(E_UNDEFINED_SATELLITE, FATAL)
      return
    end if

    do i=1,this%nsurfaces

      if(id == this%surface(i)%id) then
        getSurfaceDiffRefl = this%surface(i)%reflDiff
        found = .true.
        exit
      end if

    end do

    if(.not. found) then
      call setNeptuneError(E_ID_MATCH, FATAL)
      getSurfaceDiffRefl = -1.d0
      return
    end if

    if(isControlled()) then
      call checkOut(csubid)
    end if

    return

  end function getSurfaceDiffRefl

!=============================================================================
!
!> @anchor      getSurfaceArea
!!
!> @brief       Returns the area for requested surface.
!> @author      Vitali Braun
!!
!> @param[in]   id    Surface id
!!
!> @return      area / m**2
!!
!> @date

!!
 28.01.2014 (initial design)

!!

!!
!-----------------------------------------------------------------------------
  real(dp) function getSurfaceArea(this, id)

    class(Satellite_class)  :: this
    integer, intent(in)     :: id

    character(len=*), parameter :: csubid = 'getSurfaceArea'
    integer :: i    ! counter
    logical :: found = .false.

    getSurfaceArea = undefined

    if(isControlled()) then
      if(hasToReturn()) return
      call checkIn(csubid)
    end if

    if(.not. this%isSet) then
      call setNeptuneError(E_UNDEFINED_SATELLITE, FATAL)
      return
    end if

    do i=1,this%nsurfaces

      if(id == this%surface(i)%id) then
        getSurfaceArea = this%surface(i)%area
        found = .true.
        exit
      end if

    end do

    if(.not. found) then
      call setNeptuneError(E_ID_MATCH, FATAL)
      getSurfaceArea = -1.d0
      return
    end if

    if(isControlled()) then
      call checkOut(csubid)
    end if

    return

  end function getSurfaceArea

!==================================================================================================
!
!> @anchor      getObjectBallisticCoefficient
!!
!> @brief       Returns the ballistic coefficient of the object for the given epoch in velocity direction
!> @author      Vitali Braun
!!
!> @param[in]   solarsystem_model The solar system model
!> @param[in]   reduction         reduction handler
!> @param[in]   time_mjd          Modified Julian Day of epoch
!> @param[in]   r                 Radius vector Earth -> Satellite in GCRF
!> @param[in]   v                 Velocity vector, actually being the vector the cross section is computed for
!!
!> @return      ballistic coefficient / kg/m**2
!!
!> @date

!!
 02.06.2014 (initial design)

!!

!!
!> @details     The ballistic coefficient (in kg/m**2) is computed via the cross-section as seen
!!              from the velocity direction without taking into account the shadowing effects
!!              which some surfaces may experience. Also the current mass and the drag parameter are
!!              taken into account. Note that the ballistic coefficient only takes into account
!!              the mass and the cross-section (not Cd or Cr).
!!
!---------------------------------------------------------------------------------------------------
  real(dp) function getObjectBallisticCoefficient(this, solarsystem_model, reduction, time_mjd, r, v) result(bc)

    class(Satellite_class)                  :: this
    type(Solarsystem_class),intent(inout)   :: solarsystem_model
    type(Reduction_type),intent(inout)      :: reduction
    real(dp),               intent(in)      :: time_mjd
    real(dp), dimension(3), intent(in)      :: r
    real(dp), dimension(3), intent(in)      :: v

    character(len=*), parameter :: csubid = 'getObjectBallisticCoefficient'

    bc = 0.d0

    if(isControlled()) then
      if(hasToReturn()) return
      call checkIn(csubid)
    end if

    if(.not. this%isSet) then

      call setNeptuneError(E_UNDEFINED_SATELLITE, FATAL)
      return

    else

      bc = this%getObjectMass()/(this%getObjectCrossSection(solarsystem_model, reduction, time_mjd, r, v)*1.d6) ! 1.d6 to correct for 'm**2'
      if(hasFailed()) return

    end if

    !** done
    if(isControlled()) then
      call checkOut(csubid)
    end if

    return

  end function getObjectBallisticCoefficient

!==================================================================================================
!
!> @anchor      getObjectCrossSection
!!
!> @brief       Returns the cross section of the object for the given epoch in velocity direction
!> @author      Vitali Braun
!!
!> @param[in]   solarsystem_model The solar system model
!> @param[in]   reduction         reduction handler
!> @param[in]   time_mjd          Modified Julian Day of epoch
!> @param[in]   r                 Radius vector Earth -> Satellite in GCRF
!> @param[in]   v                 Velocity vector, actually being the vector the cross section is computed for
!!
!> @return      cross section / km**2
!!
!> @date

!!
 27.01.2014 (initial design)

!!

!!
!> @details     The cross-section as seen from the velocity direction is computed without taking
!!              into account the shadowing effects which some surfaces may experience.
!!
!---------------------------------------------------------------------------------------------------
  real(dp) function getObjectCrossSection(this,solarsystem_model,reduction,time_mjd, r, v)

    class(Satellite_class)                  :: this
    type(Solarsystem_class),intent(inout)   :: solarsystem_model
    type(Reduction_type),intent(inout)     :: reduction
    real(dp),               intent(in)      :: time_mjd
    real(dp), dimension(3), intent(in)      :: r
    real(dp), dimension(3), intent(in)      :: v

    character(len=*), parameter :: csubid = 'getObjectCrossSection'
    integer  :: i       ! loop counter
    real(dp) :: temp    ! temporary

    getObjectCrossSection = 0.d0

    if(isControlled()) then
      if(hasToReturn()) return
      call checkIn(csubid)
    end if

    if(.not. this%isSet) then

      call setNeptuneError(E_UNDEFINED_SATELLITE, FATAL)
      return

    else if(this%surface(1)%orientation == ORIENT_SPHERE) then    ! return cross-section for 'sphere' mode

      getObjectCrossSection = this%surface(1)%area
      if(isControlled()) then
        call checkOut(csubid)
      end if
      return

    end if

    !** perform update of satellite's orientation
    call this%updateOrientation(solarsystem_model, reduction, time_mjd, r, v)

    !write(*,*) "nsurfaces = ", this%nsurfaces
    !write(*,*) "surface area = ", this%surface(1)%area, this%surface(2)%area
    !write(*,*) "normal 1: ", this%surface(1)%normal_GCRF
    !write(*,*) "normal 2: ", this%surface(2)%normal_GCRF

    !read(*,*)
    !** compute cross-section as sum of projected surfaces with cos < 90 deg.
    do i=1,this%nsurfaces

      temp = dot_product(this%surface(i)%normal_GCRF, v)

      if(temp > 0.d0) then

        getObjectCrossSection = getObjectCrossSection + temp/mag(v)*this%surface(i)%area

      end if

    end do

    !** done
    if(isControlled()) then
      call checkOut(csubid)
    end if

    return

  end function getObjectCrossSection

!========================================================================================================
!
!> @anchor      hasChangedSatellite
!!
!> @brief       Returns TRUE if there was any change to the satellite setup between different calls
!> @author      Vitali Braun
!!
!> @param[in]   id    Subroutine ID
!!
!> @return       .true. when there has been changes to the satellite
!!
!> @date

!!
 27.01.2014 (initial design)

!!

!!
!> @details     This routine returns a flag, which tells, whether there have been changes to parameters
!!              in the satellite configuration, which are specific to the calling routine. E.g. for
!!              atmospheric perturbations, the drag coefficient and the mass are important, while
!!              for SRP, it is the specular and diffuse reflectivity, as well as the mass.
!---------------------------------------------------------------------------------------------------------
  logical function hasChangedSatellite(this, id)

    class(Satellite_class)  :: this
    integer, intent(in)     :: id

    select case(id)
      case(ID_ATMOSPHERE)
        hasChangedSatellite = this%hasChanged(1)
        this%hasChanged(1)      = .false.
      case(ID_SRP)
        hasChangedSatellite = this%hasChanged(2)
        this%hasChanged(2)      = .false.
      case(ID_ALBEDO)
        hasChangedSatellite = this%hasChanged(3)
        this%hasChanged(3)      = .false.
      case default  ! for an unknown id, always TRUE will be returned, so that a re-acquiring of data is forced in case of some error which might have led here...
        hasChangedSatellite     = .true.

    end select

  end function hasChangedSatellite

!=============================================================================
!
!> @anchor      readSurfaceDefinitionFile
!!
!> @brief       Reads the surfaces definition file ('neptune.srf' as default)
!> @author      Vitali Braun
!> @author      Christopher Kebschull
!!
!> @param[in]   cpath   Path where the surfaces definition file is located.
!!
!> @date

!!
VB:  26.01.2014 (initial design)

!!
CHK: 04.01.2017 (simplified routine by applying object-oriented approach)

!!

!!
!-----------------------------------------------------------------------------
  subroutine readSurfaceDefinitionFile(this,cpath)

    class(Satellite_class)          :: this
    character(len=*), intent(in)    :: cpath

    character(len=255)                                          :: cbuf         ! character buffer
    character(len=(len_trim(cpath) + len(this%csurfile) + 1))   :: cfile
    character(len=*), parameter                                 :: csubid = 'readSurfaceDefinitionFile'

    integer                                     :: ich                          ! data file channel
    integer                                     :: itemp                        ! temporary
    type(surface_t),dimension(MAX_SURFACES)     :: tmp_surface                  ! temporary surfaces

    if(isControlled()) then
      if(hasToReturn()) return
      call checkIn(csubid)
    end if

    !** open file
    cfile = trim(adjustl(cpath))//cdelimit//trim(adjustl(this%csurfile))
    ich = openFile(cfile, SEQUENTIAL, IN_FORMATTED)

    call message(' - Reading surfaces definition file...', LOG_AND_STDOUT)

    !=========================================
    !
    ! Read file
    !
    !-------------------------------

    !** Satellite mass
    call nxtbuf('#', 0, ich, cbuf)
    read(cbuf,*) this%mass

    !** Drag coefficient
    call nxtbuf('#', 0, ich, cbuf)
    read(cbuf,*) this%cdrag

    !** Equivalent Solar Hours feature
    call nxtbuf('#', 0, ich, cbuf)
    read(cbuf,*) itemp

    if(itemp /= 0) then
      this%eshFlag = .true.
    end if

    !** Read individual surfaces and count them

    this%nsurfaces = 0

    do

      call nxtbuf('#', 0, ich, cbuf)
      if(len_trim(cbuf) == 0) exit  ! end of file

      this%nsurfaces = this%nsurfaces + 1
      read(cbuf,*) tmp_surface(this%nsurfaces)%area,               &
                   tmp_surface(this%nsurfaces)%orientation,        &
                   tmp_surface(this%nsurfaces)%normal_angle(1),    &
                   tmp_surface(this%nsurfaces)%normal_angle(2),    &
                   tmp_surface(this%nsurfaces)%reflSpec,           &
                   tmp_surface(this%nsurfaces)%reflDiff

      this%surface(this%nsurfaces)%id = this%nsurfaces

    end do

    this%surface(1:this%nsurfaces) = tmp_surface(1:this%nsurfaces)
    this%surface(1:this%nsurfaces)%normal_angle(1) = tmp_surface(1:this%nsurfaces)%normal_angle(1)*deg2rad  ! convert to radians
    this%surface(1:this%nsurfaces)%normal_angle(2) = tmp_surface(1:this%nsurfaces)%normal_angle(2)*deg2rad  ! convert to radians

    !** now init object
    call this%initObject()

    if(isControlled()) then
      call checkOut(csubid)
    end if

    return

  end subroutine readSurfaceDefinitionFile

!=============================================================================
!
!> @anchor      setObjectMass
!!
!> @brief       Sets the mass of the object
!> @author      Vitali Braun
!!
!> @date

!!
 08.11.2013 (initial design)

!!

!!
!-----------------------------------------------------------------------------
  subroutine setObjectMass(this,mass)

    class(Satellite_class)  :: this
    real(dp), intent(in)    :: mass

    character(len=*), parameter :: csubid = 'setObjectMass'

    if(isControlled()) then
      if(hasToReturn()) return
      call checkIn(csubid)
    end if

    if(mass < 0.d0) then
      call setNeptuneError(E_NEGATIVE_MASS, FATAL)
      return
    else
      this%mass = mass
    end if

    if(isControlled()) then
      call checkOut(csubid)
    end if
    return

  end subroutine setObjectMass

!=============================================================================
!
!> @anchor      resetObject
!!
!> @brief       Resets the surface ids and sets the init flag to .false.
!> @author      Vitali Braun
!!
!> @date

!!
 07.11.2013 (initial design)

!!
 04.01.2018 (surfaces are re-allocated)

!!
 09.03.2018 (surfaces are no longer dynamically allocated)

!!

!!
!-----------------------------------------------------------------------------
  subroutine resetObject(this)

    class(Satellite_class)  :: this

    this%surface(:)%id=0
    this%surface(:)%esh = 0.0

    this%isSet = .false.
    return

  end subroutine resetObject

!=============================================================================
!
!> @anchor      updateOrientation
!!
!> @brief       Updates the orientation of the satellite for the given epoch
!> @author      Vitali Braun
!!
!> @param[in]   time_mjd    MJD for which update has to be performed
!> @param[in]   r           Radius vector Earth -> satellite (GCRF)
!> @param[in]   v           Velocity vector (GCRF)
!!
!> @date

!!
 28.01.2014 (initial design)

!!
 02.02.2015 (fixed bug for multi-oriented surfaces in minimum incidence evaluation)

!!

!!
!> @details     This routine performs the update of all surface normals for
!!              the defined satellite configuration depending on the orientation
!!              mode. It is private and can thus only be called from within this
!!              module. Note that it does not have any means of error handling,
!!              as this routine assumes that the configuration of the satellite
!!              is available as soon as it is called.
!!
!-----------------------------------------------------------------------------
  subroutine updateOrientation(this, solarsystem_model, reduction, time_mjd, r, v)

    class(Satellite_class)                  :: this
    type(Solarsystem_class),intent(inout)   :: solarsystem_model
    type(Reduction_type),intent(inout)     :: reduction
    real(dp), intent(in)                    :: time_mjd
    real(dp), dimension(3), intent(in)      :: r
    real(dp), dimension(3), intent(in)      :: v

    integer :: i    ! loop counter

    real(dp)               :: de_norm   ! declination of the normal vector in radian
    real(dp)               :: de_sun    ! declination of the sun in radian
    real(dp), dimension(3) :: h         ! orbit normal vector
    real(dp)               :: habs      ! magnitude of h
    real(dp)               :: incidence ! sun incidence angle for surface
    real(dp)               :: minIncidence ! minimum sun incidence angle for surface (due to orbit geometry)
    real(dp), dimension(3) :: n_uvw     ! normal vector in UVW coordinates
    real(dp)               :: ra_norm   ! right ascension of the normal vector in radian
    real(dp)               :: ra_sun    ! right ascension of the sun in radian
    real(dp), dimension(3) :: rsun      ! Sun vector in GCRF
    real(dp)               :: rsun_abs  ! magnitude of rsun
    real(dp)               :: temp      ! temporary

    !** check whether update is required
    !--------------------------------------------------------------------
    if(abs(this%mjd - time_mjd) < eps9) then    ! no update required

      return

    else if(this%mjd < 0.d0) then   ! called for first time, so that time_mjd actually is the initial epoch

      this%first_orientation      = .true.

    end if

    !** perform update
    !-------------------------------------------------------------------

    this%mjd = time_mjd

    do i=1,this%nsurfaces

      select case(this%surface(i)%orientation)

        case(ORIENT_EARTH)

          !** coordinates in UVW system
          n_uvw(1) = sin(this%surface(i)%normal_angle(2))                                         ! u = sin(El)
          n_uvw(2) = cos(this%surface(i)%normal_angle(2))*cos(this%surface(i)%normal_angle(1))  ! v = cos(El)*cos(Az)
          n_uvw(3) = cos(this%surface(i)%normal_angle(2))*sin(this%surface(i)%normal_angle(1))  ! w = cos(El)*sin(Az)

          !** convert to inertial frame
          call reduction%uvw2eci(r, v, n_uvw, this%surface(i)%normal_GCRF)

        case(ORIENT_SUN)

          !** get Sun orientation
          rsun     = solarsystem_model%getBodyPosition(time_mjd, ID_SUN)
          rsun_abs = mag(rsun)

          !** compute Sun's right ascension and declination
          ra_sun = atan2(rsun(2), rsun(1))
          de_sun = asin(rsun(3)/rsun_abs)

          !** now add surface orientation - first right ascension:
          ra_norm = ra_sun + this%surface(i)%normal_angle(1)

          !** correct to interval [0:360] deg
          ra_norm = redang(ra_norm, 2, 1, .false.)

          de_norm = de_sun + this%surface(i)%normal_angle(2)

          !** for declination, it is important to note, that a correction is required, as soon as
          !   the difference in right ascension is in the interval [90:270] deg.
          if((ra_norm > halfPi) .and. (ra_norm - halfPi < pi)) then
            de_norm = -1.d0*de_norm
          end if

          !** get minimum incidence angle if Earth-oriented satellite with Sun-oriented surfaces
          if(this%multiOriented) then

            !** check whether the values are above minimum incidence angle
            incidence = acos(cos(ra_norm)*cos(de_norm))

            h    = cross(r,v)
            habs = mag(h)

            temp = acos(dot_product(rsun, h)/rsun_abs/habs)

            if(temp > halfPi) then
              temp = pi - temp
            end if

            minIncidence = halfPi - temp

            if(minIncidence > incidence) then ! correct Delta right ascension or Delta elevation

              if(minIncidence > this%surface(i)%normal_angle(1)) then   ! add some declination

                temp    = acos(cos(minIncidence)/cos(this%surface(i)%normal_angle(1)))
                de_norm = de_norm + temp

              else  ! add some right ascension

                temp    = acos(cos(minIncidence)/cos(this%surface(i)%normal_angle(2)))
                ra_norm = ra_norm + temp

              end if

            end if

          end if

          !** convert to GCRF
          this%surface(i)%normal_GCRF(1) = cos(ra_norm)*cos(de_norm)
          this%surface(i)%normal_GCRF(2) = sin(ra_norm)*cos(de_norm)
          this%surface(i)%normal_GCRF(3) = sin(de_norm)

        case(ORIENT_SPACE)

          if(this%first_orientation) then

            this%surface(i)%normal_GCRF(1) = cos(this%surface(i)%normal_angle(1))*cos(this%surface(i)%normal_angle(2))
            this%surface(i)%normal_GCRF(2) = sin(this%surface(i)%normal_angle(1))*cos(this%surface(i)%normal_angle(2))
            this%surface(i)%normal_GCRF(3) = sin(this%surface(i)%normal_angle(2))

          end if

        case default
          cycle

      end select

    end do

  end subroutine updateOrientation

!=============================================================================
!
!> @anchor      getOrientationMode
!!
!> @brief       Get the orientation mode which is used in the simulation
!> @author      Vitali Braun
!!
!> @date

!!
 03.03.2014: initial design

!!

!!
!-----------------------------------------------------------------------------
  integer function getOrientationMode(this)

    class(Satellite_class)  :: this
    if(this%cannon_ball_mode) then
      getOrientationMode = MODE_CANNON_BALL
    else
      getOrientationMode = MODE_ORIENTED
    end if

    return

  end function getOrientationMode

!=============================================================================
!
!> @anchor      getSurfaceDefinitionFileName
!!
!> @brief       Get the name of the surfaces definition file
!> @author      Vitali Braun
!!
!> @date

!!
 26.01.2014: initial design

!!

!!
!-----------------------------------------------------------------------------
  character(len=255) function getSurfaceDefinitionFileName(this)

    class(Satellite_class)  :: this
    getSurfaceDefinitionFileName = this%csurfile
    return

  end function getSurfaceDefinitionFileName

!=============================================================================
!
!> @anchor      setSurfaceDefinitionFileName
!!
!> @brief       Sets the name of the surfaces definition file
!> @author      Vitali Braun
!!
!> @param[in]   val     Requested name of the SD file
!!
!> @date

!!
 26.01.2014 (initial design)

!!

!!
!-----------------------------------------------------------------------------

  subroutine setSurfaceDefinitionFileName(this,val)

    class(Satellite_class)          :: this
    character(len=*), intent(in)    :: val

    this%csurfile = val(1:min(len(val),len(this%csurfile)))
    return

  end subroutine setSurfaceDefinitionFileName

end module satellite


        SUBROUTINE  MA_CST0 ( marrpt, istarr, icmand, ipt, iret)
C************************************************************************
C* MA_CST0                                                              *
C*                                                                      *
C* This subroutine gets the (1) CMAN station report ID, (2) the report  *
C* GMT observational time, (3) the indicator for the source and units   *
C* of wind speed, (4) the latitude of CMAN station, (5) the longitude   *
C* of the CMAN station, (6) the quadrant of the globe where the         *
C* station is located, and (7) the elevation of the station in meters.  *
C* The elevation, the latitude, and the longitude data are not part of  *
C* the report, but are gotten from a station table data file.           *
C* The routine also stores the receipt time of the report in the        *
C* interface array.                                                     *
C*                                                                      *
C* MA_CST0 ( MARRPT, ISTARR, ICMAND, IPT, IRET )                        *
C*                                                                      *
C* Input parameters:                                                    *
C*      MARRPT         CHAR*             Report array                   *
C*      ISTARR (*)     INTEGER           System time - YY,MM,DD,HH,MM   *
C*      ICMAND         CHAR*             YYGGi(w) group in CMAN bulletn *
C*      JSTNID (*)     CHAR*             Station IDs                    *
C*      ELEV (*)       INTEGER           Elevations of stations in m    *
C*      YLAT (*)       REAL              Latitude of stations in        *
C*                                       hundredths of degrees          *
C*      YLONG (*)      REAL              Longitude of stations in       *
C*                                       hundredths of degrees          *
C*      RCTIM (*)      REAL              Receipt date/time of bulletin  *
C*					                                *
C* Output parameters:                                                   *
C*      CIVALS(ICSTID) CHAR*             Report ID (CMAN station id)    *
C*      IHOUR          INTEGER           Hour of observation of report  *
C*      IRPTDT (*)     INTEGER           Report date-time               *
C*                                       (YYYY, MM, DD, HH, MM)         *
C*      RIVALS(IRYEAR) REAL              Report year  -  YYYY           *
C*      RIVALS(IRMNTH) REAL              Report month -  MM             *
C*      RIVALS(IRDAYS) REAL              Report day   -  DD             *
C*      RIVALS(IRHOUR) REAL              Report hour  -  HH             *
C*      RIVALS(IRMINU) REAL              Report minute - MM             *
C*      RIVALS(IRSUWS) REAL              Indicator for source and units *
C*                                       of wind speed                  *
C*      RIVALS(IRSELV  REAL              Elevation of station in meters *
C*      RIVALS(IRSLAT) REAL              Latitude in degrees            *
C*      RIVALS(IRSLON) REAL              Longitude in degrees           *
C*      IPT            INTEGER           Points to start of next group  *
C*                                       in marrpt                      *
C*      IRET           INTEGER           Return code                    *
C*                                         0 = Normal return            *
C*                                         1 = Problems                 *
C*                                                                      *
C**                                                                     *
C* Log:                                                                 *
C* R. Hollern/NCEP       6/96                                           *
C* R. Hollern/NCEP       9/96   Added RCTS to receipt time data         *
C* R. Hollern/NCEP      10/96   Added corrected report indicator logic  *
C* R. Hollern/NCEP      11/96   Changed wording of LOG message          *
C* D. Kidwell/NCEP	 4/97 	Changed interface and cleaned up code   *
C* D. Kidwell/NCEP	10/97 	Changed interface , cleaned up code     *
C* R. Hollern/NCEP	12/97 	Replaced MA_RTIM call with DC_RTIM	*
C* R. Hollern/NCEP	 7/99 	Added date/time data to interface array *
C* J. Ator/NCEP         12/00   Check validity of iuwind                *
C************************************************************************
	INCLUDE		'GEMPRM.PRM'
        INCLUDE  	'macmn.cmn'
C*
        CHARACTER*(*)   marrpt, icmand
        INTEGER  	istarr (*)
C*
        CHARACTER   	stnid*8, fld2*2, fld1*1
        LOGICAL  	more, again
C------------------------------------------------------------------------
        iret = 0
        more = .true.
        jp = 0
        ip = 0
        stnid = ' '
C
C*      Get corrected report indicator
C
        IF ( bbb (1:3) .eq. 'COR' ) THEN
            rivals ( ircorn ) = 1.0
          ELSE
            rivals ( ircorn ) = 0.0
        END IF
C
C*      Get CMAN station ID.
C*      Ip points to start of ID. Locate next space, the end of ID.
C
        DO WHILE (more)
C
            ip = ip + 1
            IF ( marrpt ( ip:ip ) .ne. ' ' ) THEN
                jp = jp + 1
                IF ( jp .lt. 9 ) stnid ( jp:jp ) = marrpt ( ip:ip )
              ELSE
                more = .false.
            END IF
C
        END DO
C
C*      Save report id (CMAN station id).
C
        civals ( icstid ) = stnid
C
        ipt = ip
C
C*      Get the station elevation, latitude, and longitude
C*      from the station table data.
C
        again = .true.
        i = 0
C
        DO WHILE ( again )
C
            i = i + 1
            IF ( stnid ( 1:5 ) .eq. jstnid (i) ( 1:5 ) ) THEN
                rivals ( irselv ) = elev ( i )
                rivals ( irslat ) = ylat ( i )
                rivals ( irslon ) = ylong ( i )
                again = .false.
            END IF
C
            IF ( i .gt. jstn ) THEN
C
C*              If CMAN station ID is not in dictionary, skip decoding
C*              station data for now.
C
                loglvl = 2
                CALL ST_UNPR( marrpt, 80, logmsg, len, iunpr )
                CALL DC_WLOG( loglvl, 'MA', 3, logmsg (1:len), ierwlg )
	        logmsg = ' '
                iret   = 1
                RETURN
            END IF
C
        END DO
C
C*      Get day of month of observation.
C
        fld2 = icmand ( 1:2 )
        CALL  ST_INTG ( fld2, ival, ier )
        IF ( ier .eq. 0 ) THEN
            IF ( ival .gt. 0 .and. ival .lt. 32 ) THEN
                imnday = ival
              ELSE
                ierrno = 7
                CALL MA_ERRS ( ierrno, marrpt, kret )
                iret = 1
                RETURN
            END IF
          ELSE
            iret = 1
            RETURN
        END IF
C
C*      Get hour of observation.
C
        fld2 = icmand ( 3:4 )
        CALL  ST_INTG ( fld2, ival, ier )
        IF ( ier .eq. 0 ) THEN
            IF ( ival .ge. 0 .and. ival .lt. 24 ) THEN
                ihour = ival
              ELSE
                ierrno = 8
                CALL MA_ERRS ( ierrno, marrpt, kret )
                iret = 1
                RETURN
            END IF
          ELSE
            iret = 1
            RETURN
        END IF
C
C*      Set minutes of obs hour to zero.
C
        imins = 0
C
C*      Combine the run times and obs times into a report date-time.
C
        ndays = 10
        CALL DC_RTIM ( istarr, imnday, ihour, imins, ndays, irptdt,
     +                 jret  )
C
        IF ( jret .ne. 0 ) THEN
            iret = 1
            RETURN
        END IF
C
C*      Save date/time data in interface array.
C
        rivals (iryear) = FLOAT ( irptdt (1) )
        rivals (irmnth) = FLOAT ( irptdt (2) )
        rivals (irdays) = FLOAT ( irptdt (3) )
        rivals (irhour) = FLOAT ( irptdt (4) )
        rivals (irminu) = FLOAT ( irptdt (5) )
C
C*      Get indicator of units of wind speed.
C
        fld1 = icmand ( 5:5 )
        CALL  ST_INTG ( fld1, iuwind, ier )
        IF ( ier .eq. 0 ) THEN
            ip = ip + 1
            IF  ( ( iuwind .eq. 0 ) .or. ( iuwind .eq. 1 ) .or.
     +            ( iuwind .eq. 3 ) .or. ( iuwind .eq. 4 ) )  THEN
                rivals ( irsuws ) = FLOAT ( iuwind )
	      ELSE
	        iuwind = IMISSD
	    END IF
        END IF
C
C*      Set quadrant of the globe (not currently used).
C
        iquad = 7
C*
	RETURN
	END