mod_input Module Reference

Functions/Subroutines
subroutine	commandlineio (CVS_ID, CVS_Date, CVS_Name, CVS_Revision)
subroutine	name_list_initialize
subroutine	name_list_print
subroutine	name_list_read
subroutine	check_io_dirs
subroutine	nullify_file_pointers
subroutine	incriment_fname (FNAME)
subroutine	open_startup_file
subroutine	open_crashstart
subroutine	search_for_last_matching_name (FNAME)
subroutine	open_coldstart
subroutine	open_new_output
subroutine	open_forcing
subroutine	load_horizontal_mixing_coefficient (NN, CC)
subroutine	load_bottom_roughness (Z0)
subroutine	load_grid_type (NCF, G)
subroutine	load_restart_grid (NVG)
subroutine	load_restart_obc_grid (IOBCN_GL, I_OBC_GL, TYPE_OBC_GL)
subroutine	load_restart_lsf_grid (N_GL, I_GL, GEO_GL, WDF_GL)
subroutine	load_restart_coords (X_LCL, Y_LCL)
subroutine	load_restart_depth (H_LCL)
subroutine	load_restart_coriolis (C_LCL)
subroutine	load_restart_sponge (SPG)
subroutine	load_restart_sigma (Z, Z1)
subroutine	load_coldstart_grid (NVG)
subroutine	load_coldstart_obc_grid (IOBCN_GL, I_OBC_GL, TYPE_OBC_GL)
subroutine	load_coldstart_lsf (N_GL, I_GL, GEO_GL, WDF_GL)
subroutine	load_coldstart_coords (X_GBL, Y_GBL, X_LCL, Y_LCL)
subroutine	load_coldstart_depth (X_GBL, Y_GBL, H_LCL)
subroutine	load_coldstart_coriolis (X_GBL, Y_GBL, C_LCL)
subroutine	load_coldstart_sponge (X_GBL, Y_GBL, NSPONGE, N_SPG, R_SPG, C_SPG, X_SPG, Y_SPG)
subroutine	load_coldstart_sigma
subroutine	load_julian_obc (NTC, NAMES, PRD, EQ_AMP, EQ_BETA, EQ_TYPE, MPTD, PHS, RF, TORG)
subroutine	read_julian_obc (JULOBCUNIT_TEMP, NTC, NAMES, PRD, EQ_AMP, EQ_BETA, EQ_TYPE, MPTD, PHS, RF, TORG)
subroutine	parse_tide (line, cnt, ntc, data, ierr)
subroutine	read_coldstart_grid (GRIDUNIT, MGL, NGL, NVG)
subroutine	read_coldstart_obc_grid (OBCUNIT, MGL, IOBCN_GL, I_OBC_GL, TYPE_OBC_GL)
subroutine	read_coldstart_lsf (LSFUNIT, N_GL, I_GL, GEO_GL, WDF_GL)
subroutine	read_coldstart_coords (GRIDUNIT, MGL, XG2, YG2)
subroutine	read_coldstart_depth (DEPTHUNIT, MGL, XG2, YG2, HG2)
subroutine	read_coldstart_coriolis (CORIOLISUNIT, MGL, XG, YG, CORG)
subroutine	read_coldstart_sponge (SPONGEUNIT, MGL, NSPONGE, N_SPG, R_SPG, C_SPG)
subroutine	read_coldstart_sigma
subroutine	helptxt (IPT)

Variables
type(ncfile), pointer	nc_dat
type(ncfile), pointer	nc_avg
type(ncfile), pointer	nc_rst
type(ncfile), pointer	nc_start

Function/Subroutine Documentation

check_io_dirs()

subroutine mod_input::check_io_dirs

(

)

Definition at line 884 of file mod_input.f90.

    USE control
    IMPLICIT NONE
    integer :: ncfileind, datfileind,ios,charnum, i,ios2
    logical :: fexist,back,connected
    character(len=100) :: testchar
    character(len=160) :: pathnfile
    character(len=2) :: cios
    ! CHECK FOR INPUT AND OUTPUT DIRECTORIES


    ! Check for '/' at the end of directory strings

    back = .true.
    charnum=index(trim(input_dir),"/",back)
    if (charnum /= len_trim(input_dir)) then
       input_dir=trim(input_dir)//"/"
       if(dbg_set(dbg_io)) &
            write(ipt,*) "Added '/' to input_dir: ",trim(input_dir)
    end if

    charnum= index(trim(output_dir),"/",back)
    if ( charnum /= len_trim(output_dir)) then
       output_dir=trim(output_dir)//"/"
       if(dbg_set(dbg_io)) &
            write(ipt,*) "Added '/' to output_dir: ",trim(output_dir)
    end if

    ! CHECK for Existance of output_dir and input_dir
    if (msr) then
       ! OUTPUT_DIR TEST FILE - must exist + Read/write permissions
       testchar = trim(output_dir)//".fvcomtestfile"

       OPEN(unit=testunit,file=trim(testchar),&
            & form="formatted",status="unknown",iostat=ios)
       write(cios,'(i2.2)') ios
       if (ios == 9) then
          CALL fatal_error("Unable to OPEN the test file:",&
               & trim(testchar), "IOSTAT ERROR#"//cios//"; suggests ba&
               &d permissions in:", trim(output_dir))

       elseif (ios ==29) then
          CALL fatal_error("Unable to OPEN the test file:",&
               & trim(testchar), "IOSTAT ERROR#"//cios//"; suggests ba&
               &d directory path:", trim(output_dir))
   
       else if (ios /= 0) then
          CALL fatal_error("Unable to OPEN the test file:",&
               & trim(testchar), "Unknown IOSTAT error# "//cios)
       end if
          
       write(testunit,*)"This is a test file created by FVCOM. You may delete it."
       write(testunit,*)"Have a nice day."
       
       CLOSE(unit=testunit,iostat=ios2)
       if (ios2 /= 0) then
          write(cios,'(i2.2)') ios2
          CALL fatal_error("Unable to CLOSE the test file:",&
               & trim(testchar), "Unknown IOSTAT error# "//cios)
       end if


       ! INPUT_DIR TEST FILE
       testchar = trim(input_dir)//".fvcomtestfile"
       OPEN(unit=testunit,file=trim(testchar),&
            & form="formatted",status="unknown",iostat=ios)
       write(cios,'(i2.2)') ios
       if (ios == 9) then
          CALL warning("Unable to OPEN the test file:",&
               & trim(testchar), "IOSTAT ERROR#"//cios//"; suggests bad permissions&
               & in:", trim(input_dir))
       elseif (ios ==29) then
          CALL warning("Unable to OPEN the test file:",&
               & trim(testchar), "IOSTAT ERROR#"//cios//"; suggests ba&
               &d directory path:",trim(input_dir))
       else if (ios /= 0) then
          CALL fatal_error("Unable to OPEN the test file:",&
               & trim(testchar), "Unknown IOSTAT error# "//cios)

       else if (ios == 0) then
          write(testunit,*)"This is a test file created by FVCOM. You may delete it."
          write(testunit,*)"Have a nice day."
          CLOSE(unit=testunit,iostat=ios2)
          if (ios2 /= 0) then
             write(cios,'(i2.2)') ios2
             CALL fatal_error("Unable to CLOSE the test file:",&
                  & trim(testchar), "Unknown IOSTAT error# "//cios)
          end if
       end if
          

    end if

Here is the caller graph for this function:

commandlineio()

subroutine mod_input::commandlineio	(	character(len=*), intent(in)	CVS_ID,
		character(len=*), intent(in)	CVS_Date,
		character(len=*), intent(in)	CVS_Name,
		character(len=*), intent(in)	CVS_Revision
	)

Definition at line 66 of file mod_input.f90.

    use mod_sng ! [mdl] String manipulatio
    USE control


    implicit none
    ! Parameters
    character(len=*), INTENT(IN)::CVS_Id  ! [sng] CVS Identification
    character(len=*), INTENT(IN)::CVS_Date ! [sng] Date string
    character(len=*), INTENT(IN)::CVS_Name ! [sng] File name string
    character(len=*), INTENT(IN)::CVS_Revision ! [sng] File revision string
    character(len=*),parameter::nlc=char(0) ! [sng] NUL character = ASCII 0 = char(0)

    ! Command-line parsing
    character(80)::arg_val ! [sng] command-line argument value
    character(200)::cmd_ln ! [sng] command-line
    character(80)::opt_sng ! [sng] Option string
    character(2)::dsh_key ! [sng] command-line dash and switch
    character(200)::prg_ID ! [sng] Program ID

    integer::arg_idx ! [idx] Counting index
    integer::arg_nbr ! [nbr] Number of command-line arguments
    integer::opt_lng ! [nbr] Length of option

    logical :: outtofile = .false.

    ! Initialize values from in variables 
    casename="empty"//nlc ! declared in mod_main - all_vars
    dbg_lvl=0 ! declared in mod_dbg
    infofile="screen"//nlc ! Get output file parameter
    namelist_name = "empty"//nlc ! Name of blank name list file-
    ! declared in mod_main

    ! Main code
    call ftn_strini(cmd_ln) ! [sng] sng(1:len)=NUL

    call ftn_cmd_ln_sng(cmd_ln) ! [sng] Re-construct command-line into single string
    call ftn_prg_id_mk(cvs_id,cvs_revision,cvs_date,prg_id) ! [sng] Program ID

    arg_nbr=command_argument_count() ! [nbr] Number of command-line arguments

    if (arg_nbr .LE. 0 ) then
       if(msr) WRITE(ipt,*) "You must specify a case name: "
       if(msr) Call helptxt(ipt)
       call pshutdown
    end if

    arg_idx=1 ! [idx] Counting index
    do while (arg_idx <= arg_nbr)
       call ftn_getarg_wrp(arg_idx,arg_val) ! [sbr] Call getarg, increment arg_idx
       dsh_key=arg_val(1:2) ! [sng] First two characters of option
       if (dsh_key == "--") then
          opt_lng=ftn_opt_lng_get(arg_val) ! [nbr] Length of option
          if (opt_lng <= 0) then
             if(msr) write(ipt,*) "Long option has no name"
             call pshutdown
          end if

          opt_sng=arg_val(3:2+opt_lng) ! [sng] Option string
          if (dbg_lvl >= dbg_io) then
             if(msr) write (6,"(5a,i3)") prg_nm(1:ftn_strlen(prg_nm)), &
                  ": DEBUG Double hyphen indicates multi-character option: ", &
                  "opt_sng = ",opt_sng(1:ftn_strlen(opt_sng)),", opt_lng = ",opt_lng
          end if
          if (opt_sng == "dbg" .or. opt_sng == "dbg_lvl" ) then
             call ftn_arg_get(arg_idx,arg_val,dbg_lvl) ! [enm] Debugging level

          else if (opt_sng == "dbg_par" .or.opt_sng == "Dbg_Par"&
               & .or.opt_sng == "DBG_PAR") then

             dbg_par = .true.

          else if (opt_sng == "crashrestart" .or.opt_sng == "CrashRestart"&
               & .or.opt_sng == "CRASHRESTART") then

             cmdln_restart = .true.
             !           call ftn_arg_get(arg_idx,arg_val,dbg_par) ! [sng] Input file

          else if (opt_sng == "CaseName" .or.opt_sng == "casename"&
               & .or.opt_sng == "CASENAME") then

             call ftn_arg_get(arg_idx,arg_val,casename) ! [sng] Input file
             casename=casename(1:ftn_strlen(casename))
             ! Convert back to a fortran string!

          else if (opt_sng == "Create_NameList" .or.opt_sng == "create_namelist"&
               & .or.opt_sng == "CREATE_NAMELIST") then

             call ftn_arg_get(arg_idx,arg_val,namelist_name)
             namelist_name = namelist_name(1:ftn_strlen(namelist_name))

             blank_namelist = .true.

          else if (opt_sng == "LogFile" .or.opt_sng == "logfile"&
               & .or.opt_sng == "LOGFILE") then

             call ftn_arg_get(arg_idx,arg_val,infofile) 
             infofile=infofile(1:ftn_strlen(infofile))
             
             outtofile=.true.
             
          else if (opt_sng == "help" .or.opt_sng == "HELP" .or. opt_sng&
               & == "Help") then

             if(msr) call helptxt(ipt)
             call pshutdown
!!$   THIS DOES NOT SEEM PRACTICAL - MODIFY THE RUN FILE INSTEAD
!!$          else if (opt_sng == "CrashRestart") then
!!$             call ftn_arg_get(arg_idx,arg_val,CrashRestart) ! [lgc] Logical

          else ! Option not recognized
             arg_idx=arg_idx-1 ! [idx] Counting index
             if(msr) call ftn_getarg_err(arg_idx,arg_val) ! [sbr] Error handler for getarg()
          endif ! endif option is recognized
          ! Jump to top of while loop
          cycle ! C, F77, and F90 use "continue", "goto", and "cycle"
       endif ! endif long option

       if (dsh_key == "-V" .or.dsh_key == "-v" ) then

          if(msr) write(ipt,*) prg_id
          call pshutdown

       else if (dsh_key == "-H" .or.dsh_key == "-h" ) then

          if(msr) Call helptxt(ipt)
          Call pshutdown

       else ! Option not recognized
          arg_idx=arg_idx-1 ! [idx] Counting index
          if(msr) call ftn_getarg_err(arg_idx,arg_val) ! [sbr] Error handler for getarg()
       endif ! endif arg_val


    end do ! end while (arg_idx <= arg_nbr)

    if (blank_namelist) then
       infofile =trim(namelist_name)//"_run.nml"
       casename= namelist_name
       outtofile = .true.
    end if

    CALL dbg_init(ipt_base,outtofile)

Here is the call graph for this function:

Here is the caller graph for this function:

helptxt()

subroutine mod_input::helptxt

(

integer, intent(in)

IPT

)

Definition at line 3880 of file mod_input.f90.

    implicit none
    INTEGER, INTENT(IN) :: IPT
    write(ipt,*) "Need to put something here!"
    write(ipt,*) "This is not a very helpful help message!"
    write(ipt,*) "LONG INPUT OPTIONS"
    write(ipt,*) "--HELP => PRINT THIS MESSAGE"
    write(ipt,*) "--CASENAME=<YOUR_CASE> (REQUIRED)"
    write(ipt,*) "--CREATE_NAMELIST => PRINT BLANK NAMELIST AND RETURN"
    write(ipt,*) "--LOGFILE=<FILENAME> => TO OUTPUT TO A LOG FILE"
    write(ipt,*) "--CRASHRESTART  => RUN FROM CURRENT TIME IN RESTART FILE"
    write(ipt,*) "SHORT INPUT OPTIONS"
    write(ipt,*) "-V => PRINT FVCOM VERSION INFO AND RETURN"
    write(ipt,*) "-H => PRINT THIS MESSAGE AND RETURN"
    write(ipt,*) ""
    write(ipt,*) "DEBUG LEVELS"
    write(ipt,*) "--dbg=0 => DBG LOG (DEFAULT"
    write(ipt,*) "--dbg=1 => DBG IO FILENAMES"
    write(ipt,*) "--dbg=2 => DBG SCALARS"
    write(ipt,*) "--dbg=4 => DBG SUBROUTINE NAMES"
    write(ipt,*) "--dbg=5 => DBG SUBROUTINE IO"
    write(ipt,*) "--dbg=6 => DBG VECTORS"
    write(ipt,*) "--dbg=7 => DBG EVERYTHING"
    write(ipt,*) "--dbg_par => WRITE LOG FOR EACH PROCESSOR"
    write(ipt,*) ""

Here is the caller graph for this function:

incriment_fname()

subroutine mod_input::incriment_fname

(

character(len=160)

FNAME

)

Definition at line 988 of file mod_input.f90.

    IMPLICIT NONE
    CHARACTER(LEN=160) FNAME
    CHARACTER(LEN=4) NUMSTR
    integer LENGTH,start,end,value
    if(dbg_set(dbg_sbr)) &
         & write(ipt,*) "STARTING INCRIMENT_FNAME"

    if(dbg_set(dbg_sbrio)) write(ipt,*) 'INCRIMENTING OLD FILE NAME: '//trim(fname)

    ! GET POSITION OF FILE NUMBER IN FNAME
    length = len_trim(fname)
    start = length - 6
    end = LENGTH - 3

    ! READ FILE NUMBER AND INCRIMENT BY ONE
    numstr=fname(start:end)
    read(numstr,*) value
    value = value + 1
    write(numstr,'(I4.4)') value

    ! INSERT BACK INTO FNAME
    fname(start:end) = numstr

    if(dbg_set(dbg_sbrio)) write(ipt,*) 'NEW FILE NAME: '//trim(fname)

   if(dbg_set(dbg_sbr)) &
         & write(ipt,*) "END INCRIMENT_FNAME"

Here is the call graph for this function:

Here is the caller graph for this function:

load_bottom_roughness()

subroutine mod_input::load_bottom_roughness

(

real(sp), dimension(:), allocatable

Z0

)

Definition at line 1747 of file mod_input.f90.

    USE control
    IMPLICIT NONE
    REAL(SP),ALLOCATABLE :: Z0(:)
    TYPE(NCFILE), POINTER :: NCF
    TYPE(NCVAR),  POINTER :: VAR
    TYPE(NCDIM),  POINTER :: DIM1
    TYPE(NCDIM),  POINTER :: DIM2
    integer status,I,IERR
    
    LOGICAL FOUND

    ! FIND THE Bottom Roughness FILE OBJECT
    ncf => find_file(filehead,trim(bottom_roughness_file),found)
    IF(.not. found) CALL fatal_error &
         & ("COULD NOT FIND BOTTOM_ROUGHNESS_FILE FILE OBJECT",&
         & "FILE NAME: "//trim(bottom_roughness_file))

    dim1 => find_dim(ncf,'nele',found)
    IF(.not. found) CALL fatal_error &
         & ("COULD NOT FIND BOTTOM_ROUGHNESS_FILE DIMENSION 'nele' in:",&
         & "FILE NAME: "//trim(bottom_roughness_file))
    IF (dim1%DIM /= ngl)CALL fatal_error &
         & ("Dimension 'nele' in the BOTTOM_ROUGHNESS_FILE does not match NGL for this model?",&
         & "FILE NAME: "//trim(bottom_roughness_file)) 


    ! FIND THE 'z0B' variable
    var => find_var(ncf,'z0b',found)
    IF(.not. found) CALL fatal_error &
         & ("COULD NOT FIND BOTTOM_ROUGHNESS_FILE VARIABLE 'z0b' in:",&
         & "FILE NAME: "//trim(bottom_roughness_file))

    CALL nc_connect_avar(var,z0)
    CALL nc_read_var(var)
    CALL nc_disconnect(var)

    

Here is the caller graph for this function:

load_coldstart_coords()

subroutine mod_input::load_coldstart_coords	(	real(sp), dimension(:), allocatable	X_GBL,
		real(sp), dimension(:), allocatable	Y_GBL,
		real(sp), dimension(:), allocatable	X_LCL,
		real(sp), dimension(:), allocatable	Y_LCL
	)

Definition at line 2444 of file mod_input.f90.

    USE control
    IMPLICIT NONE
    REAL(SP), ALLOCATABLE :: X_GBL(:),Y_GBL(:),X_LCL(:),Y_LCL(:)
    INTEGER :: SENDID

    integer status,I,IERR

    IF (msr) THEN
       CALL read_coldstart_coords(gridunit,mgl,x_gbl,y_gbl)
       CLOSE(gridunit)
    END IF

    IF (serial) THEN
       x_lcl = x_gbl
       y_lcl = y_gbl
       
    ! BROADCAST TO OTHER PROCS
    ELSE
    END IF

    ! DO NOT DEALLOCATE THE GLOBAL ARRAYS!

Here is the call graph for this function:

Here is the caller graph for this function:

load_coldstart_coriolis()

subroutine mod_input::load_coldstart_coriolis	(	real(sp), dimension(:), intent(in), allocatable	X_GBL,
		real(sp), dimension(:), intent(in), allocatable	Y_GBL,
		real(sp), dimension(:), allocatable	C_LCL
	)

Definition at line 2496 of file mod_input.f90.

    USE control
    IMPLICIT NONE
    integer :: SENDID
    REAL(SP), ALLOCATABLE             :: C_LCL(:)
    REAL(SP), ALLOCATABLE, INTENT(IN) :: X_GBL(:),Y_GBL(:)
    REAL(SP), ALLOCATABLE :: C_GBL(:)
    
    ! WE ONLY USE A CORIOLIS FILE IF THE GRID FILE UNITS ARE METERS
    IF (msr) THEN
       ALLOCATE(c_gbl(0:mgl)); c_gbl= 0.0_sp
       
       IF (grid_file_units == 'degrees') THEN
          c_gbl = y_gbl
          
       ELSE IF (grid_file_units == 'meters') THEN
          
          CALL read_coldstart_coriolis(coriolisunit,mgl,x_gbl,y_gbl,c_gbl)
          CLOSE (coriolisunit)
       END IF
    END IF

    IF (serial) THEN
       c_lcl(0:mt) = c_gbl(0:mt)
       
    ELSE
    END IF
    
    IF(msr) DEALLOCATE(c_gbl)
    

Here is the call graph for this function:

Here is the caller graph for this function:

load_coldstart_depth()

subroutine mod_input::load_coldstart_depth	(	real(sp), dimension(:), intent(in), allocatable	X_GBL,
		real(sp), dimension(:), intent(in), allocatable	Y_GBL,
		real(sp), dimension(:), allocatable	H_LCL
	)

Definition at line 2469 of file mod_input.f90.

    USE control
    USE all_vars
    IMPLICIT NONE
    integer status,I,IERR
    REAL(SP), ALLOCATABLE             :: H_LCL(:)
    REAL(SP), ALLOCATABLE, INTENT(IN) :: X_GBL(:),Y_GBL(:)
!    REAL(SP), ALLOCATABLE :: HG(:)
    INTEGER :: SENDID,SENDER

    IF (msr) THEN
       ALLOCATE(hg(0:mgl)); hg=0.0_sp
       CALL read_coldstart_depth(depthunit,mgl,x_gbl,y_gbl,hg)
       CLOSE(depthunit)
    END IF


   IF (serial) THEN
      h_lcl(0:mgl) = hg(0:mgl)
      
   ELSE
    END IF
    
!    IF(MSR) DEALLOCATE(HG)

Here is the call graph for this function:

Here is the caller graph for this function:

load_coldstart_grid()

subroutine mod_input::load_coldstart_grid

(

integer, dimension(:,:), intent(out), allocatable

NVG

)

Definition at line 2373 of file mod_input.f90.

    USE control
    IMPLICIT NONE
    INTEGER, ALLOCATABLE, INTENT(OUT) :: NVG(:,:)
    integer :: status,I,IERR, SENDER, nvals
    
    IF(msr) THEN
       CALL read_coldstart_grid(gridunit,mgl,ngl,nvg)
       ! DO NOT CLOSE THE GRID FILE HERE
       ! READ THE COORDS FIRST
    END IF
    
    ! BROADCAST TO OTHER PROCS
    IF(par) THEN
    END IF
    

Here is the call graph for this function:

Here is the caller graph for this function:

load_coldstart_lsf()

subroutine mod_input::load_coldstart_lsf	(	integer, intent(out)	N_GL,
		integer, dimension(:), intent(out), allocatable	I_GL,
		real(sp), dimension(:), intent(out), allocatable	GEO_GL,
		real(sp), dimension(:), intent(out), allocatable	WDF_GL
	)

Definition at line 2417 of file mod_input.f90.

    USE control
    IMPLICIT NONE
    INTEGER, INTENT(OUT)  :: N_GL
    INTEGER, INTENT(OUT), Allocatable :: I_GL(:)
    REAL(SP), INTENT(OUT), Allocatable :: GEO_GL(:),WDF_GL(:)
    INTEGER :: IERR, SENDER

    IF(.NOT. obc_longshore_flow_on) THEN
       if(dbg_set(dbg_log)) then
          WRITE(ipt,*)'!  OPEN BOUNDARY LONGSHORE FLOW IS OFF  '
          WRITE(ipt,*)'!'
       end if
       RETURN
    END IF
    
    IF(msr) THEN
       CALL read_coldstart_lsf(lsfunit,n_gl,i_gl, geo_gl,wdf_gl)
       CLOSE(obcunit)
    END IF

    IF(par) THEN
    END IF
    

Here is the call graph for this function:

Here is the caller graph for this function:

load_coldstart_obc_grid()

subroutine mod_input::load_coldstart_obc_grid	(	integer, intent(out)	IOBCN_GL,
		integer, dimension(:), intent(out), allocatable	I_OBC_GL,
		integer, dimension(:), intent(out), allocatable	TYPE_OBC_GL
	)

Definition at line 2392 of file mod_input.f90.

    USE control
    IMPLICIT NONE
    INTEGER, INTENT(OUT)  :: IOBCN_GL
    INTEGER, INTENT(OUT), Allocatable :: I_OBC_GL(:), TYPE_OBC_GL(:)
    INTEGER :: IERR, SENDER

    IF(.NOT. obc_on) THEN
       if(dbg_set(dbg_log)) then
          WRITE(ipt,*)'!  OBC IS OFF  '
          WRITE(ipt,*)'!'
       end if
       RETURN
    END IF
    
    IF(msr) THEN
       CALL read_coldstart_obc_grid(obcunit,mgl,iobcn_gl,i_obc_gl, type_obc_gl)
       CLOSE(obcunit)
    END IF

    IF(par) THEN
    END IF
    

Here is the call graph for this function:

Here is the caller graph for this function:

load_coldstart_sigma()

subroutine mod_input::load_coldstart_sigma

(

)

Definition at line 2558 of file mod_input.f90.

    USE control
    IMPLICIT NONE
    INTEGER :: STYPE_LEN, IERR, SENDER, STATUS

    stype=""

    IF (msr) THEN
       CALL read_coldstart_sigma
       CLOSE(sigmaunit)
    END IF



    kbm1 = kb -1 
    kbm2 = kb -2

Here is the call graph for this function:

Here is the caller graph for this function:

load_coldstart_sponge()

subroutine mod_input::load_coldstart_sponge	(	real(sp), dimension(:), intent(in), allocatable	X_GBL,
		real(sp), dimension(:), intent(in), allocatable	Y_GBL,
		integer, intent(out)	NSPONGE,
		integer, dimension(:), intent(out), allocatable	N_SPG,
		real(sp), dimension(:), intent(out), allocatable	R_SPG,
		real(sp), dimension(:), intent(out), allocatable	C_SPG,
		real(sp), dimension(:), intent(out), allocatable	X_SPG,
		real(sp), dimension(:), intent(out), allocatable	Y_SPG
	)

Definition at line 2528 of file mod_input.f90.

    USE control
    IMPLICIT NONE
    REAL(SP), ALLOCATABLE, INTENT(IN) :: X_GBL(:),Y_GBL(:)
    INTEGER, INTENT(OUT)              :: NSPONGE
    INTEGER, ALLOCATABLE, INTENT(OUT) :: N_SPG(:)
    REAL(SP), ALLOCATABLE, INTENT(OUT):: R_SPG(:),C_SPG(:),X_SPG(:),Y_SPG(:)
    INTEGER :: SENDER,IERR

    IF(msr) THEN
       CALL read_coldstart_sponge(spongeunit,mgl,nsponge,n_spg,r_spg,c_spg)
       CLOSE(spongeunit)
    END IF


    
    IF(nsponge == 0) RETURN
    
    ALLOCATE(x_spg(nsponge)); x_spg = 0.0 
    ALLOCATE(y_spg(nsponge)); y_spg = 0.0 

    IF(msr) THEN
       x_spg= x_gbl(n_spg) 
       y_spg= y_gbl(n_spg)
    END IF


    

Here is the call graph for this function:

Here is the caller graph for this function:

load_grid_type()

subroutine mod_input::load_grid_type	(	type(ncfile), pointer	NCF,
		type(grid), pointer	G
	)

Definition at line 1789 of file mod_input.f90.

    IMPLICIT NONE

    TYPE(NCFILE), POINTER :: NCF
    TYPE(GRID), POINTER :: G
    
    
    TYPE(NCVAR),  POINTER :: VAR
    TYPE(NCDIM),  POINTER :: DIM1
    TYPE(NCDIM),  POINTER :: DIM2
    integer status,I,IERR
    
    LOGICAL FOUND
    
    !==============================================================================|
    
    
    ! GET GLOBAL DIMENSION!
    dim1 => find_dim(ncf,"node",found)
    IF(.not. found) CALL fatal_error&
         &("COULD NOT FIND DIMENSION 'node' IN THE FILE OBJECT:"//trim(ncf%FNAME))
    
    IF(g%MGL==0) THEN
       g%MGL = dim1%DIM
    ELSEIF(g%MGL/= dim1%DIM)THEN
       CALL fatal_error &
            &("THE GRID TYPE DIMENSION MGL DOES NOT MATCH THE FILE DIMENSION:"//trim(ncf%FNAME))
    END IF

    dim1 => find_dim(ncf,"nele",found)
    IF(.not. found) CALL fatal_error&
         &("COULD NOT FIND DIMENSION 'nele' IN THE FILE OBJECT:"//trim(ncf%FNAME))

    IF(g%NGL==0) THEN
       g%NGL = dim1%DIM
    ELSEIF(g%NGL/= dim1%DIM)THEN
       CALL fatal_error &
            &("THE GRID TYPE DIMENSION NGL DOES NOT MATCH THE FILE DIMENSION:"//trim(ncf%FNAME))
    END IF

    IF(g%MT == 0) g%MT = g%MGL
    IF(g%NT == 0) g%NT = g%NGL

    
    ! CHECK TO MAKE SURE DIMENSION THREE IS THERE
    dim1 => find_dim(ncf,"three",found)
    IF(.not. found) CALL fatal_error&
         &("COULD NOT FIND DIMENSION 'three' IN THE FILE OBJECT:"//trim(ncf%FNAME))

    IF(dim1%DIM /=3) CALL fatal_error&
         &("DIMENSION 'three' IS NOT 3 IN THE FILE OBJECT:"//trim(ncf%FNAME))
    

    ! SIGLEV/Z
    dim1 => find_dim(ncf,"siglev",found)
    IF(.not. found) CALL fatal_error&
         &("COULD NOT FIND DIMENSION 'siglev' IN THE FILE OBJECT:"//trim(ncf%FNAME))
    
    IF(g%KB==0) THEN
       g%KB = dim1%DIM
    ELSEIF(g%KB/= dim1%DIM)THEN
       CALL fatal_error &
            &("THE GRID TYPE DIMENSION KB DOES NOT MATCH THE FILE DIMENSION:"//trim(ncf%FNAME))
    END IF
    
    
    !SIGLAY/ZZ
    dim1 => find_dim(ncf,"siglay",found)
    IF(.not. found) CALL fatal_error&
         &("COULD NOT FIND DIMENSION 'siglay' IN THE FILE OBJECT:"//trim(ncf%FNAME))
    
    g%KBM1 = dim1%DIM
    IF(g%KBM1 /= g%KB -1) CALL fatal_error&
         &("KB and KBM1 DO NOT MATCH IN THE FILE:"//trim(ncf%FNAME))
    
    g%KBM2 = g%KB - 2
    

    IF(.NOT. ioproc)THEN
       
       ! READ THE GRID DATA
       ALLOCATE(g%NV(0:g%NGL,4),stat=status)
       IF (status /=0 ) CALL fatal_error("COULD NOT ALLOCATE G%NV WHILE READING:"//trim(ncf%FNAME))
       g%nv=0
       
       var => find_var(ncf,'nv',found)
       IF(.not. found) CALL fatal_error&
            &("COULD NOT FIND VARIABLE 'nv' IN THE FILE OBJECT:"//trim(ncf%FNAME))
       
       var%ARR_INT => g%nv(1:g%NGL,1:3)
       CALL nc_read_var(var)
       CALL nc_disconnect(var)
       
       g%NV(:,4)=g%NV(:,1)
       
       
       ! READ THE COORDINATES
       ! X - meters
       ALLOCATE(g%XM(0:g%MT),stat=status)
       IF (status /=0 ) CALL fatal_error("COULD NOT ALLOCATE G%XM WHILE READING:"//trim(ncf%FNAME))
       g%XM=0.0_sp
       
       var => find_var(ncf,'x',found)
       IF(.not. found) CALL fatal_error&
            &("COULD NOT FIND VARIABLE 'x' IN THE FILE OBJECT:"//trim(ncf%FNAME))
       
       CALL nc_connect_pvar(var,g%XM)
       CALL nc_read_var(var)
       CALL nc_disconnect(var)
       
       ! Y - meters
       ALLOCATE(g%YM(0:g%MT),stat=status)
       IF (status /=0 ) CALL fatal_error("COULD NOT ALLOCATE G%YM WHILE READING:"//trim(ncf%FNAME))
       g%YM=0.0_sp
       
       var => find_var(ncf,'y',found)
       IF(.not. found) CALL fatal_error&
            &("COULD NOT FIND VARIABLE 'y' IN THE FILE OBJECT:"//trim(ncf%FNAME))
       
       CALL nc_connect_pvar(var,g%YM)
       CALL nc_read_var(var)
       CALL nc_disconnect(var)
       
       ! X element - meters
       ALLOCATE(g%XMC(0:g%NT),stat=status)
       IF (status /=0 ) CALL fatal_error("COULD NOT ALLOCATE G%XMC WHILE READING:"//trim(ncf%FNAME))
       g%XMC=0.0_sp
       
       var => find_var(ncf,'xc',found)
       IF(.not. found) CALL fatal_error&
            &("COULD NOT FIND VARIABLE 'xc' IN THE FILE OBJECT:"//trim(ncf%FNAME))
       
       CALL nc_connect_pvar(var,g%XMC)
       CALL nc_read_var(var)
       CALL nc_disconnect(var)
       
       ! Y element - meters
       ALLOCATE(g%YMC(0:g%NT),stat=status)
       IF (status /=0 ) CALL fatal_error("COULD NOT ALLOCATE G%YMC WHILE READING:"//trim(ncf%FNAME))
       g%YMC=0.0_sp

       var => find_var(ncf,'yc',found)
       IF(.not. found) CALL fatal_error&
            &("COULD NOT FIND VARIABLE 'yc' IN THE FILE OBJECT:"//trim(ncf%FNAME))
       
       CALL nc_connect_pvar(var,g%YMC)
       CALL nc_read_var(var)
       CALL nc_disconnect(var)
       
       
       ! Longitude
       ALLOCATE(g%LON(0:g%MT),stat=status)
       IF (status /=0 ) CALL fatal_error("COULD NOT ALLOCATE G%LON WHILE READING:"//trim(ncf%FNAME))
       g%LON=0.0_sp
       
       var => find_var(ncf,'lon',found)
       IF(.not. found) CALL fatal_error&
            &("COULD NOT FIND VARIABLE 'lon' IN THE FILE OBJECT:"//trim(ncf%FNAME))
       
       CALL nc_connect_pvar(var,g%LON)
       CALL nc_read_var(var)
       CALL nc_disconnect(var)
       
       ! Latitude
       ALLOCATE(g%LAT(0:g%MT),stat=status)
       IF (status /=0 ) CALL fatal_error("COULD NOT ALLOCATE G%LAT WHILE READING:"//trim(ncf%FNAME))
       g%LAT=0.0_sp
       
       var => find_var(ncf,'lat',found)
       IF(.not. found) CALL fatal_error&
            &("COULD NOT FIND VARIABLE 'lat' IN THE FILE OBJECT:"//trim(ncf%FNAME))
       
       CALL nc_connect_pvar(var,g%LAT)
       CALL nc_read_var(var)
       CALL nc_disconnect(var)
       
       ! Longitude - element
       ALLOCATE(g%LONC(0:g%NT),stat=status)
       IF (status /=0 ) CALL fatal_error("COULD NOT ALLOCATE G%LONC WHILE READING:"//trim(ncf%FNAME))
       g%LONC=0.0_sp
       
       var => find_var(ncf,'lonc',found)
       IF(.not. found) CALL fatal_error&
            &("COULD NOT FIND VARIABLE 'lonc' IN THE FILE OBJECT:"//trim(ncf%FNAME))
       
       CALL nc_connect_pvar(var,g%LONC)
       CALL nc_read_var(var)
       CALL nc_disconnect(var)
       
       ! Latitude - element
       ALLOCATE(g%LATC(0:g%NT),stat=status)
       IF (status /=0 ) CALL fatal_error("COULD NOT ALLOCATE G%LATC WHILE READING:"//trim(ncf%FNAME))
       g%LATC=0.0_sp
       
       var => find_var(ncf,'latc',found)
       IF(.not. found) CALL fatal_error&
            &("COULD NOT FIND VARIABLE 'latc' IN THE FILE OBJECT:"//trim(ncf%FNAME))
       
       CALL nc_connect_pvar(var,g%LATC)
       CALL nc_read_var(var)
       CALL nc_disconnect(var)
       
       
       ! h
       ALLOCATE(g%H(0:g%MT),stat=status)
       IF (status /=0 ) CALL fatal_error("COULD NOT ALLOCATE G%H WHILE READING:"//trim(ncf%FNAME))
       g%H=0.0_sp
       
       var => find_var(ncf,'h',found)
       IF(.not. found) CALL fatal_error&
            &("COULD NOT FIND VARIABLE 'h' IN THE FILE OBJECT:"//trim(ncf%FNAME))
       
       CALL nc_connect_pvar(var,g%H)
       CALL nc_read_var(var)
       CALL nc_disconnect(var)
       
       ! h1
       ALLOCATE(g%H1(0:g%NT),stat=status)
       IF (status /=0 ) CALL fatal_error("COULD NOT ALLOCATE G%H1 WHILE READING:"//trim(ncf%FNAME))
       g%H1=0.0_sp
       
       var => find_var(ncf,'h_center',found)
       IF(.not. found) CALL fatal_error&
            &("COULD NOT FIND VARIABLE 'h_center' IN THE FILE OBJECT:"//trim(ncf%FNAME))
       
       CALL nc_connect_pvar(var,g%H1)
       CALL nc_read_var(var)
       CALL nc_disconnect(var)
       
       ! zz
       ALLOCATE(g%ZZ(0:g%MT,g%KBM1),stat=status)
       IF (status /=0 ) CALL fatal_error("COULD NOT ALLOCATE G%ZZ WHILE READING:"//trim(ncf%FNAME))
       g%ZZ=0.0_sp
       
       var => find_var(ncf,'siglay',found)
       IF(.not. found) CALL fatal_error&
            &("COULD NOT FIND VARIABLE 'siglay' IN THE FILE OBJECT:"//trim(ncf%FNAME))
       
       CALL nc_connect_pvar(var,g%ZZ)
       CALL nc_read_var(var)
       CALL nc_disconnect(var)
       
       ! zz1
       ALLOCATE(g%ZZ1(0:g%NT,g%KBM1),stat=status)
       IF (status /=0 ) CALL fatal_error("COULD NOT ALLOCATE G%ZZ1 WHILE READING:"//trim(ncf%FNAME))
       g%ZZ1=0.0_sp
       
       var => find_var(ncf,'siglay_center',found)
       IF(.not. found) CALL fatal_error&
            &("COULD NOT FIND VARIABLE 'siglay_center' IN THE FILE OBJECT:"//trim(ncf%FNAME))
       
       CALL nc_connect_pvar(var,g%ZZ1)
       CALL nc_read_var(var)
       CALL nc_disconnect(var)
       
    END IF
       
       
    

load_horizontal_mixing_coefficient()

subroutine mod_input::load_horizontal_mixing_coefficient	(	real(sp), dimension(:), allocatable	NN,
		real(sp), dimension(:), allocatable	CC
	)

Definition at line 1690 of file mod_input.f90.

    USE control
    IMPLICIT NONE
    REAL(SP),ALLOCATABLE :: NN(:),CC(:)
    TYPE(NCFILE), POINTER :: NCF
    TYPE(NCVAR),  POINTER :: VAR
    TYPE(NCDIM),  POINTER :: DIM1
    TYPE(NCDIM),  POINTER :: DIM2
    integer status,I,IERR
    
    LOGICAL FOUND

    ! FIND THE HVC FILE OBJECT
    ncf => find_file(filehead,trim(horizontal_mixing_file),found)
    IF(.not. found) CALL fatal_error &
         & ("COULD NOT FIND HORIZONTAL_MIXING_FILE FILE OBJECT",&
         & "FILE NAME: "//trim(horizontal_mixing_file))

    dim1 => find_dim(ncf,'nele',found)
    IF(.not. found) CALL fatal_error &
         & ("COULD NOT FIND HORIZONTAL_MIXING_FILE DIMENSION 'nele' in:",&
         & "FILE NAME: "//trim(horizontal_mixing_file))
    IF (dim1%DIM /= ngl)CALL fatal_error &
         & ("Dimension 'nele' in the HORIZONTAL_MIXING_FILE does not match NGL for this model?",&
         & "FILE NAME: "//trim(horizontal_mixing_file)) 

    dim2 => find_dim(ncf,'node',found)
    IF(.not. found) CALL fatal_error &
         & ("COULD NOT FIND HORIZONTAL_MIXING_FILE DIMENSION 'node' in:",&
         & "FILE NAME: "//trim(horizontal_mixing_file))
    IF (dim2%DIM /= mgl)CALL fatal_error &
         & ("Dimension 'node' in the HORIZONTAL_MIXING_FILE does not match MGL for this model?",&
         & "FILE NAME: "//trim(horizontal_mixing_file)) 

    ! FIND THE 'nn_hvc' variable
    var => find_var(ncf,'nn_hvc',found)
    IF(.not. found) CALL fatal_error &
         & ("COULD NOT FIND HORIZONTAL_MIXING_FILE VARIABLE 'nn_hvc' in:",&
         & "FILE NAME: "//trim(horizontal_mixing_file))

    CALL nc_connect_avar(var,nn)
    CALL nc_read_var(var)
    CALL nc_disconnect(var)

    ! FIND THE 'cc_hvc' variable
    var => find_var(ncf,'cc_hvc',found)
    IF(.not. found) CALL fatal_error &
         & ("COULD NOT FIND HORIZONTAL_MIXING_FILE VARIABLE 'cc_hvc' in:",&
         & "FILE NAME: "//trim(horizontal_mixing_file))

    CALL nc_connect_avar(var,cc)
    CALL nc_read_var(var)
    CALL nc_disconnect(var)

Here is the caller graph for this function:

load_julian_obc()

subroutine mod_input::load_julian_obc	(	integer, intent(out)	NTC,
		character(len=*), dimension(:), allocatable	NAMES,
		real(sp), dimension(:), intent(out), allocatable	PRD,
		real(sp), dimension(:), intent(out), allocatable	EQ_AMP,
		real(sp), dimension(:), intent(out), allocatable	EQ_BETA,
		character(len=*), dimension(:), allocatable	EQ_TYPE,
		real(sp), dimension(:,:), intent(out), allocatable	MPTD,
		real(sp), dimension(:,:), intent(out), allocatable	PHS,
		real(sp), dimension(:), intent(out), allocatable	RF,
		type(time), intent(out)	TORG
	)

Definition at line 2580 of file mod_input.f90.

    USE control
    USE bcs
    IMPLICIT NONE
    INTEGER,INTENT(OUT) :: NTC  ! Number of Tidal Components
    REAL(SP),INTENT(OUT), ALLOCATABLE :: PRD(:) ! Tidal Period
    REAL(SP),INTENT(OUT), ALLOCATABLE :: EQ_AMP(:) ! Tidal Period
    REAL(SP),INTENT(OUT), ALLOCATABLE :: EQ_BETA(:) ! Tidal Period
    CHARACTER(LEN=*),ALLOCATABLE :: EQ_TYPE(:)   ! Name of Components

    REAL(SP),INTENT(OUT), ALLOCATABLE :: MPTD(:,:) ! Amplitude
    REAL(SP),INTENT(OUT), ALLOCATABLE :: PHS(:,:)! Phase
    REAL(SP),INTENT(OUT), ALLOCATABLE :: RF(:)   ! Reference Height
    CHARACTER(LEN=*), ALLOCATABLE  :: Names(:)   ! Name of Components
    TYPE(TIME),INTENT(OUT) :: TORG


    REAL(SP), ALLOCATABLE :: MPTD_GL(:,:) ! Amplitude
    REAL(SP), ALLOCATABLE :: PHS_GL(:,:)! Phase
    REAL(SP), ALLOCATABLE :: RF_GL(:)   ! Reference Height

    INTEGER :: CHAR_LEN,IERR, SENDER, STATUS, I

    IF(serial) THEN
       CALL read_julian_obc(julobcunit,ntc,names,prd,eq_amp,eq_beta&
            &,eq_type,mptd,phs,rf,torg)
       CLOSE(julobcunit)
       
       IF(obc_elevation_forcing_on .and. SIZE(rf) /= iobcn_gl) CALL fatal_error&
            &("LOAD_JULIAN_OBC: THE NUMBER OF  OBC NODES DOES NOT MATCH",&
            & "THE NON JULIAN ASCII FORCING FILE")
       
    END IF



    

Here is the call graph for this function:

Here is the caller graph for this function:

load_restart_coords()

subroutine mod_input::load_restart_coords	(	real(sp), dimension(:), allocatable, target	X_LCL,
		real(sp), dimension(:), allocatable, target	Y_LCL
	)

Definition at line 2246 of file mod_input.f90.

    USE control
    IMPLICIT NONE
    REAL(SP), ALLOCATABLE,TARGET :: X_LCL(:),Y_LCL(:)

    TYPE(NCVAR),  POINTER :: VAR
    INTEGER STATUS
    LOGICAL FOUND

    ! NEED LOGIC TO DECIDE WHICH TO LOAD LAT/LON or X/Y
    SELECT CASE(grid_file_units)
    
    CASE('meters')
       ! CONNECT THE VARIABLE OBJECTS AND LOAD THE DATA
       var => find_var(nc_start,'x',found)
       IF(.not. found) CALL fatal_error("COULD NOT FIND VARIABLE 'x'&
            & IN THE HOTSTART FILE OBJECT")
       CALL nc_connect_avar(var, x_lcl)
       CALL nc_read_var(var)
       CALL nc_disconnect(var)
    
       
       var => find_var(nc_start,'y',found)
       IF(.not. found) CALL fatal_error("COULD NOT FIND VARIABLE 'y'&
            & IN THE HOTSTART FILE OBJECT")
       CALL nc_connect_avar(var, y_lcl)
       CALL nc_read_var(var)
       CALL nc_disconnect(var)

    CASE('degrees')
       ! CONNECT THE VARIABLE OBJECTS AND LOAD THE DATA
       var => find_var(nc_start,'lon',found)
       IF(.not. found) CALL fatal_error("COULD NOT FIND VARIABLE 'lon'&
            & IN THE HOTSTART FILE OBJECT")
       CALL nc_connect_avar(var, x_lcl)
       CALL nc_read_var(var)
       CALL nc_disconnect(var)
       
       
       var => find_var(nc_start,'lat',found)
       IF(.not. found) CALL fatal_error("COULD NOT FIND VARIABLE 'lat'&
            & IN THE HOTSTART FILE OBJECT")
       
       CALL nc_connect_avar(var, y_lcl)
       CALL nc_read_var(var)
       CALL nc_disconnect(var)

    CASE DEFAULT
       
       CALL fatal_error("UNKNOWN GRID_FILE_UNITS: "//trim(grid_file_units))
       
    END SELECT
    

Here is the caller graph for this function:

load_restart_coriolis()

subroutine mod_input::load_restart_coriolis

(

real(sp), dimension(:), allocatable, target

C_LCL

)

Definition at line 2318 of file mod_input.f90.

    IMPLICIT NONE
    REAL(SP), ALLOCATABLE, TARGET:: C_LCL(:)
    TYPE(NCVAR),  POINTER :: VAR
    INTEGER STATUS
    LOGICAL FOUND

    var => find_var(nc_start,'cor',found)
    IF(.not. found) CALL fatal_error("COULD NOT FIND VARIABLE 'cor'&
         & IN THE HOTSTART FILE OBJECT")
    CALL nc_connect_avar(var, c_lcl)
    CALL nc_read_var(var)
    CALL nc_disconnect(var)

Here is the caller graph for this function:

load_restart_depth()

subroutine mod_input::load_restart_depth

(

real(sp), dimension(:), allocatable, target

H_LCL

)

Definition at line 2302 of file mod_input.f90.

    IMPLICIT NONE
    REAL(SP), ALLOCATABLE, TARGET:: H_LCL(:)
    TYPE(NCVAR),  POINTER :: VAR
    INTEGER STATUS
    LOGICAL FOUND

    var => find_var(nc_start,'h',found)
    IF(.not. found) CALL fatal_error("COULD NOT FIND VARIABLE 'h'&
         & IN THE HOTSTART FILE OBJECT")
    CALL nc_connect_avar(var, h_lcl)
    CALL nc_read_var(var)
    CALL nc_disconnect(var)

Here is the caller graph for this function:

load_restart_grid()

subroutine mod_input::load_restart_grid

(

integer, dimension(:,:), intent(out), allocatable, target

NVG

)

Definition at line 2052 of file mod_input.f90.

    USE control
    IMPLICIT NONE
    INTEGER, ALLOCATABLE, TARGET, INTENT(OUT) :: NVG(:,:)
    
    TYPE(NCVAR),  POINTER :: VAR
    TYPE(NCDIM),  POINTER :: DIM1
    TYPE(NCDIM),  POINTER :: DIM2
    integer status,I,IERR
    
    LOGICAL FOUND
    
    !==============================================================================|
    
    
    ! FIND THE RESTART FILE OBJECT
    
    
    ! GET GLOBAL DIMENSION!
    dim1 => find_dim(nc_start,"node",found)
    IF(.not. found) CALL fatal_error("COULD NOT FIND DIMENSION NODE&
         & IN THE HOTSTART FILE OBJECT")
    
    mgl = dim1%DIM
    
    dim1 => find_dim(nc_start,"nele",found)
    IF(.not. found) CALL fatal_error("COULD NOT FIND DIMENSION NODE&
         & IN THE HOTSTART FILE OBJECT")
    
    ngl= dim1%DIM
    
    ! CHECK TO MAKE SURE DIMENSION THREE IS THERE
    dim1 => find_dim(nc_start,"three",found)
    IF(.not. found) CALL fatal_error("COULD NOT FIND DIMENSION NODE&
         & IN THE HOTSTART FILE OBJECT")
    
    dim1 => find_dim(nc_start,"siglev",found)
    IF(.not. found) CALL fatal_error("COULD NOT FIND DIMENSION SIGLEV&
         & IN THE HOTSTART FILE OBJECT")
    
    kb = dim1%DIM

    dim1 => find_dim(nc_start,"siglay",found)
    IF(.not. found) CALL fatal_error("COULD NOT FIND DIMENSION SIGLEV&
         & IN THE HOTSTART FILE OBJECT")
    
    kbm1 = dim1%DIM

    kbm2 = kb - 2
    

    ALLOCATE(nvg(0:ngl,4),stat=status)
    IF (status /=0 ) CALL fatal_error("COULD NOT ALLOCATE YG_GRD")
    nvg=0

    var => find_var(nc_start,'nv',found)
    IF(.not. found) CALL fatal_error("COULD NOT FIND VARIABLE 'nv'&
         & IN THE HOTSTART FILE OBJECT")
    ! THIS IS DANGEROUS BUT IT WORKS... IN GENERAL IT IS NOT A GOOD
    ! IDEA TO PASS AROUND NON-CONTIGUOUS MEMORY POINTERS!
    var%ARR_INT => nvg(1:ngl,1:3)

    CALL nc_read_var(var)
    CALL nc_disconnect(var)
    
    nvg(:,4)=nvg(:,1)
    
    if(dbg_set(dbg_log)) then
       WRITE(ipt,*)'!  Finished Reading Grid from HOTSTART'
       WRITE(ipt,*)'!  # OF NODES            :',mgl
       WRITE(ipt,*)'!  # OF CELLS            :',ngl
       WRITE(ipt,*)'!  # OF LEVELS           :',kb
       WRITE(ipt,*)'!'
    end if
    

Here is the caller graph for this function:

load_restart_lsf_grid()

subroutine mod_input::load_restart_lsf_grid	(	integer, intent(out)	N_GL,
		integer, dimension(:), intent(out), allocatable, target	I_GL,
		real(sp), dimension(:), intent(out), allocatable, target	GEO_GL,
		real(sp), dimension(:), intent(out), allocatable, target	WDF_GL
	)

Definition at line 2183 of file mod_input.f90.

   USE control
   IMPLICIT NONE
   INTEGER, INTENT(OUT)  :: N_GL
   INTEGER, INTENT(OUT), Allocatable, TARGET :: I_GL(:)
   REAL(SP), INTENT(OUT), Allocatable, TARGET :: GEO_GL(:),WDF_GL(:)

   TYPE(NCVAR),  POINTER :: VAR
   TYPE(NCDIM),  POINTER :: DIM
   LOGICAL :: FOUND


   IF(.NOT. obc_longshore_flow_on) THEN
      if(dbg_set(dbg_log)) then
         WRITE(ipt,*)'!  OPEN BOUNDARY LONGSHORE FLOW IS OFF  '
         WRITE(ipt,*)'!'
      end if
      RETURN
   END IF

   dim => find_dim(nc_start,"nlsf",found)
    IF(.not. found) CALL fatal_error("COULD NOT FIND DIMENSION 'nlsf'&
         & IN THE HOTSTART FILE OBJECT")

   n_gl=dim%DIM

   ALLOCATE(i_gl(n_gl))
   ALLOCATE(geo_gl(n_gl))
   ALLOCATE(wdf_gl(n_gl))


   var => find_var(nc_start,'lsf_nodes',found)
   IF(.not. found) CALL fatal_error("COULD NOT FIND VARIABLE 'lsf_nodes'&
        & IN THE HOTSTART FILE OBJECT")
   CALL nc_connect_avar(var, i_gl)
   CALL nc_read_var(var)
    CALL nc_disconnect(var)

   var => find_var(nc_start,'wdf',found)
   IF(.not. found) CALL fatal_error("COULD NOT FIND VARIABLE 'wdf'&
        & IN THE HOTSTART FILE OBJECT")
   CALL nc_connect_avar(var, wdf_gl)
   CALL nc_read_var(var)
   CALL nc_disconnect(var)

   var => find_var(nc_start,'geo',found)
   IF(.not. found) CALL fatal_error("COULD NOT FIND VARIABLE 'geo'&
        & IN THE HOTSTART FILE OBJECT")
   CALL nc_connect_avar(var, geo_gl)
   CALL nc_read_var(var)
   CALL nc_disconnect(var)


   if(dbg_set(dbg_log)) then
      WRITE(ipt,*)'!  FINISHED READING LSF GRID FROM HOTSTART:'
      WRITE(ipt,*)'!  LSF NODES  =           :',n_gl
      WRITE(ipt,*)'!'
   end if

Here is the caller graph for this function:

load_restart_obc_grid()

subroutine mod_input::load_restart_obc_grid	(	integer, intent(out)	IOBCN_GL,
		integer, dimension(:), intent(out), allocatable, target	I_OBC_GL,
		integer, dimension(:), intent(out), allocatable, target	TYPE_OBC_GL
	)

Definition at line 2130 of file mod_input.f90.

   USE control
   IMPLICIT NONE
   INTEGER, INTENT(OUT)  :: IOBCN_GL
   INTEGER, INTENT(OUT), Allocatable, TARGET :: I_OBC_GL(:), TYPE_OBC_GL(:)
   TYPE(NCVAR),  POINTER :: VAR
   TYPE(NCDIM),  POINTER :: DIM
   LOGICAL :: FOUND


   IF(.NOT. obc_on) THEN
      if(dbg_set(dbg_log)) then
         WRITE(ipt,*)'!  OBC IS OFF  '
         WRITE(ipt,*)'!'
      end if
      RETURN
   END IF
   
   
   dim => find_dim(nc_start,"nobc",found)
   IF(.not. found) CALL fatal_error("COULD NOT FIND DIMENSION 'nobc'&
         & IN THE HOTSTART FILE OBJECT")

   iobcn_gl=dim%DIM

   if(iobcn_gl==0) return

   ALLOCATE(i_obc_gl(iobcn_gl))
   ALLOCATE(type_obc_gl(iobcn_gl))

   var => find_var(nc_start,'obc_nodes',found)
   IF(.not. found) CALL fatal_error("COULD NOT FIND VARIABLE 'obc_nodes'&
        & IN THE HOTSTART FILE OBJECT")
   CALL nc_connect_avar(var, i_obc_gl)
   CALL nc_read_var(var)
    CALL nc_disconnect(var)

   var => find_var(nc_start,'obc_type',found)
   IF(.not. found) CALL fatal_error("COULD NOT FIND VARIABLE 'obc_type'&
        & IN THE HOTSTART FILE OBJECT")
   CALL nc_connect_avar(var, type_obc_gl)
   CALL nc_read_var(var)
    CALL nc_disconnect(var)

   if(dbg_set(dbg_log)) then
      WRITE(ipt,*)'!  FINISHED READING OBC GRID FROM HOTSTART:'
      WRITE(ipt,*)'!  OBC NODES  =           :',iobcn_gl
      WRITE(ipt,*)'!'
   end if

Here is the caller graph for this function:

load_restart_sigma()

subroutine mod_input::load_restart_sigma	(	real(sp), dimension(:,:), allocatable, target	Z,
		real(sp), dimension(:,:), allocatable, target	Z1
	)

Definition at line 2351 of file mod_input.f90.

    USE all_vars, ONLY : n2e3d
    IMPLICIT NONE
    REAL(SP), ALLOCATABLE, TARGET:: Z(:,:),Z1(:,:)
    TYPE(NCVAR),  POINTER :: VAR
    INTEGER STATUS
    LOGICAL FOUND


    var => find_var(nc_start,'siglev',found)
    IF(.not. found) CALL fatal_error("COULD NOT FIND VARIABLE 'siglev'&
         & IN THE HOTSTART FILE OBJECT")
    CALL nc_connect_avar(var, z)
    CALL nc_read_var(var)
    CALL nc_disconnect(var)

    CALL n2e3d(z,z1)

Here is the call graph for this function:

Here is the caller graph for this function:

load_restart_sponge()

subroutine mod_input::load_restart_sponge

(

real(sp), dimension(:), allocatable, target

SPG

)

Definition at line 2334 of file mod_input.f90.

    IMPLICIT NONE
    REAL(SP), ALLOCATABLE, TARGET:: SPG(:)
    TYPE(NCVAR),  POINTER :: VAR
    INTEGER STATUS
    LOGICAL FOUND


    var => find_var(nc_start,'cc_sponge',found)
    IF(.not. found) CALL fatal_error("COULD NOT FIND VARIABLE 'cc_sponge'&
         & IN THE HOTSTART FILE OBJECT")
    CALL nc_connect_avar(var, spg)
    CALL nc_read_var(var)
    CALL nc_disconnect(var)

Here is the caller graph for this function:

name_list_initialize()

subroutine mod_input::name_list_initialize

(

)

Definition at line 216 of file mod_input.f90.

    USE control

    IMPLICIT NONE

    !--Parameters in NameList NML_CASE
    case_title = "'AN FVCOM CASE DESCRIPTION' - note string must be in 'quotes'"
    timezone = "Select Time Zone or for idealized case select 'none' (start time=0.0)" 
    use_real_world_time=.false.
    date_format="A three letter string specify date format: 'YMD' or 'DMY'"
    date_reference= "Date (specified as a string -- example '2007-11-05 00:00:00') or 'default'"
    start_date= "Date and Time are specified as a string (example '2007-11-05 00:00:00')"
    END_DATE= "For an idealized case specify 'seconds=(flt)','days=(flt)', or 'cycles=(int)'"

    
    startup_type = "'hotstart', 'coldstart', 'forecast' or 'crashrestart'"
    startup_file= trim(casename)//"_restart.nc"
    startup_uv_type = "'default' or 'set values'"
    startup_turb_type = "'default' or 'set values'"
    startup_ts_type = "'constant' 'linear' 'observed' or 'set values'"
    startup_t_vals = -99.0_sp
    startup_s_vals = -99.0_sp
    startup_u_vals = -99.0_sp
    startup_v_vals = -99.0_sp
    startup_dmax = -99.0_sp
    
    !--Parameters in NameList NML_IO
    input_dir = "/Your/relative/path/to/input/files"
    output_dir = "/Your/relative/path/to/output/files :Must already exist!"
    ireport = 0
    visit_all_vars = .false.
    wait_for_visit = .false.
    use_mpi_io_mode = .false.


    !--Parameters in NameList NML_INTEGRATION
    extstep_seconds = 0.0
    isplit = 0
    iramp = 0 
    static_ssh_adj = 0.0
    min_depth = 0.0

    !--Parameters in NameList NML_RESTART
    rst_on            = .false.
    rst_first_out     = 'Date to start RESTART OUTPUT: Format the same as START_DATE'
    rst_out_interval  = "A length of time: 'seconds= ','days= ', or 'cycles= '"
    rst_output_stack  = 0

    !--Parameters in NameList NML_NETCDF
    nc_on = .false.
    nc_first_out = 'Date to start NETCDF OUTPUT: Format the same as START_DATE'
    nc_out_interval = "A length of time: 'seconds= ','days= ', or 'cycles= '"
    nc_output_stack = 0
    nc_subdomain_files= "FVCOM"
    nc_grid_metrics = .false.
    nc_file_date    = .false.   
    nc_velocity     = .false.
    nc_salt_temp    = .false.
    nc_turbulence   = .false.
    nc_average_vel  = .false.
    nc_vertical_vel = .false.
    nc_nh_qp        = .false.
    nc_nh_rhs       = .false.
    nc_wind_vel     = .false.
    nc_wind_stress  = .false.
    nc_wave_para    = .false.  !Jadon
    nc_wave_stress  = .false.  !Jadon
    nc_evap_precip  = .false.
    nc_surface_heat = .false.
    nc_groundwater  = .false.
    nc_vorticity    = .false.
    nc_wqm          = .false.
    nc_bio          = .false.
    
    ! OUTPUT VARIABLES DEFAULT TO OFF

    !--Parameters in NameList NML_NETCDF_AV
    ncav_on = .false.
    ncav_first_out = "Date to start NETCDF interval averaged output: Format the same as START_DATE"
    ncav_out_interval = "A length of time: 'seconds= ','days= ', or 'cycles= '"
    ncav_output_stack = 0
    ncav_subdomain_files= "FVCOM"
    ncav_grid_metrics = .false.
    ncav_file_date    = .false.   
    ncav_velocity     = .false.
    ncav_salt_temp    = .false.
    ncav_turbulence   = .false.
    ncav_average_vel  = .false.
    ncav_vertical_vel = .false.
    ncav_nh_qp        = .false.
    ncav_nh_rhs       = .false.
    ncav_wind_vel     = .false.
    ncav_wind_stress  = .false.
    ncav_wave_para    = .false.  !Jadon
    ncav_wave_stress  = .false.  !Jadon
    ncav_evap_precip  = .false.
    ncav_surface_heat = .false.
    ncav_groundwater  = .false.
    ncav_vorticity    = .false.
    ncav_wqm          = .false.
    ncav_bio          = .false.


    ! OUTPUT VARIABLES DEFAULT TO OFF

    !--Parameters in NameList NML_PHYSICS
    horizontal_mixing_type = "'closure' or 'constant'"
    horizontal_mixing_file = trim(casename)//"_hvc.nc"
    horizontal_mixing_kind = "Options:"//trim(cnstnt)//","//trim(sttc)
    horizontal_mixing_coefficient =-1.0_sp
    horizontal_prandtl_number = -1.0_sp

    vertical_mixing_type = "'closure' or 'constant'"
    vertical_mixing_coefficient = -1.0_sp
    vertical_prandtl_number = -1.0_sp


    bottom_roughness_minimum = -1.0_sp
    bottom_roughness_lengthscale = -1.0_sp
    bottom_roughness_type   = "'"//trim(br_orig)//"', or '"&
         &//trim(br_gotm)//"'; Select your bottom roughness equation (brough.F)"
    bottom_roughness_kind = "Options:"//trim(cnstnt)//","//trim(sttc)
    bottom_roughness_file =trim(casename)//"_brf.nc"
    
    convective_overturning     = .false.  
    scalar_positivity_control  = .false.
    barotropic                 = .false. 

    baroclinic_pressure_gradient = "'sigma levels' or 'z coordinates'; select method of calculation"

    sea_water_density_function = "'"//trim(sw_dens1)//"', '"&
         &//trim(sw_dens2)//"', or '"//trim(sw_dens3)//"; Select your equation of state (eqs_of_state.F)"

    recalculate_rho_mean = .false.
    interval_rho_mean = "A length of time or number of cycles in standard format"

    temperature_active  = .false.          
    salinity_active     = .false.          
    surface_wave_mixing = .false.          
    wetting_drying_on   = .false.
!J. Ge
    ! for tracer advection
    backward_advection = .false.
    backward_step = -1
!J. Ge

    adcor_on = .true.
    equator_beta_plane = .false.
    noflux_bot_condition = .true.

    !--Parameters in NameList NML_SURFACE_FORCING
    wind_on = .false.
    wind_type = "Options::"//trim(speed)//","//trim(stress)
    wind_file = trim(casename)//"_wnd.nc"
    wind_kind = "Options:"//trim(cnstnt)//","//trim(sttc)//","//trim(tmdpndnt)//","//trim(prdc)//","//trim(vrbl)
    wind_x = 0.0_sp
    wind_y = 0.0_sp
    heating_on = .false.
    heating_type = "'body' or 'flux'"
    heating_file = trim(casename)//"_hfx.nc"
    heating_kind = "Options:"//trim(cnstnt)//","//trim(sttc)//","//trim(tmdpndnt)//","//trim(prdc)//","//trim(vrbl)
    heating_radiation = 0.0_sp
    heating_netflux = 0.0_sp
    heating_longwave_perctage = 0.78_sp
    heating_longwave_lengthscale = 1.4_sp
    heating_shortwave_lengthscale= 6.3_sp
    precipitation_on = .false.
    precipitation_file = trim(casename)//"_emp.nc"
    precipitation_kind = "Options:"//trim(cnstnt)//","//trim(sttc)//","//trim(tmdpndnt)//","//trim(prdc)//","//trim(vrbl)
    precipitation_prc = 0.0_sp
    precipitation_evp = 0.0_sp
    airpressure_on    = .false.
    airpressure_kind  = "Options:"//trim(cnstnt)//","//trim(sttc)//","//trim(tmdpndnt)//","//trim(prdc)//","//trim(vrbl)
    airpressure_file  = trim(casename)//"_aip.nc"
    airpressure_value = 0.0_sp
!    Jadon
    wave_on = .false.
    wave_file = trim(casename)//"_wav.nc"
    wave_kind = "Options:"//trim(cnstnt)//","//trim(sttc)//","//trim(tmdpndnt)//","//trim(prdc)//","//trim(vrbl)
    wave_height     = 0.0_sp
    wave_length     = 0.0_sp
    wave_direction  = 0.0_sp 
    wave_period     = 0.0_sp
    wave_per_bot    = 0.0_sp
    wave_ub_bot     = 0.0_sp

    !--Parameters in NameList NML_RIVER_TYPE
    river_number = -1
    river_kind = "Options:"//trim(prdc)//" or "//trim(vrbl)
    river_ts_setting = "'calculated' or 'specified'"
    river_inflow_location = "'node' or 'edge'"
    river_info_file = "'default' or 'filename'"


    !--Parameters in NameList NML_RIVERS
    river_name = "River Name in netcdf data file; use mulitple namelists for multiple rivers!"
    river_file = trim(casename)//"_riv.nc"
    river_grid_location = -1
    river_vertical_distribution = -99

    !--Parameters in NameList NML_OPEN_BOUNDARY
    obc_on = .false.
    obc_node_list_file = trim(casename)//"_obc.dat"
    obc_elevation_forcing_on = .false.
    obc_elevation_file = trim(casename)//"_obc.nc "
    obc_ts_type = -1
    obc_temp_nudging = .false.
    obc_temp_file = trim(casename)//"_obc.nc "
    obc_temp_nudging_timescale = 0.0
    obc_salt_nudging = .false.
    obc_salt_file = trim(casename)//"_obc.nc "
    obc_salt_nudging_timescale = 0.0
    obc_meanflow = .false.
    obc_meanflow_file = trim(casename)//"_obc.nc"
    obc_longshore_flow_on = .false.
    obc_longshore_flow_file = trim(casename)//"_lsf.dat"
    obc_tideout_initial  = 0       !TIME STEPS
    obc_tideout_interval = 0       !TIME STEPS
    obc_depth_control_on = .true.

    !--Parameters in NameList GRID_COORDINATES
    grid_file = trim(casename)//"_grd.dat"
    grid_file_units = "Can be 'degrees' or 'meters'; certain make options required"
    projection_reference = "none: A recognized reference coordinate for proj&
         &tion for PROJ4"
    sigma_levels_file = trim(casename)//"_sigma.dat"
    coriolis_file = trim(casename)//"_cor.dat"
    depth_file = trim(casename)//"_dep.dat"
    sponge_file = trim(casename)//"_spg.dat"


    !--Parameters in NameList NML_GROUNDWATER
    groundwater_on = .false.
    groundwater_salt_on = .false.
    groundwater_temp_on = .false.
    groundwater_kind ="Options:"//trim(cnstnt)//","//trim(sttc)&
         &//","//trim(tmdpndnt)//","//trim(prdc)//","//trim(vrbl)
    groundwater_file = trim(casename)//"_grndwtr.nc"
    groundwater_flow = 0.0
    groundwater_temp = 0.0
    groundwater_salt = 0.0

    !--Parameters in NameList NML_LAG_PART
    lag_particles_on = .false.
    lag_start_file   = "init_lag.nc"
    lag_out_file     = "lag_out.nc"
    lag_first_out    = "A Date or time"
    lag_restart_file = "lag_restart.nc"
    lag_out_interval = "A length of time: 'seconds= ','days= ', or 'cycles= '"
    lag_scal_choice  = "none"


    !--Parameters in NameList NML_ADDITIONAL_MODELS
!    WATER_QUALITY_MODEL = .FALSE.
!    WATER_QUALITY_MODEL_FILE = "DO NOT ADD UNTILL FVCOM IS RUNNING BY ITS SELF FIRST"
    data_assimilation  = .false.
    data_assimilation_file = "./"//trim(casename)//"_run.nml"
    biological_model= .false.
!--------- J. Ge for biology --------------
    biological_model_file = "DO NOT ADD UNTILL FVCOM IS RUNNING BY ITS SELF FIRST"
!------------------------------------------
    startup_bio_type = "'observed' use this option only now"   ! constant, linear, observed, set values
    sediment_model= .false.
    sediment_model_file = "DO NOT ADD UNTILL FVCOM IS RUNNING BY ITS SELF FIRST"
    sediment_parameter_type = "DO NOT ADD UNTILL FVCOM IS RUNNING BY ITS SELF FIRST"
    sediment_parameter_file = "DO NOT ADD UNTILL FVCOM IS RUNNING BY ITS SELF FIRST"
    bedflag_type = "DO NOT ADD UNTIL FVCOM IS RUNNING BY ITS SELF FIRST"
    bedflag_file = "DO NOT ADD UNTILL FVCOM IS RUNNING BY ITS SELF FIRST"
    ice_model= .false.
    ice_forcing_file = "DO NOT ADD UNTILL FVCOM IS RUNNING BY ITS SELF FIRST"
    ice_forcing_kind ="Options:"//trim(cnstnt)//","//trim(sttc)&
         &//","//trim(tmdpndnt)//","//trim(prdc)//","//trim(vrbl)
    ice_sea_level_pressure = 0.0
    ice_air_temp           = 0.0
    ice_spec_humidity      = 0.0
    ice_cloud_cover        = 0.0
    ice_shortwave          = 0.0
    ice_longwave_type      = "'PW' or 'RM'" !PW -- longwave as in Parkinson and Washington (1979)
                                            !RM -- longwave, Rosati and Miyakoda, JPO 18, p. 1607 (1988)

    icing_model= .false.
    icing_forcing_file = "DO NOT ADD UNTILL FVCOM IS RUNNING BY ITS SELF FIRST"
    icing_forcing_kind ="Options:"//trim(cnstnt)//","//trim(sttc)&
         &//","//trim(tmdpndnt)//","//trim(prdc)//","//trim(vrbl)
    icing_air_temp = 0.0
    icing_wspd    = 0.0

    probes_on = .false.
    probes_number =0
    probes_file = "Probe namelist file name"

    high_latitude_wave = .false.

Here is the caller graph for this function:

name_list_print()

subroutine mod_input::name_list_print

(

)

Definition at line 512 of file mod_input.f90.

    USE control

    IMPLICIT NONE


    ! MODIFY THIS ROUTINE TO PRINT EACH NAME LIST TO A CHARCTER STRING:
    !  PARSE AND FORMAT THE STRING TO MAKE IT LOOK 'PRETTY'!

    write(unit=ipt,nml=nml_case)
    write(unit=ipt,nml=nml_startup)
    write(unit=ipt,nml=nml_io)
    write(unit=ipt,nml=nml_integration)
    write(unit=ipt,nml=nml_restart)
    write(unit=ipt,nml=nml_netcdf)
    write(unit=ipt,nml=nml_netcdf_av)
    write(unit=ipt,nml=nml_surface_forcing)
    write(unit=ipt,nml=nml_physics)
    write(unit=ipt,nml=nml_river_type)
    write(unit=ipt,nml=nml_river)
    write(unit=ipt,nml=nml_open_boundary_control)
    write(unit=ipt,nml=nml_grid_coordinates)
    write(unit=ipt,nml=nml_groundwater)
    write(unit=ipt,nml=nml_lag)
    write(unit=ipt,nml=nml_additional_models)
    write(unit=ipt,nml=nml_probes)
    write(unit=ipt,nml=nml_boundschk)  !bounds checking

  RETURN

Here is the caller graph for this function:

name_list_read()

subroutine mod_input::name_list_read

(

)

Definition at line 544 of file mod_input.f90.

     USE control
    IMPLICIT NONE
    integer :: ios, i
    Character(Len=120):: FNAME
    character(len=160) :: pathnfile
    if(dbg_set(dbg_sbr)) &
         & write(ipt,*) "Subroutine Begins: Read_Name_List;"

    ios = 0

    fname = "./"//trim(casename)//"_run.nml"

    if(dbg_set(dbg_io)) &
         & write(ipt,*) "Read_Name_List: File: ",trim(fname)

    CALL fopen(nmlunit,trim(fname),'cfr')

    !READ NAME LIST FILE

    ! Read IO Information
    READ(unit=nmlunit, nml=nml_io,iostat=ios)
    if(ios .NE. 0 ) Then
       if(dbg_set(dbg_log)) write(unit=ipt,nml=nml_io)
       Call fatal_error("Can Not Read NameList NML_IO from file: "//trim(fname))
    end if
    CALL check_io_dirs

    rewind(nmlunit)

    if(dbg_set(dbg_scl)) &
         & write(ipt,*) "Read_Name_List:"

    if(dbg_set(dbg_scl)) &
         & write(unit=ipt,nml=nml_io)

    ! Read Case Information
    READ(unit=nmlunit, nml=nml_case,iostat=ios)
    if(ios .NE. 0 ) THEN
       if(dbg_set(dbg_log)) write(unit=ipt,nml=nml_case)
       CALL fatal_error("Can Not Read NameList NML_CASE from file: "//trim(fname))
    end if

    rewind(nmlunit)

    if(dbg_set(dbg_scl)) &
         & write(ipt,*) "Read_Name_List:"

    if(dbg_set(dbg_scl)) &
         & write(unit=ipt,nml=nml_case)

    ! Read STARTUP TYPE INFORMATION
    READ(unit=nmlunit, nml=nml_startup,iostat=ios)
    if(ios .NE. 0 ) Then
       if(dbg_set(dbg_log)) write(unit=ipt,nml=nml_startup)
       Call fatal_error("Can Not Read NameList NML_STARTUP from file: "//trim(fname))
    end if

    rewind(nmlunit)

    if(dbg_set(dbg_scl)) &
         & write(ipt,*) "Read_Name_List:"

    if(dbg_set(dbg_scl)) &
         & write(unit=ipt,nml=nml_startup)

    ! Read Integration Settings
    READ(unit=nmlunit, nml=nml_integration,iostat=ios)
    if(ios .NE. 0 ) Then
       if(dbg_set(dbg_log)) write(unit=ipt,nml=nml_integration)
       Call fatal_error("Can Not Read NameList NML_INTEGRATION from file: "//trim(fname))
    end if

    rewind(nmlunit)

    if(dbg_set(dbg_scl)) &
         & write(ipt,*) "Read_Name_List:"

    if(dbg_set(dbg_scl)) &
         & write(unit=ipt,nml=nml_integration)

    ! Read Netcdf Output Settings
    READ(unit=nmlunit, nml=nml_restart,iostat=ios)
    if(ios .NE. 0 ) then
       if(dbg_set(dbg_log)) write(unit=ipt,nml=nml_restart)
       Call fatal_error("Can Not Read NameList NML_RESTART from file: "//trim(fname))
    end if

    rewind(nmlunit)

    if(dbg_set(dbg_scl)) &
         & write(ipt,*) "Read_Name_List:"

    if(dbg_set(dbg_scl)) &
         & write(unit=ipt,nml=nml_restart)

    ! Read Netcdf Output Settings
    READ(unit=nmlunit, nml=nml_netcdf,iostat=ios)
    if(ios .NE. 0 ) then
       if(dbg_set(dbg_log)) write(unit=ipt,nml=nml_netcdf)
       Call fatal_error("Can Not Read NameList NML_NETCDF from file: "//trim(fname))
    end if

    rewind(nmlunit)

    if(dbg_set(dbg_scl)) &
         & write(ipt,*) "Read_Name_List:"

    if(dbg_set(dbg_scl)) &
         & write(unit=ipt,nml=nml_netcdf)

    ! Read Netcdf Average Output Settings
    READ(unit=nmlunit, nml=nml_netcdf_av,iostat=ios)
    if(ios .NE. 0 ) then
       if(dbg_set(dbg_log)) write(unit=ipt,nml=nml_netcdf_av)
       Call fatal_error("Can Not Read NameList NML_NETCDF_AV from file: "//trim(fname))
    end if

    rewind(nmlunit)

    if(dbg_set(dbg_scl)) &
         & write(ipt,*) "Read_Name_List:"

    if(dbg_set(dbg_scl)) &
         & write(unit=ipt,nml=nml_netcdf_av)

    ! Read Model Physics Settings
    READ(unit=nmlunit, nml=nml_physics,iostat=ios)
    if(ios .NE. 0 ) then
       if(dbg_set(dbg_log)) write(unit=ipt,nml=nml_physics)
       Call fatal_error("Can Not Read NameList NML_PHYSICS from file: "//trim(fname))
    end if

    rewind(nmlunit)

    if(dbg_set(dbg_scl)) &
         & write(ipt,*) "Read_Name_List:"

    if(dbg_set(dbg_scl)) &
         & write(unit=ipt,nml=nml_physics)


    ! Read Surface Forcing Settings
    READ(unit=nmlunit, nml=nml_surface_forcing,iostat=ios)
    if(ios .NE. 0 ) then
       if(dbg_set(dbg_log)) write(unit=ipt,nml=nml_surface_forcing)
       Call fatal_error("Can Not Read NameList NML_SURFACE_FORCING from file: "//trim(fname))
    end if

    rewind(nmlunit)

    if(dbg_set(dbg_scl)) &
         & write(ipt,*) "Read_Name_List:"

    if(dbg_set(dbg_scl)) &
         & write(unit=ipt,nml=nml_surface_forcing)


    ! Read River settings
    READ(unit=nmlunit, nml=nml_river_type,iostat=ios)
    if(ios .NE. 0 ) then
       if(dbg_set(dbg_log)) write(unit=ipt,nml=nml_river_type)
       Call fatal_error("Can Not Read NameList NML_RIVER_TYPE from file: "//trim(fname))
    end if

    if(dbg_set(dbg_scl)) &
         & write(ipt,*) "Read_Name_List:"

    if(dbg_set(dbg_scl)) &
         & write(unit=ipt,nml=nml_river_type)

    IF(river_number > 0) THEN
       SELECT CASE (river_info_file(2:8))
       CASE('default')
          rewind(nmlunit)
          rivernmlunit=nmlunit
         !!  'default' use present runfile namelist
       CASE DEFAULT
         !!  use the specified river file information
          rivernmlunit=800
          pathnfile = trim(input_dir)//trim(river_info_file)
          Call fopen(rivernmlunit,trim(pathnfile),'cfr')
       END SELECT

       ALLOCATE(rivers(river_number))

       ! Read River Namelists...
       ios = 0
       i = 0
       DO 
          READ(unit=rivernmlunit, nml=nml_river,iostat=ios)

          if (ios /= 0 ) exit
          i = i +1
          if  (i > river_number) exit ! To prevent sigsev...
    
          rivers(i)%NAME=river_name
          rivers(i)%FILE=river_file
          rivers(i)%LOCATION=river_grid_location
          rivers(i)%DISTRIBUTION=river_vertical_distribution
       END DO

       IF(i .NE. river_number) THEN
          if(dbg_set(dbg_log))  then
             write(ipt,*)"Bad River data in the Name List!"
             write(ipt,*)"Specified number of rivers:",river_number
             write(ipt,*)"But Found",i, "; Valid river name list objects.(Printing Last)"
             write(unit=ipt,nml=nml_river)
          end if
          
          CALL fatal_error('PLEASE REPAIR THE NAME LIST SO IT IS CONSISTANT... see above')
       END IF
       
    ELSE IF (river_number .eq. 0) THEN
       
       READ(unit=nmlunit, nml=nml_river,iostat=ios)
       !THERE SHOULD BE NO RIVER NAME LISTS
       if (ios == 0 ) CALL fatal_error &
            & ('THERE ARE ONE OR MORE RIVER NAME LISTS, BUT RIVER TYPE SPECIFIED ZERO RIVERS?')
       
    ELSE
       if(dbg_set(dbg_log)) write(unit=ipt,nml=nml_river_type)
       CALL fatal_error("YOU CAN'T HAVE A NEGATIVE NUMBER OF RIVERS!")
    END IF


    rewind(nmlunit)


    ! Read Open Boundary Control Settings
    READ(unit=nmlunit, nml=nml_open_boundary_control,iostat=ios)
    if(ios .NE. 0 ) then
       if(dbg_set(dbg_log)) write(unit=ipt,nml=nml_open_boundary_control)
       Call fatal_error("Can Not Read NameList NML_OPEN_BOUNDARY_CONTROL from file: "//trim(fname))
    end if

    rewind(nmlunit)

    if(dbg_set(dbg_scl)) &
         & write(ipt,*) "Read_Name_List:"

    if(dbg_set(dbg_scl)) &
         & write(unit=ipt,nml=nml_open_boundary_control)


    ! Read Grid Coordinates Settings
    READ(unit=nmlunit, nml=nml_grid_coordinates,iostat=ios)
    if(ios .NE. 0 ) then
       if(dbg_set(dbg_log)) write(unit=ipt,nml=nml_grid_coordinates)
       Call fatal_error("Can Not Read NameList NML_GRID_COORDINATES from file: "//trim(fname))
    end if

    rewind(nmlunit)

    if(dbg_set(dbg_scl)) &
         & write(ipt,*) "Read_Name_List:"

    if(dbg_set(dbg_scl)) &
         & write(unit=ipt,nml=nml_grid_coordinates)


    ! Read Groundwater Settings
    READ(unit=nmlunit, nml=nml_groundwater,iostat=ios)
    if(ios .NE. 0 ) then
       if(dbg_set(dbg_log)) write(unit=ipt,nml=nml_groundwater)
       Call fatal_error("Can Not Read NameList NML_GROUNDWATER from file: "//trim(fname))
    end if

    rewind(nmlunit)

    if(dbg_set(dbg_scl)) &
         & write(ipt,*) "Read_Name_List:"

    if(dbg_set(dbg_scl)) &
         & write(unit=ipt,nml=nml_groundwater)

    ! Read LAG
    READ(unit=nmlunit, nml=nml_lag,iostat=ios)
    if(ios .NE. 0 ) then
       if(dbg_set(dbg_log)) write(unit=ipt,nml=nml_lag)
       Call fatal_error("Can Not Read NameList NML_LAG from file: "//trim(fname))
    end if
       
    rewind(nmlunit)

    if(dbg_set(dbg_scl)) &
         & write(ipt,*) "Read_Name_List:"

    if(dbg_set(dbg_scl)) &
         & write(unit=ipt,nml=nml_lag)


    ! Read Additional Models Settings
    READ(unit=nmlunit, nml=nml_additional_models,iostat=ios)
    if(ios .NE. 0 ) then
       if(dbg_set(dbg_log)) write(unit=ipt,nml=nml_additional_models)
       Call fatal_error("Can Not Read NameList NML_ADDITIONAL_MODELS from file: "//trim(fname))
    end if

    rewind(nmlunit)

    if(dbg_set(dbg_scl)) &
         & write(ipt,*) "Read_Name_List:"

    if(dbg_set(dbg_scl)) &
         & write(unit=ipt,nml=nml_additional_models)

    ! Read PROBE Settings
    READ(unit=nmlunit, nml=nml_probes,iostat=ios)
    if(ios .NE. 0 ) then
       if(dbg_set(dbg_log)) write(unit=ipt,nml=nml_probes)
       Call fatal_error("Can Not Read NameList NML_PROBES from file: "//trim(fname))
    end if

    ! Read BOUNDS CHECK (THRESHOLD SHUTDOWN)  Settings
    !=> bounds checking
    READ(unit=nmlunit, nml=nml_boundschk,iostat=ios)
    if(ios .NE. 0 ) then
       if(dbg_set(dbg_log)) write(unit=ipt,nml=nml_boundschk)
       Call fatal_error("Can Not Read NameList NML_BOUNDSCHK from file: "//trim(fname))
    end if
    

    rewind(nmlunit)

    if(dbg_set(dbg_scl)) &
         & write(ipt,*) "Read_Name_List:"

    if(dbg_set(dbg_scl)) &
         & write(unit=ipt,nml=nml_probes)
    

    CLOSE(nmlunit)

! ----- END
    if(dbg_set(dbg_sbr)) &
         & write(ipt,*) "Subroutine Ends: Read_Name_List;"    

Here is the call graph for this function:

Here is the caller graph for this function:

nullify_file_pointers()

subroutine mod_input::nullify_file_pointers

(

)

Definition at line 979 of file mod_input.f90.

    IMPLICIT NONE

    NULLIFY(nc_dat)
    NULLIFY(nc_avg)
    NULLIFY(nc_rst)
    NULLIFY(nc_start)

Here is the caller graph for this function:

open_coldstart()

subroutine mod_input::open_coldstart

(

)

Definition at line 1156 of file mod_input.f90.

    USE control
    IMPLICIT NONE
    TYPE(NCFILE), POINTER :: NCF
    integer :: ncfileind, datfileind,ios,charnum, i
    logical :: fexist,back,connected
    character(len=100) :: testchar
    character(len=160) :: pathnfile
    character(len=2) :: cios

    back = .true.
    
    ! TEST FILE NAME
    IF(obc_on) THEN
       charnum = index(obc_node_list_file,".dat")
       if (charnum /= len_trim(obc_node_list_file)-3)&
            & CALL warning("OBC NODE LIST FILE does not end in .dat", &
            & trim(obc_node_list_file))
       ! OPEN FILE
       pathnfile = trim(input_dir)//trim(obc_node_list_file)
       Call fopen(obcunit,trim(pathnfile),'cfr')

       IF(obc_longshore_flow_on) THEN
          charnum = index(obc_longshore_flow_file,".dat")
          if (charnum /= len_trim(obc_longshore_flow_file)-3)&
               & CALL warning("OBC LONGSHORE FLOW FILE does not end in .dat", &
               & trim(obc_longshore_flow_file))
          ! OPEN FILE
          pathnfile = trim(input_dir)//trim(obc_longshore_flow_file)
          Call fopen(lsfunit,trim(pathnfile),'cfr')
       END IF


    END IF

        
    !Check Sigma File and open:
    ! TEST FILE NAME
    charnum = index(sigma_levels_file,".dat")
    if (charnum /= len_trim(sigma_levels_file)-3)&
         & CALL warning("SIGMA LEVELS FILE does not end in .dat", &
         & trim(sigma_levels_file))
    ! OPEN FILE
    pathnfile = trim(input_dir)//trim(sigma_levels_file)
    Call fopen(sigmaunit,trim(pathnfile),'cfr')
    
    !Check Grid File and open:
    ! TEST FILE NAME
    charnum = index(grid_file,".dat")
    if (charnum /= len_trim(grid_file)-3)&
         & CALL warning("GRID FILE does not end in .dat", &
         & trim(grid_file))
    ! OPEN FILE
    pathnfile = trim(input_dir)//trim(grid_file)
    Call fopen(gridunit,trim(pathnfile),'cfr')
    
    
    !Check Depth File and open:
    ! TEST FILE NAME
    charnum = index(depth_file,".dat")
    if (charnum /= len_trim(depth_file)-3)&
         & CALL warning("DEPTH FILE does not end in .dat", &
         & trim(depth_file))
    ! OPEN FILE
    pathnfile = trim(input_dir)//trim(depth_file)
    Call fopen(depthunit,trim(pathnfile),'cfr')
    
    !Check Sponge File and open:
    ! TEST FILE NAME
    charnum = index(sponge_file,".dat")
    if (charnum /= len_trim(sponge_file)-3)&
         & CALL warning("SPONGE FILE does not end in .dat", &
         & trim(sponge_file))
    ! OPEN FILE
    pathnfile = trim(input_dir)//trim(sponge_file)
    Call fopen(spongeunit,trim(pathnfile),'cfr')
    
    IF (grid_file_units == 'meters') THEN
       !Check Coriolis File and open:
       ! TEST FILE NAME
       charnum = index(coriolis_file,".dat")
       if (charnum /= len_trim(coriolis_file)-3)&
            & CALL warning("CORIOLIS FILE does not end in .dat", &
            & trim(coriolis_file))
       ! OPEN FILE
       pathnfile = trim(input_dir)//trim(coriolis_file)
       Call fopen(coriolisunit,trim(pathnfile),'cfr')
    END IF
    

Here is the caller graph for this function:

open_crashstart()

subroutine mod_input::open_crashstart

(

)

Definition at line 1051 of file mod_input.f90.

    USE control
    IMPLICIT NONE
    TYPE(NCFILE), POINTER :: NCF
    integer :: ncfileind, datfileind,ios,charnum, i
    logical :: fexist,back,connected
    character(len=100) :: testchar
    character(len=160) :: pathnfile
    character(len=160) :: nextpathnfile
    character(len=2) :: cios

    Nullify(ncf)

    IF(rst_on) then
       !RESTART FILE
       restart_file_name = trim(casename)//"_restart_0001.nc"
       pathnfile= trim(output_dir)//trim(restart_file_name)
       
       CALL search_for_last_matching_name(pathnfile)
       
       ! OPEN THE FILE AND LOAD FOR STARTUP
       ncf => new_file()
       ncf%FNAME=trim(pathnfile)
       Call nc_open(ncf)
       CALL nc_load(ncf)
       nc_start => ncf
       
       Nullify(ncf)
       

       ! NOW CREATE ANOTHER FILE OBJECT FOR OUTPUT
       ! INITIALIZE TYPE TO HOLD FILE METADATA
       ncf => new_file()
       ncf%FNAME=trim(pathnfile)
       ncf%writable = .true.
       nc_rst => ncf
       filehead => add(filehead,ncf)
       
    END IF

    IF(nc_on) then
       ! DATA FILE
       nc_file_name = trim(casename)//"_0001.nc"
       pathnfile= trim(output_dir)//trim(nc_file_name)
       
       CALL search_for_last_matching_name(pathnfile)
       ncf => new_file()
       ncf%FNAME=trim(pathnfile)
       ncf%writable = .true.
       nc_dat => ncf
       filehead => add(filehead,ncf)

    END IF
       

    IF(ncav_on) then
       ! DATA FILE
       ncav_file_name = trim(casename)//"_avg_0001.nc"
       pathnfile= trim(output_dir)//trim(ncav_file_name)
       
       CALL search_for_last_matching_name(pathnfile)
       ncf => new_file()
       ncf%FNAME=trim(pathnfile)
       ncf%writable = .true.
       nc_avg => ncf
       filehead => add(filehead,ncf)

    END IF

Here is the call graph for this function:

Here is the caller graph for this function:

open_forcing()

subroutine mod_input::open_forcing

(

)

Definition at line 1312 of file mod_input.f90.

    USE control

    IMPLICIT NONE
    TYPE(NCFILE), POINTER :: NCF
    integer :: ncfileind, datfileind,ios,charnum, i
    logical :: fexist,back,connected
    character(len=100) :: testchar
    character(len=160) :: pathnfile
    character(len=2) :: cios

    character(len=3) :: ftype
    integer :: fid, status

    back = .true.

    ! Check air pressure file and open
    if (airpressure_on .and. airpressure_kind/= cnstnt) then

       ! TEST FILE NAME
       charnum = index(airpressure_file,".nc",back)
       if (charnum /= len_trim(airpressure_file)-2)&
            & CALL warning("AIRPRESSURE FILE does not end in .nc", &
            & trim(airpressure_file))

       ! INITIALIZE TYPE TO HOLD FILE METAData
       pathnfile = trim(input_dir)//trim(airpressure_file)
       CALL nc_init(ncf,pathnfile)

       ! OPEN THE FILE AND LOAD METADATA
       If(.not. ncf%OPEN) then
          Call nc_open(ncf)
          CALL nc_load(ncf)
          filehead => add(filehead,ncf)
       end if

    end if

    ! Check wind stress file and open
    if (wind_on .and. wind_kind /= cnstnt) then
       
       ! TEST FILE NAME
       charnum = index(wind_file,".nc",back)
       if (charnum /= len_trim(wind_file)-2)&
            & CALL warning("WIND FILE does not end in .nc", &
            & trim(wind_file))
       
       ! INITIALIZE TYPE TO HOLD FILE METAData
       pathnfile = trim(input_dir)//trim(wind_file)
       CALL nc_init(ncf,pathnfile)

       ! OPEN THE FILE AND LOAD METADATA       
       If(.not. ncf%OPEN) then
          Call nc_open(ncf)
          CALL nc_load(ncf)
          filehead => add(filehead,ncf)
       end if

    end if

    ! Check Heat file and open
    if (heating_on .and. heating_kind /= cnstnt) then

       ! TEST FILE NAME
       charnum = index(heating_file,".nc",back)
       if (charnum /= len_trim(heating_file)-2)&
            & CALL warning("HEATING FILE does not end in .nc", &
            & trim(heating_file))

       ! INITIALIZE TYPE TO HOLD FILE METADATA
       pathnfile= trim(input_dir)//trim(heating_file)
       CALL  nc_init(ncf,pathnfile)

       ! OPEN THE FILE AND LOAD METADATA
       if(.not. ncf%OPEN) then
          Call nc_open(ncf)
          CALL nc_load(ncf)

          filehead => add(filehead,ncf)
       end if

    end if



    ! Check Precip file and open
    if (precipitation_on .and. precipitation_kind /= cnstnt) then

       ! TEST FILE NAME
       charnum = index(precipitation_file,".nc",back)
       if (charnum /= len_trim(precipitation_file)-2)&
            & CALL warning("PRECIPITATION FILE does not end in .nc", &
            & trim(precipitation_file))
       
       ! INITIALIZE TYPE TO HOLD FILE METADATA
       pathnfile= trim(input_dir)//trim(precipitation_file)
       CALL  nc_init(ncf,pathnfile)
       
       ! OPEN THE FILE AND LOAD METADATA
       if(.not. ncf%OPEN) then
          Call nc_open(ncf)
          CALL nc_load(ncf)
           filehead => add(filehead,ncf)
        end if
    end if

    ! Check Wave file and open
    if (wave_on .and. wave_kind /= cnstnt) then

       ! TEST FILE NAME
       charnum = index(wave_file,".nc",back)
       if (charnum /= len_trim(wave_file)-2)&
            & CALL warning("WAVE FILE does not end in .nc", &
            & trim(wave_file))
       
       ! INITIALIZE TYPE TO HOLD FILE METADATA
       pathnfile= trim(input_dir)//trim(wave_file)
       CALL  nc_init(ncf,pathnfile)
       
       ! OPEN THE FILE AND LOAD METADATA
       if(.not. ncf%OPEN) then
          Call nc_open(ncf)
          CALL nc_load(ncf)
           filehead => add(filehead,ncf)
        end if
    end if




    !Check RIVER files and open
    
    do i =1, river_number

       ! TEST FILE NAME
       charnum = index(rivers(i)%FILE,".nc",back)
       if (charnum /= len_trim(rivers(i)%FILE)-2)&
            & CALL warning("RIVER FILE does not end in .nc", &
            & trim(rivers(i)%FILE))
       
       ! INITIALIZE TYPE TO HOLD FILE METADATA
       pathnfile= trim(input_dir)//trim(rivers(i)%FILE)
       CALL  nc_init(ncf,pathnfile)
       
       ! OPEN THE FILE AND LOAD METADATA IF NOT ALREADY DONE
       if(.not. ncf%OPEN) then
          Call nc_open(ncf)
          CALL nc_load(ncf)
          filehead => add(filehead,ncf)
       end if

    end do

    
    !Check OBC files and open:

    if (obc_on) then

       IF(obc_elevation_forcing_on) THEN

          ! Determine file type:
          pathnfile= trim(input_dir)//trim(obc_elevation_file)
          

          ! TRY opening file as a netcdf file
          IF(dbg_set(dbg_log))write(ipt,*) "! Trying to open Boundary Forcing file: "//trim(obc_elevation_file)
          
          status = nf90_open(trim(pathnfile), nf90_nowrite, fid)
          if(status == nf90_noerr) then
             status = nf90_close(fid)

             IF(dbg_set(dbg_log))write(ipt,*) "! Open Boundary Forcing file is a NETCDF FILE"

             ! INITIALIZE TYPE TO HOLD FILE METADATA
             CALL  nc_init(ncf,pathnfile)
             
             ! OPEN THE FILE AND LOAD METADATA
             if(.not. ncf%OPEN) then
                Call nc_open(ncf)
                CALL nc_load(ncf)
                filehead => add(filehead,ncf)
             end if
          else

             IF(dbg_set(dbg_log)) write(ipt,*) "! Open Boundary Forcing file is not a NETCDF file"
             IF(msr) THEN
                
                Call fopen(julobcunit,trim(pathnfile),'cfr')

                write(ipt,*) "! Open Boundary Forcing file is an ASCII file"
             END IF

             ! INITIALIZE DUMMY FILE TYPE FOR ASCII FILE
             ncf => new_file(pathnfile)
             ncf => add(ncf,nc_make_att("type","ASCII FILE DUMMY ATTRIBUTE"))
             filehead => add(filehead,ncf)
             
          end if
          
       END IF
      
      
      if (obc_temp_nudging) then
         
         ! TEST FILE NAME
         charnum = index(obc_temp_file,".nc",back)
         if (charnum /= len_trim(obc_temp_file)-2)&
              & CALL warning("OBC TEMP FILE does not end in .nc", &
              & trim(obc_temp_file))
         
         ! INITIALIZE TYPE TO HOLD FILE METADATA
         pathnfile= trim(input_dir)//trim(obc_temp_file)
         CALL  nc_init(ncf,pathnfile)
         
         ! OPEN THE FILE AND LOAD METADATA
         if(.not. ncf%OPEN)then 
            Call nc_open(ncf)
            CALL nc_load(ncf)
            filehead => add(filehead,ncf)
         end if
      end if
      
      if (obc_salt_nudging) then
         
         ! TEST FILE NAME
         charnum = index(obc_salt_file,".nc",back)
         if (charnum /= len_trim(obc_salt_file)-2)&
              & CALL warning("OBC SALT FILE does not end in .nc", &
              & trim(obc_salt_file))
         
         ! INITIALIZE TYPE TO HOLD FILE METADATA
         pathnfile= trim(input_dir)//trim(obc_salt_file)
         CALL  nc_init(ncf,pathnfile)
         
         ! OPEN THE FILE AND LOAD METADATA
         if(.not. ncf%OPEN) then
            Call nc_open(ncf)
            CALL nc_load(ncf)
            filehead => add(filehead,ncf)
         end if
      end if
      
      if (obc_meanflow) then
         
         ! TEST FILE NAME
         charnum = index(obc_meanflow_file,".nc",back)
         if (charnum /= len_trim(obc_meanflow_file)-2)&
              & CALL warning("OBC MEANFLOW FILE does not end in .nc", &
              & trim(obc_meanflow_file))
         
         ! INITIALIZE TYPE TO HOLD FILE METADATA
         pathnfile= trim(input_dir)//trim(obc_meanflow_file)
         CALL  nc_init(ncf,pathnfile)
         
         ! OPEN THE FILE AND LOAD METADATA
         if(.not. ncf%OPEN) then
            Call nc_open(ncf)
            CALL nc_load(ncf)
            filehead => add(filehead,ncf)
         end if
      end if
      
      
   end if
   

    !Check Ground Water File and open:
    if (groundwater_on .and. groundwater_kind /= cnstnt) then

       ! TEST FILE NAME
       charnum = index(groundwater_file,".nc",back)
       if (charnum /= len_trim(groundwater_file)-2)&
            & CALL warning("GROUNDWATER FILE does not end in .nc", &
            & trim(groundwater_file))
       
       ! INITIALIZE TYPE TO HOLD FILE METADATA
       pathnfile= trim(input_dir)//trim(groundwater_file)
       CALL  nc_init(ncf,pathnfile)
       
       ! OPEN THE FILE AND LOAD METADATA
       if(.not. ncf%OPEN) then
          Call nc_open(ncf)
          CALL nc_load(ncf)
          filehead => add(filehead,ncf)
       end if
    end if


    IF (icing_model .and. icing_forcing_kind /= cnstnt) THEN

       ! TEST FILE NAME
       charnum = index(icing_forcing_file,".nc",back)
       if (charnum /= len_trim(icing_forcing_file)-2)&
            & CALL warning("ICING MODEL FILE does not end in .nc", &
            & trim(icing_forcing_file))
       
       ! INITIALIZE TYPE TO HOLD FILE METADATA
       pathnfile= trim(input_dir)//trim(icing_forcing_file)
       CALL  nc_init(ncf,pathnfile)
       
       ! OPEN THE FILE AND LOAD METADATA
       if(.not. ncf%OPEN) then
          Call nc_open(ncf)
          CALL nc_load(ncf)
          filehead => add(filehead,ncf)
       end if

    END IF

    IF (ice_model .and. ice_forcing_kind /= cnstnt) THEN

       ! TEST FILE NAME
       charnum = index(ice_forcing_file,".nc",back)
       if (charnum /= len_trim(ice_forcing_file)-2)&
            & CALL warning("ICE MODEL FILE does not end in .nc", &
            & trim(ice_forcing_file))
       
       ! INITIALIZE TYPE TO HOLD FILE METADATA
       pathnfile= trim(input_dir)//trim(ice_forcing_file)
       CALL  nc_init(ncf,pathnfile)
       
       ! OPEN THE FILE AND LOAD METADATA
       if(.not. ncf%OPEN) then
          Call nc_open(ncf)
          CALL nc_load(ncf)
          filehead => add(filehead,ncf)
       end if
       
    END IF

    ! LOAD HORIZONTAL MIXING FILE
    IF (horizontal_mixing_kind /= cnstnt) THEN

       ! TEST FILE NAME
       charnum = index(horizontal_mixing_file,".nc",back)
       if (charnum /= len_trim(horizontal_mixing_file)-2)&
            & CALL warning("Horizontal Mixing File does not end in .nc", &
            & trim(horizontal_mixing_file))
       
       ! INITIALIZE TYPE TO HOLD FILE METADATA
       pathnfile= trim(input_dir)//trim(horizontal_mixing_file)
       CALL  nc_init(ncf,pathnfile)
       
       ! OPEN THE FILE AND LOAD METADATA
       if(.not. ncf%OPEN) then
          Call nc_open(ncf)
          CALL nc_load(ncf)
          filehead => add(filehead,ncf)
       end if
       
    END IF


    ! LOAD BOTTOM ROUGHNESS LENGTH SCALE
    IF (bottom_roughness_kind /= cnstnt) THEN

       ! TEST FILE NAME
       charnum = index(bottom_roughness_file,".nc",back)
       if (charnum /= len_trim(bottom_roughness_file)-2)&
            & CALL warning("Bottom Roughness File does not end in .nc", &
            & trim(bottom_roughness_file))
       
       ! INITIALIZE TYPE TO HOLD FILE METADATA
       pathnfile= trim(input_dir)//trim(bottom_roughness_file)
       CALL  nc_init(ncf,pathnfile)
       
       ! OPEN THE FILE AND LOAD METADATA
       if(.not. ncf%OPEN) then
          Call nc_open(ncf)
          CALL nc_load(ncf)
          filehead => add(filehead,ncf)
       end if
       
    END IF

Here is the caller graph for this function:

open_new_output()

subroutine mod_input::open_new_output

(

)

Definition at line 1247 of file mod_input.f90.

    USE control
    IMPLICIT NONE
    TYPE(NCFILE), POINTER :: NCF
    integer :: ncfileind, datfileind,ios,charnum, i
    logical :: fexist,back,connected
    character(len=100) :: testchar
    character(len=160) :: pathnfile
    character(len=2) :: cios


    back = .true.
    ! SETUP AND CREATE DATA OUTPUT FILES!
    IF(nc_on) THEN
       nc_file_name = trim(casename)//"_0001.nc"
       pathnfile = trim(output_dir)//trim(nc_file_name)
       CALL nc_init(ncf,pathnfile)
       if(msr) then
          CALL nc_create(ncf)
          CALL nc_close(ncf)
       else
          ncf%writable = .true.
       end if

       nc_dat => ncf

       filehead => add(filehead,ncf)

    END IF
    
    IF(ncav_on) THEN
       ncav_file_name = trim(casename)//"_avg_0001.nc"
       pathnfile = trim(output_dir)//trim(ncav_file_name)
       CALL nc_init(ncf,pathnfile)
       if(msr) then
          CALL nc_create(ncf)
          CALL nc_close(ncf)
       else
          ncf%writable = .true.
       end if

       nc_avg => ncf

       filehead => add(filehead,ncf)
    END IF
    
    
    if(rst_on) then
       restart_file_name = trim(casename)//"_restart_0001.nc"
       pathnfile = trim(output_dir)//trim(restart_file_name)
       CALL nc_init(ncf,pathnfile)
       if(msr) then
          CALL nc_create(ncf)
          CALL nc_close(ncf)
       else
          ncf%writable = .true.
       end if

       nc_rst => ncf

       filehead => add(filehead,ncf)
    end if

Here is the caller graph for this function:

open_startup_file()

subroutine mod_input::open_startup_file

(

)

Definition at line 1019 of file mod_input.f90.

    USE control
    IMPLICIT NONE
    TYPE(NCFILE), POINTER :: NCF
    integer :: ncfileind, datfileind,ios,charnum, i
    logical :: fexist,back,connected
    character(len=100) :: testchar
    character(len=160) :: pathnfile
    character(len=2) :: cios
    ! CHECK FOR INPUT AND OUTPUT DIRECTORIES

    back = .true.
    
    ! TEST FILE NAME
    charnum = index(startup_file,".nc",back)
    if (charnum /= len_trim(startup_file)-2)&
         & CALL warning("STARUP FILE NAME does not end in .nc", &
         & trim(startup_file))
    
    ! INITIALIZE TYPE TO HOLD FILE METADATA
    pathnfile= trim(input_dir)//trim(startup_file)

    ncf => new_file()
    ncf%FNAME=trim(pathnfile)

    Call nc_open(ncf)
    CALL nc_load(ncf)
       
    nc_start => ncf
    

Here is the caller graph for this function:

parse_tide()

subroutine mod_input::parse_tide	(	character(len=*)	line,
		integer	cnt,
		integer	ntc,
		real(sp), dimension(:,:), allocatable	data,
		integer	ierr
	)

Definition at line 2922 of file mod_input.f90.

    implicit none
    
    CHARACTER(LEN=*) :: line
    Integer :: cnt, ntc, ierr
    Real(sp), allocatable :: data(:,:) 
    
    CHARACTER(LEN=20), allocatable :: item(:) !Automatically deallocate on exit!
    CHARACTER(LEN=80) :: TEST
    INTEGER :: I, VAL, J
    LOGICAL :: ISFLOAT

    ! If the string is empty
    ierr = -1
    IF(len_trim(line)<=1) return

    CALL split_string(line," ",item)

    val = read_int(item(1),ierr)
    IF(ierr /= 0) RETURN
       

    cnt = cnt + 1

    IF(cnt >SIZE(DATA,1)) CALL fatal_error&
         &("THERE IS A MISTAKE IN THE NON JULIAN TIDAL FORCING INPUT FILE",&
         & "THERE ARE MORE BOUNDARY POINTS LISTED THAN THE STATED NUMBER?",&
         & "Line :"//trim(line))

    IF(val /= cnt) CALL fatal_error&
         &("THERE IS A MISTAKE IN THE NON JULIAN TIDAL FORCING INPUT FILE",&
         & "THE LIST OF BOUNDARY POINTS IS OUT OF ORDER OR CAN NOT BE READ?",&
         & "Line :"//trim(line))


    ! NOW READ THE DATA
    DO j = 1, ntc

       IF(j+1 > SIZE(item)) CALL fatal_error&
            &("INVALID LINE IN NON JULIAN TIDAL FORCING FILE",&
            & "Incorrect number of tidal compontents",&
            & "Line: "//trim(line))

       DATA(cnt,j) = read_float(item(j+1),ierr)
       if(ierr/=0)CALL fatal_error&
            &("INVALID DATA IN ASCII NON_JULIAN FORCING FILE",&
            & "Non Floating Point Value: '"//item(j+1)//"' ; in li&
            &ne: "//trim(line))

    END DO
    
    
    ! SUCCESS
    ierr = 0
    

Here is the caller graph for this function:

read_coldstart_coords()

subroutine mod_input::read_coldstart_coords	(	integer, intent(in)	GRIDUNIT,
		integer, intent(in)	MGL,
		real(sp), dimension(:), allocatable	XG2,
		real(sp), dimension(:), allocatable	YG2
	)

Definition at line 3284 of file mod_input.f90.

!    USE ALL_VARS   !Jadon Ge
    IMPLICIT NONE
    INTEGER, INTENT(IN)    :: MGL
    INTEGER, INTENT(IN)    :: GRIDUNIT
    REAL(SP), ALLOCATABLE  :: XG2(:),YG2(:)
    CHARACTER(LEN=80)      :: temp
    INTEGER                :: I,LM1,J,IOS,LMAX,CellCount,NodeCount
    INTEGER                :: N1, N2, N3, ISCAN
    real(SP)               :: X1, Y1
    !==============================================================================|
    
    ! DO NOT REWIND - SAVED LOCATION FROM READING CONNECTIVITY
    i =0
    DO WHILE (.true.)
       
       READ(gridunit,*,iostat=ios)j,x1,y1
       IF(ios<0) exit
       
       i = i + 1
       IF(i > mgl) THEN
          write(ipt,*) "Read ", i, "; lines of coordiante data with out reaching EOF?"
          CALL fatal_error('Number of rows of data in the grid file coordinates exceeds the stated number of nodes ?')
       END IF

       
       xg2(i) = x1
       yg2(i) = y1
    END DO
    
    if( i .NE. mgl) THEN
       write(ipt,*) "Read, ", i, "rows of data but mgl= ",mgl 
       CALL fatal_error('Number of rows of data in the grid file coordinates does not equal the stated number of nodes ?')
    END if

      if(dbg_set(dbg_log)) then
      WRITE(ipt,*)'!  Finished Reading coordinates from Grid File'
      WRITE(ipt,*)'!  Max/Min(X)  =          :',maxval(xg2(1:mgl)),minval(xg2(1:mgl))
      WRITE(ipt,*)'!  Max/Min(Y)  =          :',maxval(yg2(1:mgl)),minval(yg2(1:mgl))
      WRITE(ipt,*)'!'
   end if
    

Here is the caller graph for this function:

read_coldstart_coriolis()

subroutine mod_input::read_coldstart_coriolis	(	integer, intent(in)	CORIOLISUNIT,
		integer, intent(in)	MGL,
		real(sp), dimension(:), intent(in), allocatable	XG,
		real(sp), dimension(:), intent(in), allocatable	YG,
		real(sp), dimension(:), allocatable	CORG
	)

Definition at line 3437 of file mod_input.f90.

    IMPLICIT NONE
    INTEGER, INTENT(IN)  :: CORIOLISUNIT, MGL
    REAL(SP),ALLOCATABLE,INTENT(IN) :: XG(:),YG(:)
    REAL(SP),ALLOCATABLE ::CORG(:)
    CHARACTER(LEN=80)    :: INPLINE,temp,xchr,ychr
    INTEGER              :: I,J,IOS,NodeCount,ISCAN
    Real(sp)             :: X1, Y1, C1,DiffxMax,DiffyMax
    logical              :: test
    !==============================================================================|
    test=.false.  
    diffxmax=0.0_sp
    diffymax=0.0_sp
    !
    !----------------Determine Number of Nodes -------------------------------!
    
    iscan = scan_file(coriolisunit,"Node Number",iscal = nodecount)
    IF(iscan /= 0) then
       write(temp,'(I2)') iscan
       call fatal_error('Improper formatting of CORIOLIS FILE: ISCAN ERROR&
            &# '//trim(temp),&
            & 'The header must contain: "Node Number = "', &
            & 'Followed by an integer number of nodes')
    END IF

    if ( nodecount .NE. mgl) &
         & CALL fatal_error('The stated number of nodes in the coriolis file',&
         ' does not match the number in the gird file')

!----------------Read Depth Array----------------------------------!
!

    ! FIND FIRST LINE of CORIOLIS DATA
    rewind coriolisunit
    DO WHILE(.true.)
       READ(coriolisunit,*,iostat=ios,end=99)x1,y1,c1
       if (ios == 0) then
          backspace coriolisunit
          exit
       end if

       cycle
99 Call fatal_error('Improper formatting of CORIOLIS FILE:',&
           &'Reached end of file with out finding CORIOLIS data?',&
           &'FORMAT: X Y COR (ALL REALS)')
    END DO

    ! READ IN CORIOLIS DATA

    i = 0
    DO WHILE(.true.)

       READ(coriolisunit,*,iostat=ios) x1,y1,c1
       IF(ios < 0) exit
       
       i = i + 1
       IF(i > mgl) CALL fatal_error('Number of rows of data in the Coriolis file &
            &exceeds the number of nodes ?')


       ! THIS SHOULD SCREEN OUT MOST ROUNDOFF ERRORS
       IF (xg(i) .NE. x1 .or. yg(i) .NE. y1) then

          test=.true.
          diffxmax=max(diffxmax,abs(xg(i)-x1))
          diffymax=max(diffymax,abs(yg(i)-y1))

!!$  UNCOMMNET FOR STRICT MATCHING 
!!$             write(temp,'(I8)') I
!!$             Call FATAL_ERROR('Grid Coordinates do not match between the&
!!$                  & grid file and the coriolis file','The bad value occurs&
!!$                  & at Node Number: '//trim(temp))


       END IF

       corg(i)=c1
    END DO

    WRITE(xchr,*)diffxmax
    WRITE(ychr,*)diffymax
    IF(test) CALL warning("THE GRID FILE AND CORIOLIS FILE COORDINATES DO NOT MATCH EXACTLY",&
         & "LARGEST DIFFERENCE IN X-COORDINATE:"//trim(xchr),&
         & "LARGEST DIFFERENCE IN Y-COORDINATE:"//trim(ychr),&
         & "See mod_input.F::READ_COLDSTART_CORIOLIS for details")

    if ( i .NE. mgl) &
         & CALL fatal_error('The number of rows of data in the coriolis file does&
         & not equal the number of nodes?')

   if(dbg_set(dbg_log)) then
      WRITE(ipt,*)'!  Finished Reading Coriolis File'
      WRITE(ipt,*)'!  Max Coriolis =           :',maxval(corg(1:mgl))
      WRITE(ipt,*)'!  Min Coriolis =           :',minval(corg(1:mgl))
      WRITE(ipt,*)'!'
   end if

    

Here is the caller graph for this function:

read_coldstart_depth()

subroutine mod_input::read_coldstart_depth	(	integer, intent(in)	DEPTHUNIT,
		integer, intent(in)	MGL,
		real(sp), dimension(:), intent(in), allocatable	XG2,
		real(sp), dimension(:), intent(in), allocatable	YG2,
		real(sp), dimension(:), allocatable	HG2
	)

Definition at line 3329 of file mod_input.f90.

!    USE ALL_VARS !Jadon Ge
    IMPLICIT NONE
    INTEGER, INTENT(IN)  :: DEPTHUNIT, MGL
    REAL(SP),ALLOCATABLE,INTENT(IN) :: XG2(:),YG2(:)
    REAL(SP),ALLOCATABLE ::HG2(:)
    CHARACTER(LEN=80)    :: temp,XCHR,YCHR
    INTEGER              :: I,J,IOS,NodeCount, ISCAN
    Real(sp)             :: X1, Y1, HDEP,DiffxMax,DiffyMax
    logical              :: back, test
    !==============================================================================|
    test=.false.
    diffxmax=0.0_sp
    diffymax=0.0_sp
    !
    !----------------Determine Number of Nodes -------------------------------!
    
    iscan = scan_file(depthunit,"Node Number",iscal = nodecount)
    IF(iscan /= 0) then
       write(temp,'(I2)') iscan
       call fatal_error('Improper formatting of DEPTH FILE: ISCAN ERROR&
            &# '//trim(temp),&
            & 'The header must contain: "Node Number ="', &
            & 'Followed by an integer number of nodes')
    END IF

    if ( nodecount .NE. mgl) &
         & CALL fatal_error('The stated number of nodes in the depth file',&
         ' does not match the number in the grid file')



!----------------Read Depth Array----------------------------------!
!

   ! FIND FIRST LINE of CONNECTIVITY ARRAY
    rewind depthunit
    DO WHILE(.true.)
       READ(depthunit,*,iostat=ios,end=99)x1,y1,hdep
       if (ios == 0) then
          backspace depthunit
          exit
       end if

       cycle
       
99 Call fatal_error('Improper formatting of DEPTH FILE:',&
           &'Reached end of file with out finding DEPTH data?',&
           &'FORMAT: X Y H (ALL REALS)')
          
    END DO

    i = 0
    DO WHILE(.true.)

       READ(depthunit,*,iostat=ios) x1,y1,hdep
       IF(ios < 0) exit
       
       i = i + 1
       IF(i > mgl) CALL fatal_error('Number of rows of data in the depth file &
            &exceeds the number of nodes ?')


       ! THIS SHOULD SCREEN OUT MOST ROUNDOFF ERRORS
       IF (xg2(i) .NE. x1 .or. yg2(i) .NE. y1) then
          test = .true.
          
          diffxmax=max(diffxmax,abs(xg2(i)-x1))
          diffymax=max(diffymax,abs(yg2(i)-y1))
          
!!$  UNCOMMNET FOR STRICT MATCHING
!!$             write(temp,'(I8)') I
!!$             Call FATAL_ERROR('Grid Coordinates do not match between the&
!!$                  & grid file and the depth file','The bad value occurs&
!!$                  & at Node Number: '//trim(temp))

       END IF

       hg2(i)=hdep
    END DO

    WRITE(xchr,*)diffxmax
    WRITE(ychr,*)diffymax

    IF(test) CALL warning("THE GRID FILE AND DEPTH FILE COORDINATES DO NOT MATCH EXACTLY",&
         & "LARGEST DIFFERENCE IN X-COORDINATE:"//trim(xchr),&
         & "LARGEST DIFFERENCE IN Y-COORDINATE:"//trim(ychr),&
         & "See mod_input.F::READ_COLDSTART_DEPTH for details")

    if ( i .NE. mgl) &
         & CALL fatal_error('The number of rows of data in the depth file does&
         & not equal the number of nodes?')

   if(dbg_set(dbg_log)) then
      WRITE(ipt,*)'!  Finished Reading DEPTH File'
      WRITE(ipt,*)'!  Max DEPTH =           :',maxval(hg2(1:mgl))
      WRITE(ipt,*)'!  Min DEPTH =           :',minval(hg2(1:mgl))
      WRITE(ipt,*)'!'
   end if

!%# if defined (DATA_ASSIM_OI)
! Jadon Ge added for the HG support in mod_assim_io.F
!   ALLOCATE(HG(0:MGL))  ; HG = 0.0_SP
!%   HG(1:MGL) = HG2(1:MGL)
!%# endif

Here is the caller graph for this function:

read_coldstart_grid()

subroutine mod_input::read_coldstart_grid	(	integer, intent(in)	GRIDUNIT,
		integer, intent(out)	MGL,
		integer, intent(out)	NGL,
		integer, dimension(:,:), allocatable	NVG
	)

Definition at line 2980 of file mod_input.f90.

    IMPLICIT NONE
    INTEGER, INTENT(OUT) :: NGL, MGL
    INTEGER, INTENT(IN)    :: GRIDUNIT
    INTEGER, ALLOCATABLE   :: NVG(:,:)
    CHARACTER(LEN=80)      :: temp
    INTEGER                :: I,LM1,J,IOS,LMAX,CellCount,NodeCount
    INTEGER                :: N1, N2, N3, ISCAN,K
    INTEGER :: SENDER,nvals, IERR, STATUS
    real(SP)               :: X1, Y1
    !----------------Determine Number of Nodes -------------------------------!
    iscan = scan_file(gridunit,"Node Number",iscal = mgl)
    IF(iscan /= 0) then
       write(temp,'(I2)') iscan
       call fatal_error('Improper formatting of GRID FILE: ISCAN ERROR&
            &# '//trim(temp),&
            & 'The header must contain: "Node Number = "', &
            & 'Followed by an integer number of Nodes')
    END IF
    !----------------Determine Number of Elements -------------------------------!
    
    iscan = scan_file(gridunit,"Cell Number",iscal = ngl)
    IF(iscan /= 0)then
       write(temp,'(I2)') iscan
       call fatal_error('Improper formatting of GRID FILE: ISCAN ERROR&
            &#'//trim(temp),&
            & 'The header must contain: "Cell Number = "', &
            & 'Followed by an integer number of Cells.')
       
    END IF
!----------------Read Connectivity Array----------------------------------!
!

    ! FIND FIRST LINE of CONNECTIVITY ARRAY
    rewind gridunit
    DO WHILE(.true.)
       READ(gridunit,*,iostat=ios,end=99)j,n1,n2,n3
       if (ios == 0) then
          backspace gridunit
          exit
       end if

       cycle
       
99 Call fatal_error('Improper formatting of GRID FILE:',&
           &'Reached end of file with out finding CONNECTIVITY data?',&
           &'FORMAT: CELL# NODE# NODE# NODE# (ALL INTEGERS)')
          
    END DO

    ! READ IN CONNECTIVITY

    ALLOCATE(nvg(0:ngl,4)); nvg=0
    j = 0
    i = 1
    lm1=1
    DO WHILE(.true.)

       READ(gridunit,*,iostat=ios)j,n1,n2,n3
       IF(ios < 0) CALL fatal_error('ERROR READING GRID FILE CONNECTIV&
            &ITY LIST')
       

       IF(j == 1 .AND. lm1 /= 1)THEN
          cellcount = lm1
          backspace gridunit

          READ(gridunit,*) j
          IF(j .GT. 0) THEN
             DO k=1,j
                backspace gridunit
             END DO
             EXIT
          ELSE
             CALL warning('Trouble reading grid file!')
             
             EXIT
          END IF
       END IF

       
       IF(i > ngl) CALL fatal_error &
            &('Number of rows of data in the grid file CONNECTIVITY data exceeds the stated number of Cells ?')

       ! LIST IS REORDERD!
       nvg(i,1)=n1
       nvg(i,2)=n3
       nvg(i,3)=n2
       nvg(i,4)=n1
       

       i = i + 1
       lm1 = j
    END DO

    if ( cellcount .NE. ngl) CALL fatal_error&
         ('The number of rows of data in the grid file CONNECTIVITY does  not equal the stated number?')

    nodecount = max(maxval(nvg(:,1)), maxval(nvg(:,2)), maxval(nvg(:,3)))
    if ( nodecount .NE. mgl) &
         & CALL fatal_error('The number of nodes in the grid file CONNECTIVITY does not equal the stated number ?')

    
   if(dbg_set(dbg_log)) then
      WRITE(ipt,*)'!  Finished Reading Grid File'
      WRITE(ipt,*)'!  # OF NODES            :',mgl
      WRITE(ipt,*)'!  # OF CELLS            :',ngl
      WRITE(ipt,*)'!'
   end if

Here is the caller graph for this function:

read_coldstart_lsf()

subroutine mod_input::read_coldstart_lsf	(	integer, intent(in)	LSFUNIT,
		integer, intent(out)	N_GL,
		integer, dimension(:), intent(out), allocatable	I_GL,
		real(sp), dimension(:), intent(out), allocatable	GEO_GL,
		real(sp), dimension(:), intent(out), allocatable	WDF_GL
	)

Definition at line 3194 of file mod_input.f90.

    IMPLICIT NONE
    INTEGER, INTENT(IN)  :: LSFUNIT
    INTEGER, INTENT(OUT)  :: N_GL
    INTEGER, INTENT(OUT), Allocatable :: I_GL(:)
    REAL(SP), INTENT(OUT), Allocatable :: GEO_GL(:),WDF_GL(:)
    CHARACTER(LEN=80)    :: temp,temp2
    INTEGER              :: I,J,IOS,NodeCount,ISCAN
    INTEGER              :: N1, N2, N3, N4
    REAL(SP)             :: R1, R2
    !==============================================================================|

    !
    !----------------Determine Number of Nodes -------------------------------!

    iscan = scan_file(lsfunit,"Longshore Flow Node Number",iscal = n_gl)
    IF(iscan /= 0) then
       write(temp,'(I2)') iscan
       call fatal_error('Improper formatting of LONGSHORE FLOW FILE: ISCAN ERROR&
            &# '//trim(temp),&
            & 'The header must contain: "Longshre Flow Node Number ="', &
            & 'Followed by an integer number of nodes')
    END IF


    if(n_gl==0) then

       if(dbg_set(dbg_log)) then
          WRITE(ipt,*)'!  Finished Reading LSF file: No Long Shore Flow Nodes!'
          WRITE(ipt,*)'!  LSF NODES  =           :',n_gl
          WRITE(ipt,*)'!'
       end if
       return
    end if

!----------------Read OBC Array----------------------------------!
!
   ! FIND FIRST LINE of )BC ARRAY
    rewind lsfunit
    DO WHILE(.true.)
       READ(lsfunit,*,iostat=ios,end=99)n1,n2,r1,r2
       if (ios == 0) then
          backspace lsfunit
          exit
       end if

       cycle
       
99 Call fatal_error('Improper formatting of LongShore Flow FILE:',&
           &'Reached end of file with out finding LSF data?',&
           &'FORMAT: LSFNODE# GLNODE# GEO WND (last two are real 0<=X<=1)')
          
    END DO
    ALLOCATE(i_gl(n_gl))
    ALLOCATE(geo_gl(n_gl))
    ALLOCATE(wdf_gl(n_gl))

    
    i = 0
    DO WHILE(.true.)

       READ(lsfunit,*,iostat=ios) n1,n2,r1,r2
       IF(ios < 0) exit
       
       i = i + 1
       IF(i > n_gl) CALL fatal_error('Number of rows of data in the LongShore Flow file &
            &exceeds the stated number of boundary nodes in the header ?')


       i_gl(i)    = n2
       geo_gl(i) = r1
       wdf_gl(i) = r2

    END DO

    if ( i .NE. n_gl) &
         & CALL fatal_error('The number of rows of data in the LONGSHORE FLOW file does&
         & not equal the number of nodes in the header?')
   

   if(dbg_set(dbg_log)) then
      WRITE(ipt,*)'!  Finished Reading LSF File'
      WRITE(ipt,*)'!  LSF NODES  =           :',n_gl
      WRITE(ipt,*)'!'
   end if
   
    

Here is the caller graph for this function:

read_coldstart_obc_grid()

subroutine mod_input::read_coldstart_obc_grid	(	integer, intent(in)	OBCUNIT,
		integer, intent(in)	MGL,
		integer, intent(out)	IOBCN_GL,
		integer, dimension(:), intent(out), allocatable	I_OBC_GL,
		integer, dimension(:), intent(out), allocatable	TYPE_OBC_GL
	)

Definition at line 3093 of file mod_input.f90.

    IMPLICIT NONE
    INTEGER, INTENT(IN)  :: OBCUNIT, MGL
    INTEGER, INTENT(OUT)  :: IOBCN_GL
    INTEGER, INTENT(OUT), Allocatable :: I_OBC_GL(:), TYPE_OBC_GL(:)
    CHARACTER(LEN=80)    :: temp,temp2
    INTEGER              :: I,J,IOS,NodeCount,ISCAN
    INTEGER              :: N1, N2, N3
    !==============================================================================|

    !
    !----------------Determine Number of Nodes -------------------------------!

    iscan = scan_file(obcunit,"OBC Node Number",iscal = iobcn_gl)
    IF(iscan /= 0) then
       write(temp,'(I2)') iscan
       call fatal_error('Improper formatting of OBC FILE: ISCAN ERROR&
            &# '//trim(temp),&
            & 'The header must contain: "OBC Node Number ="', &
            & 'Followed by an integer number of boundary nodes')
    END IF


    if(iobcn_gl==0) then

       if(dbg_set(dbg_log)) then
          WRITE(ipt,*)'!  Finished Reading OBC File: NO OPEN BOUNDARY'
          WRITE(ipt,*)'!  OBC NODES  =           :',iobcn_gl
          WRITE(ipt,*)'!'
       end if
       return
    end if

!----------------Read OBC Array----------------------------------!
!
   ! FIND FIRST LINE of )BC ARRAY
    rewind obcunit
    DO WHILE(.true.)
       READ(obcunit,*,iostat=ios,end=99)n1,n2,n3
       if (ios == 0) then
          backspace obcunit
          exit
       end if

       cycle
       
99 Call fatal_error('Improper formatting of OBC FILE:',&
           &'Reached end of file with out finding OBC data?',&
           &'FORMAT: OBCNODE# GLNODE# TYPE# (ALL INTEGERS)')
          
    END DO
    ALLOCATE(i_obc_gl(iobcn_gl))
    ALLOCATE(type_obc_gl(iobcn_gl))

    
    i = 0
    DO WHILE(.true.)

       READ(obcunit,*,iostat=ios) n1,n2,n3
       IF(ios < 0) exit
       
       i = i + 1
       IF(i > iobcn_gl) CALL fatal_error('Number of rows of data in the OBC file &
            &exceeds the stated number of boundary nodes in the header ?')

       IF( 1 > n2 .or. n2 > mgl) then
          write(temp,'(I8)') i
          write(temp2,'(I8)') mgl
          CALL fatal_error('OPEN BOUNDARY NODE NUMBER'//trim(temp)//&
               & 'IS NOT IN THE GLOBAL DOMAIN',&
               & 'CHECK INPUT FILE AND ENSURE OPEN BOUNDARY NODES <= '//trim(temp2))
       END IF

       IF( 1 > n3 .or. n3 > 10) then
          write(temp,'(I8)') i
          CALL fatal_error('OPEN BOUNDARY NODE NUMBER'//trim(temp)//&
               & ' IS NOT IN THE VALID RANGE',&
               & 'THE OPEN BOUNDARY NODE TYPE MUST BE GREATER THAN 0',&
               & 'AND LESS THAN 11. SEE MOD_OBC.F FOR DESCRIPTION')
       END IF


       i_obc_gl(i)    = n2
       type_obc_gl(i) = n3

    END DO

    if ( i .NE. iobcn_gl) &
         & CALL fatal_error('The number of rows of data in the OBC file does&
         & not equal the number of nodes in the header?')
   

   if(dbg_set(dbg_log)) then
      WRITE(ipt,*)'!  Finished Reading OBC File'
      WRITE(ipt,*)'!  OBC NODES  =           :',iobcn_gl
      WRITE(ipt,*)'!'
   end if
   
    

Here is the caller graph for this function:

read_coldstart_sigma()

subroutine mod_input::read_coldstart_sigma

(

)

Definition at line 3639 of file mod_input.f90.

    USE control ! Several variables for sigma coords!
    IMPLICIT NONE
    CHARACTER(LEN=80)    :: INPLINE,temp,temp2
    INTEGER              :: I,J,IOS,NodeCount, ISCAN
    INTEGER              :: N1, N2, N3

    !==============================================================================|
    
    ! Get data from Sigma file for the following variables - depends
    ! on coordinate type, some may not exist!

    ! GET SIGMA COORDINATE TYPE
    iscan = scan_file(sigmaunit,"NUMBER OF SIGMA LEVELS",iscal = kb)
    IF(iscan /= 0) then
       write(temp,'(I2)') iscan
       call fatal_error('Improper formatting of SIGMA FILE: ISCAN ERROR&
            &# '//trim(temp),&
            & 'The header must contain: "NUMBER OF SIGMA LEVELS"', &
            & 'Followed by an integer number of levels.')
    END IF


    ! GET SIGMA COORDINATE TYPE
    iscan = scan_file(sigmaunit,"SIGMA COORDINATE TYPE",cval = stype)
    IF(iscan /= 0) then
       write(temp,'(I2)') iscan
       call fatal_error('Improper formatting of SIGMA FILE: ISCAN ERROR&
            &# '//trim(temp),&
            & 'The header must contain: "SIGMA COORDINATE TYPE"', &
            & 'Followed by one of four defined types:',&
            & '"UNIFORM" or "GEOMETRIC" or "TANH" or "GENERALIZED" ')
    END IF

    ! SELECT CASE BASED ON SIGMA COORDINATE TYPE
    select case(trim(stype))
! DEGENERATE CASE OF GEOMETRIC SIGMA COORDINATES - UNIFROM DISTRIBUTION
    case(trim(stype_uniform))  
       p_sigma = 1.0
       if(dbg_set(dbg_log)) then
          WRITE(ipt,*)'!  Finished Reading SIGMA File'
          WRITE(ipt,*)'!  SIGMA COORDINATE TYPE = : '//trim(stype)
          WRITE(ipt,*)'!  P_SIGMA (UNIFORM)     = : ',p_sigma
          WRITE(ipt,*)'!  # OF SIGMA LEVELS(KB) = : ',kb
          WRITE(ipt,*)'!'
       end if

! GEOMETRIC SIGMA COORDINATES- P_SIGMA = 2 => Quadratic distribution
    case(trim(stype_geometric))

       iscan = scan_file(sigmaunit,"SIGMA POWER",fscal = p_sigma)
       IF(iscan /= 0) then
          write(temp,'(I2)') iscan
          call fatal_error('Improper formatting of SIGMA FILE: ISCAN ERROR&
               &# '//trim(temp),&
               & 'For GEOMETRIC SIGMA COORDINATE TYPE', &
               & 'The header must conatain "SIGMA POWER"',&
               & 'Followed by a real value (1.0 is uniform sigma coordinates)')
       END IF
       
       
       if(dbg_set(dbg_log)) then
          WRITE(ipt,*)'!  Finished Reading SIGMA File'
          WRITE(ipt,*)'!  SIGMA COORDINATE TYPE = : '//trim(stype)
          WRITE(ipt,*)'!  P_SIGMA               = : ',p_sigma
          WRITE(ipt,*)'!  # OF SIGMA LEVELS(KB) = : ',kb
          WRITE(ipt,*)'!'
       end if
              
! HYPERBOLIC TANGENT DISTRIBUTION OF SURFACE AND BOTTOM INTESIFIED LAYERS
    case(trim(stype_tanh))
       
       iscan = scan_file(sigmaunit,"DU",fscal = du2)
       IF(iscan /= 0) then
          write(temp,'(I2)') iscan
          call fatal_error('Improper formatting of SIGMA FILE: ISCAN ERROR&
               &# '//trim(temp),&
               & 'For TANH SIGMA COORDINATE TYPE', &
               & 'The header must conatain "DU"',&
               & 'Followed by a real value (See set_sigma.F')
       END IF

       iscan = scan_file(sigmaunit,"DL",fscal = dl2)
       IF(iscan /= 0) then
          write(temp,'(I2)') iscan
          call fatal_error('Improper formatting of SIGMA FILE: ISCAN ERROR&
               &# '//trim(temp),&
               & 'For TANH SIGMA COORDINATE TYPE', &
               & 'The header must conatain "DL"',&
               & 'Followed by a real value (See set_sigma.F')
       END IF
       
       if(dbg_set(dbg_log)) then
          WRITE(ipt,*)'!  Finished Reading SIGMA File'
          WRITE(ipt,*)'!  SIGMA COORDINATE TYPE = : '//trim(stype)
          WRITE(ipt,*)'!  # OF SIGMA LEVELS(KB) = : ',kb
          WRITE(ipt,*)'!  DU                    = : ',du2
          WRITE(ipt,*)'!  DL                    = : ',dl2
          WRITE(ipt,*)'!'
       end if

! A SPATIALLY DEPENDENT DISTRIBUTION OF LAYER THICKNESS BASED ON DEPTH
    case(trim(stype_generalized))

       iscan = scan_file(sigmaunit,"DU",fscal = duu)
       IF(iscan /= 0) then
          write(temp,'(I2)') iscan
          call fatal_error('Improper formatting of SIGMA FILE: ISCAN ERROR&
               &# '//trim(temp),&
               & 'For GENERALIZED SIGMA COORDINATE TYPE', &
               & 'The header must conatain "DU"',&
               & 'Followed by a real value (See set_sigma.F')
       END IF

       iscan = scan_file(sigmaunit,"DL",fscal = dll)
       IF(iscan /= 0) then
          write(temp,'(I2)') iscan
          call fatal_error('Improper formatting of SIGMA FILE: ISCAN ERROR&
               &# '//trim(temp),&
               & 'For GENERALIZED SIGMA COORDINATE TYPE', &
               & 'The header must conatain "DL"',&
               & 'Followed by a real value (See set_sigma.F')
       END IF

       iscan = scan_file(sigmaunit,"MIN CONSTANT DEPTH",fscal = hmin1)
       IF(iscan /= 0) then
          write(temp,'(I2)') iscan
          call fatal_error('Improper formatting of SIGMA FILE: ISCAN ERROR&
               &# '//trim(temp),&
               & 'For GENERALIZED SIGMA COORDINATE TYPE', &
               & 'The header must conatain "MIN CONSTANT DEPTH"',&
               & 'Followed by a real value (See set_sigma.F')
       END IF

       iscan = scan_file(sigmaunit,"KU",iscal = ku)
       IF(iscan /= 0) then
          write(temp,'(I2)') iscan
          call fatal_error('Improper formatting of SIGMA FILE: ISCAN ERROR&
               &# '//trim(temp),&
               & 'For GENERALIZED SIGMA COORDINATE TYPE', &
               & 'The header must conatain "KU"',&
               & 'Followed by a real value (See set_sigma.F')
       END IF

       iscan = scan_file(sigmaunit,"KL",iscal = kl)
       IF(iscan /= 0) then
          write(temp,'(I2)') iscan
          call fatal_error('Improper formatting of SIGMA FILE: ISCAN ERROR&
               &# '//trim(temp),&
               & 'For GENERALIZED SIGMA COORDINATE TYPE', &
               & 'The header must conatain "KL"',&
               & 'Followed by a real value (See set_sigma.F')
       END IF

!------------------------------------------------------------------------------|
!     "ZKU"   !! 
!------------------------------------------------------------------------------|
   IF(ku .ge. 1 .and. ku .LE. 150)THEN

     ALLOCATE(zku(ku)); zku=0.0_sp
     iscan = scan_file(sigmaunit,"ZKU",fvec = zku ,nsze = n1)
     IF(iscan /= 0) then
        write(temp,'(I2)') iscan
        call fatal_error('Improper formatting of SIGMA FILE: ISCAN ERROR&
             &# '//trim(temp),&
             & 'For GENERALIZED SIGMA COORDINATE TYPE', &
             & 'The header must conatain "ZKU"',&
             & 'Followed by a real values (See set_sigma.F')
     END IF
     
     
     IF(n1 /= ku)THEN
        call fatal_error('Improper formatting of SIGMA FILE:',&
             & 'For GENERALIZED SIGMA COORDINATE TYPE', &
             & 'THE NUMBER OF SPECIFIED DEPTHS IN ZKU IS NOT EQUAL TO KU') 
     END IF
     


  ELSE IF( ku .NE. 0) THEN
     call fatal_error('Improper formatting of SIGMA FILE:',&
          & 'For GENERALIZED SIGMA COORDINATE TYPE', &
          & 'Requirement: 1<= KL <= 150;') 
     
  END IF
!------------------------------------------------------------------------------|
!     "ZKL"   !! 
!--------------------------------------------------------------------
   IF(kl .ge. 1 .and. kl .LE. 150)THEN

     ALLOCATE(zkl(kl)); zkl=0.0_sp
     iscan = scan_file(sigmaunit,"ZKL",fvec = zkl ,nsze = n1)
     IF(iscan /= 0) then
        write(temp,'(I2)') iscan
        call fatal_error('Improper formatting of SIGMA FILE: ISCAN ERROR&
             &# '//trim(temp),&
             & 'For GENERALIZED SIGMA COORDINATE TYPE', &
             & 'The header must conatain "ZKL"',&
             & 'Followed by a real values (See set_sigma.F')
     END IF
     
     
     IF(n1 /= kl)THEN
        call fatal_error('Improper formatting of SIGMA FILE:',&
             & 'For GENERALIZED SIGMA COORDINATE TYPE', &
             & 'THE NUMBER OF SPECIFIED DEPTHS IN ZKL IS NOT EQUAL TO KL') 
     END IF
     
  ELSE IF (kl .NE. 0) THEN
     call fatal_error('Improper formatting of SIGMA FILE:',&
          & 'For GENERALIZED SIGMA COORDINATE TYPE', &
          & 'Requirement: 1<= KL <= 150;') 
     
  END IF

   ! END GET VARIABLES
  
  if(dbg_set(dbg_log)) then
     WRITE(ipt,*)'!  Finished Reading SIGMA File'
     WRITE(ipt,*)'!  SIGMA COORDINATE TYPE = : '//trim(stype)
     WRITE(ipt,*)'!  # OF SIGMA LEVELS(KB) = : ',kb
     WRITE(ipt,*)'!  DU                    = : ',duu
     WRITE(ipt,*)'!  DL                    = : ',dll
     WRITE(ipt,*)'!  MIN CONSTANT DEPTH    = : ',hmin1
     WRITE(ipt,*)'!  KU                    = : ',ku
     WRITE(ipt,*)'!  KL                    = : ',kl
     WRITE(ipt,*)'!'
  end if
  
  
  
case default
   call fatal_error('Improper formatting of SIGMA FILE',&
        & 'Allowed SIGMA COORDINATE TYPEs are:',&
         & '"UNIFORM" or "GEOMETRIC" or "TANH" or "GENERALIZED"',&
         & 'See Set_Sigma.F for a description')
    end select
    
    

Here is the caller graph for this function:

read_coldstart_sponge()

subroutine mod_input::read_coldstart_sponge	(	integer, intent(in)	SPONGEUNIT,
		integer, intent(in)	MGL,
		integer, intent(out)	NSPONGE,
		integer, dimension(:), intent(out), allocatable	N_SPG,
		real(sp), dimension(:), intent(out), allocatable	R_SPG,
		real(sp), dimension(:), intent(out), allocatable	C_SPG
	)

Definition at line 3539 of file mod_input.f90.

    IMPLICIT NONE
    REAL(SP), INTENT(OUT), ALLOCATABLE :: R_SPG(:),C_SPG(:) 
    INTEGER, INTENT(OUT), ALLOCATABLE  :: N_SPG(:)
    INTEGER, INTENT(IN)   :: SPONGEUNIT,MGL
    INTEGER, INTENT(OUT)  :: NSPONGE
    CHARACTER(LEN=80)     :: temp,temp2
    INTEGER               :: I,J,IOS,NodeCount,ISCAN
    INTEGER               :: N1
    REAL(SP)              :: R1,R2
    !==============================================================================|

    !
    !----------------Determine Number of Nodes -------------------------------

    iscan = scan_file(spongeunit,"Sponge Node Number",iscal = nsponge)
    IF(iscan /= 0) then
       write(temp,'(I2)') iscan
       call fatal_error('Improper formatting of SPONGE FILE: ISCAN ERROR&
            &# '//trim(temp),&
            & 'The header must contain: "Sponge Node Number ="', &
            & 'Followed by an integer number of nodes where the sponge&
            & value is set')
    END IF

!----------------Read SPONGE Array----------------------------------!
!

    if(nsponge==0) then
       if(dbg_set(dbg_log)) then
          WRITE(ipt,*)'!  Finished Reading SPONGE File: NO SPONGE NODES'
          WRITE(ipt,*)'!  SPONGE NODES  =',nsponge
          WRITE(ipt,*)'!'
       end if
       return
    end if



   ! FIND FIRST LINE of )BC ARRAY
    rewind spongeunit
    DO WHILE(.true.)
       READ(spongeunit,*,iostat=ios,end=99)n1,r1,r2
       if (ios == 0) then
          backspace spongeunit
          exit
       end if

       cycle
       
99 Call fatal_error('Improper formatting of SPONGE FILE:',&
           &'Reached end of file with out finding sponge data?',&
           &'FORMAT: GLBNODE#  RADIUS SPGVAL (INT, REAL, REAL)')
          
    END DO

    ALLOCATE(n_spg(nsponge)); n_spg = 0
    ALLOCATE(r_spg(nsponge)); r_spg = 0.0
    ALLOCATE(c_spg(nsponge)); c_spg = 0.0


    
    i = 0
    DO WHILE(.true.)

       READ(spongeunit,*,iostat=ios) n1,r1,r2
       IF(ios < 0) exit
       
       i = i + 1
       IF(i > nsponge) CALL fatal_error('Number of rows of data in the SPONGE file &
            &exceeds the stated number in the header ?')

       IF( 1 > n1 .or. n1 > mgl) then
          write(temp,'(I8)') i
          write(temp2,'(I8)') mgl
          CALL fatal_error('SPONGE NODE NUMBER'//trim(temp)//&
               & 'IS NOT IN THE GLOBAL DOMAIN',&
               & 'CHECK INPUT FILE AND ENSURE SPONGE NODE# is <= '//trim(temp2))
       END IF
       n_spg(i) = n1
       r_spg(i) = r1
       c_spg(i) = r2

    END DO

    if ( i .NE. nsponge) &
         & CALL fatal_error('The number of rows of data in the sponge file does&
         & not equal the number of nodes in the header?')

   if(dbg_set(dbg_log)) then
      WRITE(ipt,*)'!  Finished Reading Sponge File'
      WRITE(ipt,*)'!  SPONGE NODES  =        :',nsponge
      WRITE(ipt,*)'!'
   end if


    

Here is the caller graph for this function:

read_julian_obc()

subroutine mod_input::read_julian_obc	(	integer, intent(in)	JULOBCUNIT_TEMP,
		integer, intent(out)	NTC,
		character(len=*), dimension(:), intent(out), allocatable	NAMES,
		real(sp), dimension(:), intent(out), allocatable	PRD,
		real(sp), dimension(:), intent(out), allocatable	EQ_AMP,
		real(sp), dimension(:), intent(out), allocatable	EQ_BETA,
		character(len=*), dimension(:), intent(out), allocatable	EQ_TYPE,
		real(sp), dimension(:,:), intent(out), allocatable	MPTD,
		real(sp), dimension(:,:), intent(out), allocatable	PHS,
		real(sp), dimension(:), intent(out), allocatable	RF,
		type(time), intent(out)	TORG
	)

Definition at line 2621 of file mod_input.f90.

    USE control
    IMPLICIT NONE
    INTEGER, INTENT(IN) :: JULOBCUNIT_TEMP
    INTEGER,INTENT(OUT) :: NTC  ! Number of Tidal Components
    REAL(SP),INTENT(OUT), ALLOCATABLE :: PRD(:) ! Tidal Period
    REAL(SP),INTENT(OUT), ALLOCATABLE :: EQ_AMP(:) ! Equilibrium Amplitude
    REAL(SP),INTENT(OUT), ALLOCATABLE :: EQ_BETA(:) ! Equilibrium Beta
    CHARACTER(LEN=*),INTENT(OUT),ALLOCATABLE :: EQ_TYPE(:)   ! Equilibrium Type
    REAL(SP),INTENT(OUT), ALLOCATABLE :: MPTD(:,:) ! Amplitude
    REAL(SP),INTENT(OUT), ALLOCATABLE :: PHS(:,:)! Phase
    REAL(SP),INTENT(OUT), ALLOCATABLE :: RF(:)   ! Reference Height
    CHARACTER(LEN=*),INTENT(OUT), ALLOCATABLE  :: Names(:)   ! Name of Components
    TYPE(TIME),INTENT(OUT) :: TORG

    REAL(DP) :: TORGDP

    REAL(SP), ALLOCATABLE :: RFTMP(:,:)   ! Dummy REF
    INTEGER :: ISCAN, I, MYOBC, IOS, CNT, J
    CHARACTER(LEN=80)      :: Iserr,COMPN

    CHARACTER(LEN=80)     :: line
    CHARACTER(LEN=500)     :: long_line
    CHARACTER(LEN=20), allocatable :: item(:)
    CHARACTER(LEN=80) :: TEST

    CHARACTER(LEN=80), Parameter :: line_amp = "Amplitude"
    CHARACTER(LEN=80), Parameter :: line_pha = "Phase"
    CHARACTER(LEN=80), Parameter :: line_ref = "Eref"

     LOGICAL :: ISFLOAT

    if(dbg_set(dbg_io)) WRITE(ipt,*) "! READING NON-JULIAN TIDAL FORCING FILE"

    iscan = scan_file(julobcunit_temp,"Tidal Component Number",iscal = ntc)
    IF(iscan /= 0) then
       write(iserr,'(I2)') iscan
       call fatal_error('Improper formatting of Non-Julian Tidal Forcing File: ISCAN ERROR&
            &# '//trim(iserr),&
            & 'The header must contain: "Tidal Component Number = "', &
            & 'Followed by an integer number')
    END IF
    

    if(dbg_set(dbg_io)) write(ipt,*) "Tidal Component Number", ntc

 
    ALLOCATE(prd(ntc))
    ALLOCATE(names(ntc))
    ALLOCATE(eq_amp(0))
    ALLOCATE(eq_beta(0))
    ALLOCATE(eq_type(0))

    DO i = 1,ntc

       !write(COMPN,'(I)') I
       write(compn,*) i
       compn= adjustl(compn)
       iscan = scan_file(julobcunit_temp,trim(compn),cval = line)
       IF(iscan /= 0) then
          write(iserr,'(I2)') iscan
          call fatal_error('Improper formatting of Non-Julian Tidal Forcing File: ISCAN ERROR&
               &# '//trim(iserr),&
               & 'The header must contain: "'//trim(compn)//' = "', &
               & 'Followed by: Name,Period,Eq. Amp.*, Eq. Beta*, Type*')
       END IF
       
       CALL split_string(line," ",item)

       IF(SIZE(item) >= 2) THEN
          
          ! GET THE NAME OF THE COMPONENT
          names(i) = trim(item(1))
          
          ! GET THE PERIOD OF THE COMPONENT
          prd(i) = read_float(item(2), ios)
          ! -------- new: Karsten Lettmann, 2016, march -------
          ! initialize Test:
          test = item(2)
          ! -------------- end new ----------------------------
          IF(ios /=0) CALL fatal_error&
               &("INVALID DATA IN ASCII NON_JULIAN FORCING FILE",&
               & "Non Floating Point Value: '"//trim(test)//"' ; in line: "//trim(line))

       ELSE
          CALL fatal_error&
               & ("Improper Line in Non Julian Tidal forcing file:",&
               &  "Line :"//trim(line),&
               &  "The Tidal Component section must conatin:",&
               &  "Component# = Name, Period")
       END IF

       DEALLOCATE(item)

    END DO

    ! GET THE TIME ORIGIN
    iscan = scan_file(julobcunit_temp,"Time Origin",cval = line)
    IF(iscan /= 0) then
       write(iserr,'(I2)') iscan
       call fatal_error('Improper formatting of Non-Julian Tidal Forcing File: ISCAN ERROR&
            &# '//trim(iserr),&
            & 'The header must contain: "Time Origin = "', &
            & 'Followed by a data or time')
    END IF
    
    IF (use_real_world_time) THEN

       torg = read_datetime(line,date_format,timezone,ios)
       IF(ios == 0) Call fatal_error&
            &("NON JULIAN TIDAL FORCING FILE - Time Origin error"&
            &"Could not read the date string Time Origin",&
            & "The model is running using real dates")

       if(dbg_set(dbg_io)) CALL print_real_time(torg,ipt,"NON JULIAN T0")

    ELSE

       CALL split_string(line," ",item)

       IF (size(item)>1 ) THEN
          torgdp = read_float(item(1),ios)
          IF(ios /=0) CALL fatal_error&
               & ("NON JULIAN TIDAL FORCING FILE - Time Origin error",&
               &  "Could not read the floating point number",&
               &  "Line :"//trim(line),&
               &  "The model is running using ideal time (starting from 0.0)")
       ELSE
          CALL fatal_error&
            &("NON JULIAN TIDAL FORCING FILE - Time Origin error",&
            & "Could not read the string Time Origin",&
            & "Line :"//trim(line),&
            & "The model is running using ideal time (starting from 0.0)")
       END IF

       IF(item(2)=="seconds") THEN
            torg = seconds2time(torgdp)
       ELSEIF(item(2)=="days" .and. size(item)>1 ) THEN
            torg = days2time(torgdp)
       ELSE
          CALL fatal_error&
            &("NON JULIAN TIDAL FORCING FILE - Time Origin error",&
            & "Could not read the string Time Origin",&
            & "The model is running using ideal time (starting from 0.0)")
       END IF

       if(dbg_set(dbg_io)) CALL print_time(torg,ipt,"NON JULIAN T0")


    END IF

    iscan = scan_file(julobcunit_temp,"OBC Node Number",iscal = myobc)
    IF(iscan /= 0) then
       write(iserr,'(I2)') iscan
       call fatal_error&
            &('Improper formatting of Non-Julian Tidal Forcing File: ISCAN ERROR# '//trim(iserr),&
            & 'The header must contain: "OBC Node Number = "', &
            & 'Followed by and integer number of boundary nodes')
    END IF
    
    if(dbg_set(dbg_io)) write(ipt,*) "OBC NODE NUMBER =",myobc
    
    ALLOCATE(mptd(myobc,ntc))
    ALLOCATE(phs(myobc,ntc))
    ALLOCATE(rftmp(myobc,1))
    ALLOCATE(rf(myobc))

    IF(myobc == 0) RETURN



    ! READ THE AMPLITUDE

    if(dbg_set(dbg_io)) write(ipt,*) "READING AMPLITUDE DATA"
    rewind julobcunit_temp

    DO WHILE(.true.)
       READ(julobcunit_temp,*,iostat=ios) line
       if (ios /= 0) CALL fatal_error&
            &("Could not read Non Julian Tidal Forcing file. no keyword: 'Amplitude'")
       
       IF(line == line_amp) Exit
       
    END DO

    cnt = 0
    DO
       READ(julobcunit_temp,'(a)',iostat=ios) long_line
       IF(ios /=0) CALL fatal_error&
            &("While Reading Non Julian Tidal forcing Amplitude:",&
            & "Invalid line or end of file reached with out end of section!")


       IF(long_line == line_amp) THEN

          ! IF FINISHED READING SECTION => EXIT
          IF(cnt == myobc) EXIT

          ! OTHERWISE CALL AN ERROR
          CALL fatal_error&
            &("Unexpected end of section Amplitude in Non Julian Tidal forcing file",&
            & "Check the number of nodes in the list")
       END IF

       Call parse_tide(long_line,cnt,ntc,mptd,ios)
       ! IF THIS IS A COMMENT LINE OR BLANK
       IF(ios /=0) cycle

       ! ELSE CONTINUE TO NEXT
    END DO


    ! READ THE PHASE
    if(dbg_set(dbg_io)) write(ipt,*) "READING PHASE DATA"
    rewind julobcunit_temp

    DO WHILE(.true.)
       READ(julobcunit_temp,*,iostat=ios) line
       if (ios /= 0) CALL fatal_error&
            &("Could not read Non Julian Tidal Forcing file. no keyword: 'Phase'")
       
       IF(line == line_pha) Exit
       
    END DO

    cnt = 0
    DO WHILE(cnt <= myobc)
       READ(julobcunit_temp,'(a)',iostat=ios) long_line
       IF(ios /=0) CALL fatal_error&
            &("While Reading Non Julian Tidal forcing Phase:",&
            & "Invalid line or end of file reached with out end of section!")


       IF(long_line == line_pha) THEN

          ! IF FINISHED READING SECTION => EXIT
          IF(cnt == myobc) EXIT

          ! OTHERWISE CALL AN ERROR
          CALL fatal_error&
            &("Unexpected end of section Phase in Non Julian Tidal forcing file",&
            & "Check the number of nodes in the list")
       END IF


       Call parse_tide(long_line,cnt,ntc,phs,ios)
       ! IF THIS IS A COMMENT LINE OR BLANK
       IF(ios /=0) cycle

    END DO

    ! READ THE REFERENCE HEIGHT

    if(dbg_set(dbg_io)) write(ipt,*) "READING REFERENCE HEIGHT DATA"
    rewind julobcunit_temp

    DO WHILE(.true.)
       READ(julobcunit_temp,*,iostat=ios) line
       if (ios /= 0) CALL fatal_error&
            &("Could not read Non Julian Tidal Forcing file. no keyword: 'Eref'")
       
       IF(line == line_ref) Exit
       
    END DO

    cnt = 0
    DO WHILE(cnt <= myobc)
       READ(julobcunit_temp,'(a)',iostat=ios) long_line
       IF(ios /=0) CALL fatal_error&
            &("While Reading Non Julian Tidal forcing Eref:",&
            & "Invalid line or end of file reached with out end of section!")

       IF(long_line == line_ref) THEN

          ! IF FINISHED READING SECTION => EXIT
          IF(cnt == myobc) EXIT

          ! OTHERWISE CALL AN ERROR
          CALL fatal_error&
            &("Unexpected end of section Eref in Non Julian Tidal forcing file",&
            & "Check the number of nodes in the list")
       END IF



       Call parse_tide(long_line,cnt,1,rftmp,ios)
       ! IF THIS IS A COMMENT LINE OR BLANK
       IF(ios /=0) cycle


    END DO

    rf = rftmp(:,1)
    DEALLOCATE(rftmp)


    if(dbg_set(dbg_io)) WRITE(ipt,*) "! FINISHED READING NON-JULIAN TIDAL FORCING FILE"

Here is the call graph for this function:

Here is the caller graph for this function:

search_for_last_matching_name()

subroutine mod_input::search_for_last_matching_name

(

character(len=160), intent(inout)

FNAME

)

Definition at line 1126 of file mod_input.f90.

    IMPLICIT NONE
    CHARACTER(LEN=160), INTENT(INOUT) :: FNAME 
    CHARACTER(LEN=160) :: FNAME_NEXT
    logical :: fexist

    inquire(file=trim(fname),exist=fexist)
    IF(.not. fexist) CALL fatal_error &
         & ("Base name can not be found while searching for crashrestart file:",&
         & trim(fname), "If there is no output yet a crashrestart does&
         & not make much sense...", "there is something wrong with your model")

    DO 
       fname_next = fname
       CALL incriment_fname(fname_next)
       ! ADD A MORE DEFINIATIVE CHECK THAN EXISTANCE OF FILE!
       inquire(file=trim(fname_next),exist=fexist)

       IF(.not. fexist) THEN
          if(dbg_set(dbg_log))&
               & write(ipt,*) "FOUND LAST FILE: "//trim(fname)
       
          RETURN
       ELSE
          fname = fname_next
       END IF
    END DO

Here is the call graph for this function:

Here is the caller graph for this function:

Variable Documentation

nc_avg

type(ncfile), pointer mod_input::nc_avg

Definition at line 49 of file mod_input.f90.

  TYPE(NCFILE), POINTER ::NC_AVG

nc_dat

type(ncfile), pointer mod_input::nc_dat

Definition at line 48 of file mod_input.f90.

  TYPE(NCFILE), POINTER ::NC_DAT

nc_rst

type(ncfile), pointer mod_input::nc_rst

Definition at line 50 of file mod_input.f90.

  TYPE(NCFILE), POINTER ::NC_RST

nc_start

type(ncfile), pointer mod_input::nc_start

Definition at line 51 of file mod_input.f90.

  TYPE(NCFILE), POINTER ::NC_START