! ------------------------------------------------------------------------------
! Bernese GPS Software Version 5.1
! ------------------------------------------------------------------------------

MODULE s_ETRSIN

  IMPLICIT NONE

#include "COM_CPU.inc"

CONTAINS

SUBROUTINE etrsin(title,datum,param,rates)

! ------------------------------------------------------------------------------
! Purpose:    Read Input File for PROGRAM ETRS89 (new version of ETRSIN.f)
!
! Author:     H. Bock
!
! Created:    25-Oct-2001
!
! Changes:    23-Apr-2003 CU: Nullify local pointers
!             10-Aug-2005 SS: Inverse transformation;
!                             epoch variable removed
!             28-Feb-2007 AG: Use 206264... from DEFCON
!             14-Dec-2011 SL: use m_bern with ONLY, write format, DATSEL
!             28-NOV-2016 PF: Add srName, call cpu_enter and cpu_exit
!             10-Apr-2017 ST: Move IMPLICIT NONE to module scope
!             10-Apr-2017 ST: Add #include "COM_CPU.inc"
!             10-Apr-2017 ST: Add IF(srfDebug) in front of CALL cpu_
!             22-Dec-2020 RD: Transform D_CONST to a protected structure CONST
!             29-Nov-2023 SL: 14 instead of 6 manual parameters
!             31-Jan-2024 SL/SS: Adopting the ETRS89 tool extension made at PNAC
!
! Copyright:  Astronomical Institute
!             University of Bern
!             Switzerland
! ------------------------------------------------------------------------------

! Modules
! -------
  USE m_cpu,    ONLY: cpu_enter, cpu_exit
  USE m_bern,   ONLY: i4b, r8b, keyValueLength, lfnErr
  USE s_ckoptr
  USE s_readkeys
  USE s_exitrc
  USE s_ckoptl
  USE s_ckoptb
  USE s_exitrc


! List of arguments
! ------------------
! OUT:
  CHARACTER(LEN=80)       :: title    ! General Title Line
  CHARACTER(LEN=16)       :: datum    ! Local Geodetic Datum
  REAL(r8b), DIMENSION(8) :: param    ! Parameters and epoch
  REAL(r8b), DIMENSION(7) :: rates    ! Parameter rates

! Local parameters
! ----------------
  CHARACTER(LEN=*), PARAMETER :: srName = 'etrsin'

! Local Variables
! ---------------
  CHARACTER(LEN=keyValueLength), DIMENSION(:), POINTER :: keyValue

  INTEGER(i4b) :: irCode
  INTEGER(i4b) :: irc
  INTEGER(i4b) :: invTrafo


! DEBUG: entry
! ------------
  IF (srfDebug) CALL cpu_enter(srName)


! Initialization
! --------------
  irCode = 0
  NULLIFY(keyValue)


! Title line
! ----------
  CALL readKeys('TITLE',keyValue,irc)
  CALL ckoptl(0,'TITLE',keyValue,srName,                                    &
              'Printing options: title line',irc,irCode,                    &
              maxVal=1,maxLength=80,result1=title)


! Get Datum selection
! -------------------
  CALL readkeys('DATSEL',keyValue,irc)

  IF(irc /= 0) CALL exitrc(2)

  datum = TRIM(keyValue(1))

  IF(datum /= 'MANUAL') THEN
    IF (srfDebug) CALL cpu_exit(srName)
    RETURN
  ENDIF


! Read Local Geodetic Datum
! -------------------------
  CALL readKeys('LGTDAT',keyValue,irc)
  CALL ckoptl(0,'LGTDAT',keyValue,srName,                                   &
              'Local Geodetic Datum',irc,irCode,                            &
              maxVal=1,maxLength=16,result1=datum)


! Read Epoch
! ----------
  CALL readKeys('EPOCH', keyValue, irc)
  CALL ckoptr(1,'EPOCH',keyValue,srName,                                    &
              'Reference Epoch',irc,irCode,                                 &
              gt=0d0,maxVal=1,error=9999.D0,result1=param(8))


! Read Parameters
! ---------------
  CALL readKeys('TRAX', keyValue, irc)
  CALL ckoptr(1,'TRAX',keyValue,srName,                                     &
              'Translation Parameter in x-Coordinate',irc,irCode,           &
              maxVal=1,error=9999.D0,result1=param(1))

  CALL readKeys('TRAY', keyValue, irc)
  CALL ckoptr(1,'TRAY',keyValue,srName,                                     &
              'Translation Parameter in y-Coordinate',irc,irCode,           &
              maxVal=1,error=9999.D0,result1=param(2))

  CALL readKeys('TRAZ', keyValue, irc)
  CALL ckoptr(1,'TRAZ',keyValue,srName,                                     &
              'Translation Parameter in z-Coordinate',irc,irCode,           &
              maxVal=1,error=9999.D0,result1=param(3))

  CALL readKeys('SCAL', keyValue, irc)
  CALL ckoptr(1,'SCAL',keyValue,srName,                                     &
              'Scaling factor',irc,irCode,                                  &
              maxVal=1,error=9999.D0,result1=param(4))

  CALL readKeys('ROTX', keyValue, irc)
  CALL ckoptr(1,'ROTX',keyValue,srName,                                     &
              'Rotation Parameter around x-Axis',irc,irCode,                &
              maxVal=1,error=9999.D0,result1=param(5))

  CALL readKeys('ROTY', keyValue, irc)
  CALL ckoptr(1,'ROTY',keyValue,srName,                                     &
              'Rotation Parameter around y-Axis',irc,irCode,                &
              maxVal=1,error=9999.D0,result1=param(6))

  CALL readKeys('ROTZ', keyValue, irc)
  CALL ckoptr(1,'ROTZ',keyValue,srName,                                     &
              'Rotation Parameter around z-Axis',irc,irCode,                &
              maxVal=1,error=9999.D0,result1=param(7))


! Read Parameter Rates
! --------------------
  CALL readKeys('TRAXR', keyValue, irc)
  CALL ckoptr(1,'TRAXR',keyValue,srName,                                    &
              'Translation Parameter rate in x-Coordinate',irc,irCode,      &
              maxVal=1,error=9999.D0,result1=rates(1))

  CALL readKeys('TRAYR', keyValue, irc)
  CALL ckoptr(1,'TRAYR',keyValue,srName,                                    &
              'Translation Parameter rate in y-Coordinate',irc,irCode,      &
              maxVal=1,error=9999.D0,result1=rates(2))

  CALL readKeys('TRAZR', keyValue, irc)
  CALL ckoptr(1,'TRAZR',keyValue,srName,                                    &
              'Translation Parameter rate in z-Coordinate',irc,irCode,      &
              maxVal=1,error=9999.D0,result1=rates(3))

  CALL readKeys('SCALR', keyValue, irc)
  CALL ckoptr(1,'SCALR',keyValue,srName,                                    &
              'Scaling factor rate',irc,irCode,                             &
              maxVal=1,error=9999.D0,result1=rates(4))

  CALL readKeys('ROTXR', keyValue, irc)
  CALL ckoptr(1,'ROTXR',keyValue,srName,                                    &
              'Rotation Parameter rate around x-Axis',irc,irCode,           &
              maxVal=1,error=9999.D0,result1=rates(5))

  CALL readKeys('ROTYR', keyValue, irc)
  CALL ckoptr(1,'ROTYR',keyValue,srName,                                    &
              'Rotation Parameter rate around y-Axis',irc,irCode,           &
              maxVal=1,error=9999.D0,result1=rates(6))

  CALL readKeys('ROTZR', keyValue, irc)
  CALL ckoptr(1,'ROTZR',keyValue,srName,                                    &
              'Rotation Parameter rate around z-Axis',irc,irCode,           &
              maxVal=1,error=9999.D0,result1=rates(7))


! Inverse transformation
! ----------------------
  CALL ckoptb(1,(/'INVTRAFO'/),srName,'Inverse transformation', &
              irCode, result1=invTrafo)

  IF(irCode /= 0) CALL exitrc(2)

  IF(invTrafo == 1) THEN
    param(:) = -param(:)
    param(8) = ABS(param(8))
    rates(:) = -rates(:)

    IF(DATUM(1:4) /= 'ITRF') THEN
      WRITE(lfnerr,"(/,' ### SR ',A,':',A)") srName, &
           ' ITRF datum identifier expected'
      WRITE(lfnErr,'(8X,A,A)') 'Datum identifier: ',TRIM(datum)
      WRITE(lfnErr,*)
    ENDIF
  ELSE
    IF(DATUM(1:4) /= 'ETRF') THEN
      WRITE(lfnerr,"(/,' ### SR ',A,':',A)") srName, &
           ' ETRF datum identifier expected'
      WRITE(lfnErr,'(8X,A,A)') 'Datum identifier: ',TRIM(datum)
      WRITE(lfnErr,*)
    ENDIF
  ENDIF


  IF(ASSOCIATED(keyValue)) NULLIFY(keyValue)


! Stop if an error in the input options found
! -------------------------------------------
  IF(irCode /= 0) CALL exitrc(2)


! DEBUG: exit
! -----------
  IF (srfDebug) CALL cpu_exit(srName)

  RETURN


END SUBROUTINE etrsin

END MODULE s_ETRSIN
