ecearth3/sources/oasis3-mct/lib/mct/mpeu/m_FileResolv.F90

!-------------------------------------------------------------------------
!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
! CVS m_FileResolv.F90,v 1.5 2012-04-30 01:02:53 jacob Exp
! CVS MCT_2_8_0  
!-----------------------------------------------------------------------
!BOP
!
! !MODULE:  m_FileResolv --- Resolve file name templates
! 
! !INTERFACE:
!

   MODULE  m_FileResolv

! !USES:

   use  m_StrTemplate  ! grads style templates
   use  m_die
   Implicit NONE

!
! !PUBLIC MEMBER FUNCTIONS:
!
   PRIVATE
   PUBLIC  FileResolv
   PUBLIC  remote_cp
   PUBLIC  gunzip
!
! !DESCRIPTION: This module provides routines for resolving GrADS like
!               file name templates. 
!
! !REVISION HISTORY: 
!
!  10Jan2000 da Silva  Initial code.
!
!EOP
!-------------------------------------------------------------------------

  character(len=255) :: remote_cp = 'rcp'
  character(len=255) ::    gunzip = 'gunzip'

CONTAINS

!-------------------------------------------------------------------------
!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-------------------------------------------------------------------------
!BOP
!
! !IROUTINE: FileResolv -- Resolve file name templates (single file)
! 
! !INTERFACE:
!
    subroutine FileResolv ( expid, nymd, nhms, templ, fname, &
                            stat, cache )  

! !USES:

    IMPLICIT NONE

!
! !INPUT PARAMETERS: 
!
    character(len=*), intent(in) :: expid          ! Experiment id
    integer,          intent(in) :: nymd           ! Year-month-day
    integer,          intent(in) :: nhms           ! Hour-min-sec
    character(len=*), intent(in) :: templ       ! file name template

!
! !OUTPUT PARAMETERS: 
!
    character(len=*),  intent(out) :: fname        ! resolved file name

    integer, OPTIONAL, intent(out) :: stat         ! Status
                                                   !  0 - file exists
                                                   !  1 - file does not exist

    logical, OPTIONAL, intent(in) :: cache         ! skips rcp/gunzip if
                                                   ! file exists locally

! !DESCRIPTION: Resolve file name templates, rcp'ing files from remote and
!               performing gunzip'ing as necessary.
!
! !TO DO:
!         1. Expand environment variables in templates           
!
! !REVISION HISTORY: 
!
! 10Jan2000  da Silva  Initial code,
! 23Jul2002  J. Larson <larson@mcs.anl.gov> - fixed bug detected by the
!            Fujitsu frt compiler (on the VPP).
!
!EOP
!--------------------------------------------------------------------------

   character(len=*), parameter	:: myname = 'MCT(MPEU)::FileResolv'

#if SYSUNICOS || CPRCRAY
   integer, external  :: ishell
#elif (!defined __GFORTRAN__)
   integer, external  :: system
#endif
   character(len=255) :: path, host, dirn, basen, head, tail, cmd, filen

   integer i, rc
   logical :: fexists, caching


!  Default is cache = .true.
!  -------------------------
   if ( present(cache) ) then
        caching = cache
   else
        caching = .TRUE.
   end if

!  Start by expanding template
!  ---------------------------
   call strTemplate ( path, templ, 'GRADS', trim(expid), nymd, nhms, rc )
   if ( rc .ne. 0 ) then
        if ( present(stat) ) then 
             stat = 1
             return
        else
             call die ( myname, 'cannot expand template '//trim(templ) )
        end if
   end if


!  Parse file name
!  ---------------
   i = index ( trim(path), ':' )
   if ( i .gt. 0 ) then
        host  = path(1:i-1)
        fname = path(i+1:)
   else
        host = ''
        fname = path
   end if
   i = index ( trim(fname), '/', back=.true. )
   if ( i .gt. 1 ) then
        dirn  = fname(1:i-1)
        basen = fname(i+1:) 
   else if ( i .gt. 0 ) then
        dirn  = fname(1:i)
        basen = fname(i+1:) 
   else
        dirn  = ''
        basen = fname 
   end if
   i = index ( basen, '.', back=.true. )
   if ( i .gt. 0 ) then
      head = basen(1:i-1)
      tail = basen(i+1:)
   else
      head = basen
      tail = ''
   end if

!   print *, 'Template = |'//trim(templ)//'|'
!   print *, '   path  = |'//trim(path)//'|'
!   print *, '   host  = |'//trim(host)//'|'
!   print *, '   dirn  = |'//trim(dirn)//'|'
!   print *, '   basen = |'//trim(basen)//'|'
!   print *, '   head  = |'//trim(head)//'|'
!   print *, '   tail  = |'//trim(tail)//'|'
!   print *, '   fname = |'//trim(fname)//'|'


!  If file is remote, bring it here
!  --------------------------------
   if ( len_trim(host) .gt. 0 ) then
      if ( trim(tail) .eq. 'gz' ) then
           inquire ( file=trim(head),  exist=fexists ) 
           filen = head
      else
           inquire ( file=trim(basen), exist=fexists )
           filen = basen
      end if
      if ( .not. ( fexists .and. caching ) ) then
         cmd = trim(remote_cp) // ' ' // &
               trim(host) // ':' // trim(fname) // ' . '
#if SYSUNICOS || CPRCRAY
         rc = ishell ( cmd ) 
#else
         rc = system ( cmd ) 
#endif

         if ( rc .eq. 0 ) then
            fname = basen
         else
            if ( present(stat) ) then ! return an error code
               stat = 2
               return
	    else ! shut down
               fname = basen
               call die ( myname, 'cannot execute: '//trim(cmd) )
            end if
         end if
       else 
         fname = filen
         call warn(myname,'using cached version of '//trim(filen) )
       end if


!  If not, make sure file exists locally
!  -------------------------------------
   else

      inquire ( file=trim(fname), exist=fexists )
      if ( .not. fexists ) then
           if ( present(stat) ) then
              stat = 3
           else
              call die(myname,'cannot find '//trim(fname) )
           end if
      end if
 
   end if 


!  If file is gzip'ed, leave original alone and create uncompressed
!  version in the local directory
!  ----------------------------------------------------------------
   if ( trim(tail) .eq. 'gz' ) then
      inquire ( file=trim(head), exist=fexists ) ! do we have a local copy?
      if ( .not. ( fexists .and. caching ) ) then
        if ( len_trim(host) .gt. 0 ) then             ! remove file.gz 
             cmd = trim(gunzip) // ' -f ' // trim(fname) 
        else                                          ! keep   file.gz
             cmd = trim(gunzip) // ' -c ' // trim(fname) // ' > ' // trim(head)
        end if
#if SYSUNICOS || CPRCRAY
        rc = ishell ( cmd ) 
#else
        rc = system ( cmd ) 
#endif
        if ( rc .eq. 0 ) then
           fname = head             
        else
           if ( present(stat) ) then
              stat = 4
              return
           else
              call die ( myname, 'cannot execute: '//trim(cmd) )
           end if
        end if
       else 
         fname = head             
         call warn(myname,'using cached version of '//trim(head) )
       end if
    end if


!   Once more, make sure file exists
!   --------------------------------
    inquire ( file=trim(fname), exist=fexists )
    if ( .not. fexists ) then
       if ( present(stat) ) then
          stat = 3
       else
          call die(myname,'cannot find '//trim(fname) )
       end if
    end if
 

!   All done
!   --------        
    if ( present(stat) ) stat = 0

  end subroutine FileResolv

  end MODULE m_FileResolv