ecearth3/sources/tm5mp/base/user_output_common.F90

!#################################################################
!
! User_Output_Common  -  common settings and tools for user output
!
!### macro's #####################################################
!
#define TRACEBACK write (gol,'("in ",a," (",a,", line",i5,")")') rname, __FILE__, __LINE__; call goErr
#define IF_NOTOK_RETURN(action) if (status/=0) then; TRACEBACK; action; return; end if
#define IF_ERROR_RETURN(action) if (status> 0) then; TRACEBACK; action; return; end if
!
#include "tm5.inc"
!
!#################################################################

module User_Output_Common

  use GO, only : gol, goErr, goPr

  implicit none
  
  
  ! --- in/out -----------------------------------
  
  private
  
  public  ::  User_Output_Common_Init
  public  ::  User_Output_Common_Done
  public  ::  User_Output_Check_Overwrite
  
  
  ! --- const ------------------------------------
  
  ! module name:
  character(len=*), parameter  ::  mname = 'User_Output_Common'
  
  
  ! --- local ------------------------------------
  
  ! allow existing files to be overwritten ?
  logical           ::  output_overwrite


contains


  ! ====================================================================
  
  
  subroutine User_Output_Common_Init( status )
  
    use GO,                  only : TrcFile, Init, Done, ReadRc
    use global_data,         only : rcfile

    ! --- in/out --------------------------------
    
    integer, intent(out)    ::  status
    
    ! --- const -------------------------------
    
    character(len=*), parameter  ::  rname = mname//'/User_Output_Common_Init'
    
    ! --- local ---------------------------------
    
    type(TrcFile)     ::  rcF
    
    ! --- begin ---------------------------------

    ! open settings:
    call Init( rcF, rcfile, status )
    IF_NOTOK_RETURN(status=1)
    
    ! read flag that allows overwriting existing files:
    call ReadRc( rcF, 'output.overwrite', output_overwrite, status )
    IF_NOTOK_RETURN(status=1)

    ! close rcfile:
    call Done( rcF, status  )
    IF_NOTOK_RETURN(status=1)
    
    ! ok
    status = 0

  end subroutine User_Output_Common_Init
  
  
  ! ***
  
     
  subroutine User_Output_Common_Done( status )
  
    ! --- in/out --------------------------------
    
    integer, intent(out)    ::  status
    
    ! --- const -------------------------------
    
    character(len=*), parameter  ::  rname = mname//'/User_Output_Common_Done'
    
    ! --- begin ---------------------------------
    
    ! ok
    status = 0

  end subroutine User_Output_Common_Done
  
  
  ! ***
  
  
  ! check if file with provided filename already exists;
  ! if it exists, and output_overwrite flag is .false.,
  ! then return with error status 1;
  ! otherwise error status 0
  
     
  subroutine User_Output_Check_Overwrite( filename, status )
  
    ! --- in/out --------------------------------
    
    character(len=*), intent(in)    ::  filename
    integer, intent(out)            ::  status
    
    ! --- const -------------------------------
    
    character(len=*), parameter  ::  rname = mname//'/User_Output_Check_Overwrite'
    
    ! --- local ---------------------------------
    
    logical         ::  exist
    
    ! --- begin ---------------------------------
    
    ! overwriteing existing files not allowed ?
    if ( .not. output_overwrite ) then
      ! check presence:
      inquire( file=trim(filename), exist=exist )
      ! and ?
      if ( exist ) then
        ! info ...
        write (gol,'("output file already present :")'); call goErr
        write (gol,'("  ",a)') trim(filename); call goErr
        write (gol,'("remove the file, or set in the rcfile the flag")'); call goErr
        write (gol,'("`output.overwrite` to `T` to overwrite existing files")'); call goErr
        TRACEBACK; status=1; return
      end if
    end if
    
    ! ok
    status = 0

  end subroutine User_Output_Check_Overwrite


end module User_Output_Common