mod_utils Module Reference

Data Types
interface	degrees2meters
interface	interp_anodal
interface	interp_azonal
interface	interp_pnodal
interface	interp_pzonal
interface	meters2degrees
interface	shutdown_check

Functions/Subroutines
subroutine	initialize_control (NAME)
logical function	dbg_set (vrb)
subroutine	dbg_init (IPT_BASE, outtofile)
subroutine	fatal_error (ER1, ER2, ER3, ER4)
subroutine	warning (ER1, ER2, ER3, ER4)
subroutine	pstop
subroutine	pshutdown
subroutine	shutdown_check_1d (VAR, MSG)
subroutine	shutdown_check_2d (VAR, MSG)
logical function	have_proj (proj_ref)
subroutine	degrees2meters_scl_flt (LON, LAT, proj_ref, X, Y)
subroutine	degrees2meters_vec_flt (LON, LAT, proj_ref, X, Y, nsze)
subroutine	degrees2meters_arr_flt (LON, LAT, proj_ref, X, Y, nsze, msze)
subroutine	degrees2meters_scl_dbl (LON, LAT, proj_ref, X, Y)
subroutine	degrees2meters_vec_dbl (LON, LAT, proj_ref, X, Y, nsze)
subroutine	degrees2meters_arr_dbl (LON, LAT, proj_ref, X, Y, nsze, msze)
subroutine	meters2degrees_scl_flt (X, Y, proj_ref, LON, LAT)
subroutine	meters2degrees_vec_flt (X, Y, proj_ref, LON, LAT, nsze)
subroutine	meters2degrees_arr_flt (X, Y, proj_ref, LON, LAT, nsze, msze)
subroutine	meters2degrees_scl_dbl (X, Y, proj_ref, LON, LAT)
subroutine	meters2degrees_vec_dbl (X, Y, proj_ref, LON, LAT, nsze)
subroutine	meters2degrees_arr_dbl (X, Y, proj_ref, LON, LAT, nsze, msze)
real(spa) function	interp_anodal_2d_flt (xloc, yloc, i, Field)
real(dp) function	interp_anodal_2d_dbl (xloc, yloc, i, Field)
real(spa) function	interp_pnodal_2d_flt (xloc, yloc, i, Field)
real(dp) function	interp_pnodal_2d_dbl (xloc, yloc, i, Field)
real(spa) function	interp_anodal_3d_flt (xloc, yloc, sigloc, lvls, i, Field)
real(dp) function	interp_anodal_3d_dbl (xloc, yloc, sigloc, lvls, i, Field)
real(spa) function	interp_pnodal_3d_flt (xloc, yloc, sigloc, lvls, i, Field)
real(dp) function	interp_pnodal_3d_dbl (xloc, yloc, sigloc, lvls, i, Field)
real(spa) function	interp_azonal_2d_flt (xloc, yloc, i, Field)
real(dp) function	interp_azonal_2d_dbl (xloc, yloc, i, Field)
real(spa) function	interp_pzonal_2d_flt (xloc, yloc, i, Field)
real(dp) function	interp_pzonal_2d_dbl (xloc, yloc, i, Field)
real(spa) function	interp_azonal_3d_flt (xloc, yloc, sigloc, lvls, i, Field)
real(dp) function	interp_azonal_3d_dbl (xloc, yloc, sigloc, lvls, i, Field)
real(spa) function	interp_pzonal_3d_flt (xloc, yloc, sigloc, lvls, i, Field)
real(dp) function	interp_pzonal_3d_dbl (xloc, yloc, sigloc, lvls, i, Field)
integer function	find_element_containing (xloc, yloc, GUESS)
integer function	find_element_containing_robust (xloc, yloc)
integer function	find_element_containing_quick (xloc, yloc, Guess)
logical function	isintri (X0, Y0, Xt, Yt)
logical function	isintriangle (i, x0, y0)
logical function	sameside (p1, p2, a, b)
subroutine	grid_neighbor_index (FOUND, IDEX, CNT, ORDER)
subroutine	write_banner (PAR, NP, ID)
subroutine	fopen (IUNIT, INSTR, IOPT)
integer function	open_dat (FNAME, UNIT, PATH)
subroutine	get_value (LNUM, NUMCHAR, TEXT_LINE, VARNAME, VARTYPE, LOGVAL, STRINGVAL, REALVAL, INTVAL, NVAL)
integer function	scan_file (UNIT, VNAME, ISCAL, FSCAL, IVEC, FVEC, CVEC, NSZE, CVAL, LVAL)
subroutine	split_string (instring, delim, outstrings)
subroutine	path_split (STRING, PATH, FILE, EXTENSION)
subroutine	test_split_strings
real(sp) function	limled (a, b, q)
real(sp) function	limled1 (a, b, alpha)
real(sp) function	limled2 (a, b, alpha)
real(dp) function	read_float (ITEM, IERR)
real(sp) function	read_int (ITEM, IERR)
integer function	scan_file2 (FNAME, VNAME, ISCAL, FSCAL, IVEC, FVEC, CVEC, NSZE, CVAL, LVAL)
integer function	scan_file3 (FNAME, VNAME, ISCAL, FSCAL, IVEC, FVEC, CVEC, NSZE, CVAL, LVAL)

Variables
integer, parameter	sync_tag =3601
integer, parameter	ext_code =3602
integer, parameter	wait_code =3603
integer	restart_code
integer	nc_code
integer	ncav_code
integer	init_code
integer	nesting_code
integer	initnest_code
integer, parameter	dbg_nbr =9
integer, parameter	dbg_log =0
integer, parameter	dbg_io =1
integer, parameter	dbg_scl =2
integer, parameter	dbg_mpi =3
integer, parameter	dbg_sbr =4
integer, parameter	dbg_sbrio =5
integer, parameter	dbg_vec =6
integer, parameter	dbg_vrb =7
character(len=80)	prg_nm
integer	dbg_lvl
logical	dbg_par =.false.

Function/Subroutine Documentation

dbg_init()

subroutine mod_utils::dbg_init	(	integer, intent(in)	IPT_BASE,
		logical, intent(in)	outtofile
	)

Definition at line 197 of file mod_utils.f90.

    use control, only: infofile, prg_name, msr
    use lims, only: myid
    implicit none
    integer, intent(in):: IPT_BASE
    logical, intent(in):: outtofile
    character(LEN=3) :: ch3
    character(len=100) :: debugname

    if (outtofile .AND. msr) then
       WRITE(ipt,*)"========================================================================"
       WRITE(ipt,*)"=== All further standard output goes to the user specified log file ===="
       WRITE(ipt,*)"=== Any further standard error messages will still print to screen ====="
       WRITE(ipt,*)"=== LOG FILE NAME: "//trim(infofile)
       WRITE(ipt,*)"========================================================================"
       ipt = ipt_base+1
       CALL fopen(ipt, trim(infofile) ,"ofr")
       
    end if

    if (dbg_par .AND. .NOT. msr) then       
       ipt = ipt_base + myid
       write(ch3,'(i3.3)') myid
       debugname=trim(prg_name)//"_DEBUG."&
            & // trim(adjustl(ch3)) // ".log"
 
       CALL fopen(ipt, trim(debugname) ,"ofr")
       
    end if

Here is the call graph for this function:

Here is the caller graph for this function:

dbg_set()

logical function mod_utils::dbg_set

(

integer, intent(in)

vrb

)

Definition at line 182 of file mod_utils.f90.

    USE control, only: msr
    IMPLICIT NONE
    INTEGER, INTENT(IN) :: vrb
    
    ! ONLY RETURN TRUE IF LEVEL PASSED IS .LE. THE RUN TIME LEVEL 
    dbg_set =.false.
    if (vrb <= dbg_lvl) then
       if ( msr .OR. dbg_par) dbg_set =.true.
    end if
       
    return

degrees2meters_arr_dbl()

subroutine mod_utils::degrees2meters_arr_dbl	(	real(dp), dimension(nsze,msze), intent(in)	LON,
		real(dp), dimension(nsze,msze), intent(in)	LAT,
		character(len=*), intent(in)	proj_ref,
		real(dp), dimension(nsze,msze), intent(out)	X,
		real(dp), dimension(nsze,msze), intent(out)	Y,
		integer, intent(in)	nsze,
		integer, intent(in)	msze
	)

Definition at line 435 of file mod_utils.f90.

    implicit none
    integer, intent(in) :: nsze, msze
    REAL(DP), INTENT(IN)  :: LON(nsze,msze), LAT(nsze,msze)
    character(LEN=*), INTENT(IN)    :: proj_ref
    REAL(DP), INTENT(OUT) :: X(nsze,msze), Y(nsze,msze)
    x=-1.0_dp
    y=-1.0_dp

degrees2meters_arr_flt()

subroutine mod_utils::degrees2meters_arr_flt	(	real(spa), dimension(nsze,msze), intent(in)	LON,
		real(spa), dimension(nsze,msze), intent(in)	LAT,
		character(len=*), intent(in)	proj_ref,
		real(spa), dimension(nsze,msze), intent(out)	X,
		real(spa), dimension(nsze,msze), intent(out)	Y,
		integer, intent(in)	nsze,
		integer, intent(in)	msze
	)

Definition at line 402 of file mod_utils.f90.

    implicit none
    integer, intent(in) :: nsze, msze
    REAL(SPA), INTENT(IN)  :: LON(nsze,msze), LAT(nsze,msze)
    character(LEN=*), INTENT(IN)    :: proj_ref
    REAL(SPA), intent(out):: X(nsze,msze), Y(nsze,msze)

    x=-1.0_spa
    y=-1.0_spa

degrees2meters_scl_dbl()

subroutine mod_utils::degrees2meters_scl_dbl	(	real(dp), intent(in)	LON,
		real(dp), intent(in)	LAT,
		character(len=*), intent(in)	proj_ref,
		real(dp), intent(out)	X,
		real(dp), intent(out)	Y
	)

Definition at line 413 of file mod_utils.f90.

!    USE PROJ4
    implicit none
    REAL(DP), INTENT(IN)  :: LON, LAT
    character(LEN=*), INTENT(IN)    :: proj_ref
    REAL(DP), intent(out):: X, Y
    
    x=-1.0_dp
    y=-1.0_dp

degrees2meters_scl_flt()

subroutine mod_utils::degrees2meters_scl_flt	(	real(spa), intent(in)	LON,
		real(spa), intent(in)	LAT,
		character(len=*), intent(in)	proj_ref,
		real(spa), intent(out)	X,
		real(spa), intent(out)	Y
	)

Definition at line 382 of file mod_utils.f90.

    implicit none
    REAL(SPA), INTENT(IN)  :: LON, LAT
    character(LEN=*), INTENT(IN)    :: proj_ref
    REAL(SPA), intent(out):: X, Y
    x=-1.0_spa
    y=-1.0_spa

degrees2meters_vec_dbl()

subroutine mod_utils::degrees2meters_vec_dbl	(	real(dp), dimension(nsze), intent(in)	LON,
		real(dp), dimension(nsze), intent(in)	LAT,
		character(len=*), intent(in)	proj_ref,
		real(dp), dimension(nsze), intent(out)	X,
		real(dp), dimension(nsze), intent(out)	Y,
		integer, intent(in)	nsze
	)

Definition at line 424 of file mod_utils.f90.

!    USE PROJ4
    implicit none
    integer, intent(in) :: nsze
    REAL(DP), INTENT(IN)  :: LON(nsze), LAT(nsze)
    character(LEN=*), INTENT(IN)    :: proj_ref
    REAL(DP), INTENT(OUT) :: X(nsze), Y(nsze)
    x=-1.0_dp
    y=-1.0_dp

degrees2meters_vec_flt()

subroutine mod_utils::degrees2meters_vec_flt	(	real(spa), dimension(nsze), intent(in)	LON,
		real(spa), dimension(nsze), intent(in)	LAT,
		character(len=*), intent(in)	proj_ref,
		real(spa), dimension(nsze), intent(out)	X,
		real(spa), dimension(nsze), intent(out)	Y,
		integer, intent(in)	nsze
	)

Definition at line 391 of file mod_utils.f90.

    implicit none
   integer, intent(in) :: nsze
    REAL(SPA), INTENT(IN)  :: LON(nsze), LAT(nsze)
    character(LEN=*), INTENT(IN)    :: proj_ref
    REAL(SPA), intent(out):: X(nsze), Y(nsze)

    x=-1.0_spa
    y=-1.0_spa

fatal_error()

subroutine mod_utils::fatal_error	(	character(len=*)	ER1,
		character(len=*), optional	ER2,
		character(len=*), optional	ER3,
		character(len=*), optional	ER4
	)

Definition at line 230 of file mod_utils.f90.

    USE control, only: prg_name
    implicit none
    character(Len=*) :: ER1
    CHARACTER(LEN=*), OPTIONAL   :: ER2
    CHARACTER(LEN=*), OPTIONAL   :: ER3
    CHARACTER(LEN=*), OPTIONAL   :: ER4

    if(dbg_set(dbg_log)) then
       write(ipt,*) "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
       write(ipt,*) trim(prg_name)//" Fatal Error!"
       write(ipt,*) er1
       IF(PRESENT(er2)) WRITE(ipt,*) er2
       IF(PRESENT(er3)) WRITE(ipt,*) er3
       IF(PRESENT(er4)) WRITE(ipt,*) er4
       write(ipt,*) "Stopping "//trim(prg_name)
       write(ipt,*) "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%"
    end if
    call pstop

Here is the call graph for this function:

find_element_containing()

integer function mod_utils::find_element_containing	(	real(sp), intent(in)	xloc,
		real(sp), intent(in)	yloc,
		integer, intent(in), optional	GUESS
	)

Definition at line 1185 of file mod_utils.f90.

     !==============================================================================|
     !  find home element for points (x,y)                                          |
     !  search nearest element to progressively further elements.
     !==============================================================================|

     !------------------------------------------------------------------------------|

     use all_vars
     implicit none
     INTEGER :: EID

     !------------------------------------------------------------------------------|
     real(sp),INTENT(IN) :: xloc,yloc
     INTEGER, INTENT(IN),OPTIONAL :: GUESS

     IF(PRESENT(guess)) THEN
        eid  = find_element_containing_quick(xloc,yloc,guess)
        IF (eid /= 0) RETURN
     END IF

     eid  = find_element_containing_robust(xloc,yloc)

Here is the call graph for this function:

find_element_containing_quick()

integer function mod_utils::find_element_containing_quick	(	real(sp), intent(in)	xloc,
		real(sp), intent(in)	yloc,
		integer, intent(in)	Guess
	)

Definition at line 1271 of file mod_utils.f90.

     !==============================================================================|
     !  determine which element a location reside in by searching neighboring 
     !  elements.  
     !==============================================================================|

     !------------------------------------------------------------------------------|

     use all_vars, only: nv,nbve,ntve,nv
     implicit none
     INTEGER :: EID

     REAL(SP), INTENT(IN) :: Xloc,Yloc
     INTEGER, INTENT(IN)  :: GUESS

     integer i,j,k,iney,ncheck
     real(sp), dimension(3) :: xlast,ylast,xney,yney

     !==============================================================================|
     eid = 0 
     IF (guess == 0) RETURN

     if(isintriangle(guess,xloc,yloc))then       !!particle remains in element
        eid = guess
     else                                             !!check neighbors
        outer: do j=1,3
           ncheck = nv(guess,j)
           do k=1,ntve(ncheck)
              iney = nbve(ncheck,k) 
              if(isintriangle(iney,xloc,yloc))then
                 eid   = iney 
                 exit outer
              end if
           end do
        end do outer
     end if
     
     return

Here is the call graph for this function:

Here is the caller graph for this function:

find_element_containing_robust()

integer function mod_utils::find_element_containing_robust	(	real(sp), intent(in)	xloc,
		real(sp), intent(in)	yloc
	)

Definition at line 1215 of file mod_utils.f90.

     !==============================================================================|
     !  find home element for points (x,y)                                          |
     !  search nearest element to progressively further elements.
     !==============================================================================|

     !------------------------------------------------------------------------------|

     use all_vars
     USE mod_spherical
     implicit none
     INTEGER :: EID

     !------------------------------------------------------------------------------|
     real(sp),INTENT(IN) :: xloc,yloc

     integer i,min_loc
     real(sp), dimension(1:nt,1) :: radlist
     real(sp), dimension(3) :: xtri,ytri
     real(sp) :: radlast
     integer  :: locij(2), cnt

     !==============================================================================|

     eid = 0

     cnt = 0
!     radlist(1:nt,1) = sqrt((xc(1:nt)-xloc)**2 + (yc(1:nt)-yloc)**2)

!---------------------------------------------------------------
     radlist(1:nt,1) = abs(xc(1:nt)-xloc) + abs(yc(1:nt)-yloc)

     radlast = -1.0_sp
     in:  do while(cnt < 50)
        cnt = cnt+1
        locij   = minloc(radlist,radlist>radlast)
        min_loc = locij(1)
        if(min_loc == 0) then
           exit in
        end if

        if(isintriangle(min_loc,xloc,yloc))then
           eid = min_loc
           exit in 
        end if
        radlast = radlist(min_loc,1)
     end do in

     return

Here is the call graph for this function:

Here is the caller graph for this function:

fopen()

subroutine mod_utils::fopen	(	integer, intent(in)	IUNIT,
		character(len=*)	INSTR,
		character(len=3), intent(in)	IOPT
	)

Definition at line 1577 of file mod_utils.f90.

!==============================================================================|
! FOPEN Utility to open non Netcdf files
!==============================================================================|
  
   IMPLICIT NONE
   INTEGER, INTENT(IN)             :: IUNIT
   CHARACTER(LEN=*)                :: INSTR 
   CHARACTER(LEN=3), INTENT(IN)    :: IOPT  
   CHARACTER(LEN=11) :: FORMSTR
   CHARACTER(LEN=7) :: STATSTR
   LOGICAL CHECK,FEXIST
   CHARACTER(LEN=2) :: cios
   integer :: ios

   IF(iopt(1:1) == "c")THEN  
     statstr = "old"
     check = .true.
   ELSE IF(iopt(1:1) == "o") THEN 
     statstr = "unknown"
     check = .false.
   ELSE
     CALL fatal_error("FIRST LETTER IN FOPEN OPTION STRING MUST BE 'c' OR 'o'")
   END IF

   IF(iopt(2:2) == "f")THEN  
     formstr = "formatted"
   ELSE IF(iopt(2:2) == "u") THEN 
     formstr = "unformatted"
   ELSE
     CALL fatal_error("ERROR PROCESSING FOPEN ON FILE",instr,"2ND LETTER IN FOPEN OPTION STRING MUST BE 'f' OR 'u'")
   END IF

   IF(check)THEN
     INQUIRE(file=instr,exist=fexist)
     IF(.NOT. fexist)  CALL fatal_error("FILE "//instr//" NOT FOUND")
   END IF

   OPEN(iunit,file=instr,status=trim(statstr),form=trim(formstr),iostat=ios) 


   write(cios,'(i2.2)') ios
   if (ios == 9) then
      CALL fatal_error("UNABLE TO OPEN THE FILE:",&
           & instr, "IOSTAT ERROR#"//cios//"; suggests bad permissions ?")
      
   elseif (ios ==29) then
      CALL fatal_error("UNABLE TO OPEN THE FILE:",&
           & instr, "IOSTAT ERROR#"//cios//"; suggests bad directory path ?")
      
      
   elseif (ios /= 0)then
      Call fatal_error("UNABLE TO OPEN THE FILE:",instr,"IOSTAT ERROR# &
           &"//cios//"; UNNKOWN ERROR ?")
   END IF


   IF(iopt(3:3) == "r")  rewind(iunit)

   if(dbg_set(dbg_io))  &
        & write(ipt,*) "Opend File: ",instr
   

Here is the call graph for this function:

Here is the caller graph for this function:

get_value()

subroutine mod_utils::get_value	(	integer, intent(in)	LNUM,
		integer, intent(in)	NUMCHAR,
		character(len=numchar)	TEXT_LINE,
		character(len=40), intent(out)	VARNAME,
		character(len=7), intent(out)	VARTYPE,
		logical, intent(out)	LOGVAL,
		character(len=80), dimension(150), intent(out)	STRINGVAL,
		real(dp), dimension(150), intent(inout)	REALVAL,
		integer, dimension(150), intent(inout)	INTVAL,
		integer, intent(out)	NVAL
	)

Definition at line 1677 of file mod_utils.f90.

!==============================================================================!
  USE mod_prec
  IMPLICIT NONE
  INTEGER, INTENT(IN) :: LNUM,NUMCHAR
  CHARACTER(LEN=NUMCHAR) :: TEXT_LINE
  CHARACTER(LEN=40), INTENT(OUT) :: VARNAME
  CHARACTER(LEN=7), INTENT(OUT) :: VARTYPE
  LOGICAL, INTENT(OUT) :: LOGVAL
  CHARACTER(LEN=80), INTENT(OUT) :: STRINGVAL(150)
  REAL(DP), INTENT(INOUT) :: REALVAL(150)
  INTEGER, INTENT(INOUT) :: INTVAL(150)
  INTEGER, INTENT(OUT) :: NVAL
!------------------------------------------------------------------------------!
  CHARACTER(LEN=NUMCHAR) :: VARVAL,TEMP,FRAG(200)
  CHARACTER(LEN=80) :: TSTRING
  CHARACTER(LEN=3) :: ERRSTRING
  CHARACTER(LEN=16) :: NUMCHARS 
  INTEGER LENGTH,EQLOC,LVARVAL,DOTLOC
  INTEGER I,J,LOCEX,NP
  LOGICAL ONFRAG

!==============================================================================!
  frag = " "
  numchars = "0123456789+-Ee. " 
  vartype = "error"
  logval = .false.
  length = len_trim(text_line) 
  WRITE(errstring,"(I3)") lnum
  locex = index(text_line,"!")

!
!-----------------------CHECK FOR BLANK LINE OR COMMENT------------------------!
!
  IF(length == 0 .OR. locex==1)THEN
    vartype = "no data"
    varname = "no data"
    RETURN
  END IF

!
!-----------------------CHANGE COMMAS TO BLANKS--------------------------------!
!
  DO i=1,length
    IF(text_line(i:i) == ",") text_line(i:i) = " "
  END DO
!
!-----------------------REMOVING TRAILING COMMENTS-----------------------------!
!
  IF(locex /= 0)THEN
    temp = text_line(1:locex-1)
    text_line = temp
   END IF
!
!--------------------ENSURE "=" EXISTS AND DETERMINE LOCATION------------------!
!
   eqloc = index(text_line,"=")
   IF(eqloc == 0) then
      CALL warning(& 
        &'Could not find correct variable name in the datafile header',&
        &'Header comment lines must start with "!", Data lines must contain "="',&
        &'DATA LINE '//errstring//': This often occurs if the header variable is missing!')
      vartype = "no data"
      varname = "no data"
      RETURN
   END IF

!
!--------------------SPLIT OFF VARNAME AND VARVAL STRINGS----------------------!
!
   varname = text_line(1:eqloc-1)
   varval  = adjustl(text_line(eqloc+1:length))
   lvarval = len_trim(varval)
   IF(lvarval == 0) then
      CALL warning('IN DATA PARAMETER FILE', &
           & 'VARIABLE'//varname//'; LINE'//errstring//' HAS NO ASSOCIATED VALUE')
      vartype = "no data"
      varname = "no data"
      RETURN
   END IF

!-----------------DETERMINE TYPE OF VARVAL-------------------------------------!
!

!
!  CHECK FOR LOGICAL
!
   IF((varval(1:1) == "T" .OR. varval(1:1) == "F") .AND. lvarval == 1)THEN 
     vartype = "logical"
     IF(varval(1:1) == "T") logval = .true.
     RETURN
   END IF

!
!  CHECK IF IT IS A STRING  (CONTAINS CHARACTERS OTHER THAN 0-9,+,-,e,E,.)
!
   DO i=1,lvarval
     IF(index(numchars,varval(i:i)) == 0) vartype = "string" 
   END DO

!
!  PROCESS STRING (MAY BE MULTIPLE)
!
   IF(vartype == "string") THEN
     tstring = varval
     stringval(1) = tstring 
     nval = 1
     onfrag = .true.
     DO i=1,lvarval
       IF(varval(i:i) /= " ")THEN
         frag(nval) = trim(frag(nval))//varval(i:i)
         onfrag = .true.
       ELSE
         IF(onfrag) nval = nval + 1
         onfrag = .false.
       END IF
     END DO
     DO i=1,nval
       stringval(i+1) = trim(frag(i))
     END DO
     RETURN
   END IF

!
!  CHECK IF IT IS A FLOAT
!

   dotloc = index(varval,".")
   IF(dotloc /= 0) THEN
     vartype = "float"
   ELSE
     vartype = "integer"
   END IF
!
!-----------------FRAGMENT INTO STRINGS FOR MULTIPLE VALUES---------------------!
!
   np = 1
   onfrag = .true.
   DO i=1,lvarval
     IF(varval(i:i) /= " ")THEN 
       frag(np) = trim(frag(np))//varval(i:i)
       onfrag = .true.
     ELSE
       IF(onfrag) np = np + 1
       onfrag = .false.
     END IF
   END DO
!
!-----------------EXTRACT NUMBER(S) FROM CHARACTER STRINGS----------------------!
!
   
   nval = np
   DO i=1,np
     temp = trim(frag(i))
     IF(vartype == "float") THEN 
       READ(temp,*)realval(i)
     ELSE
       READ(temp,*)intval(i)
     END IF
   END DO

Here is the call graph for this function:

Here is the caller graph for this function:

grid_neighbor_index()

subroutine mod_utils::grid_neighbor_index	(	integer, dimension(:), pointer	FOUND,
		integer, dimension(:,:), pointer	IDEX,
		integer, dimension(:), pointer	CNT,
		integer, dimension(:), pointer	ORDER
	)

Definition at line 1423 of file mod_utils.f90.

    USE all_vars
    IMPLICIT NONE
    INTEGER, POINTER :: FOUND(:)
    INTEGER, POINTER :: IDEX(:,:)
    INTEGER, POINTER :: CNT(:)
    INTEGER, POINTER :: ORDER(:)
    
    INTEGER :: i,j
    INTEGER :: LOOP
    INTEGER :: ORD
    ! DO NO ALLOCATION HERE - ASSUME ALL VARIALBE ARE ALLOCATED
    
    ! LOOKING FOR NEIGHBORING NODES
    IF (ubound(found,1) == mt) THEN
    
       loop = 0
       ord = 0
       DO WHILE(any(found==-1))
          
          loop = loop +1
          IF(loop>m) CALL fatal_error&
               &("LOOP COUNT EXCEEDED IN GRID_NEIGHBOR_INDEX")

          DO i=1,m
             
             IF(found(i) == -1) THEN

                ! look to see if this node has neighbors which are set
                DO j=1,ntsn(i)
                   IF(found(nbsn(i,j))>-1.and.found(nbsn(i,j))<loop )THEN
                      ! INCREASE THE COUNT FOR AVERAGE
                      cnt(i)= cnt(i) +1
                      ! RECORD THE INDEX
                      idex(i,cnt(i)) = nbsn(i,j)
                      ! RECORD WHICH LOOP FOUND IT
                      found(i) = loop

                   END IF
                   
                   
                END DO
                
                ! RECORD THE ORDER IN WHICH THIS NODE WAS FOUND
                IF (cnt(i) >0) THEN
                   ord = ord +1
                   order(ord) = i
                END IF
                   
             END IF

          END DO

       END DO

    ! LOOKING FOR NEIGHBORING ELEMENTS
    ELSEIF (ubound(found,1) == nt) THEN

       loop = 0
       ord = 0
       DO WHILE(any(found==-1))
          
          loop = loop +1
          IF(loop>n) CALL fatal_error&
               &("LOOP COUNT EXCEEDED IN GRID_NEIGHBOR_INDEX")

          DO i=1,n
             
             IF(found(i) == -1) THEN

                ! look to see if this element has neighbors which are found
                DO j=1,3
                   IF(found(nbe(i,j))>-1 .and.found(nbe(i,j))<loop )THEN
                      ! INCREASE THE COUNT FOR AVERAGE
                      cnt(i)= cnt(i) +1
                      ! RECORD THE INDEX
                      idex(i,cnt(i)) = nbe(i,j)
                      ! RECORD WHICH LOOP FOUND IT
                      found(i) = loop

                   END IF
                   
                   
                END DO
                
                ! RECORD THE ORDER IN WHICH THIS NODE WAS FOUND
                IF (cnt(i) >0) THEN
                   ord = ord +1
                   order(ord) = i
                END IF
                   
             END IF

          END DO

       END DO


    ELSE

       CALL fatal_error("PASSED INVALID SIZE TO GRID_NEIGHBOR_INDEX ???")
    
    END IF

Here is the call graph for this function:

Here is the caller graph for this function:

have_proj()

logical function mod_utils::have_proj

(

character(len=*), intent(in)

proj_ref

)

Definition at line 376 of file mod_utils.f90.

     LOGICAL :: RES
     character(LEN=*), INTENT(IN)    :: proj_ref
     res=.false.

Here is the caller graph for this function:

initialize_control()

subroutine mod_utils::initialize_control

(

character(len=*), intent(in)

NAME

)

Definition at line 141 of file mod_utils.f90.

    USE lims
    USE control
    IMPLICIT NONE
    CHARACTER(LEN=*), INTENT(IN) :: NAME
    
!==============================================================================!
!  FVCOM VERSION                                                               !
!==============================================================================!

   fvcom_version     = 'FVCOM_3.0'
   fvcom_website     = 'http://fvcom.smast.umassd.edu, http://codfish.smast.umassd.edu'
   institution       = 'School for Marine Science and Technology'

   ! Set the IO UNIT value to screen output for now:
   ipt = 6


!==============================================================================!
!   SETUP PARALLEL ENVIRONMENT                                                 !
!==============================================================================!
   ! DEFAULT SETTINGS
                 serial = .true. 
                    par = .false. 
                    msr = .true.
         in_mpi_io_loop = .false.
        use_mpi_io_mode = .false.
                   myid = 1
                  msrid = 1
                 nprocs = 1
               prg_name = name
            mx_nbr_elem = 0
           nprocs_total => nprocs
               ioprocid =-1

         zerotime%MUSOD = 0
           zerotime%MJD = 0
        mpi_fvcom_group = -1

Here is the caller graph for this function:

interp_anodal_2d_dbl()

real(dp) function mod_utils::interp_anodal_2d_dbl	(	real(dp), intent(in)	xloc,
		real(dp), intent(in)	yloc,
		integer, intent(in)	i,
		real(dp), dimension(:), intent(in), allocatable, target	Field
	)

Definition at line 535 of file mod_utils.f90.

     IMPLICIT NONE
     REAL(DP) :: FPT
     INTEGER, INTENT(IN) :: i ! Cell Number
     REAL(DP), INTENT(IN):: xloc,yloc
     REAL(DP), ALLOCATABLE, TARGET, INTENT(IN) ::FIELD(:) 
     REAL(DP), POINTER :: PFIELD(:)
     
     pfield => field
     fpt = interp_pnodal_2d_dbl(xloc,yloc,i,pfield)

Here is the call graph for this function:

interp_anodal_2d_flt()

real(spa) function mod_utils::interp_anodal_2d_flt	(	real(spa), intent(in)	xloc,
		real(spa), intent(in)	yloc,
		integer, intent(in)	i,
		real(spa), dimension(:), intent(in), allocatable, target	Field
	)

Definition at line 522 of file mod_utils.f90.

     IMPLICIT NONE
     REAL(SPA) :: FPT
     INTEGER, INTENT(IN) :: i ! Cell Number
     REAL(SPA), INTENT(IN):: xloc,yloc
     REAL(SPA), ALLOCATABLE, TARGET, INTENT(IN) ::FIELD(:) 
     REAL(SPA), POINTER :: PFIELD(:)
     
     pfield => field
     fpt = interp_pnodal_2d_flt(xloc,yloc,i,pfield)

Here is the call graph for this function:

interp_anodal_3d_dbl()

real(dp) function mod_utils::interp_anodal_3d_dbl	(	real(dp), intent(in)	xloc,
		real(dp), intent(in)	yloc,
		real(dp), intent(in)	sigloc,
		integer, intent(in)	lvls,
		integer, intent(in)	i,
		real(dp), dimension(:,:), intent(in), allocatable, target	Field
	)

Definition at line 639 of file mod_utils.f90.

     IMPLICIT NONE
     REAL(DP) :: FPT
     INTEGER, INTENT(IN) :: i,lvls ! Cell Number, Number of Levels in data (kb or kbm1)
     REAL(DP), INTENT(IN):: xloc,yloc,sigloc
     REAL(DP), ALLOCATABLE, TARGET, INTENT(IN) ::FIELD(:,:)
     REAL(DP), POINTER :: PFIELD(:,:)

     pfield => field
     fpt = interp_pnodal_3d_dbl(xloc,yloc,sigloc,lvls,i,pfield)

Here is the call graph for this function:

interp_anodal_3d_flt()

real(spa) function mod_utils::interp_anodal_3d_flt	(	real(spa), intent(in)	xloc,
		real(spa), intent(in)	yloc,
		real(spa), intent(in)	sigloc,
		integer, intent(in)	lvls,
		integer, intent(in)	i,
		real(spa), dimension(:,:), intent(in), allocatable, target	Field
	)

Definition at line 626 of file mod_utils.f90.

     IMPLICIT NONE
     REAL(SPA) :: FPT
     INTEGER, INTENT(IN) :: i,lvls ! Cell Number, Number of Levels in data (kb or kbm1)
     REAL(SPA), INTENT(IN):: xloc,yloc,sigloc
     REAL(SPA), ALLOCATABLE, TARGET, INTENT(IN) ::FIELD(:,:)
     REAL(SPA), POINTER :: PFIELD(:,:)

     pfield => field
     fpt = interp_pnodal_3d_flt(xloc,yloc,sigloc,lvls,i,pfield)

Here is the call graph for this function:

interp_azonal_2d_dbl()

real(dp) function mod_utils::interp_azonal_2d_dbl	(	real(dp), intent(in)	xloc,
		real(dp), intent(in)	yloc,
		integer, intent(in)	i,
		real(dp), dimension(:), intent(in), allocatable, target	Field
	)

Definition at line 871 of file mod_utils.f90.

     IMPLICIT NONE
     REAL(DP) :: FPT
     INTEGER, INTENT(IN) :: i ! Cell Number
     REAL(DP), INTENT(IN):: xloc,yloc
     REAL(DP), ALLOCATABLE, TARGET, INTENT(IN) ::FIELD(:) 
     REAL(DP), POINTER :: PFIELD(:)
     
     pfield => field
     fpt = interp_pzonal_2d_dbl(xloc,yloc,i,pfield)

Here is the call graph for this function:

interp_azonal_2d_flt()

real(spa) function mod_utils::interp_azonal_2d_flt	(	real(spa), intent(in)	xloc,
		real(spa), intent(in)	yloc,
		integer, intent(in)	i,
		real(spa), dimension(:), intent(in), allocatable, target	Field
	)

Definition at line 858 of file mod_utils.f90.

     IMPLICIT NONE
     REAL(SPA) :: FPT
     INTEGER, INTENT(IN) :: i ! Cell Number
     REAL(SPA), INTENT(IN):: xloc,yloc
     REAL(SPA), ALLOCATABLE, TARGET, INTENT(IN) ::FIELD(:) 
     REAL(SPA), POINTER :: PFIELD(:)
     
     pfield => field
     fpt = interp_pzonal_2d_flt(xloc,yloc,i,pfield)

Here is the call graph for this function:

interp_azonal_3d_dbl()

real(dp) function mod_utils::interp_azonal_3d_dbl	(	real(dp), intent(in)	xloc,
		real(dp), intent(in)	yloc,
		real(dp), intent(in)	sigloc,
		integer, intent(in)	lvls,
		integer, intent(in)	i,
		real(dp), dimension(:,:), intent(in), allocatable, target	Field
	)

Definition at line 973 of file mod_utils.f90.

     IMPLICIT NONE
     REAL(DP) :: FPT
     INTEGER, INTENT(IN) :: i, lvls ! Cell Number, Number of levels(kb,or kbm1)
     REAL(DP), INTENT(IN):: xloc,yloc,sigloc
     REAL(DP), ALLOCATABLE, TARGET, INTENT(IN) ::FIELD(:,:) 
     REAL(DP), POINTER :: PFIELD(:,:)
     
     pfield => field
     fpt = interp_pzonal_3d_dbl(xloc,yloc,sigloc,lvls,i,pfield)

Here is the call graph for this function:

interp_azonal_3d_flt()

real(spa) function mod_utils::interp_azonal_3d_flt	(	real(spa), intent(in)	xloc,
		real(spa), intent(in)	yloc,
		real(spa), intent(in)	sigloc,
		integer, intent(in)	lvls,
		integer, intent(in)	i,
		real(spa), dimension(:,:), intent(in), allocatable, target	Field
	)

Definition at line 960 of file mod_utils.f90.

     IMPLICIT NONE
     REAL(SPA) :: FPT
     INTEGER, INTENT(IN) :: i, lvls ! Cell Number, Number of levels(kb,or kbm1)
     REAL(SPA), INTENT(IN):: xloc,yloc,sigloc
     REAL(SPA), ALLOCATABLE, TARGET, INTENT(IN) ::FIELD(:,:) 
     REAL(SPA), POINTER :: PFIELD(:,:)
     
     pfield => field
     fpt = interp_pzonal_3d_flt(xloc,yloc,sigloc,lvls,i,pfield)

Here is the call graph for this function:

interp_pnodal_2d_dbl()

real(dp) function mod_utils::interp_pnodal_2d_dbl	(	real(dp), intent(in)	xloc,
		real(dp), intent(in)	yloc,
		integer, intent(in)	i,
		real(dp), dimension(:), intent(in), pointer	Field
	)

Definition at line 585 of file mod_utils.f90.

     USE all_vars, only : aw0,awx,awy,nv,xc,yc
     IMPLICIT NONE
     REAL(DP) :: FPT
     INTEGER, INTENT(IN) :: i  ! Cell Number
     REAL(DP), INTENT(IN):: xloc,yloc
     REAL(DP), POINTER, INTENT(IN) :: FIELD(:) 

     REAL(DP):: X0c, Y0c,F0,Fx,Fy
     INTEGER :: n1,n2,n3
     REAL(DP) :: dx_sph
     IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "START: INTERP_PNODAL_2D"

     !element location (i) and surrounding nodes (n1,n2,n3)
     n1  = nv(i,1)
     n2  = nv(i,2)
     n3  = nv(i,3)

!offset from element center
!---------------------------------------------------------------
     !offset from element center
     x0c = xloc - xc(i)
     y0c = yloc - yc(i)
!---------------------------------------------------------------
!---------------------------------------------------------------

     !linear interpolation of Field
     f0 = aw0(i,1)*field(n1)+aw0(i,2)*field(n2)+aw0(i,3)*field(n3)
     fx = awx(i,1)*field(n1)+awx(i,2)*field(n2)+awx(i,3)*field(n3)
     fy = awy(i,1)*field(n1)+awy(i,2)*field(n2)+awy(i,3)*field(n3)
     fpt = f0 + fx*x0c + fy*y0c


     IF(dbg_set(dbg_sbr)) WRITE(ipt,*)"END: INTERP_PNODAL_2D"

Here is the call graph for this function:

Here is the caller graph for this function:

interp_pnodal_2d_flt()

real(spa) function mod_utils::interp_pnodal_2d_flt	(	real(spa), intent(in)	xloc,
		real(spa), intent(in)	yloc,
		integer, intent(in)	i,
		real(spa), dimension(:), intent(in), pointer	Field
	)

Definition at line 548 of file mod_utils.f90.

     USE all_vars, only : aw0,awx,awy,nv,xc,yc
     IMPLICIT NONE
     REAL(SPA) :: FPT
     INTEGER, INTENT(IN) :: i  ! Cell Number
     REAL(SPA), INTENT(IN):: xloc,yloc
     REAL(SPA), POINTER, INTENT(IN) :: FIELD(:) 

     REAL(SPA):: X0c, Y0c,F0,Fx,Fy
     INTEGER :: n1,n2,n3
     REAL(SPA) :: dx_sph
     IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "START: INTERP_PNODAL_2D"

     !element location (i) and surrounding nodes (n1,n2,n3)
     n1  = nv(i,1)
     n2  = nv(i,2)
     n3  = nv(i,3)

!offset from element center
!---------------------------------------------------------------

     x0c = xloc - xc(i)
     y0c = yloc - yc(i)
!---------------------------------------------------------------
!---------------------------------------------------------------

     !linear interpolation of Field
     f0 = aw0(i,1)*field(n1)+aw0(i,2)*field(n2)+aw0(i,3)*field(n3)
     fx = awx(i,1)*field(n1)+awx(i,2)*field(n2)+awx(i,3)*field(n3)
     fy = awy(i,1)*field(n1)+awy(i,2)*field(n2)+awy(i,3)*field(n3)
     fpt = f0 + fx*x0c + fy*y0c


     IF(dbg_set(dbg_sbr)) WRITE(ipt,*)"END: INTERP_PNODAL_2D"

Here is the call graph for this function:

Here is the caller graph for this function:

interp_pnodal_3d_dbl()

real(dp) function mod_utils::interp_pnodal_3d_dbl	(	real(dp), intent(in)	xloc,
		real(dp), intent(in)	yloc,
		real(dp), intent(in)	sigloc,
		integer, intent(in)	lvls,
		integer, intent(in)	i,
		real(dp), dimension(:,:), intent(in), pointer	Field
	)

Definition at line 752 of file mod_utils.f90.

     USE all_vars, only : aw0,awx,awy,nv,xc,yc,kbm2,kbm1,kb,z1,zz1,dz1,dzz1
     IMPLICIT NONE
     REAL(DP) :: FPT
     INTEGER, INTENT(IN) :: i, lvls ! Cell Number, Number of Levels in data (kb or kbm1)
     REAL(DP), INTENT(IN):: xloc,yloc,sigloc
     REAL(DP), POINTER, INTENT(IN) :: FIELD(:,:) 

     REAL(DP):: X0c,Y0c,F0,Fx,Fy,F_LOWER,F_UPPER, alpha,dsig
     INTEGER :: n1,n2,n3,k1,k2,k
     REAL(DP) :: dx_sph

     IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "START: INTERP_PNODAL_3D"
     
     !element location (i) and surrounding nodes (n1,n2,n3)
     n1  = nv(i,1)
     n2  = nv(i,2)
     n3  = nv(i,3)

!offset from element center
!---------------------------------------------------------------
     
     x0c = xloc - xc(i)
     y0c = yloc - yc(i)
!---------------------------------------------------------------
!---------------------------------------------------------------


     ! Determine the layer in which the point resides
     IF(lvls == kbm1) THEN

        !top
        if(sigloc >= zz1(i,1))then
           k1 = 1
           k2 = 1
           alpha = -1
        elseif(sigloc > zz1(i,kbm1)) then!intermediate 
           do k=1,kbm2
              if(sigloc  < zz1(i,k) .and. sigloc >= zz1(i,k+1) )then
                 k1 = k
                 k2 = k+1 
                 alpha = (zz1(i,k)-sigloc)/dzz1(i,k)
                 exit
              endif
           end do
        else
           ! TOP
           k1 = kbm1
           k2 = kbm1
           alpha = -1
        endif
     ELSE IF(lvls == kb) THEN
        
        !top
        if(sigloc >= z1(i,1))then
           k1 = 1
           k2 = 1
           alpha = -1
        elseif(sigloc > z1(i,kb)) then !intermediate 
           do k=1,kbm1
              if(sigloc  < z1(i,k) .and. sigloc >= z1(i,k+1) )then
                 k1 = k
                 k2 = k+1 
                 alpha = (z1(i,k)-sigloc)/dz1(i,k)
              endif
           end do
        else
           !bottom
           k1 = kbm1
           k2 = kbm1
           alpha = -1 
        endif

     ELSE
        CALL fatal_error("INTERP_PNODAL_3D: Invalid number of levels passed",&
             & "(Must be equal to either KB or KBM1")
     END IF
        
     !linear interpolation of Field
     f0 = aw0(i,1)*field(n1,k1)+aw0(i,2)*field(n2,k1)+aw0(i,3)*field(n3,k1)
     fx = awx(i,1)*field(n1,k1)+awx(i,2)*field(n2,k1)+awx(i,3)*field(n3,k1)
     fy = awy(i,1)*field(n1,k1)+awy(i,2)*field(n2,k1)+awy(i,3)*field(n3,k1)
     f_upper = f0 + fx*x0c + fy*y0c

     IF(k1 == k2) THEN
        fpt = f_upper

     ELSE
        
        f0 = aw0(i,1)*field(n1,k2)+aw0(i,2)*field(n2,k2)+aw0(i,3)*field(n3,k2)
        fx = awx(i,1)*field(n1,k2)+awx(i,2)*field(n2,k2)+awx(i,3)*field(n3,k2)
        fy = awy(i,1)*field(n1,k2)+awy(i,2)*field(n2,k2)+awy(i,3)*field(n3,k2)
        f_lower = f0 + fx*x0c + fy*y0c

        fpt = (alpha)*f_lower + (1.0_dp-alpha)*f_upper
     END IF


     IF(dbg_set(dbg_sbr)) WRITE(ipt,*)"END: INTERP_PNODAL_3D"

Here is the call graph for this function:

Here is the caller graph for this function:

interp_pnodal_3d_flt()

real(spa) function mod_utils::interp_pnodal_3d_flt	(	real(spa), intent(in)	xloc,
		real(spa), intent(in)	yloc,
		real(spa), intent(in)	sigloc,
		integer, intent(in)	lvls,
		integer, intent(in)	i,
		real(spa), dimension(:,:), intent(in), pointer	Field
	)

Definition at line 652 of file mod_utils.f90.

     USE all_vars, only : aw0,awx,awy,nv,xc,yc,kbm2,kbm1,kb,z1,zz1,dz1,dzz1
     IMPLICIT NONE
     REAL(SPA) :: FPT
     INTEGER, INTENT(IN) :: i, lvls ! Cell Number, Number of Levels in data (kb or kbm1)
     REAL(SPA), INTENT(IN):: xloc,yloc,sigloc
     REAL(SPA), POINTER, INTENT(IN) :: FIELD(:,:) 

     REAL(SPA):: X0c,Y0c,F0,Fx,Fy,F_LOWER,F_UPPER, alpha,dsig
     INTEGER :: n1,n2,n3,k1,k2,k
     REAL(SPA) :: dx_sph

     IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "START: INTERP_PNODAL_3D"
     
     !element location (i) and surrounding nodes (n1,n2,n3)
     n1  = nv(i,1)
     n2  = nv(i,2)
     n3  = nv(i,3)

!offset from element center
!---------------------------------------------------------------

     x0c = xloc - xc(i)
     y0c = yloc - yc(i)
!---------------------------------------------------------------
!---------------------------------------------------------------

     ! Determine the layer in which the point resides
     IF(lvls == kbm1) THEN

        !top
        if(sigloc >= zz1(i,1))then
           k1 = 1
           k2 = 1
           alpha = -1
        elseif(sigloc > zz1(i,kbm1)) then!intermediate 
           do k=1,kbm2
              if(sigloc  < zz1(i,k) .and. sigloc >= zz1(i,k+1) )then
                 k1 = k
                 k2 = k+1 
                 alpha = (zz1(i,k)-sigloc)/dzz1(i,k)
                 exit
              endif
           end do
        else
           ! TOP
           k1 = kbm1
           k2 = kbm1
           alpha = -1
        endif
     ELSE IF(lvls == kb) THEN
        
        !top
        if(sigloc >= z1(i,1))then
           k1 = 1
           k2 = 1
           alpha = -1
        elseif(sigloc > z1(i,kb)) then !intermediate 
           do k=1,kbm1
              if(sigloc  < z1(i,k) .and. sigloc >= z1(i,k+1) )then
                 k1 = k
                 k2 = k+1 
                 alpha = (z1(i,k)-sigloc)/dz1(i,k)
              endif
           end do
        else
           !bottom
           k1 = kbm1
           k2 = kbm1
           alpha = -1 
        endif

     ELSE
        CALL fatal_error("INTERP_PNODAL_3D: Invalid number of levels passed",&
             & "(Must be equal to either KB or KBM1")
     END IF
        
     !linear interpolation of Field
     f0 = aw0(i,1)*field(n1,k1)+aw0(i,2)*field(n2,k1)+aw0(i,3)*field(n3,k1)
     fx = awx(i,1)*field(n1,k1)+awx(i,2)*field(n2,k1)+awx(i,3)*field(n3,k1)
     fy = awy(i,1)*field(n1,k1)+awy(i,2)*field(n2,k1)+awy(i,3)*field(n3,k1)
     f_upper = f0 + fx*x0c + fy*y0c

     IF(k1 == k2) THEN
        fpt = f_upper

     ELSE
        
        f0 = aw0(i,1)*field(n1,k2)+aw0(i,2)*field(n2,k2)+aw0(i,3)*field(n3,k2)
        fx = awx(i,1)*field(n1,k2)+awx(i,2)*field(n2,k2)+awx(i,3)*field(n3,k2)
        fy = awy(i,1)*field(n1,k2)+awy(i,2)*field(n2,k2)+awy(i,3)*field(n3,k2)
        f_lower = f0 + fx*x0c + fy*y0c

        fpt = (alpha)*f_lower + (1.0_spa-alpha)*f_upper
     END IF


     IF(dbg_set(dbg_sbr)) WRITE(ipt,*)"END: INTERP_PNODAL_3D"

Here is the call graph for this function:

Here is the caller graph for this function:

interp_pzonal_2d_dbl()

real(dp) function mod_utils::interp_pzonal_2d_dbl	(	real(dp), intent(in)	xloc,
		real(dp), intent(in)	yloc,
		integer, intent(in)	i,
		real(dp), dimension(:), intent(in), pointer	Field
	)

Definition at line 920 of file mod_utils.f90.

     USE all_vars, only : a1u,a2u,xc,yc,nbe
     IMPLICIT NONE
     REAL(DP) :: FPT
     INTEGER, INTENT(IN) :: i  ! Cell Number
     REAL(DP), INTENT(IN):: xloc,yloc
     REAL(DP), POINTER, INTENT(IN) :: FIELD(:) 

     REAL(DP):: X0c, Y0c,F0,Fx,Fy
     INTEGER :: e1,e2,e3
     REAL(DP) :: dx_sph
     IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "START: INTERP_PZONAL_2D"

!offset from element center
!---------------------------------------------------------------
     !offset from element center
     x0c = xloc - xc(i)
     y0c = yloc - yc(i)
!---------------------------------------------------------------
!---------------------------------------------------------------

     !Surrounding Element IDs
     e1  = nbe(i,1)
     e2  = nbe(i,2)
     e3  = nbe(i,3)

     !interpolate Field to the location
     fx = a1u(i,1)*field(i)+a1u(i,2)*field(e1)+a1u(i,3)*field(e2)+a1u(i,4)*field(e3)
     fy = a2u(i,1)*field(i)+a2u(i,2)*field(e1)+a2u(i,3)*field(e2)+a2u(i,4)*field(e3)
     fpt = field(i) + fx*x0c + fy*y0c
     
     IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "START: INTERP_PZONAL_2D"

Here is the call graph for this function:

Here is the caller graph for this function:

interp_pzonal_2d_flt()

real(spa) function mod_utils::interp_pzonal_2d_flt	(	real(spa), intent(in)	xloc,
		real(spa), intent(in)	yloc,
		integer, intent(in)	i,
		real(spa), dimension(:), intent(in), pointer	Field
	)

Definition at line 886 of file mod_utils.f90.

     USE all_vars, only : a1u,a2u,xc,yc,nbe
     IMPLICIT NONE
     REAL(SPA) :: FPT
     INTEGER, INTENT(IN) :: i  ! Cell Number
     REAL(SPA), INTENT(IN):: xloc,yloc
     REAL(SPA), POINTER, INTENT(IN) :: FIELD(:) 

     REAL(SPA):: X0c, Y0c,F0,Fx,Fy
     INTEGER :: e1,e2,e3
     REAL(SPA) :: dx_sph
     IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "START: INTERP_PZONAL_2D"

!offset from element center
!---------------------------------------------------------------

     x0c = xloc - xc(i)
     y0c = yloc - yc(i)
!---------------------------------------------------------------
!---------------------------------------------------------------
     !Surrounding Element IDs
     e1  = nbe(i,1)
     e2  = nbe(i,2)
     e3  = nbe(i,3)

     !interpolate Field to the location
     fx = a1u(i,1)*field(i)+a1u(i,2)*field(e1)+a1u(i,3)*field(e2)+a1u(i,4)*field(e3)
     fy = a2u(i,1)*field(i)+a2u(i,2)*field(e1)+a2u(i,3)*field(e2)+a2u(i,4)*field(e3)
     fpt = field(i) + fx*x0c + fy*y0c
     
     IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "START: INTERP_PZONAL_2D"

Here is the call graph for this function:

Here is the caller graph for this function:

interp_pzonal_3d_dbl()

real(dp) function mod_utils::interp_pzonal_3d_dbl	(	real(dp), intent(in)	xloc,
		real(dp), intent(in)	yloc,
		real(dp), intent(in)	sigloc,
		integer, intent(in)	lvls,
		integer, intent(in)	i,
		real(dp), dimension(:,:), intent(in), pointer	Field
	)

Definition at line 1083 of file mod_utils.f90.

     USE all_vars, only : a1u,a2u,xc,yc,nbe,kbm2,kbm1,kb,z1,dz1,zz1,dzz1
     IMPLICIT NONE
     REAL(DP) :: FPT
     INTEGER, INTENT(IN) :: i,lvls  ! Cell Number, Number of levels(kb,or kbm1)
     REAL(DP), INTENT(IN):: xloc,yloc,sigloc
     REAL(DP), POINTER, INTENT(IN) :: FIELD(:,:) 

     REAL(DP):: X0c, Y0c,F0,Fx,Fy,alpha,F_upper,F_lower
     INTEGER :: e1,e2,e3,k1,k2,k

     REAL(DP) :: dx_sph
     IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "START: INTERP_PZONAL_3D"


!offset from element center
!---------------------------------------------------------------
     !offset from element center
     x0c = xloc - xc(i)
     y0c = yloc - yc(i)
!---------------------------------------------------------------
!---------------------------------------------------------------

     !Surrounding Element IDs
     e1  = nbe(i,1)
     e2  = nbe(i,2)
     e3  = nbe(i,3)

!----determine sigma layers above and below sigloc

     IF(lvls == kbm1) THEN

        k1  = 1
        k2  = 1
        alpha = -1
        if(sigloc < zz1(i,kbm1)) then !!particle near bottom
           k1 = kbm1
           k2 = kbm1
           alpha = -1
        else
           do k=1,kbm2
              if(sigloc  < zz1(i,k) .and. sigloc >= zz1(i,k+1) )then
                 k1 = k
                 k2 = k+1 
                 alpha = (zz1(i,k)-sigloc)/dzz1(i,k)
                 exit
              endif
           end do
        end if
        
     ELSE IF(lvls == kb) THEN
        
        !surface (default)
        k1 = 1
        k2 = 1
        alpha = -1        
        !bottom
        if(sigloc < z1(i,kb))then
           k1 = kb
           k2 = kb
           alpha = -1
        else !intermediate 
           do k=1,kbm1
              if(sigloc  < z1(i,k) .and. sigloc >= z1(i,k+1) )then
                 k1 = k
                 k2 = k+1 
                 alpha = (z1(i,k)-sigloc)/dz1(i,k)
              endif
           end do
        endif

     ELSE
        CALL fatal_error("INTERP_PZONAL_3D: Invalid number of levels passed",&
             & "(Must be equal to either KB or KBM1")
     END IF

     !interpolate Field to the location
     fx = a1u(i,1)*field(i,k1)+a1u(i,2)*field(e1,k1)+a1u(i,3)*field(e2,k1)+a1u(i,4)*field(e3,k1)
     fy = a2u(i,1)*field(i,k1)+a2u(i,2)*field(e1,k1)+a2u(i,3)*field(e2,k1)+a2u(i,4)*field(e3,k1)
     f_upper = field(i,k1) + fx*x0c + fy*y0c
     
     IF(k1 == k2) THEN
        fpt = f_upper
     ELSE
        
        fx = a1u(i,1)*field(i,k2)+a1u(i,2)*field(e1,k2)+a1u(i,3)*field(e2,k2)+a1u(i,4)*field(e3,k2)
        fy = a2u(i,1)*field(i,k2)+a2u(i,2)*field(e1,k2)+a2u(i,3)*field(e2,k2)+a2u(i,4)*field(e3,k2)
        f_lower = field(i,k2) + fx*x0c + fy*y0c
        
        fpt = (alpha)*f_lower + (1.0_dp-alpha)*f_upper
     END IF


     IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "START: INTERP_PZONAL_3D"

Here is the call graph for this function:

Here is the caller graph for this function:

interp_pzonal_3d_flt()

real(spa) function mod_utils::interp_pzonal_3d_flt	(	real(spa), intent(in)	xloc,
		real(spa), intent(in)	yloc,
		real(spa), intent(in)	sigloc,
		integer, intent(in)	lvls,
		integer, intent(in)	i,
		real(spa), dimension(:,:), intent(in), pointer	Field
	)

Definition at line 988 of file mod_utils.f90.

     USE all_vars, only : a1u,a2u,xc,yc,nbe,kbm2,kbm1,kb,z1,dz1,zz1,dzz1
     IMPLICIT NONE
     REAL(SPA) :: FPT
     INTEGER, INTENT(IN) :: i,lvls  ! Cell Number, Number of levels(kb,or kbm1)
     REAL(SPA), INTENT(IN):: xloc,yloc,sigloc
     REAL(SPA), POINTER, INTENT(IN) :: FIELD(:,:) 

     REAL(SPA):: X0c, Y0c,F0,Fx,Fy,alpha,F_upper,F_lower
     INTEGER :: e1,e2,e3,k1,k2,k
     REAL(SPA) :: dx_sph
     IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "START: INTERP_PZONAL_3D"

!offset from element center
!---------------------------------------------------------------
     !offset from element center
     x0c = xloc - xc(i)
     y0c = yloc - yc(i)
!---------------------------------------------------------------
!---------------------------------------------------------------

     !Surrounding Element IDs
     e1  = nbe(i,1)
     e2  = nbe(i,2)
     e3  = nbe(i,3)

!----determine sigma layers above and below sigloc

     IF(lvls == kbm1) THEN

        k1  = 1
        k2  = 1
        alpha = -1
        if(sigloc < zz1(i,kbm1)) then !!particle near bottom
           k1 = kbm1
           k2 = kbm1
           alpha = -1
        else
           do k=1,kbm2
              if(sigloc  < zz1(i,k) .and. sigloc >= zz1(i,k+1) )then
                 k1 = k
                 k2 = k+1 
                 alpha = (zz1(i,k)-sigloc)/dzz1(i,k)
                 exit
              endif
           end do
        end if
        
     ELSE IF(lvls == kb) THEN
        
        !surface (default)
        k1 = 1
        k2 = 1
        alpha = -1        
        !bottom
        if(sigloc < z1(i,kb))then
           k1 = kb
           k2 = kb
           alpha = -1
        else !intermediate 
           do k=1,kbm1
              if(sigloc  < z1(i,k) .and. sigloc >= z1(i,k+1) )then
                 k1 = k
                 k2 = k+1 
                 alpha = (z1(i,k)-sigloc)/dz1(i,k)
              endif
           end do
        endif

     ELSE
        CALL fatal_error("INTERP_PZONAL_3D: Invalid number of levels passed",&
             & "(Must be equal to either KB or KBM1")
     END IF

     !interpolate Field to the location
     fx = a1u(i,1)*field(i,k1)+a1u(i,2)*field(e1,k1)+a1u(i,3)*field(e2,k1)+a1u(i,4)*field(e3,k1)
     fy = a2u(i,1)*field(i,k1)+a2u(i,2)*field(e1,k1)+a2u(i,3)*field(e2,k1)+a2u(i,4)*field(e3,k1)
     f_upper = field(i,k1) + fx*x0c + fy*y0c
     
     IF(k1 == k2) THEN
        fpt = f_upper
     ELSE
        
        fx = a1u(i,1)*field(i,k2)+a1u(i,2)*field(e1,k2)+a1u(i,3)*field(e2,k2)+a1u(i,4)*field(e3,k2)
        fy = a2u(i,1)*field(i,k2)+a2u(i,2)*field(e1,k2)+a2u(i,3)*field(e2,k2)+a2u(i,4)*field(e3,k2)
        f_lower = field(i,k2) + fx*x0c + fy*y0c
        
        fpt = (alpha)*f_lower + (1.0-alpha)*f_upper
     END IF


     IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "START: INTERP_PZONAL_3D"

Here is the call graph for this function:

Here is the caller graph for this function:

isintri()

logical function mod_utils::isintri	(	real(sp), intent(in)	X0,
		real(sp), intent(in)	Y0,
		real(sp), dimension(3), intent(in)	Xt,
		real(sp), dimension(3), intent(in)	Yt
	)

Definition at line 1315 of file mod_utils.f90.

     use mod_prec
     implicit none
     real(sp), intent(in) :: x0,Y0
     real(sp), intent(in) :: xt(3),yt(3)
     real(sp) :: f1,f2,f3

!---------------------------------------------------------------
!---------------------------------------------------------------

     isintri = .false. 
     
     if(y0 < minval(yt) .or. y0 > maxval(yt)) then
     isintri = .false.
     return
   endif
   if(x0 < minval(xt) .or. x0 > maxval(xt)) then
     isintri = .false.
     return
   endif

   f1 = (y0-yt(1))*(xt(2)-xt(1)) - (x0-xt(1))*(yt(2)-yt(1))
   f2 = (y0-yt(3))*(xt(1)-xt(3)) - (x0-xt(3))*(yt(1)-yt(3))
   f3 = (y0-yt(2))*(xt(3)-xt(2)) - (x0-xt(2))*(yt(3)-yt(2))
   if(f1*f3 >= 0.0_sp .and. f3*f2 >= 0.0_sp) isintri = .true.
!---------------------------------------------------------------
!---------------------------------------------------------------


   return

Here is the caller graph for this function:

isintriangle()

logical function mod_utils::isintriangle	(	integer, intent(in)	i,
		real(sp), intent(in)	x0,
		real(sp), intent(in)	y0
	)

Definition at line 1350 of file mod_utils.f90.

!==============================================================================|
!  determine if point (x0,y0) is in triangle defined by nodes (xt(3),yt(3))    |
!  using algorithm used for scene rendering in computer graphics               |
!  algorithm works well unless particle happens to lie in a line parallel      |
!  to the edge of a triangle.                                                  |
!  This can cause problems if you use a regular grid, say for idealized        |
!  modelling and you happen to see particles right on edges or parallel to     |
!  edges.                                                                      |
!==============================================================================|

   use mod_prec
   use all_vars, only : nv, vx, vy
   implicit none
   real(sp), intent(in) :: x0,y0
   integer, intent(in)  :: i
   real(sp) :: xt(3),yt(3)
   real(sp) :: f1,f2,f3
   real(sp) :: x1(2)
   real(sp) :: x2(2)
   real(sp) :: x3(2)
   real(sp) :: p(2)

!------------------------------------------------------------------------------|

   isintriangle = .false. 

   xt = vx(nv(i,1:3))
   yt = vy(nv(i,1:3))

   isintriangle = isintri(x0,y0,xt,yt)

!
!   if(sameside(p,x1,x2,x3).and.sameside(p,x2,x1,x3).and. &
!      sameside(p,x3,x1,x2)) isintriangle = .true. 
!!$   if(y0 < minval(yt) .or. y0 > maxval(yt)) then
!!$     isintriangle = .false.
!!$     return
!!$   endif
!!$   if(x0 < minval(xt) .or. x0 > maxval(xt)) then
!!$     isintriangle = .false.
!!$     return
!!$   endif
!!$
!!$   f1 = (y0-yt(1))*(xt(2)-xt(1)) - (x0-xt(1))*(yt(2)-yt(1))
!!$   f2 = (y0-yt(3))*(xt(1)-xt(3)) - (x0-xt(3))*(yt(1)-yt(3))
!!$   f3 = (y0-yt(2))*(xt(3)-xt(2)) - (x0-xt(2))*(yt(3)-yt(2))
!!$   if(f1*f3 >= 0.0_sp .and. f3*f2 >= 0.0_sp) isintriangle = .true.

   return

Here is the call graph for this function:

Here is the caller graph for this function:

limled()

real(sp) function mod_utils::limled	(	real(sp)	a,
		real(sp)	b,
		real(sp)	q
	)

Definition at line 2216 of file mod_utils.f90.

  IMPLICIT NONE

  real(sp) a,b
  real(sp) q,R
  real(sp) eps
  eps = epsilon(eps)

 ! exponent
 ! q = 0. !1st order
 ! q = 1. !minmod
 ! q = 2. !van leer

  r = abs(   (a-b)/(abs(a)+abs(b)+eps) )**q
  lim = .5*(1-r)*(a+b)

limled1()

real(sp) function mod_utils::limled1	(	real(sp)	a,
		real(sp)	b,
		real(sp)	alpha
	)

Definition at line 2235 of file mod_utils.f90.

  IMPLICIT NONE

  real(sp) a,b,alpha

  lim = 0.5_sp*(sign(1.,a)+sign(1.,b))*max(min(alpha*abs(a),abs(b)),min(abs(a),alpha*abs(b)))

limled2()

real(sp) function mod_utils::limled2	(	real(sp)	a,
		real(sp)	b,
		real(sp)	alpha
	)

Definition at line 2244 of file mod_utils.f90.

  IMPLICIT NONE

  real(sp) a,b,alpha

  lim = 0.5_sp*(sign(1.,a)+sign(1.,b))*min(0.5_sp*abs(a+b),alpha*abs(a),alpha*abs(b))

Here is the caller graph for this function:

meters2degrees_arr_dbl()

subroutine mod_utils::meters2degrees_arr_dbl	(	real(dp), dimension(nsze,msze), intent(in)	X,
		real(dp), dimension(nsze,msze), intent(in)	Y,
		character(len=*), intent(in)	proj_ref,
		real(dp), dimension(nsze,msze), intent(out)	LON,
		real(dp), dimension(nsze,msze), intent(out)	LAT,
		integer, intent(in)	nsze,
		integer, intent(in)	msze
	)

Definition at line 504 of file mod_utils.f90.

    implicit none
    integer, intent(in) :: nsze, msze
    REAL(DP), INTENT(OUT)  :: LON(nsze,msze), LAT(nsze,msze)
    character(LEN=*), INTENT(IN)    :: proj_ref
    REAL(DP), intent(IN):: X(nsze,msze), Y(nsze,msze)

    lon=-1.0_dp
    lat=-1.0_dp

meters2degrees_arr_flt()

subroutine mod_utils::meters2degrees_arr_flt	(	real(spa), dimension(nsze,msze), intent(in)	X,
		real(spa), dimension(nsze,msze), intent(in)	Y,
		character(len=*), intent(in)	proj_ref,
		real(spa), dimension(nsze,msze), intent(out)	LON,
		real(spa), dimension(nsze,msze), intent(out)	LAT,
		integer, intent(in)	nsze,
		integer, intent(in)	msze
	)

Definition at line 470 of file mod_utils.f90.

    implicit none
    integer, intent(in) :: nsze, msze
    REAL(SPA), INTENT(OUT)  :: LON(nsze,msze), LAT(nsze,msze)
    character(LEN=*), INTENT(IN)    :: proj_ref
    REAL(SPA), intent(IN):: X(nsze,msze), Y(nsze,msze)
        
    lon=-1.0_spa
    lat=-1.0_spa

meters2degrees_scl_dbl()

subroutine mod_utils::meters2degrees_scl_dbl	(	real(dp), intent(in)	X,
		real(dp), intent(in)	Y,
		character(len=*), intent(in)	proj_ref,
		real(dp), intent(out)	LON,
		real(dp), intent(out)	LAT
	)

Definition at line 481 of file mod_utils.f90.

!    USE PROJ4
    implicit none
    REAL(DP), INTENT(OUT)  :: LON, LAT
    character(LEN=*), INTENT(IN)    :: proj_ref
    REAL(DP), intent(IN):: X, Y

    lon=-1.0_dp
    lat=-1.0_dp

meters2degrees_scl_flt()

subroutine mod_utils::meters2degrees_scl_flt	(	real(spa), intent(in)	X,
		real(spa), intent(in)	Y,
		character(len=*), intent(in)	proj_ref,
		real(spa), intent(out)	LON,
		real(spa), intent(out)	LAT
	)

Definition at line 449 of file mod_utils.f90.

    implicit none
    REAL(SPA), INTENT(OUT)  :: LON, LAT
    character(LEN=*), INTENT(IN)    :: proj_ref
    REAL(SPA), intent(IN):: X, Y
    
    lon=-1.0_spa
    lat=-1.0_spa

meters2degrees_vec_dbl()

subroutine mod_utils::meters2degrees_vec_dbl	(	real(dp), dimension(nsze), intent(in)	X,
		real(dp), dimension(nsze), intent(in)	Y,
		character(len=*), intent(in)	proj_ref,
		real(dp), dimension(nsze), intent(out)	LON,
		real(dp), dimension(nsze), intent(out)	LAT,
		integer, intent(in)	nsze
	)

Definition at line 492 of file mod_utils.f90.

!    USE PROJ4
    implicit none
    integer, intent(in) :: nsze
    REAL(DP), INTENT(OUT)  :: LON(nsze), LAT(nsze)
    character(LEN=*), INTENT(IN)    :: proj_ref
    REAL(DP), intent(IN):: X(nsze), Y(nsze)

    lon=-1.0_dp
    lat=-1.0_dp

meters2degrees_vec_flt()

subroutine mod_utils::meters2degrees_vec_flt	(	real(spa), dimension(nsze), intent(in)	X,
		real(spa), dimension(nsze), intent(in)	Y,
		character(len=*), intent(in)	proj_ref,
		real(spa), dimension(nsze), intent(out)	LON,
		real(spa), dimension(nsze), intent(out)	LAT,
		integer, intent(in)	nsze
	)

Definition at line 459 of file mod_utils.f90.

    implicit none
   integer, intent(in) :: nsze
    REAL(SPA), INTENT(OUT)  :: LON(nsze), LAT(nsze)
    character(LEN=*), INTENT(IN)    :: proj_ref
    REAL(SPA), intent(IN):: X(nsze), Y(nsze)

    lon=-1.0_spa
    lat=-1.0_spa

open_dat()

integer function mod_utils::open_dat	(	character(len=*)	FNAME,
		integer	UNIT,
		character(len=*), optional	PATH
	)

Definition at line 1644 of file mod_utils.f90.

  USE control, only : input_dir
  implicit none
  CHARACTER(LEN=*) :: FNAME
  INTEGER :: UNIT
  CHARACTER(LEN=*), OPTIONAL :: PATH
  
  CHARACTER(LEN=400) :: PATHNFILE
  
  open_dat = -1
  IF (len_trim(fname) ==0) return
  
  IF (PRESENT(path)) THEN
     IF (len_trim(path) ==0) return
     
     pathnfile = trim(path)//trim(fname)
  ELSE
     IF (len_trim(input_dir) ==0) return
     pathnfile = trim(input_dir)//trim(fname)
  END IF
  Call fopen(unit,trim(pathnfile),'cfr')
  open_dat = 0
  
  

Here is the call graph for this function:

path_split()

subroutine mod_utils::path_split	(	character(len=*), intent(in)	STRING,
		character(len=*), intent(out)	PATH,
		character(len=*), intent(out)	FILE,
		character(len=*), intent(out)	EXTENSION
	)

Definition at line 2146 of file mod_utils.f90.

     IMPLICIT NONE
     
     CHARACTER(LEN=*), INTENT(IN) :: STRING
     CHARACTER(LEN=*), INTENT(OUT):: PATH,FILE,EXTENSION

     INTEGER :: IDX, LGN, I

     lgn = len_trim(string)

     path = ''
     file = ''
     extension = ''

     idx = 1
     DO i=1,lgn
        if(string(i:i) == '/') idx = i
     END DO
     

     IF(idx>1) THEN
        path = string(1:idx)
        idx = idx+1
     ELSE ! HANDLE THE CASE OF NO PATH
        path = './'
     END IF

     
     DO i = idx,lgn
        IF(string(i:i) == '.') THEN
           file = string(idx:(i-1))
           extension =string(i:lgn)
           EXIT
        END IF
     END DO

     ! HANDLE THE CASE OF NO EXTENSION
     IF (len_trim(file) == 0) file = string(idx:lgn)

pshutdown()

subroutine mod_utils::pshutdown

(

)

Definition at line 280 of file mod_utils.f90.

    !==============================================================================|
    stop

Here is the caller graph for this function:

pstop()

subroutine mod_utils::pstop

(

)

Definition at line 273 of file mod_utils.f90.

    !==============================================================================|
    stop

Here is the caller graph for this function:

read_float()

real(dp) function mod_utils::read_float	(	character(len=*), intent(in)	ITEM,
		integer, intent(out)	IERR
	)

Definition at line 2253 of file mod_utils.f90.

    IMPLICIT NONE
    CHARACTER(LEN=*),INTENT(IN)     :: ITEM
    INTEGER, INTENT(OUT) :: IERR
    
    LOGICAL :: ISFLOAT
    INTEGER :: I

    ierr = -1
    isfloat = .false.
    read_float = -99999.9
    DO i = 1,len_trim(item)
       IF (item(i:i) == ".") THEN
          isfloat = .true.
          cycle
       END IF
       
       IF( lgt("0",item(i:i)) .or. llt("9",item(i:i)) ) THEN
          isfloat = .false.
          EXIT
       END IF
       
    END DO

    IF(isfloat) THEN
       READ(item,*,iostat=ierr) read_float
    END IF

read_int()

real(sp) function mod_utils::read_int	(	character(len=*), intent(in)	ITEM,
		integer, intent(out)	IERR
	)

Definition at line 2283 of file mod_utils.f90.

    IMPLICIT NONE
    CHARACTER(LEN=*),INTENT(IN)     :: ITEM
    INTEGER, INTENT(OUT) :: IERR
    
    INTEGER :: I

    ierr = -1
    read_int = -99999.9
    DO i = 1,len_trim(item)
       
       IF( lgt("0",item(i:i)) .or. llt("9",item(i:i)) ) THEN
          RETURN
       END IF
       
    END DO

    READ(item,*,iostat=ierr) read_int
    

sameside()

logical function mod_utils::sameside	(	real(sp), dimension(2), intent(in)	p1,
		real(sp), dimension(2), intent(in)	p2,
		real(sp), dimension(2), intent(in)	a,
		real(sp), dimension(2), intent(in)	b
	)

Definition at line 1402 of file mod_utils.f90.

     real(sp), intent(in) :: p1(2)
     real(sp), intent(in) :: p2(2)
     real(sp), intent(in) :: a(2)
     real(sp), intent(in) :: b(2)
     logical value
     real(sp) :: cp1,cp2
  
     cp1 = (b(1)-a(1))*(p1(2)-a(2)) - (b(2)-a(2))*(p1(1)-a(1))
     cp2 = (b(1)-a(1))*(p2(2)-a(2)) - (b(2)-a(2))*(p2(1)-a(1))
  
     value = .false.
     if(cp1*cp2 >= 0) value = .true.

scan_file()

integer function mod_utils::scan_file	(	integer, intent(in)	UNIT,
		character(len=*)	VNAME,
		integer, intent(inout), optional	ISCAL,
		real(sp), intent(inout), optional	FSCAL,
		integer, dimension(*), intent(inout), optional	IVEC,
		real(sp), dimension(*), intent(inout), optional	FVEC,
		character(len=80), dimension(*), optional	CVEC,
		integer, intent(inout), optional	NSZE,
		character(len=80), optional	CVAL,
		logical, intent(inout), optional	LVAL
	)

Definition at line 1844 of file mod_utils.f90.

!==============================================================================|
!   Scan an Input File for a Variable                                          |
!   RETURN VALUE:                                                              |
!        0 = FILE FOUND, VARIABLE VALUE FOUND                                  |
!       -1 = FILE DOES NOT EXIST OR PERMISSIONS ARE INCORRECT                  |
!       -2 = VARIABLE NOT FOUND OR IMPROPERLY SET                              |
!       -3 = VARIABLE IS OF DIFFERENT TYPE, CHECK INPUT FILE                   |
!       -4 = VECTOR PROVIDED BUT DATA IS SCALAR TYPE                           |
!       -5 = NO DATATYPE DESIRED, EXITING                                      |
!                                                  |
!   REQUIRED INPUT:                                    |
!        UNIT = File UNIT                                  |
!        FSIZE = Length of Filename                        |
!                                                                              | 
!   OPTIONAL (MUST PROVIDE ONE)                                | 
!        ISCAL = INTEGER SCALAR                                |
!        FSCAL = FLOAT SCALAR                              | 
!        CVAL = CHARACTER VARIABLE                                             |
!        LVAL = LOGICAL VARIABLE                                               |
!        IVEC = INTEGER VECTOR **                                              |
!        FVEC = FLOAT VECTOR **                                                |
!        CVEC = STRING VECTOR ** (STRINGS OF LENGTH 80)                        |
!      **NSZE = ARRAY SIZE (MUST BE PROVIDED WITH IVEC/FVEC)                   |
!                                                                              | 
!==============================================================================|

   IMPLICIT NONE
   INTEGER, INTENT(IN) :: UNIT
   CHARACTER(LEN=*) :: VNAME
   INTEGER, INTENT(INOUT), OPTIONAL :: ISCAL,IVEC(*)
   REAL(SP),INTENT(INOUT), OPTIONAL :: FSCAL,FVEC(*)
   CHARACTER(LEN=80), OPTIONAL      :: CVAL,CVEC(*)
   LOGICAL, INTENT(INOUT), OPTIONAL :: LVAL
   INTEGER, INTENT(INOUT), OPTIONAL :: NSZE 
   
!------------------------------------------------------------------------------|
   INTEGER :: SCAN_FILE
   REAL(DP) REALVAL(150)
   INTEGER  INTVAL(150)
   CHARACTER(LEN=40 ) :: VARNAME
   CHARACTER(LEN=80 ) :: STRINGVAL(150),TITLE
   CHARACTER(LEN=400 ) :: INPLINE
   CHARACTER(LEN=800) :: TLINE
   CHARACTER(LEN=7  ) :: VARTYPE, ENDLINE
   CHARACTER(LEN=20 ), DIMENSION(200)  :: SET
   INTEGER I,NVAL,J,NSET,NLINE,NREP,bgn,nd, LEL
   LOGICAL SETYES,ALLSET,CHECK,LOGVAL


   scan_file = 0

!==============================================================================|
!            SCAN THE FILE FOR THE VARIABLE NAME                               |
!==============================================================================|

   ENDLINE='\\'
   lel = len_trim(endline)-1

   rewind(unit)

   nset = 0
   nline = 0
   DO WHILE(.true.)

      if(nline >200) then
         CALL warning("Read 200 lines of header with out finding parameters! ")
         scan_file=-2
         return
      end if

     tline(1:len(tline)) = ' ' 
     nrep  = 0
     nline = nline + 1
     READ(unit,'(a)',end=20) inpline
     tline = trim(inpline)

!----PROCESS LINE CONTINUATIONS------------------------------------------------!
     DO
!        write(ipt,*) '"'//TRIM(INPLINE)//'"'
        i = len_trim(inpline)
        IF(i > 1)THEN

           IF( inpline(i-lel:i) == trim(endline))THEN
              
              nrep = nrep + 1
              READ(unit,'(a)',end=20) inpline
              nline = nline + 1
              bgn = len_trim(tline)+1
              nd = bgn +len_trim(inpline)
              
              tline(bgn:nd) = trim(inpline)
           ELSE
              EXIT
              
           END IF
        ELSE
           EXIT
        END IF
     END DO

!----REMOVE LINE CONTINUATION CHARACTER \\-------------------------------------!
     IF(nrep > 0)THEN
       DO i=2,len_trim(tline)
         IF( tline(i-lel:i) == endline) tline(i-lel:i) = '  '

       END DO
     END IF
       
!----PROCESS THE LINE----------------------------------------------------------!
     CALL get_value(nline,len_trim(tline),adjustl(tline),varname,vartype,logval,&
                 stringval,realval,intval,nval)

!----IF VARNAME MATCHES, PROCESS VARIABLE AND ERROR-CHECK----------------------!

     IF(trim(varname) == trim(vname))THEN

       IF(PRESENT(iscal))THEN
          IF(vartype == 'integer')THEN
           iscal = intval(1)
           RETURN
         ELSE
           scan_file = -3
           return
         END IF
       ELSE IF(PRESENT(fscal))THEN
         IF(vartype == 'float')THEN
           fscal = realval(1)
           RETURN
         ELSE
           scan_file = -3
           return
         END IF
       ELSE IF(PRESENT(cval))THEN
         IF(vartype == 'string')THEN
           cval = stringval(1) 
           RETURN
         ELSE
           scan_file = -3
           return
         END IF
       ELSE IF(PRESENT(lval))THEN
         IF(vartype == 'logical')THEN
           lval = logval 
           RETURN
         ELSE
           scan_file = -3
           return
         END IF
       ELSE IF(PRESENT(ivec))THEN
         IF(nval > 1)THEN
           IF(vartype == 'integer')THEN
             ivec(1:nval) = intval(1:nval) 
             nsze = nval         
             RETURN
           ELSE
             scan_file = -3
             return
           END IF
           ELSE
           scan_file = -4
           return
         END IF
       ELSE IF(PRESENT(fvec))THEN
         IF(nval > 1)THEN
           IF(vartype == 'float')THEN
             fvec(1:nval) = realval(1:nval) 
             nsze = nval           
             RETURN
           ELSE
             scan_file = -3
             return
           END IF
         ELSE
           scan_file = -4
           return
         END IF
       ELSE IF(PRESENT(cvec))THEN
         IF(nval > 0)THEN
           IF(vartype == 'string')THEN
             cvec(1:nval) = stringval(2:nval+1)
             nsze = nval 
             RETURN
           ELSE
             scan_file = -3
             return
           END IF
         ELSE
           scan_file = -4
           return
         END IF
       ELSE
         scan_file = -5
         return
       END IF
     END IF  !!VARIABLE IS CORRECT
            
   END DO !!LOOP OVER INPUT FILE

20   scan_file = -2

   RETURN 

Here is the call graph for this function:

scan_file2()

integer function mod_utils::scan_file2	(	character(len=*)	FNAME,
		character(len=*)	VNAME,
		integer, intent(inout), optional	ISCAL,
		real(sp), intent(inout), optional	FSCAL,
		integer, dimension(*), intent(inout), optional	IVEC,
		real(sp), dimension(*), intent(inout), optional	FVEC,
		character(len=80), dimension(*), optional	CVEC,
		integer, intent(inout), optional	NSZE,
		character(len=80), optional	CVAL,
		logical, intent(inout), optional	LVAL
	)

Definition at line 2304 of file mod_utils.f90.

!==============================================================================|
!   Scan an Input File for a Variable                                          |
!   RETURN VALUE:                                                              |
!        0 = FILE FOUND, VARIABLE VALUE FOUND                                  |
!       -1 = FILE DOES NOT EXIST OR PERMISSIONS ARE INCORRECT                  |
!       -2 = VARIABLE NOT FOUND OR IMPROPERLY SET                              |
!       -3 = VARIABLE IS OF DIFFERENT TYPE, CHECK INPUT FILE                   |
!       -4 = VECTOR PROVIDED BUT DATA IS SCALAR TYPE                           |
!       -5 = NO DATATYPE DESIRED, EXITING                                      |
!                                                  |
!   REQUIRED INPUT:                                    |
!        FNAME = File Name                                 |
!        FSIZE = Length of Filename                        |
!                                                                              | 
!   OPTIONAL (MUST PROVIDE ONE)                                | 
!        ISCAL = INTEGER SCALAR                                |
!        FSCAL = FLOAT SCALAR                              | 
!        CVAL = CHARACTER VARIABLE                                             |
!        LVAL = LOGICAL VARIABLE                                               |
!        IVEC = INTEGER VECTOR **                                              |
!        FVEC = FLOAT VECTOR **                                                |
!        CVEC = STRING VECTOR ** (STRINGS OF LENGTH 80)                        |
!      **NSZE = ARRAY SIZE (MUST BE PROVIDED WITH IVEC/FVEC)                   |
!                                                                              | 
!==============================================================================|

   USE mod_prec
   USE ocpcomm4
   IMPLICIT NONE
   CHARACTER(LEN=*) :: FNAME,VNAME
   INTEGER, INTENT(INOUT), OPTIONAL :: ISCAL,IVEC(*)
   REAL(SP),INTENT(INOUT), OPTIONAL :: FSCAL,FVEC(*)
   CHARACTER(LEN=80), OPTIONAL      :: CVAL,CVEC(*)
   LOGICAL, INTENT(INOUT), OPTIONAL :: LVAL
   INTEGER, INTENT(INOUT), OPTIONAL :: NSZE 
   
!------------------------------------------------------------------------------|

   INTEGER :: SCAN_FILE2
   REAL(DP) REALVAL(150)
   INTEGER  INTVAL(150)
   CHARACTER(LEN=40 ) :: VARNAME
   CHARACTER(LEN=80 ) :: STRINGVAL(150),TITLE
   CHARACTER(LEN=80 ) :: INPLINE
   CHARACTER(LEN=400) :: TLINE
   CHARACTER(LEN=7  ) :: VARTYPE
   CHARACTER(LEN=20 ), DIMENSION(200)  :: SET
   INTEGER I,NVAL,J,NSET,NLINE,NREP
   LOGICAL SETYES,ALLSET,CHECK,LOGVAL


   scan_file2 = 0
!==============================================================================|
!            OPEN THE INPUT FILE                                               |
!==============================================================================|
   INQUIRE(file=trim(fname),exist=check)
   IF(.NOT.check)THEN
     scan_file2 = -1
     RETURN
   END IF

   OPEN(inputf,file=trim(fname)) ; rewind(inputf) 

!==============================================================================|
!            SCAN THE FILE FOR THE VARIABLE NAME                               |
!==============================================================================|

   nset = 0
   nline = 0
   DO WHILE(.true.)
     tline(1:len(tline)) = ' ' 
     nrep  = 0
     nline = nline + 1
     READ(inputf,'(a)',end=20) inpline
     tline(1:80) = inpline(1:80)

!----PROCESS LINE CONTINUATIONS------------------------------------------------!
 110 CONTINUE
     i = len_trim(inpline)
     IF(i /= 0)THEN
     IF( inpline(i-1:i) == '\\\\')THEN
       nrep = nrep + 1
       READ(inputf,'(a)',end=20) inpline
       nline = nline + 1
       tline( nrep*80 + 1 : nrep*80 +80) = inpline(1:80)
       GOTO 110
     END IF
     END IF
     IF(nrep > 4)CALL fatal_error("CANNOT HAVE > 4 LINE CONTINUATIONS")

!----REMOVE LINE CONTINUATION CHARACTER \\-------------------------------------!
     IF(nrep > 0)THEN
       DO i=2,len_trim(tline)
         IF( tline(i-1:i) == '\\\\') tline(i-1:i) = '  '
       END DO
     END IF
       
!----PROCESS THE LINE----------------------------------------------------------!
     CALL get_value(nline,len_trim(tline),adjustl(tline),varname,vartype,logval,&
                 stringval,realval,intval,nval)

!----IF VARNAME MATCHES, PROCESS VARIABLE AND ERROR-CHECK----------------------!

     IF(trim(varname) == trim(vname))THEN

       IF(PRESENT(iscal))THEN
         IF(vartype == 'integer')THEN
           iscal = intval(1)
           RETURN
         ELSE
           scan_file2 = -3
         END IF
       ELSE IF(PRESENT(fscal))THEN
         IF(vartype == 'float')THEN
           fscal = realval(1)
           RETURN
         ELSE
           scan_file2 = -3
         END IF
       ELSE IF(PRESENT(cval))THEN
         IF(vartype == 'string')THEN
           cval = stringval(1) 
           RETURN
         ELSE
           scan_file2 = -3
         END IF
       ELSE IF(PRESENT(lval))THEN
         IF(vartype == 'logical')THEN
           lval = logval 
           RETURN
         ELSE
           scan_file2 = -3
         END IF
       ELSE IF(PRESENT(ivec))THEN
         IF(nval > 1)THEN
           IF(vartype == 'integer')THEN
             ivec(1:nval) = intval(1:nval) 
             nsze = nval         
             RETURN
           ELSE
             scan_file2 = -3
           END IF
           ELSE
           scan_file2 = -4 
         END IF
       ELSE IF(PRESENT(fvec))THEN
         IF(nval > 1)THEN
           IF(vartype == 'float')THEN
             fvec(1:nval) = realval(1:nval) 
             nsze = nval           
             RETURN
           ELSE
             scan_file2 = -3
           END IF
         ELSE
           scan_file2 = -4 
         END IF
       ELSE IF(PRESENT(cvec))THEN
         IF(nval > 0)THEN
           IF(vartype == 'string')THEN
             cvec(1:nval) = stringval(2:nval+1)
             nsze = nval 
             RETURN
           ELSE
             scan_file2 = -3
           END IF
         ELSE
           scan_file2 = -4
         END IF
       ELSE
         scan_file2 = -5
       END IF
     END IF  !!VARIABLE IS CORRECT
            
   END DO !!LOOP OVER INPUT FILE
 20 CLOSE(inputf) 
   scan_file2 = -2

   RETURN 

Here is the call graph for this function:

Here is the caller graph for this function:

scan_file3()

integer function mod_utils::scan_file3	(	character(len=*)	FNAME,
		character(len=*)	VNAME,
		integer, intent(inout), optional	ISCAL,
		real(sp), intent(inout), optional	FSCAL,
		integer, dimension(*), intent(inout), optional	IVEC,
		real(sp), dimension(*), intent(inout), optional	FVEC,
		character(len=80), dimension(*), optional	CVEC,
		integer, intent(inout), optional	NSZE,
		character(len=80), optional	CVAL,
		logical, intent(inout), optional	LVAL
	)

Definition at line 2488 of file mod_utils.f90.

!==============================================================================|
!   Scan an Input File for a Variable                                          |
!   RETURN VALUE:                                                              |
!        0 = FILE FOUND, VARIABLE VALUE FOUND                                  |
!       -1 = FILE DOES NOT EXIST OR PERMISSIONS ARE INCORRECT                  |
!       -2 = VARIABLE NOT FOUND OR IMPROPERLY SET                              |
!       -3 = VARIABLE IS OF DIFFERENT TYPE, CHECK INPUT FILE                   |
!       -4 = VECTOR PROVIDED BUT DATA IS SCALAR TYPE                           |
!       -5 = NO DATATYPE DESIRED, EXITING                                      |
!                                                  |
!   REQUIRED INPUT:                                    |
!        FNAME = File Name                                 |
!        FSIZE = Length of Filename                        |
!                                                                              | 
!   OPTIONAL (MUST PROVIDE ONE)                                | 
!        ISCAL = INTEGER SCALAR                                |
!        FSCAL = FLOAT SCALAR                              | 
!        CVAL = CHARACTER VARIABLE                                             |
!        LVAL = LOGICAL VARIABLE                                               |
!        IVEC = INTEGER VECTOR **                                              |
!        FVEC = FLOAT VECTOR **                                                |
!        CVEC = STRING VECTOR ** (STRINGS OF LENGTH 80)                        |
!      **NSZE = ARRAY SIZE (MUST BE PROVIDED WITH IVEC/FVEC)                   |
!                                                                              | 
!==============================================================================|

   USE mod_prec
   USE ocpcomm4
   IMPLICIT NONE
   CHARACTER(LEN=*) :: FNAME,VNAME
   INTEGER, INTENT(INOUT), OPTIONAL :: ISCAL,IVEC(*)
   REAL(SP),INTENT(INOUT), OPTIONAL :: FSCAL,FVEC(*)
   CHARACTER(LEN=80), OPTIONAL      :: CVAL,CVEC(*)
   LOGICAL, INTENT(INOUT), OPTIONAL :: LVAL
   INTEGER, INTENT(INOUT), OPTIONAL :: NSZE 
   
!------------------------------------------------------------------------------|

   INTEGER :: SCAN_FILE3
   REAL(DP) REALVAL(150)
   INTEGER  INTVAL(150)
   CHARACTER(LEN=40 ) :: VARNAME
   CHARACTER(LEN=80 ) :: STRINGVAL(150),TITLE
   CHARACTER(LEN=80 ) :: INPLINE
   CHARACTER(LEN=400) :: TLINE
   CHARACTER(LEN=7  ) :: VARTYPE
   CHARACTER(LEN=20 ), DIMENSION(200)  :: SET
   INTEGER I,NVAL,J,NSET,NLINE,NREP
   LOGICAL SETYES,ALLSET,CHECK,LOGVAL


   scan_file3 = 0
!==============================================================================|
!            OPEN THE INPUT FILE                                               |
!==============================================================================|
   INQUIRE(file=trim(fname),exist=check)
   IF(.NOT.check)THEN
     scan_file3 = -1
     RETURN
   END IF

   OPEN(inputf,file=trim(fname)) ; rewind(inputf) 

!==============================================================================|
!            SCAN THE FILE FOR THE VARIABLE NAME                               |
!==============================================================================|

   nset = 0
   nline = 0
   DO WHILE(.true.)
     tline(1:len(tline)) = ' ' 
     nrep  = 0
     nline = nline + 1
     READ(inputf,'(a)',end=20) inpline
     tline(1:80) = inpline(1:80)

!----PROCESS LINE CONTINUATIONS------------------------------------------------!
 110 CONTINUE
     i = len_trim(inpline)
     IF(i > 2)THEN
     IF( inpline(i-1:i) == '\\')THEN
       nrep = nrep + 1
       READ(inputf,'(a)',end=20) inpline
       nline = nline + 1
       tline( nrep*80 + 1 : nrep*80 +80) = inpline(1:80)
       GOTO 110
     END IF
     END IF
     IF(nrep > 4)CALL fatal_error("CANNOT HAVE > 4 LINE CONTINUATIONS")

!----REMOVE LINE CONTINUATION CHARACTER \\-------------------------------------!
     IF(nrep > 0)THEN
       DO i=2,len_trim(tline)
         IF( tline(i-1:i) == '\\') tline(i-1:i) = '  '
       END DO
     END IF

      
!----PROCESS THE LINE----------------------------------------------------------!
     CALL get_value(nline,len_trim(tline),adjustl(tline),varname,vartype,logval,&
                 stringval,realval,intval,nval)

!----IF VARNAME MATCHES, PROCESS VARIABLE AND ERROR-CHECK----------------------!

     IF(trim(varname) == trim(vname))THEN

       IF(PRESENT(iscal))THEN
         IF(vartype == 'integer')THEN
           iscal = intval(1)
           CLOSE(inputf)
           RETURN
         ELSE
           scan_file3 = -3
         END IF
       ELSE IF(PRESENT(fscal))THEN
         IF(vartype == 'float')THEN
           fscal = realval(1)
           CLOSE(inputf)
           RETURN
         ELSE
           scan_file3 = -3
         END IF
       ELSE IF(PRESENT(cval))THEN
         IF(vartype == 'string')THEN
           cval = stringval(1) 
           CLOSE(inputf)
           RETURN
         ELSE
           scan_file3 = -3
         END IF
       ELSE IF(PRESENT(lval))THEN
         IF(vartype == 'logical')THEN
           lval = logval 
           CLOSE(inputf)
           RETURN
         ELSE
           scan_file3 = -3
         END IF
       ELSE IF(PRESENT(ivec))THEN
         IF(nval > 1)THEN
           IF(vartype == 'integer')THEN
             ivec(1:nval) = intval(1:nval) 
             nsze = nval
             CLOSE(inputf)         
             RETURN
           ELSE
             scan_file3 = -3
           END IF
           ELSE
           scan_file3 = -4 
         END IF
       ELSE IF(PRESENT(fvec))THEN
         IF(nval > 1)THEN
           IF(vartype == 'float')THEN
             fvec(1:nval) = realval(1:nval) 
             nsze = nval 
             CLOSE(inputf)          
             RETURN
           ELSE
             scan_file3 = -3
           END IF
         ELSE
           scan_file3 = -4 
         END IF
       ELSE IF(PRESENT(cvec))THEN
         IF(nval > 0)THEN
           IF(vartype == 'string')THEN
             cvec(1:nval) = stringval(2:nval+1)
             nsze = nval 
             CLOSE(inputf)
             RETURN
           ELSE
             scan_file3 = -3
           END IF
         ELSE
           scan_file3 = -4
         END IF
       ELSE
         scan_file3 = -5
       END IF
     END IF  !!VARIABLE IS CORRECT
            
   END DO !!LOOP OVER INPUT FILE
 20 CLOSE(inputf) 
   scan_file3 = -2

   RETURN 

Here is the call graph for this function:

Here is the caller graph for this function:

shutdown_check_1d()

subroutine mod_utils::shutdown_check_1d	(	real(sp), dimension(:), intent(in)	VAR,
		character(len=*), optional	MSG
	)

Definition at line 289 of file mod_utils.f90.

    !==============================================================================|
    USE control
    IMPLICIT NONE
    REAL(DP) :: SBUF,RBUF  
    INTEGER  :: IERR,I,J
    REAL(SP), DIMENSION(:), INTENT(IN) :: VAR
    CHARACTER(LEN=*), OPTIONAL :: MSG
    !==============================================================================|

    IF (dbg_set(dbg_sbr)) THEN
       IF (PRESENT(msg)) THEN
          WRITE(ipt,*) "START: SHUTDOWN CHECK: "//msg
       ELSE
          WRITE(ipt,*) "START: SHUTDOWN CHECK: no msg" 
       END IF
    END IF

    !Collect Depth Average to Master Processor
    sbuf = sum(dble(var(1:ubound(var,1))))
    rbuf = sbuf

    !Halt FVCOM if Depth Average = NaN          
    IF(isnan(rbuf))THEN 
       IF (PRESENT(msg)) THEN
          CALL fatal_error("SHUTDOWN_CHECK FOUND NON FINITE VALUE:",&
               & msg )
       ELSE
          CALL fatal_error('NON FINITE VALUE (DEPTH?) FOUND',&
               & 'MODEL HAS BECOME UNSTABLE')
       END IF

    END IF


    IF (dbg_set(dbg_sbr)) WRITE(ipt,*) "END: SHUTDOWN CHECK"

    RETURN

Here is the call graph for this function:

shutdown_check_2d()

subroutine mod_utils::shutdown_check_2d	(	real(sp), dimension(:,:), intent(in)	VAR,
		character(len=*), optional	MSG
	)

Definition at line 330 of file mod_utils.f90.

    !==============================================================================|
    USE control
    IMPLICIT NONE
    REAL(DP) :: SBUF,RBUF  
    INTEGER  :: IERR,I,J
    REAL(SP), DIMENSION(:,:),INTENT(IN) :: VAR
    CHARACTER(LEN=*), OPTIONAL :: MSG
    !==============================================================================|

    IF (dbg_set(dbg_sbr)) THEN
       IF (PRESENT(msg)) THEN
          WRITE(ipt,*) "START: SHUTDOWN CHECK: "//msg
       ELSE
          WRITE(ipt,*) "START: SHUTDOWN CHECK: no msg" 
       END IF
    END IF

    !Collect Depth Average to Master Processor
    sbuf = sum(sum(dble(var(1:ubound(var,1),:)),1),1)
    rbuf = sbuf

    !Halt FVCOM if Depth Average = NaN          
    IF(isnan(rbuf))THEN 
       IF (PRESENT(msg)) THEN
          CALL fatal_error("SHUTDOWN_CHECK FOUND NON FINITE VALUE:",&
               & msg )
       ELSE
          CALL fatal_error('NON FINITE VALUE (DEPTH?) FOUND',&
               & 'MODEL HAS BECOME UNSTABLE')
       END IF

    END IF


    IF (dbg_set(dbg_sbr)) WRITE(ipt,*) "END: SHUTDOWN CHECK"

    RETURN

Here is the call graph for this function:

split_string()

subroutine mod_utils::split_string	(	character(len=*), intent(in)	instring,
		character, intent(in)	delim,
		character(len=*), dimension(:), intent(out), allocatable	outstrings
	)

Definition at line 2050 of file mod_utils.f90.

     IMPLICIT NONE
     character(len=*), intent(in) :: instring
     character, intent(in) :: delim
     character(len=*), intent(OUT), ALLOCATABLE :: outstrings(:)
     integer :: nlen, i, cnt, prev,next, idx, outlen, lgn

!     character(len=len(outstrings)), ALLOCATABLE :: out_temp(:)
     character(len=len(instring)), ALLOCATABLE :: out_temp(:)
    

     ! Get the length of the string
     lgn = len_trim(instring)
     outlen = len(outstrings)
 
     ! CHECK FOR DEGERNERATE CASE (EMPTY STRING!)
     IF(lgn==0) THEN
        ALLOCATE(outstrings(1))
        outstrings=""
        RETURN
     END IF


     ! Count the number of seperations
     cnt = 0
     do i = 1,lgn
        if(instring(i:i) == delim) cnt=cnt+1
     end do
     ! If the string is not terminated, count the last entry too...
     if(instring(lgn:lgn) /= delim) cnt=cnt+1
     
     ! Allocate space
     ALLOCATE(outstrings(cnt))
     
     ! Split the string
     prev=1
     next=0
     DO i = 1,cnt
!        write(*,*) "*** '"//trim(instring(prev:lgn))//"'"
        
        ! Find the first seperation
        idx = index(instring(prev:lgn),delim) 
        if(idx==0) then
           ! IF none found, use end of string
           idx = lgn+1
        else
           ! Get the index into the real string length
           idx =idx + prev-1
        end if
        
        ! Set that last value to take
        next = idx-1
!        write(*,*) I, prev, idx, next

        if(outlen .le. next-prev) Call warning&
             ("Insufficent room to split string!")

        ! Copy it into the string array
        outstrings(i) = trim(adjustl(instring(prev:next)))

        if(outlen .le. next-prev) Call warning&
             ("Insufficent room to split string!","'"//trim(outstrings(i))//"'")

        
        ! Set the first character of the next string
        prev=idx+1
        
!        write(*,*) "! '"//trim(strings(I))//"'"
     END DO
     
     ! REMOVE DEGENERATE CASE FOR 'space' delimiter

     IF(delim == ' ') THEN
        
        idx = 0
        ALLOCATE(out_temp(cnt))
        DO i = 1,cnt
           
           IF(len_trim(outstrings(i)) > 0) THEN
              idx = idx + 1
              out_temp(idx) = outstrings(i)
           END IF
           
        END DO

        DEALLOCATE(outstrings)
        allocate(outstrings(idx))
        outstrings=out_temp


     END IF

Here is the call graph for this function:

Here is the caller graph for this function:

test_split_strings()

subroutine mod_utils::test_split_strings

(

)

Definition at line 2189 of file mod_utils.f90.

     implicit none
     CHARACTER(len=200) TESTIN
     CHARACTER(len=50),allocatable::testout(:)
     integer I
     
!     TESTIN = "Hello world"
!     TESTIN = "Hello world, Hello world2"
!     TESTIN = "Hello worldmore that fiftymore that fiftymore that fiftymore that fiftymore that fiftymore that fiftymore that fiftymore that fifty,, Hello world2,"
     testin = "Hello world, Hello world2, Hello world2, Hello world2, Hello world2"
     testin = "Hello world"//achar(10)//" Hello world2"//achar(10)//" Hello world2, Hello world2, Hello world2"
     
     call split_string(testin,achar(10),testout)
     
     write(ipt,*) "! "
     write(ipt,*) "! TESTING SPLIT STRINGS"
     write(ipt,*) "! "
     
     do i=1,size(testout)
        write(ipt,*) "! ",i,"'"//trim(testout(i))//"'"
     end do
     

Here is the call graph for this function:

warning()

subroutine mod_utils::warning	(	character(len=*)	ER1,
		character(len=*), optional	ER2,
		character(len=*), optional	ER3,
		character(len=*), optional	ER4
	)

Definition at line 251 of file mod_utils.f90.

    USE control, only: prg_name
    implicit none
    character(Len=*) :: ER1
    CHARACTER(LEN=*), OPTIONAL   :: ER2
    CHARACTER(LEN=*), OPTIONAL   :: ER3
    CHARACTER(LEN=*), OPTIONAL   :: ER4

    if(dbg_set(dbg_log)) then
       write(ipt,*) "+++++++++++++++++++++++++++++++++++++++++++++++++"
       write(ipt,*) trim(prg_name)//" WARNING!"
       write(ipt,*) er1
       IF(PRESENT(er2)) WRITE(ipt,*) er2
       IF(PRESENT(er3)) WRITE(ipt,*) er3
       IF(PRESENT(er4)) WRITE(ipt,*) er4
       write(ipt,*) trim(prg_name)//" CONTINUEING"
       write(ipt,*) "+++++++++++++++++++++++++++++++++++++++++++++++++"
    end if

Here is the call graph for this function:

Here is the caller graph for this function:

write_banner()

subroutine mod_utils::write_banner	(	logical, intent(in)	PAR,
		integer, intent(in)	NP,
		integer, intent(in)	ID
	)

Definition at line 1534 of file mod_utils.f90.

     IMPLICIT NONE
     LOGICAL, INTENT(IN) :: PAR
     INTEGER, INTENT(IN) :: NP,ID
     character(len=8) :: chr_np,chr_id

! CREATED USING: http://www.mudmagic.com/figlet-server/
!     146) rounded.flf :

WRITE(ipt,*)'!================================================================!'
WRITE(ipt,*)'  _______  _     _  _______  _______  _______  ______     _____  '
WRITE(ipt,*)' (_______)(_)   (_)(_______)(_______)(_______)(_____ \   (_____) '
WRITE(ipt,*)'  _____    _     _  _        _     _  _  _  _  _____) )  _  __ _ '
WRITE(ipt,*)' |  ___)  | |   | || |      | |   | || ||_|| |(_____ (  | |/ /| |'
WRITE(ipt,*)' | |       \ \ / / | |_____ | |___| || |   | | _____) )_|   /_| |'
WRITE(ipt,*)' |_|        \___/   \______) \_____/ |_|   |_|(______/(_)\_____/ '
WRITE(ipt,*)' -- Beta Release'
WRITE(ipt,*)'!================================================================!'
WRITE(ipt,*)'!                                                                !'
WRITE(ipt,*)'!========DOMAIN DECOMPOSITION USING: METIS 4.0.1 ================!'
WRITE(ipt,*)'!======Copyright 1998, Regents of University of Minnesota========!'
WRITE(ipt,*)'!                                                                !'
IF(par) THEN
   WRITE(chr_np,'(I3.3)') np
   WRITE(chr_id,'(I3.3)') id
WRITE(ipt,*)'!================================================================!'
WRITE(ipt,*)'!                                                                !'
WRITE(ipt,*)'! RUNNING IN PARALLEL: '//trim(chr_np)//' Processors                            !'
WRITE(ipt,*)'! MYID is '//trim(chr_id)//'                                                    !'
WRITE(ipt,*)'!================================================================!'
END IF
   RETURN

Here is the caller graph for this function:

Variable Documentation

dbg_io

integer, parameter mod_utils::dbg_io =1

Definition at line 66 of file mod_utils.f90.

  integer,parameter::dbg_io=1     ! [enm] IO Filenames

dbg_log

integer, parameter mod_utils::dbg_log =0

Definition at line 65 of file mod_utils.f90.

  integer,parameter::dbg_log=0    ! [enm] Production mode. Debugging is

dbg_lvl

integer mod_utils::dbg_lvl

Definition at line 75 of file mod_utils.f90.

  integer :: dbg_lvl ! [enm] Debugging level, initialized in input

dbg_mpi

integer, parameter mod_utils::dbg_mpi =3

Definition at line 68 of file mod_utils.f90.

  integer,parameter::dbg_mpi=3    ! [enm] Mpi Communication 

dbg_nbr

integer, parameter mod_utils::dbg_nbr =9

Definition at line 63 of file mod_utils.f90.

  integer,parameter::dbg_nbr=9 ! [nbr] Number of different debugging levels

dbg_par

logical mod_utils::dbg_par =.false.

Definition at line 76 of file mod_utils.f90.

  logical :: dbg_par=.false.

dbg_sbr

integer, parameter mod_utils::dbg_sbr =4

Definition at line 69 of file mod_utils.f90.

  integer,parameter::dbg_sbr=4    ! [enm] Subroutine names on entry and exit

dbg_sbrio

integer, parameter mod_utils::dbg_sbrio =5

Definition at line 70 of file mod_utils.f90.

  integer,parameter::dbg_sbrio=5  ! [enm] Subroutine I/O

dbg_scl

integer, parameter mod_utils::dbg_scl =2

Definition at line 67 of file mod_utils.f90.

  integer,parameter::dbg_scl=2    ! [enm] Scalars

dbg_vec

integer, parameter mod_utils::dbg_vec =6

Definition at line 71 of file mod_utils.f90.

  integer,parameter::dbg_vec=6    ! [enm] Entire vectors

dbg_vrb

integer, parameter mod_utils::dbg_vrb =7

Definition at line 72 of file mod_utils.f90.

  integer,parameter::dbg_vrb=7    ! [enm] Everything

ext_code

integer, parameter mod_utils::ext_code =3602

Definition at line 50 of file mod_utils.f90.

   INTEGER, PARAMETER ::        EXT_CODE  =3602

init_code

integer mod_utils::init_code

Definition at line 55 of file mod_utils.f90.

   INTEGER ::                   INIT_CODE

initnest_code

integer mod_utils::initnest_code

Definition at line 57 of file mod_utils.f90.

   INTEGER ::                   INITNEST_CODE 

nc_code

integer mod_utils::nc_code

Definition at line 53 of file mod_utils.f90.

   INTEGER ::                   NC_CODE 

ncav_code

integer mod_utils::ncav_code

Definition at line 54 of file mod_utils.f90.

   INTEGER ::                   NCAV_CODE 

nesting_code

integer mod_utils::nesting_code

Definition at line 56 of file mod_utils.f90.

   INTEGER ::                   NESTING_CODE 

prg_nm

character(len=80) mod_utils::prg_nm

Definition at line 74 of file mod_utils.f90.

  CHARACTER(LEN=80) :: prg_nm ! used in mod_sng and mod_input

restart_code

integer mod_utils::restart_code

Definition at line 52 of file mod_utils.f90.

   INTEGER ::                   RESTART_CODE

sync_tag

integer, parameter mod_utils::sync_tag =3601

Definition at line 49 of file mod_utils.f90.

   INTEGER, PARAMETER ::        SYNC_TAG  =3601

wait_code

integer, parameter mod_utils::wait_code =3603

Definition at line 51 of file mod_utils.f90.

   INTEGER, PARAMETER ::        WAIT_CODE =3603