readpaths.f90 3.82 KB
Newer Older
1 2
! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
! SPDX-License-Identifier: GPL-3.0-or-later
3

4
subroutine readpaths
Matthias Langer's avatar
 
Matthias Langer committed
5 6 7 8 9 10 11 12 13

  !*****************************************************************************
  !                                                                            *
  !     Reads the pathnames, where input/output files are expected to be.      *
  !     The file pathnames must be available in the current working directory. *
  !                                                                            *
  !     Author: A. Stohl                                                       *
  !                                                                            *
  !     1 February 1994                                                        *
14 15 16
  !     last modified                                                          *
  !     HS, 7.9.2012                                                           *
  !     option to give pathnames file as command line option                   *
Matthias Langer's avatar
 
Matthias Langer committed
17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
  !                                                                            *
  !*****************************************************************************
  !                                                                            *
  ! Variables:                                                                 *
  ! length(numpath)    lengths of the path names                               *
  ! path(numpath)      pathnames of input/output files                         *
  !                                                                            *
  ! Constants:                                                                 *
  ! numpath            number of pathnames to be read in                       *
  !                                                                            *
  !*****************************************************************************

  use par_mod
  use com_mod

  implicit none

34 35 36
  integer   :: i
  character(256) :: string_test 
  character(1) :: character_test 
Matthias Langer's avatar
 
Matthias Langer committed
37 38 39 40

  ! Read the pathname information stored in unitpath
  !*************************************************

41
  open(unitpath,file=trim(pathfile),status='old',err=999)
Matthias Langer's avatar
 
Matthias Langer committed
42 43 44 45

  do i=1,numpath
    read(unitpath,'(a)',err=998) path(i)
    length(i)=index(path(i),' ')-1
46 47 48 49

    
    string_test = path(i)
    character_test = string_test(length(i):length(i))
50 51 52
    !print*, 'character_test,  string_test ', character_test,  string_test 
      if ((character_test .NE. '/') .AND. (i .LT. 4))  then
         print*, 'WARNING: path not ending in /' 
53 54 55 56 57
         print*, path(i)
         path(i) = string_test(1:length(i)) // '/'
         length(i)=length(i)+1
         print*, 'fix: padded with /' 
         print*, path(i)
58
         print*, 'length(i) increased 1' 
59
      endif
60
  end do
Matthias Langer's avatar
 
Matthias Langer committed
61 62 63 64 65

  ! Check whether any nested subdomains are to be used
  !***************************************************

  do i=1,maxnests
66 67 68 69
  ! ESO 2016 Added 'end'/'err' in case user forgot '====' at end of file and
  ! maxnests > numbnests
    read(unitpath,'(a)', end=30, err=30) path(numpath+2*(i-1)+1)
    read(unitpath,'(a)', end=30, err=30) path(numpath+2*(i-1)+2)
Matthias Langer's avatar
 
Matthias Langer committed
70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
    if (path(numpath+2*(i-1)+1)(1:5).eq.'=====') goto 30
    length(numpath+2*(i-1)+1)=index(path(numpath+2*(i-1)+1),' ')-1
    length(numpath+2*(i-1)+2)=index(path(numpath+2*(i-1)+2),' ')-1
  end do


  ! Determine number of available nested domains
  !*********************************************

30   numbnests=i-1

  close(unitpath)
  return

998   write(*,*) ' #### TRAJECTORY MODEL ERROR! ERROR WHILE     #### '
  write(*,*) ' #### READING FILE PATHNAMES.                 #### '
  stop

999   write(*,*) ' #### TRAJECTORY MODEL ERROR! FILE "pathnames"#### '
  write(*,*) ' #### CANNOT BE OPENED IN THE CURRENT WORKING #### '
  write(*,*) ' #### DIRECTORY.                              #### '
  stop

end subroutine readpaths