      PROGRAM HYCOM_TIDAL_RI2PORT
      IMPLICIT NONE
!=========================================================================  
C
C  hycom_tidal_ri2port - 
C
C  Usage: hycom_tidal_ri2port ftideRIin.a idm jdm ntide type ports_latlon_ij.input ports_x.input
C
C  Purpose:  Sample the Real Field, Imag Field output from the
C             hycom_tidal_foreman program at port locations
C
C  ftideRIin.a contains two fields for the real and imaginary parts
C   of each tidal mode generated by hycom_tidal_foreman.
C  it follows the OSU (TPXO) convention for the Imaginary component:
C   phase = atan2(-Im,Re).
C  it is assumed to be in the standard order for ports, the 1st ntide
C   of m2,s2,k1,o1,n2,p1,k2,q1 with the rest set to zero.
C
C  type is the field type 1:z, 2:u, 3:v
C
C  ports_latlon_ij.input is from topo_ports_latlon
C
C  ports_x.input is the output in the form of ports_[zuv].input
C
C  Based on hycom_tidal_ri2ap.f.
C
C  Alan J. Wallcraft, NRL, August 2016.
C
C=========================================================================
      REAL*4, ALLOCATABLE :: TideR(:,:,:),TideI(:,:,:)
      REAL*4 :: PAD(4096)

      CHARACTER*240 CARG
C
      REAL          PLON,PLAT
      INTEGER       IP,JP
      INTEGER       IDM,JDM,ITYPE,NTIDE,I,J,K,L,NPAD,NRECL,NARG
      INTEGER       IOS,IREC,ITIDE,IARGC
      CHARACTER*240 CFILE_IN,CFILE_PORT,CFILE_OUT
      CHARACTER*6   CVARIN
C
C     READ ARGUMENTS.
C
      NARG = IARGC()
C
      IF  (NARG.EQ.7) THEN
        CALL GETARG(1,CFILE_IN)
        CALL GETARG(2,CARG)
        READ(CARG,*) IDM
        CALL GETARG(3,CARG)
        READ(CARG,*) JDM
        CALL GETARG(4,CARG)
        READ(CARG,*) NTIDE
        CALL GETARG(5,CARG)
        READ(CARG,*) ITYPE
        CALL GETARG(6,CFILE_PORT)
        CALL GETARG(7,CFILE_OUT)
      ELSE
        WRITE(6,*)'7 arguments expected!, got ',NARG 
        WRITE(6,'(2a)')
     &    'Usage: hycom_tidal_ri2port ftideRIin.a idm jdm ntide ',
     &    'type ports_latlon_ij.input ports_x.input'
         CALL EXIT(1)
      ENDIF
c-------------------------------------------------------------
c     Test arguments
c
      print *,'Input File  = ',TRIM(CFILE_IN)
      print *,'Port   File = ',TRIM(CFILE_PORT)  
      print *,'Output File = ',TRIM(CFILE_OUT)  
C--------------------------------------------------------------------------------
C   Allocate Arrays to hold TideR,TideI, always 8 components
c
      ALLOCATE( TideR(IDM,JDM,8), STAT=IOS )
      IF     (IOS.NE.0) THEN
        WRITE(6,*) 'Error in hycom_RI2PORT: could not allocate ',
     +             IDM*JDM*8,' words for TideR'
        CALL EXIT(2)
      ENDIF
      write(6,*)'Array  TideR(IDM,JDM,8) allocated'

      ALLOCATE( TideI(IDM,JDM,8), STAT=IOS )
      IF     (IOS.NE.0) THEN
        WRITE(6,*) 'Error in hycom_RI2PORT: could not allocate ',
     +             IDM*JDM*8,' words for TideI'
        CALL EXIT(2)
      ENDIF
      write(6,*)'Array  TideI(IDM,JDM,8) allocated'
C----------------------------------------------------------------
C  Determine Padding to read in a Field as a single record.
C
      NPAD = 4096 - MOD(IDM*JDM,4096)
      IF     (NPAD.EQ.4096) THEN
        NPAD = 0
        INQUIRE(IOLENGTH=NRECL) TideR(:,:,1)
      ELSE
        INQUIRE(IOLENGTH=NRECL) TideR(:,:,1),PAD(1:NPAD)
      ENDIF
      write(6,'(a,i5,i9)') 'npad,nrecl =',npad,nrecl
C
#ifdef CRAY
#ifdef t3e
      IF     (MOD(NRECL,4096).EQ.0) THEN
        WRITE(CASN,8000) NRECL/4096
 8000   FORMAT('-F cachea:',I4.4,':1:0')
        IU8 = 11
        CALL ASNUNIT(IU8,CASN,IOS8)
        IF     (IOS8.NE.0) THEN
          write(6,*) 'Error: can''t asnunit 11'
          write(6,*) 'ios  = ',ios8
          write(6,*) 'casn = ',casn
          CALL EXIT(5)
        ENDIF
      ENDIF
#else
      CALL ASNUNIT(11,'-F syscall -N ieee',IOS)
      IF     (IOS.NE.0) THEN
        write(6,*) 'Error: can''t asnunit 11'
        write(6,*) 'ios = ',ios
        CALL EXIT(5)
      ENDIF
#endif
#endif
C======================================================================
C    Open Input File
C
      OPEN(UNIT=11, FILE=CFILE_IN, FORM='UNFORMATTED', STATUS='OLD',
     +         ACCESS='DIRECT', RECL=NRECL, IOSTAT=IOS)
      IF     (IOS.NE.0) THEN
        write(6,*) 'Error: can''t open ',TRIM(CFILE_IN)
        write(6,*) 'ios   = ',ios
        write(6,*) 'nrecl = ',nrecl
        CALL EXIT(3)
      ENDIF
C------------------------------------------------------------------------
C      Open PORT File
C------------------------------------------------------------------------
C
      OPEN(UNIT=12,FILE=CFILE_PORT,FORM='FORMATTED',
     &     STATUS='OLD',ACTION='READ',IOSTAT=IOS)
      WRITE(6,*)TRIM(CFILE_PORT),' File Opened,IOS =',IOS
      IF     (IOS.NE.0) THEN
        write(6,*) 'Error: can''t open ',TRIM(CFILE_PORT)
        write(6,*) 'ios   = ',ios
        CALL EXIT(3)
      ENDIF      
C------------------------------------------------------------------------
C      Open OUTPUT File
C------------------------------------------------------------------------
C
      OPEN(UNIT=21,FILE=CFILE_OUT,FORM='FORMATTED',
     &     STATUS='NEW',ACTION='WRITE',IOSTAT=IOS)
      WRITE(6,*)TRIM(CFILE_OUT),' File Opened,IOS =',IOS
      IF     (IOS.NE.0) THEN
        write(6,*) 'Error: can''t open ',TRIM(CFILE_OUT)
        write(6,*) 'ios   = ',ios
        CALL EXIT(3)
      ENDIF      
C
C=========================================================================
C  Loop Through Pairs of Tidal Mode Real and Imag Fields
C
      IF     (NTIDE.NE.8) THEN
        TideR(:,:,NTIDE+1:8) = 0.0
        TideI(:,:,NTIDE+1:8) = 0.0
      ENDIF
      DO ITIDE= 1,NTIDE
        IREC=2*ITIDE-1
        READ(11,REC=IREC,IOSTAT=IOS) TideR(:,:,ITIDE)
#ifdef ENDIAN_IO
        CALL ENDIAN_SWAP(TideR(1,1,ITIDE),IDM*JDM)
#endif
        IF     (IOS.NE.0) THEN
          WRITE(6,*) 'can''t read TideR on ',TRIM(CFILE_IN)
          CALL EXIT(4)
        ENDIF
        write(6,*)'TideR ',ITIDE,' Array ',IREC,' NRECL=',NRECL
c
        IREC=2*ITIDE
        READ(11,REC=IREC,IOSTAT=IOS) TideI(:,:,ITIDE)
#ifdef ENDIAN_IO
        CALL ENDIAN_SWAP(TideI(1,1,ITIDE),IDM*JDM)
#endif
        IF     (IOS.NE.0) THEN
          WRITE(6,*) 'can''t read TideI on ',TRIM(CFILE_IN)
          CALL EXIT(4)
        ENDIF
        write(6,*)'TideI ',ITIDE,' Array ',IREC,' NRECL=',NRECL
      ENDDO !itide
      close(11)
C
C=========================================================================
C  Loop Through port locations
C
      WRITE(21,'(a,a)') ' hycom_tidal_ri2port ',trim(CFILE_IN)
      IF     (ITYPE.EQ.1) THEN
        WRITE(21,'(a)') ' Elevations (m)'
      ELSEIF (ITYPE.EQ.2) THEN
        WRITE(21,'(a)') ' WE velocity  (cm/s)'
      ELSE
        WRITE(21,'(a)') ' SN velocity  (cm/s)'
      ENDIF
      WRITE(21,'(9a)') '    Lat     Lon  |',
     &                 '   m2_Re   m2_Im',
     &                 '   s2_Re   s2_Im',
     &                 '   k1_Re   k1_Im',
     &                 '   o1_Re   o1_Im',
     &                 '   n2_Re   n2_Im',
     &                 '   p1_Re   p1_Im',
     &                 '   k2_Re   k2_Im',
     &                 '   q1_Re   q1_Im'
      DO
        READ(12,*,IOSTAT=IOS) plat,plon,ip,jp
        IF     (IOS.NE.0) THEN
          EXIT
        ENDIF
        IF     (ITYPE.EQ.1) THEN  !(m)
          WRITE(21,'(f9.4,f10.4,16f8.3)') plat,plon,
     &          (TideR(ip,jp,itide),       TideI(ip,jp,itide),itide=1,8)
        ELSE !(cm/s)
          WRITE(21,'(f9.4,f10.4,16f8.3)') plat,plon,
     &     (100.0*TideR(ip,jp,itide),100.0*TideI(ip,jp,itide),itide=1,8)
        ENDIF
      ENDDO
      close(12)
      close(21)
      CALL EXIT(0)
      END
