DiversionSaveStatus Subroutine

public subroutine DiversionSaveStatus(pathOut, time)

save diversion state variables on file

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: pathOut
type(DateTime), intent(in), optional :: time

Variables

Type Visibility Attributes Name Initial
type(Diversion), public, POINTER :: currentDiversion
integer(kind=short), public :: i
character(len=100), public :: row(3)
character(len=300), public :: string
type(Table), public :: tab

Source Code

SUBROUTINE DiversionSaveStatus &
  !
  ( pathOut, time )

IMPLICIT NONE


!arguments with intent(in):
CHARACTER ( LEN = *), INTENT (IN) :: pathOut
TYPE (DateTime), OPTIONAL, INTENT (IN) :: time

! local declarations:
TYPE (Table) :: tab
CHARACTER (LEN = 300) :: string
CHARACTER (LEN = 100) :: row (3)
INTEGER (KIND = short) :: i
TYPE (Diversion), POINTER :: currentDiversion !points to current diversion

!------------------------------end of declarations-----------------------------

!create new table
CALL TableNew ( tab )

!populate table
string = 'diversion status'
CALL TableSetId ( tab, string)

IF ( PRESENT (time) ) THEN
  timeString = time
  string = 'diversion status at: ' // timeString
ELSE
  string = 'diversion status at the end of simulation' 
END IF
CALL TableSetTitle ( tab, string)

!Allocate variables
CALL TableSetRowCol ( tab, nDiversions, 3 ) 

!set column header and unit
CALL TableSetColHeader (tab, 1, 'id')
CALL TableSetColHeader (tab, 2, 'Qin')
CALL TableSetColHeader (tab, 3, 'Qout')

CALL TableSetColUnit (tab, 1, '-')
CALL TableSetColUnit (tab, 2, 'm3/s')
CALL TableSetColUnit (tab, 3, 'm3/s')

!fill in rows
currentDiversion => diversionChannels

DO i = 1, nDiversions
     !id
     row (1) = ToString (currentDiversion % id)
     !Qin
     row (2) = ToString (currentDiversion % QinChannel)
     !Qout
     row (3) = ToString (currentDiversion % QoutChannel)
     
     currentDiversion => currentDiversion % next
     
     CALL TableFillRow (tab, i, row)
END DO

IF (PRESENT(time)) THEN
	timeString = time
	timeString = timeString (1:19) // '_'
	timeString (14:14) = '-'
	timeString (17:17) = '-'
		
ELSE
	timeString = '                    '
END IF

string = TRIM(pathOut) // TRIM(timeString) // 'diversions.tab'

CALL TableExport (tab, string )

RETURN
END SUBROUTINE DiversionSaveStatus