diff --git a/src/common/mo_check.f90 b/src/common/mo_check.f90 new file mode 100644 index 0000000000000000000000000000000000000000..083f1119d82f7fc159a6bc862c8e3f1e76fcca5a --- /dev/null +++ b/src/common/mo_check.f90 @@ -0,0 +1,79 @@ +!> \file mo_check.f90 +!> \brief Input checking routines +!> \details This module provides sanity checks for the input data. +!> \authors Sebastian Mueller +!> \date Nov 2020 + +MODULE mo_check + + USE mo_kind, ONLY : i4, dp + + IMPLICIT NONE + + PRIVATE + + PUBLIC :: check_dir + +CONTAINS + + !> \brief Check if a given directory exists. + !> \details Check if a given directory exists and write out a message about it. + !! Will also give potential information about prefixes given with the path + !> \authors Sebastian Mueller + !> \date Nov 2020 + + subroutine check_dir(path, text_, throwError_, tab_, text_length_) + + use mo_message, only : message + use mo_os, only : path_split, path_isdir + + IMPLICIT NONE + + CHARACTER(LEN=*), INTENT(IN) :: path !< input path to check + CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: text_ !< text to write out + LOGICAL, INTENT(IN), OPTIONAL :: throwError_ !< wheather to throw an error if folder not existing + integer(i4), INTENT(in), OPTIONAL :: tab_ !< tab-depth + integer(i4), INTENT(in), OPTIONAL :: text_length_ !< maximal text length (for aligning) + + LOGICAL :: throwError = .false. + integer(i4) :: tab = 0 + integer(i4) :: text_length + LOGICAL :: is_dir + CHARACTER(len=255) :: head, tail, info, prefix_info, ws, text + + ! set standard values + prefix_info = "" + ws = " " ! this should hold 255 whitespaces + text = "Directory:" + if (present(text_)) text = text_ + if (present(throwError_)) throwError = throwError_ + if (present(tab_)) tab = tab_ + text_length = len_trim(text) + if (present(text_length_)) text_length = text_length_ + + ! split path to retrieve potential prefix to output files + call path_split(path, head, tail) + ! check if base directory exists + call path_isdir(head, quiet_=.true., result_=is_dir) ! allow file prefix as path tail + + if ( is_dir ) then + info = trim(head) // " (found)" + else + info = trim(head) // " (not found)" + end if + if ( len_trim(tail) > 0 ) prefix_info = "added file prefix: " // trim(tail) + + call message( & + ws(1:tab), & + trim(text), & + ws(1:max(0, text_length-len_trim(text))), & + trim(info), & + " ", & + trim(prefix_info) & + ) + ! throw error if wanted + if (.not. is_dir .and. throwError) stop 1 + + end subroutine check_dir + +END MODULE mo_check diff --git a/src/lib/mo_os.f90 b/src/lib/mo_os.f90 index ac9f40f91dc534e58acf8162ecf0351910f30909..965b4a5ffaacaab006b59a3c47cf9c83a1a191ae 100644 --- a/src/lib/mo_os.f90 +++ b/src/lib/mo_os.f90 @@ -100,11 +100,13 @@ CONTAINS LOGICAL :: throwError = .false. LOGICAL :: exists CHARACTER(LEN=40) :: messagetext + CHARACTER(LEN=len_trim(path)) :: t_path - inquire (file=path, exist=exists) + t_path = trim(path) + inquire (file=t_path, exist=exists) #ifdef INTEL - if (.not. exists) inquire (directory=path, exist=exists) + if (.not. exists) inquire (directory=t_path, exist=exists) #endif if (present(quiet_)) quiet = quiet_ @@ -118,7 +120,7 @@ CONTAINS endif if (.not. exists) then - if (.not. quiet .or. throwError) call message(trim(messagetext), path) + if (.not. quiet .or. throwError) call message(trim(messagetext), t_path) if (throwError) stop 1 endif @@ -188,7 +190,9 @@ CONTAINS LOGICAL :: throwError LOGICAL :: exists LOGICAL :: isfile + CHARACTER(LEN=len_trim(path)) :: t_path + t_path = trim(path) quiet = .false. throwError = .false. isfile = .true. @@ -196,21 +200,21 @@ CONTAINS if (present(quiet_)) quiet = quiet_ if (present(throwError_)) throwError = throwError_ - call path_exists(path, quiet, throwError, .false., exists) + call path_exists(t_path, quiet, throwError, .false., exists) if (exists) then !checking whether the path is ending with '/' or '/.' which would indicates a directory - if (path(len(path):len(path)) .eq. '/' .or. path(len(path) - 1:len(path)) .eq. '/.') then + if (t_path(len(t_path):len(t_path)) .eq. '/' .or. t_path(len(t_path) - 1:len(t_path)) .eq. '/.') then isfile = .false. else !checking whether would still exist if '/.' is added to the end, in this case it is a directory #ifdef INTEL - inquire (directory=path//'/.', exist=exists) + inquire (directory=t_path//'/.', exist=exists) #else - inquire (file=path//'/.', exist=exists) + inquire (file=t_path//'/.', exist=exists) #endif if (exists) then isfile = .false. - if (.not. quiet .or. throwError) call message('The following path describes a directory and not a file: ', path) + if (.not. quiet .or. throwError) call message('The following path describes a directory and not a file: ', t_path) if (throwError) stop 1 endif endif @@ -284,7 +288,9 @@ CONTAINS LOGICAL :: throwError LOGICAL :: isdir LOGICAL :: exists + CHARACTER(LEN=len_trim(path)) :: t_path + t_path = trim(path) quiet = .false. throwError = .false. isdir = .true. @@ -292,12 +298,12 @@ CONTAINS if (present(quiet_)) quiet = quiet_ if (present(throwError_)) throwError = throwError_ - call path_exists(path, quiet, throwError, .true., exists) + call path_exists(t_path, quiet, throwError, .true., exists) if (exists) then - call path_isfile(path, .true., .false., exists) + call path_isfile(t_path, .true., .false., exists) if (exists) then isdir = .false. - if (.not. quiet .or. throwError) call message('The following path describes a file and not a directory: ', path) + if (.not. quiet .or. throwError) call message('The following path describes a file and not a directory: ', t_path) if (throwError) stop 1 endif else @@ -366,31 +372,33 @@ CONTAINS INTEGER :: i CHARACTER :: c LOGICAL :: isdir + CHARACTER(LEN=len_trim(path)) :: t_path - i = len(path) - 1 - c = path(len(path):len(path)) + t_path = trim(path) + i = len(t_path) - 1 + c = t_path(len(t_path):len(t_path)) !Checking, whether the path describes a directory so it cannot ends with an extension. - call path_isdir(path, .true., .false., isdir) + call path_isdir(t_path, .true., .false., isdir) if (isdir) then - i = len(path) + i = len(t_path) else !running through the path, beginning at the end until a point is found that probably indicates !the seperation of a file name and its extension or a '/' occurs what means that the rest of the !path is consisting of directories do while (.not. (c .eq. '.' .or. c .eq. '/' .or. i .eq. 0)) - c = path(i:i) + c = t_path(i:i) i = i - 1 end do !checking whether the last symbol of the path is a point or the while-loop run through the whole path !without finding a point or ended at a '/'. In any case it is not possible to seperate an extension. - if (i .eq. len(path) - 1 .or. i .eq. 0 .or. c .eq. '/') then - i = len(path) + if (i .eq. len(t_path) - 1 .or. i .eq. 0 .or. c .eq. '/') then + i = len(t_path) endif endif - root = path(1:i) - ext = path(i + 1:len(path)) + root = t_path(1:i) + ext = t_path(i + 1:len(t_path)) return END SUBROUTINE path_splitext @@ -452,25 +460,26 @@ CONTAINS INTEGER :: i CHARACTER :: c - LOGICAL :: isdir + CHARACTER(LEN=len_trim(path)) :: t_path - i = len(path) - 1 - c = path(len(path):len(path)) + t_path = trim(path) + i = len(t_path) - 1 + c = t_path(len(t_path):len(t_path)) !running through the path, beginning at the end until a point is found that probably indicates !the seperation of a file name and its extension or a '/' occurs what means that the rest of the !path is consisting of directories do while (.not. (c .eq. '/' .or. i .eq. 0)) - c = path(i:i) + c = t_path(i:i) i = i - 1 end do !checking whether the while-loop run through the whole path without finding a '/' if (i .eq. 0) then head = '' - tail = path + tail = t_path else - head = path(1:i + 1) - tail = path(i + 2:len(path)) + head = t_path(1:i + 1) + tail = t_path(i + 2:len(t_path)) endif return diff --git a/src/mHM/mhm_driver.f90 b/src/mHM/mhm_driver.f90 index 76cb38e8d4b62a78b5341d9beeb0e2856ef0df1d..df60e900f29443ebd35773630bf8a310b0450f8d 100644 --- a/src/mHM/mhm_driver.f90 +++ b/src/mHM/mhm_driver.f90 @@ -159,6 +159,7 @@ PROGRAM mhm_driver #ifdef NAG USE f90_unix_dir, ONLY : CHDIR, GETCWD #endif + USE mo_check, ONLY: check_dir IMPLICIT NONE @@ -257,26 +258,25 @@ PROGRAM mhm_driver call message(' --------------') call message(' DOMAIN ', num2str(domainID, '(I3)')) call message(' --------------') - call message(' Morphological directory: ', trim(dirMorpho(iDomain))) - call message(' Land cover directory: ', trim(dirLCover(iDomain))) - call message(' Precipitation directory: ', trim(dirPrecipitation(iDomain))) - call message(' Temperature directory: ', trim(dirTemperature(iDomain))) + call check_dir(dirMorpho(iDomain), "Morphological directory:", .false., 4, 30) + call check_dir(dirLCover(iDomain), "Land cover directory:", .false., 4, 30) + call check_dir(dirPrecipitation(iDomain), "Precipitation directory:", .false., 4, 30) + call check_dir(dirTemperature(iDomain), "Temperature directory:", .false., 4, 30) select case (processMatrix(5, 1)) - case(-1 : 0) ! PET is input - call message(' PET directory: ', trim(dirReferenceET(iDomain))) - case(1) ! Hargreaves-Samani - call message(' Min. temperature directory: ', trim(dirMinTemperature(iDomain))) - call message(' Max. temperature directory: ', trim(dirMaxTemperature(iDomain))) - case(2) ! Priestely-Taylor - call message(' Net radiation directory: ', trim(dirNetRadiation(iDomain))) - case(3) ! Penman-Monteith - call message(' Net radiation directory: ', trim(dirNetRadiation(iDomain))) - call message(' Abs. vap. press. directory: ', trim(dirabsVapPressure(iDomain))) - call message(' Windspeed directory: ', trim(dirwindspeed(iDomain))) + case(-1 : 0) ! PET is input + call check_dir(dirReferenceET(iDomain), "PET directory:", .false., 4, 30) + case(1) ! Hargreaves-Samani + call check_dir(dirMinTemperature(iDomain), "Min. temperature directory:", .false., 4, 30) + call check_dir(dirMaxTemperature(iDomain), "Max. temperature directory:", .false., 4, 30) + case(2) ! Priestely-Taylor + call check_dir(dirNetRadiation(iDomain), "Net radiation directory:", .false., 4, 30) + case(3) ! Penman-Monteith + call check_dir(dirNetRadiation(iDomain), "Net radiation directory:", .false., 4, 30) + call check_dir(dirabsVapPressure(iDomain), "Abs. vap. press. directory:", .false., 4, 30) + call check_dir(dirwindspeed(iDomain), "Windspeed directory:", .false., 4, 30) end select - call message(' Output directory: ', trim(dirOut(iDomain))) - - call message('') + call check_dir(dirOut(iDomain), "Output directory:", .true., 4, 30) + call message() end do ! Start timings diff --git a/src/mRM/mo_mrm_riv_temp_class.f90 b/src/mRM/mo_mrm_riv_temp_class.f90 index 3caa34659b7da707009660a39d04680b7bce9110..abb271f3d9cfd7b10e1307d5e25786d8330d2bec 100644 --- a/src/mRM/mo_mrm_riv_temp_class.f90 +++ b/src/mRM/mo_mrm_riv_temp_class.f90 @@ -125,6 +125,8 @@ contains use mo_common_constants, only : maxNoDomains, nodata_i4 use mo_common_variables, only : domainMeta use mo_nml, only : close_nml, open_nml, position_nml + use mo_check, only : check_dir + USE mo_string_utils, ONLY : num2str implicit none @@ -148,6 +150,8 @@ contains character(256) :: riv_widths_file ! file name for river widths character(256) :: riv_widths_name ! variable name for river widths + integer(i4) :: iDomain, domainID + ! namelist for river temperature configuration namelist /config_riv_temp/ & albedo_water, & @@ -194,6 +198,17 @@ contains ! closing the namelist file call close_nml(unamelist) + do iDomain = 1, domainMeta%nDomains + domainID = domainMeta%indices(iDomain) + call check_dir( & + path=self%dir_riv_widths(iDomain), & + text_="(domain "//trim(num2str(domainID,'(I3)'))//") River widths directory:", & + throwError_=.true., & + tab_=4, & + text_length_=40 & + ) + end do + end subroutine config !> \brief initalize the \ref riv_temp_type class for the current domain