LCOV - code coverage report
Current view: | top level - utils - ioFileMod.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 37 | 55 | 67.3 %
Date: | 2025-01-13 21:54:50 |  | Functions: | 2 | 2 | 100.0 %

              Line data    Source code
           1             : module ioFileMod
           2             : !---------------------------------------------------------------------
           3             : !
           4             : ! Purpose:
           5             : !
           6             : !       Input/Output file manipulations. Mind file on archival system, or local
           7             : !       disk etc.
           8             : !
           9             : ! Author: Mariana Vertenstein
          10             : !
          11             : !---------------------------------------------------------------------
          12             :
          13             :    use shr_kind_mod,     only: r8 => shr_kind_r8
          14             :    use cam_abortutils,   only: endrun
          15             :    use spmd_utils,       only: masterproc
          16             :    use cam_logfile,      only: iulog
          17             :
          18             :    implicit none
          19             :
          20             : !--------------------------------------------------------------------------
          21             : ! Public interfaces
          22             : !--------------------------------------------------------------------------
          23             :
          24             :    private
          25             :
          26             :    public getfil      ! Get file from archive
          27             :    public opnfil      ! Open file
          28             :
          29             : !--------------------------------------------------------------------------
          30             : ! Private interfaces
          31             : !--------------------------------------------------------------------------
          32             :
          33             : !=======================================================================
          34             :    contains
          35             : !=======================================================================
          36             :
          37        8448 : subroutine getfil(fulpath, locfn, iflag, lexist)
          38             :
          39             :    ! --------------------------------------------------------------------
          40             :    ! Determine whether file is on local disk.
          41             :    ! . first check current working directory
          42             :    ! . next check full pathname[fulpath] on disk
          43             :    ! . by default, abort if file not found.  Setting optional iflag arg
          44             :    !   to 1 overrides this behavior, and in that case the optional lexist
          45             :    !   arg is used to return status of whether the file was found or not.
          46             :    ! --------------------------------------------------------------------
          47             :
          48             :    ! ------------------------ arguments -----------------------------------
          49             :    character(len=*), intent(in)   :: fulpath ! full pathname on local disk
          50             :    character(len=*), intent(out)  :: locfn   ! local file name if found in working directory,
          51             :                                              ! set to fulpath if not found in working dir.
          52             :    integer, optional, intent(in)  :: iflag   ! set iflag=1 to return control to caller if
          53             :                                              ! file not found.  default is to abort.
          54             :    logical, optional, intent(out) :: lexist  ! When iflag=1 then getfil will return whether the
          55             :                                              ! file is found or not.  This flag is set .true.
          56             :                                              ! if the file is found, otherwise .false.
          57             :
          58             :    ! ------------------------ local variables ---------------------------
          59             :    integer :: i               ! loop index
          60             :    integer :: klen            ! length of fulpath character string
          61             :    integer :: maxlen          ! length of locfn input variable
          62             :    integer :: ierr            ! error status
          63             :    logical :: lexist_in       ! true if local file exists
          64             :    logical :: abort_on_failure
          65             :    ! --------------------------------------------------------------------
          66             :
          67        8448 :    abort_on_failure = .true.
          68        8448 :    if (present(iflag)) then
          69        3072 :       if (iflag==1) abort_on_failure = .false.
          70             :    end if
          71        8448 :    maxlen = len(locfn)
          72             :
          73             :    ! first check if file is in current working directory.
          74             :
          75             :    ! get local file name from full name: start at end. look for first "/"
          76             :
          77        8448 :    klen = len_trim(fulpath)
          78        8448 :    i = index(fulpath, '/', back=.true.)
          79             :
          80        8448 :    if ((klen-i) > maxlen) then
          81           0 :       if (abort_on_failure) then
          82           0 :          call endrun('(GETFIL): local filename variable is too short for path length')
          83             :       else
          84           0 :          if (masterproc) write(iulog,*) '(GETFIL): local filename variable is too short for path length',klen-i,maxlen
          85           0 :          if (present(lexist)) lexist = .false.
          86        8448 :          return
          87             :       end if
          88             :    end if
          89             :
          90        8448 :    locfn = fulpath(i+1:klen)
          91        8448 :    if (len_trim(locfn) == 0) then
          92           0 :       call endrun ('(GETFIL): local filename has zero length')
          93        8448 :    else if (masterproc) then
          94          11 :       write(iulog,*)'(GETFIL): attempting to find local file ', trim(locfn)
          95             :    end if
          96             :
          97        8448 :    inquire(file=locfn, exist=lexist_in)
          98        8448 :    if (present(lexist)) lexist = lexist_in
          99        8448 :    if (lexist_in) then
         100        3072 :       if (masterproc) write(iulog,*) '(GETFIL): using ',trim(locfn), ' in current working directory'
         101        3072 :       return
         102             :    end if
         103             :
         104             :    ! second check for full pathname on disk
         105             :
         106        5376 :    if (klen > maxlen) then
         107           0 :       if (abort_on_failure) then
         108           0 :          call endrun('(GETFIL): local filename variable is too short for path length')
         109             :       else
         110           0 :          if (masterproc) write(iulog,*) '(GETFIL): local filename variable is too short for path length',klen,maxlen
         111           0 :          if (present(lexist)) lexist = .false.
         112           0 :          return
         113             :       end if
         114             :    end if
         115             :
         116        5376 :    locfn = trim(fulpath)
         117        5376 :    inquire(file=locfn, exist=lexist_in)
         118        5376 :    if (present(lexist)) lexist = lexist_in
         119        5376 :    if (lexist_in) then
         120        5376 :       if (masterproc) write(iulog,*)'(GETFIL): using ',trim(fulpath)
         121        5376 :       return
         122             :    else
         123           0 :       if (masterproc) write(iulog,*)'(GETFIL): all tries to get file have been unsuccessful: ',trim(fulpath)
         124           0 :       if (abort_on_failure) then
         125           0 :          call endrun ('GETFIL: FAILED to get '//trim(fulpath))
         126             :       else
         127             :          return
         128             :       endif
         129             :    endif
         130             :
         131        8448 : end subroutine getfil
         132             :
         133             : !=======================================================================
         134             :
         135             :
         136           0 :    subroutine opnfil (locfn, iun, form, status)
         137             :
         138             : !-----------------------------------------------------------------------
         139             : ! open file locfn in unformatted or formatted form on unit iun
         140             : !-----------------------------------------------------------------------
         141             :
         142             : ! ------------------------ input variables ---------------------------
         143             :    character(len=*), intent(in):: locfn  !file name
         144             :    integer, intent(in):: iun             !fortran unit number
         145             :    character(len=1), intent(in):: form   !file format: u = unformatted. f = formatted
         146             :    character(len=*), optional, intent(in):: status !file status
         147             : ! --------------------------------------------------------------------
         148             :
         149             : ! ------------------------ local variables ---------------------------
         150             :    integer ioe             !error return from fortran open
         151             :    character(len=11) ft    !format type: formatted. unformatted
         152             :    character(len=11) st    !file status: old or unknown
         153             : ! --------------------------------------------------------------------
         154             :
         155           3 :    if (len_trim(locfn) == 0) then
         156           0 :       call endrun ('(OPNFIL): local filename has zero length')
         157             :    endif
         158           3 :    if (form=='u' .or. form=='U') then
         159           0 :       ft = 'unformatted'
         160             :    else
         161           3 :       ft = 'formatted  '
         162             :    end if
         163           3 :    if ( present(status) ) then
         164           1 :       st = status
         165             :    else
         166           2 :       st = "unknown"
         167             :    end if
         168           3 :    open (unit=iun,file=locfn,status=st, form=ft,iostat=ioe)
         169           3 :    if (ioe /= 0) then
         170           0 :       if(masterproc) write(iulog,*)'(OPNFIL): failed to open file ',trim(locfn), ' on unit ',iun,' ierr=',ioe
         171           0 :       call endrun ('opnfil')
         172             :    else
         173           3 :       if(masterproc) write(iulog,*)'(OPNFIL): Successfully opened file ',trim(locfn), ' on unit= ',iun
         174             :    end if
         175             :
         176           3 :    return
         177           3 :    end subroutine opnfil
         178             :
         179             : !=======================================================================
         180             :
         181             :
         182             : end module ioFileMod

Generated by: LCOV version 1.14