Line data    Source code

       1             : !> \file    mo_check.f90
       2             : !> \brief   \copybrief mo_check
       3             : !> \details \copydetails mo_check
       4             : 
       5             : !> \brief   Input checking routines
       6             : !> \details This module provides sanity checks for the input data.
       7             : !> \authors Sebastian Mueller
       8             : !> \date    Nov 2020
       9             : !> \copyright Copyright 2005-\today, the mHM Developers, Luis Samaniego, Sabine Attinger: All rights reserved.
      10             : !! mHM is released under the LGPLv3+ license \license_note
      11             : !> \ingroup f_common
      12             : MODULE mo_check
      13             : 
      14             :   USE mo_kind, ONLY : i4
      15             : 
      16             :   IMPLICIT NONE
      17             : 
      18             :   PRIVATE
      19             : 
      20             :   PUBLIC :: check_dir
      21             : 
      22             : CONTAINS
      23             : 
      24             :   !>       \brief   Check if a given directory exists.
      25             :   !>       \details Check if a given directory exists and write out a message about it.
      26             :   !!                Will also give potential information about prefixes given with the path
      27             :   !>       \authors Sebastian Mueller
      28             :   !>       \date    Nov 2020
      29             : 
      30         187 :   subroutine check_dir(path, text, raise, tab, text_length)
      31             : 
      32             :     use mo_constants, ONLY : nout, nerr
      33             :     use mo_message, only : message, show_msg, show_err
      34             :     use mo_os, only : path_split, path_isdir
      35             : 
      36             :     IMPLICIT NONE
      37             : 
      38             :     CHARACTER(LEN=*), INTENT(IN)           :: path        !< input path to check
      39             :     CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: text        !< text to write out
      40             :     LOGICAL, INTENT(IN), OPTIONAL          :: raise       !< whether to throw an error if folder does not exist
      41             :     integer(i4), INTENT(in), OPTIONAL      :: tab         !< tab-depth
      42             :     integer(i4), INTENT(in), OPTIONAL      :: text_length !< maximal text length (for aligning)
      43             : 
      44             :     LOGICAL            :: raise_
      45             :     integer(i4)        :: tab_
      46             :     integer(i4)        :: text_length_, uni
      47             :     LOGICAL            :: is_dir, error, show
      48             :     CHARACTER(len=255) :: head, tail, info, prefix_info, ws, text_
      49             : 
      50             :     ! set standard values
      51         187 :     prefix_info = ""
      52         187 :     ws = " " ! this should hold 255 whitespaces
      53         187 :     text_ = "Directory:"
      54         187 :     raise_ = .false.
      55         187 :     tab_ = 0
      56         187 :     if (present(text)) text_ = text
      57         187 :     if (present(raise)) raise_ = raise
      58         187 :     if (present(tab)) tab_ = tab
      59         187 :     text_length_ = len_trim(text_)
      60         187 :     if (present(text_length)) text_length_ = text_length
      61             : 
      62             :     ! split path to retrieve potential prefix to output files
      63         187 :     call path_split(path, head, tail)
      64             :     ! check if base directory exists
      65         187 :     is_dir = path_isdir(head) ! allow file prefix as path tail
      66             : 
      67         187 :     if ( is_dir ) then
      68         187 :       info = trim(head) // " (found)"
      69             :     else
      70           0 :       info = trim(head) // " (not found)"
      71             :     end if
      72         187 :     if ( len_trim(tail) > 0 ) prefix_info = "added file prefix: " // trim(tail)
      73             : 
      74         187 :     error = .not. is_dir .and. raise_
      75         187 :     show = show_msg
      76         187 :     uni = nout
      77         187 :     if ( error ) then
      78           0 :       show = show_err
      79           0 :       uni = nerr
      80             :     end if
      81             : 
      82             :     call message( &
      83             :       ws(1:tab_), &
      84             :       trim(text_), &
      85             :       ws(1:max(0, text_length_-len_trim(text_))), &
      86             :       trim(info), &
      87             :       " ", &
      88             :       trim(prefix_info), &
      89             :       show=show, &
      90             :       uni=uni &
      91         187 :     )
      92             :     ! throw error if wanted
      93         187 :     if ( error ) stop 1
      94             : 
      95         187 :   end subroutine check_dir
      96             : 
      97             : END MODULE mo_check