C***********************************************************************
C***********************************************************************
C Beginning of User-Specified Subroutines for TRUXTON6
C Beginning of User-Specified Subroutines for TRUXTON6
C***********************************************************************
C***********************************************************************
      SUBROUTINE OUTPUTT6(MESHNAME,NOBS,XOBS,YOBS,TOBS,TOBSGMT0,IYEAR,
     &UBAROBS,VBAROBS,DOBSMIN,DOBSMAX,DOBSTOT,CINVTYPE,DATATYPE,
     &NF,NF1,NF2,FREQ,INFER,AMPRAT, 
     &NBC,LRVS,ZCAMP,STDERR,CV,CCOV,RMSE,RCOND,IRANK,MAXRANK,SINGVALS,
     &UBARLS,VBARLS,UERR,VERR,UPARTIAL,VPARTIAL)
C Include file for parameter statements
      INCLUDE 'DCMS.DIM' 
C Fixed global assignments
      CHARACTER*72 MESHNAME
      REAL XOBS(NOBSDIM),YOBS(NOBSDIM),TOBS(NOBSDIM),TOBSGMT0(NOBSDIM),
     &UBAROBS(NOBSDIM),VBAROBS(NOBSDIM),
     &DOBSMIN(NOBSDIM),DOBSMAX(NOBSDIM),DOBSTOT(NOBSDIM)
C
      CHARACTER*72 CINVTYPE,DATATYPE
      REAL FREQ(NFDIM)
      INTEGER INFER(NFDIM)
      COMPLEX AMPRAT(NFDIM)
C
      REAL UBARLS(NOBSDIM),VBARLS(NOBSDIM),UERR(NOBSDIM),VERR(NOBSDIM)
      REAL UPARTIAL(NOBSDIM,NFDIM),VPARTIAL(NOBSDIM,NFDIM)
C
      INTEGER LRVS(NNDIM)     
      COMPLEX ZCAMP(NBCDIM,NFDIM)
      COMPLEX CCOV(NBCDIM*NFDIM,NBCDIM*NFDIM)
      REAL SINGVALS(NCOLDIM)
      REAL STDERR(NBCDIM,NFDIM),CV(NBCDIM,NFDIM)
C-----------------------------------------------------------------------
C User-defined output routine
C
C Arrays and constants:
C
C Character Strings
C   MESHNAME - Name of the finite element mesh used for simulation
C   CINVTYPE - Inverse type (WLS,SVD,FOURIER)
C   DATATYPE - Input data type (UXZ,UXV,UXZC,UXVC)
C
C Observations:
C   NOBS     - Number of space-time observational locations
C   IYEAR    - Year during which the observations occured
C   XOBS(I),YOBS(I) - Spatial locations of observations
C   TOBS(I)  - Time of observations (seconds since TOBSGMT0(1))
C   TOBSGMT0(I) - Time of observations (decimal days (ydutc0) in IYEAR)
C   UBAROBS(I),VBAROBS(I) - Amplitudes of observations
C   DOBSMAX(I),DOBSMIN(I) - Averaging depth interval observations
C   DOBSTOT(I)            - Bathymetric depth for observations
C
C Spectrum of tidal constituents
C   NF        - Number of constituents (NF = NF1+NF2)
C   NF1       - Number of primary constituents
C   NF2       - Number of additional constituents to be inferred
C   FREQ(K)   - Radian frequency, sec**(-1)
C   INFER(K)  - Inference frequency number
C                 INFER(K)  =  K    for K <= NF1
C                 INFER(K) <= NF1   for K >  NF1
C   AMPRAT(K) - Complex amplitude ratio for an inferred const.
C                 ZCAMP(J,K) = AMPRAT(K)*ZCAMP(J,INFER(K)) for  K > NF1
C
C Optimal BC's:
C   NBC         - Number of Boundary Nodes
C   LRVS(J)     - Global node number pointer BC's
C   ZCAMP(J,K)  - Complex BC amplitude
C   STDERR(J,K) - Standard Error (i.e. SQRT(diagonal of CCOV))
C   CV(J,K)     - Coefficient of variation for ZCAMP: 
C                   STDERR(J,K)/CABS(ZCAMP)
C   CCOV(JK,JK) - Complex covariance of the BC estimates 
C                   CCOV is normalized by the mean square error, RMSE**2
C                   CCOV is reported for all frequencies  
C                   The indices are numbered as follows:
C                      JK=(K-1)*NBC+1, K*NBC :BC's for nodes at freq K     
C
c Inversion:
C   RMSE        - Root mean square error, post-inversion
C   RCOND       - Condition number (an input parameter)
C   IRANK       - Actual rank used, based on RCOND
C   MAXRANK     - Maximum rank possible
C   SINGVALS(L) - Singular values from the SVD solver
C
C Model Results:
C   UBARLS(I),VBARLS(I)         - Amplitudes of model results
C   UERR(I), VERR(I)            - Amplitudes of model errors
C   UPARTIAL(I,K),VPARTIAL(I,K) - Amplitudes of model results by freq
C
C Index range:  I=1,NOBS, J=1,NBC, K=1,NF, L=1,IRANK
C   NOBS     - Number of space-time observational locations
C   NBC      - Number of dirichlet boundary nodes
C   NF       - Number of constituents used during inversion
C-----------------------------------------------------------------------
C
C Notes regarding how array contents vary for different input data types:
C
C   Arrays affected: TOBS,TOBSGMT0,UBAROBS,VBAROBS,
C                    DOBSMIN,DOBSMAX,DOBSTOT
C                    UBARLS,VBARLS,UERR,VERR,UPARTIAL,VPARTIAL
C
C   DATATYPE='UXZC' => Complex elevations are used for the inversion
C      T* - set to zero
C      U* - spatial amplitudes of elevation
C      V* - set to zero
C      D* - set to zero
C
C   DATATYPE='UXZ' => Time-domain elevations are used for the inversion
C      T* - temporal values for observations
C      U* - space-time values of elevation
C      V* - set to zero
C      D* - set to zero
C
C   DATATYPE='UXVC' => Complex velocities are used for the inversion
C      T* - set to zero
C      U* - spatial amplitudes of eastward/x component of velocity
C      V* - spatial amplitudes of northward/y component of velocity
C      D* - vertical averaging interval as input by user
C
C   DATATYPE='UXV' => Time-domain elevations are used for the inversion
C      T* - temporal values for observations
C      U* - space-time values of eastward/x component of velocity
C      V* - space-time values of northward/y component of velocity
C      D* - vertical averaging interval as input by user
C
C   DATATYPE='UXZC' or DATATYPE='UXVC' => program stops if NF>1
C
C-----------------------------------------------------------------------
C Warning: Unit (2) is the echo file for the run and is open 
C   during execution of TruxOut.  
C================Beginning-of-user-specified-instructions===============
C
C User-specified local assignments
C
      character*72 filename,begin
      begin='truxton6.5.2_simulation/'
      indxb=index(begin,' ')-1
      indxm=index(meshname,' ')-1
c
c Write tidal elevation bcs.s2c file
c
      print*,NBC, NF
      DO N = 1,NF
        DO I = 1,NBC
          print*,N,I,zcamp(i,n),phaselagd(zcamp(i,n))
        ENDDO
      ENDDO

      DO N = 1,NF
        write(*,*)'   Enter name of the elevation .bcs.s2c results file'
        write(*,*)'      (entering NO => no file will be created)'
        read(*,100)filename
        write(*,100)filename
        if(filename.NE.'NO')then
          OPEN (UNIT=7,FILE=filename,STATUS='NEW')
          write(7,100)meshname(1:indxm)
          write(7,101)IYEAR,TOBSGMT0(1),begin(1:indxb)//'tidal elev BCS'
          write(7,8000)FREQ(N)
          write(7,8002)(lrvs(i),cabs(zcamp(i,n)),
     &                 phaselagd(zcamp(i,n)),i=1,nbc)
         close(7)
        endif
      enddo

      write(*,*)' '
      write(*,*)'   Root Mean Square Velocity Error =',RMSV
      write(*,*)'   Condition Number                =',rcond
      write(*,*)'   Actual Rank                     =',irank
      write(*,*)'   Maximum Possible Rank           =',maxrank
      write(*,*)' '
c Format Statements
c
 100  format(a)
 101  format(i4,1x,f8.4,1x,a)
 8000 format(1e14.6)
 8002 format(i5,2e14.6)
C
C End of routine
C
      Return
      End
C***********************************************************************
C***********************************************************************
C End of User-Specified Subroutines for TRUXTON6
C End of User-Specified Subroutines for TRUXTON6
C***********************************************************************
C***********************************************************************

C***********************************************************************
C***********************************************************************
      Subroutine TruxOut6(NOBS,Xobs,Yobs,Tobs,Tobsgmt0,IYEAR,
     & Ubarobs,Vbarobs,Zmaxobs,Zminobs,Zbotob,
     & Nf, Nf1, Nf2, freq, infer, amprat,
     & NBC,ZCamp,LRVS,CCov,
     & Ubarls, Vbarls, Upartial, Vpartial,
     & Uerr, Verr, RMSV,rcond,irank,maxrank,MESHNAME)
C     
      Include 'DCMS.DIM'
C
      Real Xobs(*),Yobs(*),Tobs(*),Tobsgmt0(*),
     & Ubarobs(*),Vbarobs(*),Zmaxobs(*),Zminobs(*),Zbotob(*),
     & freq(*), infer(*), amprat(*),
     & LRVS(*), UBARls(*), VBARls(*),
     & Upartial(nobsdim, nfdim), Vpartial(nobsdim, nfdim),
     & Uerr(*), Verr(*)
C     
      Complex ZCamp(nbcdim,nfdim)
      Complex CCov(NBCdim*NFdim,NBCdim*NFdim)
C
C USER-BUILT Subroutine for Truxton1 Output
C
C Arrays passed:  
C
C--------------------------------------------------------------
C Observations:
C   NOBS = # of Velocity Observations
C   (Xobs,Yobs,Tobs,Tobsgmt0)_i = Space-time coords of observ'n i
C   (Ubarobs,Vbarobs)_i         = Observed velocity at i
C   (Zmaxobs,Zminobs)           = Averaging depth interval for (U,V)_i
C    Zbotobs_i                  = Bathymetric depth observed at i
C--------------------------------------------------------------
C Spectrum of tidal constituents
C    Nf   = number of constituents = Nf1+Nf2
C    Nf1  = number of primary constituents
c    Nf2  = number of additional constituents to be inferred
C    (freq, infer, amprat)_i, i=i, Nf: 
c       frequency is the radian frequency, sec**(-1)
c       infer_i is the inference frequency number
c            infer_i  =  i    for i <= Nf1
c            infer_i <= Nf1   for i >  Nf1
c       amprat_i is the complex amplitude ratio for an inferred const.
C            ZCamp_i  = amprat_i * ZCamp_(infer_i) for  i >  Nf1
C            ZCamp_i  = (1.,0.)                    for  i <= Nf1
C------------------------------------------------------------
C Optimal BC's:
C   NBC      = Number of Boudary Nodes
C   ZCamp_ij = COMPLEX BC amplitude:  Node i,    frequency j
c                                   I=1, NBC  //   j=1,Nf
C   LRVS_i   = Global node number pointer for the ith BC
C   CCov_ij  = COMPLEX covariance of the BC estimates 
C     The indices are numbered as follows:
C       i,j  = 1, NBC            :BC's for all nodes at frequency 1
C       i,j  = NBC+1, 2NBC       :BC's for all nodes at frequency 2
C       i,j  = (k-1)NBC+1, k*NBC :BC's for all nodes at frequency k     

C     CCov is normalized by the mean square velocity error, RMSV**2
c     se(i)  = sqrt(cov(i,i))is the standard error for the ith BC
c     SE(i)  = RMSV*se(i)    is the Standard Error for the ith BC
c   Zero Covariance is reported for Inference frequencies.  
C--------------------------------------------------------------
C Modeled Velocity:
C   (Ubarls, Vbarls)_i      = Model result at observation point i
C   (Upartial, Vpartial)_ij = Model result at i due to frequency j
c          i=i, nobs; j=i, nf1
C------------------------------------------------------------
C Errors (Model - Observation)
C   RMSV = Root Mean Square Velocity Error 
C   (Uerr, Verr)_i = Velocity error at observation point i 
C     i=1,Nobs 
C------------------------------------------------------------
C Warning: Unit (2) is the echo file for the run and is open 
C   during execution of TruxOut.  
C------------------------------------------------------------
C================Beginning-of-user-specified-instructions===============
C
C User-specified local assignments
      character*72 filename, meshname,m3dfile
      indxm=index(meshname,' ')-1

c
c Output RMSV to standard out
c
      write(*,*)' '
      write(*,*)'   Root Mean Square Velocity Error =',RMSV
      write(*,*)'   Condition Number                =',rcond
      write(*,*)'   Actual Rank                     =',irank
      write(*,*)'   Maximum Possible Rank           =',maxrank
      write(*,*)' '
c
c Write output .dat file
c
c      write(*,*)'    Enter name for the .dat file'
c      write(*,*)'      (entering NO => no file will be created)'
c      read(*,'(A)')filename
c      write(*,'(A)')filename
c      if(filename.NE.'NO')then
c         OPEN (UNIT=7,FILE=filename,STATUS='NEW')
c         DO I=1,NOBS
c            write(7,'(8e14.6)')TOBSGMT0(I),XOBS(I),YOBS(I),
c     &            UBARLS(I),VBARLS(I),
c     &            UERR(I),VERR(I),TOBS(I)
c         enddo
c         close(7)
c      endif

CALF 05/06/03 to include uxv output
c
c Write errorr  file uxv
c
         obsfile = 'unknown'
         ncol = 8
         write(*,*)'Name for final error file'
         read(*,'(a)') m3dfile

         indxf=index(m3dfile,' ')-1
         write(*,'(a)')m3dfile(1:indxf)

         open(1,file=m3dfile(1:indxf),status='unknown')
         write(1,'(A)')'XXXX'
         write(1,'(A)')meshname(1:indxm)
         write(1,'(A)')OBSFILE
         write(1,'(I4)')IYEAR
         write(1,'(I4)')ncol
         do ii = 1, nobs
            WRITE(1,'(F10.4,2F10.0,2E14.6,3F10.4)') TOBSGMT0(ii),
     &        xobs(ii),yobs(ii),uerr(ii),verr(ii),
     &        -zminobs(ii), -zmaxobs(ii),-Zbotob(ii)
         enddo
         close(1)

CALF 05/06/03 END

C
C End of routine
C

      Return
      End
C***********************************************************************
C***********************************************************************
C End of User-Specified Subroutines for TRUXTON6
C End of User-Specified Subroutines for TRUXTON6
C***********************************************************************
C**********************************************************************

