fileutils.f90

CCSM Research Tools: Community Atmosphere Model (CAM)

#include <misc.h>
#include <preproc.h>

module fileutils

!public methods

    public :: get_filename  
    public :: set_filename
    public :: opnfil
    public :: getfil
    public :: putfil
    public :: getavu
    public :: relavu
    private:: shell_cmd

    logical, public :: lsmiou(99)  !I/O file unit numbers (1 to 99)

!=======================================================================
CONTAINS
!=======================================================================

  character(len=256) function get_filename (fulpath)

!----------------------------------------------------------------------- 
! 
! Purpose: 
! returns filename given full pathname
!
! Method: 
! 
! Author: Mariana Vertenstein
! 
!-----------------------------------------------------------------------

! ------------------------ arguments --------------------------------
    character(len=*), intent(in)  :: fulpath !full pathname
! -------------------------------------------------------------------

! ------------------------ local variables --------------------------
    integer i               !loop index
    integer klen            !length of fulpath character string
! -------------------------------------------------------------------

    klen = len_trim(fulpath)
    do i = klen, 1, -1
       if (fulpath(i:i) == '/') go to 10
    end do
    i = 0
10  get_filename = fulpath(i+1:klen)
    
    return
  end function get_filename
  
!=======================================================================

  character(len=256) function set_filename (rem_dir, loc_fn)
  
!----------------------------------------------------------------------- 
! 
! Purpose: 
! Set remote full path filename
! 
! Method: 
! 
! Author: Mariana Vertenstein
! 
!-----------------------------------------------------------------------

! ------------------------ arguments ------------------------------
    character(len=*), intent(in)  :: rem_dir !remote directory
    character(len=*), intent(in)  :: loc_fn  !local full path filename
! -----------------------------------------------------------------
    
! ------------------------ local variables ------------------------
    integer :: i   !integer
! -----------------------------------------------------------------

    set_filename = ' '
    do i = len_trim(loc_fn), 1, -1
       if (loc_fn(i:i)=='/') go to 10
    end do
    i = 0
10  set_filename = trim(rem_dir) // loc_fn(i+1:len_trim(loc_fn))
    
  end function set_filename

!=======================================================================

   subroutine getfil (fulpath, locfn, iflag)
 
!----------------------------------------------------------------------- 
! 
! Purpose: 
! Obtain local copy of file
! First check current working directory
! Next check full pathname[fulpath] on disk
! Finally check full pathname[fulpath] on mass store
! 
! Method: 
! 
! Author: Mariana Vertenstein
! 
!-----------------------------------------------------------------------
 
! ------------------------ arguments -----------------------------------
   character(len=*), intent(in)  :: fulpath !MSS or permanent disk full pathname
   character(len=*), intent(out) :: locfn   !output local file name
   integer, optional, intent(in) :: iflag   !0=>abort if file not found 1=>do not abort
! --------------------------------------------------------------------
 
! ------------------------ local variables ---------------------------
   integer i               !loop index
   integer klen            !length of fulpath character string
   integer ierr            !error status
   logical lexist          !true if local file exists
   character(len=256) text !mswrite command
! --------------------------------------------------------------------
 
 
! get local file name from full name: start at end. look for first "/"
 
   klen = len_trim(fulpath)
   do i = klen, 1, -1
      if (fulpath(i:i).eq.'/') go to 100
   end do
   i = 0
  100 locfn = fulpath(i+1:klen)
   if (len_trim(locfn) == 0) then
      write(6,*)'(GETFIL): local filename has zero length'
      call endrun
   else
      write(6,*)'(GETFIL): attempting to find local file ',          &
     &     trim(locfn)
   endif
 
! first check if file is in current working directory.
 
   inquire (file=locfn,exist=lexist)
   if (lexist) then
      write (6,*) '(GETFIL): using ',trim(locfn),                    &
     &     ' in current working directory'
      RETURN
   endif
 
! second check for full pathname on disk
 
   inquire(file=fulpath,exist=lexist)
   if (lexist) then
      locfn = trim(fulpath)
      write(6,*)'(GETFIL): using ',trim(fulpath)
      return
   endif
 
! finally check on mass store
 
   text='msread '//trim(locfn)//' '//trim(fulpath)
   call shell_cmd(text, ierr)
   if (ierr==0) then
      write(6,*)'(GETFIL): File ',trim(locfn),' read from MSS'
   else  ! all tries to get file have been unsuccessful
      write(6,*)'(GETFIL): failed cmd=',trim(text)
      if (present(iflag) .and. iflag==0) then
         call endrun
      else
         RETURN
      endif
   end if
 
   return
   end subroutine getfil
 
!=======================================================================
 
   subroutine putfil(locfn, mssfpn, pass, irt, lremov)
 
!----------------------------------------------------------------------- 
! 
! Purpose: 
! Dispose to Mass Store only if nonzero retention period.
! 
! Method: 
! Put mswrite command in background for asynchronous behavior.
! The string put into 'cmd' below needs to be changed to 
! the appropriate archival command for the users system 
! if a shell command 'mswrite' does not exist.
! 
! Author: Mariana Vertenstein
! 
!-----------------------------------------------------------------------
 
!------------------------------Arguments--------------------------------
   character(len=*), intent(in) :: locfn   ! Local filename
   character(len=*), intent(in) :: mssfpn  ! Mass Store full pathname
   character(len=*), intent(in) :: pass    ! write password
   integer, intent(in) :: irt              ! Mass Store retention time
   logical, intent(in) :: lremov           ! true=>remove local file
!-----------------------------------------------------------------------
 
!---------------------------Local workspace-----------------------------
   character(len=256) cmd     ! Command string
   character(len=256) cmdtem  ! Temporary for command string
   character(len=  4) crt     ! Retention time as characters
   character(len= 16) wpass   ! Write password
   integer ier                ! error number
!-----------------------------------------------------------------------
 
 
   if (irt/=0) then
      wpass = ' '
      if (pass(1:1) /= ' ') wpass = ' -w ' // trim(pass)
      write (crt,'(i4)') irt
      write (cmd,'(100a)') 'mswrite ',' -t ',crt,trim(wpass),' ',&
           trim(locfn),' ',trim(mssfpn)
      if (lremov) then
         cmdtem = '('//trim(cmd)//'; /bin/rm '//trim(locfn)//' )&'
      else
         cmdtem = '('//trim(cmd)//' )&'
      end if
      write(6,*)'(PUTFIL): Issuing shell cmd:',trim(cmdtem)
      call shell_cmd(cmdtem, ier)
      if (ier /= 0) then
         write(6,*)'(PUTFIL): Error from shell cmd'
         call endrun
      end if
   endif

   return
   end subroutine putfil
 
!=======================================================================
 
   subroutine opnfil (locfn, iun, form)
 
!----------------------------------------------------------------------- 
! 
! Purpose: 
! open file locfn in unformatted or formatted form on unit iun
! 
! Method: 
! 
! Author: Mariana Vertenstein
! 
!-----------------------------------------------------------------------
 
! ------------------------ input variables ---------------------------
   character(len=*), intent(in):: locfn  !file name
   integer, intent(in):: iun             !fortran unit number
   character(len=1), intent(in):: form   !file format: u = unformatted. f = formatted
! --------------------------------------------------------------------
 
! ------------------------ local variables ---------------------------
   integer ioe             !error return from fortran open
   character(len=11) ft    !format type: formatted. unformatted
! --------------------------------------------------------------------
 
   if (len_trim(locfn) == 0) then
      write(6,*)'(OPNFIL): local filename has zero length'
      call endrun
   endif
   if (form=='u' .or. form=='U') then
      ft = 'unformatted'
   else
      ft = 'formatted  '
   end if
   open (unit=iun,file=locfn,status='unknown',form=ft,iostat=ioe)
   if (ioe /= 0) then
      write(6,*)'(OPNFIL): failed to open file ',trim(locfn),        &
     &     ' on unit ',iun,' ierr=',ioe
      call endrun
   else
      write(6,*)'(OPNFIL): Successfully opened file ',trim(locfn),   &
     &     ' on unit= ',iun
   end if
 
   return
   end subroutine opnfil
 
!=======================================================================

  integer function getavu()

!----------------------------------------------------------------------- 
! 
! Purpose: 
! get next available Fortran unit number
!
! Method: 
! Get next available Fortran unit number itst. Set lsmiou(itst), in 
! lsmio common block, true. If coupled to CAM, use CAM function navu
! to get available unit number, in which case lsmiou is not needed.
! 
! Author: Gordon Bonan
! 
!-----------------------------------------------------------------------

#if (defined COUP_CAM)
    use units     !CAM units module
#endif

! ------------------------ local variables ------------------------
    integer itst  !Fortran unit number
! -----------------------------------------------------------------

#if (defined COUP_CAM)
    getavu = getunit()
    RETURN
#else
    do itst = 1, 99
       if (.not.lsmiou(itst)) then
          getavu = itst
          lsmiou(itst) = .true.
          RETURN
       end if
    end do
    write (6,*) 'GETAVU error: ran out of Fortran unit numbers'
    call endrun
#endif
  end function getavu

!=======================================================================

  subroutine relavu (iunit)

!----------------------------------------------------------------------- 
! 
! Purpose: 
! close and release Fortran unit no longer in use
!
! Method: 
! Close and release Fortran unit number iunit. Set lsmiou(iunit) to 
! false. If coupled to cam, use cam function relunit to close/release 
! unit number.
! 
! Author: Gordon Bonan
! 
!-----------------------------------------------------------------------

#if (defined COUP_CAM)
    use units     !CAM units module
#endif

! ------------------------ arguments ------------------------------
    integer, intent(in) :: iunit    !Fortran unit number
! -----------------------------------------------------------------

#if (defined COUP_CAM)
    close(iunit)
    call freeunit(iunit)
#else
    if (.not.lsmiou(iunit)) then
       write (6,*) 'RELAVU eror: unit ',iunit,' is not flagged as in use'
       call endrun
    end if
    if (iunit<1 .or. iunit>99) then
       write (6,*) 'RELAVU error: attempt to return out of range unit'
       call endrun
    end if
    close(iunit)
    lsmiou(iunit) = .false.
#endif
    return
  end subroutine relavu

!=======================================================================

   subroutine shell_cmd(text, ier)
 
! ------------------------ arguments -----------------------------------
   character(len=*), intent(in) :: text
   integer         , intent(out):: ier
! ----------------------------------------------------------------------
 
! ------------------------ local variables -----------------------------
#if ( defined CRAY )
   integer, external :: ishell ! System routine, execute shell command
#elif (!defined AIX)
   integer, external :: system ! System routine, execute shell command
#endif
! ----------------------------------------------------------------------
 
#if ( defined CRAY )
   ier = ishell(trim(text))
#elif ( defined AIX )
   call system(trim(text), ier)
   ier = 0               ! Set ier to zero
#elif (!defined CRAY) && (!defined AIX)
   ier = system(trim(text))
#endif
 
   return
   end subroutine shell_cmd

!=======================================================================

end module fileutils