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