C***********************************************************************
C***********************************************************************
C Beginning of User-Specified Subroutines for FUNDY6
C Beginning of User-Specified Subroutines for FUNDY6
C***********************************************************************
C***********************************************************************
      SUBROUTINE BCF6(FREQ,U,V,III)
C Include file for parameter statements
      INCLUDE 'DCMS.DIM'
C Fixed global variables
      COMPLEX U(NNDIM),V(NNDIM)
C-----------------------------------------------------------------------
C This subroutine must be modified by the user to assign proper
C   Boundary Conditions.  There are four sections which require
C   modification, beginning at statement labels 3,4,5, and 6.  
C Each section must begin with the appropriately labelled continue 
C   statement, and end with a return statement.
C================Beginning-of-user-specified-instructions===============
C
C User-specified local assignments
C
C
C Beginning of executable code
C
      IF(III.EQ.0) GO TO 3
      IF(III-2)4,5,6
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C This section assigns the frequency of the forcing in SEC**-1 to WW.
C A return statement must follow the WW=___  statement.
C
    3 CONTINUE
      RETURN
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C Elevation BC's are assigned in this section.  One statement of the
C   form U(I)=CVALUE must appear for each set depth node, where I is the
C   horizontal node number and CVALUE is the complex elevation for node 
C   I.  
C A return statement must follow the last elevation BC assignment.
C
    4 CONTINUE
      RETURN
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C Nonzero normal velocity BC's are assigned in this section.  One 
C   statement of the form U(I)=CVALUE must appear for each set nonzero
C   normal velocity node, where I is the horizontal node number and 
C   CVALUE is the complex value of the normal velocity for node I.  
C   Positive normal velocity indicates flow out of the system.  
C A return statement must follow the last normal velocity BC assignment.
C
    5 CONTINUE
      RETURN
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C Nonzero velocity BC's are assigned in this section.  Two statements
C   of the following form must appear for each nonzero velocity node:
C      U(I)=CXVEL
C      V(I)=CYVEL
C   I is the horizontal node number, (CXVEL,CYVEL) are the complex
C   values of the (X,Y) velocities for node I.  
C A return statement must follow the last velocity BC assignment.
C
    6 CONTINUE
      RETURN
C
C End of routine
C
      END
C***********************************************************************
C***********************************************************************
      SUBROUTINE ATMOSF6(NN,NE,XNOD,YNOD,IN,ATMX,ATMY)
C Include file for parameter statements
      INCLUDE 'DCMS.DIM'
C Fixed global variables
      REAL XNOD(NNDIM),YNOD(NNDIM)
      INTEGER IN(3,NEDIM)
      COMPLEX ATMX(NNDIM),ATMY(NNDIM)
C-----------------------------------------------------------------------
C This subroutine must be modified by the user to assign proper values
C   to arrays ATMX and ATMY, the right-sides of the conservative X- and
C   Y-momentum equations, respectively.  (i.e. H*PSI)  Two statements of
C   the following form must appear for each node where the atmospheric 
C   forcing is nonzero:
C      ATMX(I)=XVALUE
C      ATMY(I)=YVALUE
C   I is the node number and XVALUE,YVALUE are the complex values of the
C   forcing.  ATMX,ATMY are initialized with the value of zero by the
C   main routine before this routine is called.  Therefore, if no value
C   is assigned for a node in this routine, the default value of zero 
C   is used.
C
C Arrays passed to this subroutine to facilitate computations:
C          XNOD(I),YNOD(I) - Horizontal nodal coordinates
C          IN(3,L) - LABLIB STANDARD triangular element incidence list
C
C Index range:  I=1,NN, J=1,NNV
C          I=1,NN, J=1,NNV, L=1,NE
C          NN - number of horizontal nodes
C          NE - number of horizontal 2-D triangular elements
C================Beginning-of-user-specified-instructions===============
C
C User-specified local assignments
C
C
C End of routine
C
      RETURN
      END
C***********************************************************************
C***********************************************************************
      SUBROUTINE VERTGRIDF6(NN,NE,XNOD,YNOD,IN,NLEV,ZL,NNV,HDOWN,
     &Z,AK,ENZ)
C Include file for parameter statements
      INCLUDE 'DCMS.DIM'
C Fixed global arrays
      INTEGER IN(3,NEDIM)
      REAL XNOD(NNDIM),YNOD(NNDIM),ZL(NLEVDIM),HDOWN(NNDIM)
      REAL AK(NNDIM)
      REAL Z(NNDIM,NNVDIM),ENZ(NNDIM,NNVDIM)
C-----------------------------------------------------------------------
C This subroutine must be modified by the user to assign proper values
C   to the arrays:
C          Z(I,J) - Vertical coordinate of 3-D nodes
C          AK(I) - Linear bottom stress coefficient, k
C          ENZ(I,J) - Vertical viscosity, Nz
C
C Arrays passed to this subroutine to facilitate computations:
C          XNOD(I),YNOD(I) - Horizontal nodal coordinates
C          HDOWN(I) - Bathymetric depth at nodes
C          IN(3,L) - LABLIB STANDARD triangular element incidence list
C
C Index range:  I=1,NN, J=1,NNV
C          I=1,NN, J=1,NNV, L=1,NE
C          NN - number of horizontal nodes
C          NE - number of horizontal 2-D triangular elements
C          NNV - number of vertical nodes
C
C Z and J are positive upward:
C          Bottom:  Z=-HDOWN; J=1
C          Surface: Z= 0    ; J=NNV
C-----------------------------------------------------------------------
C Two standard subroutines are available to assign values to these
C   arrays:  Subroutines UNIGRID5 and SINEGRID5.
C
CCCCC
C
C   Subroutine UNIGRID6 assigns uniform ENZ, uniform AK, and uniform
C     vertical spacing.  Assignment of NNV,
C     EN0 and AK0 is required before this subroutine is called.
C
C      CALL UNIGRID6(NN,NNV,HDOWN,EN0,AK0,
C     &Z,AK,ENZ)
C
CCCCC
C
C   Subroutine SINEGRID6 assigns uniform ENZ, uniform AK, and sinusiodal
C     vertical spacing.  It requires the
C     assignment of NNV, AKO, and ENO before it is called.
C
C      CALL SINEGRID6(NN,NNV,HDOWN,EN0,AK0,DZBL,
C     &Z,AK,ENZ)
C
C================Beginning-of-user-specified-instructions===============
C
C User-specified local assignments
C
      character*72 fileen,fileak

      NNV=21
      AK0=0.004
      EN0=0.04
      DZBL=1.0
      CALL SINEGRID6(NN,NNV,HDOWN,EN0,AK0,DZBL,
     *      Z,AK,ENZ)
c
c Overwrite friction parameters with values from specified files
      WRITE(*,'(2A)')'Enter the name of the file containing the time-',
     &'average values of the linearized bottom stress coefficient:'
      READ(*,'(A)')FILEAK
      WRITE(*,'(2A)')'Enter the name of the file containing the time-',
     &'average values of the vertical eddy viscosity:'
      READ(*,'(A)')FILEEN
      OPEN(71,FILE=FILEAK,STATUS='OLD')
      READ(71,'(A)')HEADER
      READ(71,'(A)')HEADER
      DO I=1,NN
         READ(71,*)II,AK(I)
      ENDDO
      IF(II.NE.NN)THEN
         WRITE(*,*)'ERROR READING ',FILEAK
         STOP
      ENDIF
      OPEN(72,FILE=FILEEN,STATUS='OLD')
      READ(72,'(A)')HEADER
      READ(72,'(A)')HEADER
      READ(72,*)NNV
      DO I=1,NN
         DO J=1,NNV
            READ(72,*)II,ZIJ,ENZ(I,J)
         ENDDO
      ENDDO
      IF(II.NE.NN)THEN
         WRITE(*,*)'ERROR READING ',FILEEN
         STOP
      ENDIF

C End of routine
C
      RETURN
      END
C***********************************************************************
C***********************************************************************
      SUBROUTINE BAROCLINICF6(NN,NE,X,Y,IN,NLEV,ZL,NNV,Z,G,
     &PPX,PPY,IQ,JQ,BPGX,BPGY,HRBARX,HRBARY,CS)
C Include file for parameter statements
      INCLUDE 'DCMS.DIM'
C Fixed global arrays
      INTEGER IN(3,NEDIM)
      REAL X(NNDIM),Y(NNDIM),CS(NNDIM)
      REAL ZL(NLEVDIM)
      REAL Z(NNDIM,NNVDIM),ENZ(NNDIM,NNVDIM)
      INTEGER IQ(NNDIM),JQ(NFTRDIM*NNDIM)
      REAL PPX(NFTRDIM*NNDIM),PPY(NFTRDIM*NNDIM)
      COMPLEX BPGX(NNDIM,NNVDIM),BPGY(NNDIM,NNVDIM)
      COMPLEX HRBARX(NEDIM),HRBARY(NEDIM)
C-----------------------------------------------------------------------
C This subroutine must be modified by the user to assign proper values
C   to the arrays:
C          BPGX(I,J) - RHS of x-momentum equation
C          BPGY(I,J) - RHS of y-momentum equation
C          HRBARX(L) - RHS of elevation equation
C          HRBARY(L) - RHS of elevation equation
C
C Arrays passed to this subroutine to facilitate computations:
C          X(I),Y(I) - Scaled horizontal nodal coordinates
C          IN(3,L) - LABLIB STANDARD triangular element incidence list
C
C Index range:  I=1,NN, J=1,NNV
C          I=1,NN, J=1,NNV, L=1,NE
C          NN - number of horizontal nodes
C          NE - number of horizontal 2-D triangular elements
C          NNV - number of vertical nodes
C-----------------------------------------------------------------------
C================Beginning-of-user-specified-instructions===============
C
C User-specified local assignments
C
C
C End of routine
C
      RETURN
      END
C***********************************************************************
C***********************************************************************
      SUBROUTINE OUTPUTF6(MESHNAME,NN,NE,XNOD,YNOD,IN,NNV,Z,
     &ZETA,UBAR,VBAR,U,V,W,FREQ)
C Include file for parameter statements
      INCLUDE 'DCMS.DIM'
C Fixed global arrays
      REAL XNOD(NNDIM),YNOD(NNDIM),Z(NNDIM,NNVDIM)
      INTEGER IN(3,NEDIM)
      COMPLEX ZETA(NNDIM),UBAR(NNDIM),VBAR(NNDIM),
     &U(NNDIM,NNVDIM),V(NNDIM,NNVDIM),W(NNDIM,NNVDIM)
      CHARACTER*72 MESHNAME,COORDS
C-----------------------------------------------------------------------
C User-defined output routine
C
C Arrays and constants:
C          XNOD(I),YNOD(I) - Horizontal nodal coordinates
C          IN(3,L) - LABLIB STANDARD triangular element incidence list
C          Z(I,J) - Vertical coordinate of 3-D nodes
C          ZETA(I) - Free surface elevation at nodes
C          UBAR(I) - Vertically averaged velocity in x-direction
C          VBAR(I) - Vertically averaged velocity in y-direction
C          U(I,J),V(I,J),W(I,J) - x,y,and z components of velocity
C          FREQ - Frequency in rad/sec
C
C Index range:  I=1,NN, J=1,NNV
C          NN - number of horizontal nodes
C          NE - number of horizontal 2-D triangular elements
C          NNV - number of vertical nodes
C
C Z and J are positive upward:
C          Bottom:  Z=-HDOWN; J=1
C          Surface: Z= 0    ; J=NNV
C-----------------------------------------------------------------------
C A standard routine 'SUBROUTINE DUMP5' writes all computed results to a
C   user-specified file.  A single line in this subroutine suffices:
C
C      CALL DUMP5(X,Y,Z,ZETA,UBAR,VBAR,U,V,W,
C     &NN,NNV,NNDIM,NNVDIM)
C
C DUMP takes time and produces a large file.
C================Beginning-of-user-specified-instructions===============
C
C User-specified local assignments
C
C
C End of routine
C
      RETURN
      END
C***********************************************************************
C***********************************************************************
      SUBROUTINE SETF6(G,OMEGA,RAD)
C-----------------------------------------------------------------------
C purpose: This subroutine is provided to facilitate the overwriting of
C          parameters set in the main program.
C
C algorithmic design: Any assignments made to passed arguments within 
C                     this subroutine will supersede the default 
C                     settings set in the main program.  Any changes
C                     will be reflected in the .echo file.
C                     
C passed arguments:
C   G - Gravitational acceleration of celestial body (m/sec^2)
C   OMEGA - Radian frequency of celestial body (rad/sec)
C   RAD - Radius of celestial body (m)
C-----------------------------------------------------------------------
C
C User-specified local assignments
C
C
C End of routine
C
      RETURN
      END
C***********************************************************************
C***********************************************************************
      SUBROUTINE SUBTITLE (NFIL)
C-----------------------------------------------------------------------
C   Description: This user supplied subroutine is used to record
C                information on all the user provided subroutines
C                if so desired.  This routine can be left empty and
C                the execution of the QUODDY model is not affected.
C                If so desired, the provided information will be
C                written in the echo file (".echo") with the assigned
C                logical name NFIL.
C     Variables: [Argument list]
C                NFIL -- A pre-assigned logical file name of the echo
C                        file (".echo")
C                [Local character variables]
C                COMENT -- Comment on each user subroutine
C                FILSUB -- File contains all the user supplied routines
C      Accuracy: I*2, R*4 (single precision)
C         Input: NFIL
C        Output: Information on the user supplied subroutines is written
C                to the echo file (".echo")
C================Beginning-of-user-specified-instructions===============
C
C User-specified local assignments
C
C
C End of routine
C
      RETURN
      END
C***********************************************************************
C***********************************************************************
C End of User-Specified Subroutines for FUNDY6
C End of User-Specified Subroutines for FUNDY6
C***********************************************************************
C***********************************************************************
