source: CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/lib/mct/mpeu/m_FileResolv.F90 @ 4775

Last change on this file since 4775 was 4775, checked in by aclsce, 5 years ago
  • Imported oasis3-mct from Cerfacs svn server (not suppotred anymore).

The version has been extracted from ​https://oasis3mct.cerfacs.fr/svn/branches/OASIS3-MCT_2.0_branch/oasis3-mct@1818
File size: 7.3 KB
Line 
1!-------------------------------------------------------------------------
2!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
3!-------------------------------------------------------------------------
4! CVS m_FileResolv.F90,v 1.5 2012-04-30 01:02:53 jacob Exp
5! CVS MCT_2_8_0 
6!-----------------------------------------------------------------------
7!BOP
8!
9! !MODULE:  m_FileResolv --- Resolve file name templates
10!
11! !INTERFACE:
12!
13
14   MODULE  m_FileResolv
15
16! !USES:
17
18   use  m_StrTemplate  ! grads style templates
19   use  m_die
20   Implicit NONE
21
22!
23! !PUBLIC MEMBER FUNCTIONS:
24!
25   PRIVATE
26   PUBLIC  FileResolv
27   PUBLIC  remote_cp
28   PUBLIC  gunzip
29!
30! !DESCRIPTION: This module provides routines for resolving GrADS like
31!               file name templates.
32!
33! !REVISION HISTORY:
34!
35!  10Jan2000 da Silva  Initial code.
36!
37!EOP
38!-------------------------------------------------------------------------
39
40  character(len=255) :: remote_cp = 'rcp'
41  character(len=255) ::    gunzip = 'gunzip'
42
43CONTAINS
44
45!-------------------------------------------------------------------------
46!         NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
47!-------------------------------------------------------------------------
48!BOP
49!
50! !IROUTINE: FileResolv -- Resolve file name templates (single file)
51!
52! !INTERFACE:
53!
54    subroutine FileResolv ( expid, nymd, nhms, templ, fname, &
55                            stat, cache ) 
56
57! !USES:
58
59    IMPLICIT NONE
60
61!
62! !INPUT PARAMETERS:
63!
64    character(len=*), intent(in) :: expid          ! Experiment id
65    integer,          intent(in) :: nymd           ! Year-month-day
66    integer,          intent(in) :: nhms           ! Hour-min-sec
67    character(len=*), intent(in) :: templ       ! file name template
68
69!
70! !OUTPUT PARAMETERS:
71!
72    character(len=*),  intent(out) :: fname        ! resolved file name
73
74    integer, OPTIONAL, intent(out) :: stat         ! Status
75                                                   !  0 - file exists
76                                                   !  1 - file does not exist
77
78    logical, OPTIONAL, intent(in) :: cache         ! skips rcp/gunzip if
79                                                   ! file exists locally
80
81! !DESCRIPTION: Resolve file name templates, rcp'ing files from remote and
82!               performing gunzip'ing as necessary.
83!
84! !TO DO:
85!         1. Expand environment variables in templates           
86!
87! !REVISION HISTORY:
88!
89! 10Jan2000  da Silva  Initial code,
90! 23Jul2002  J. Larson <larson@mcs.anl.gov> - fixed bug detected by the
91!            Fujitsu frt compiler (on the VPP).
92!
93!EOP
94!--------------------------------------------------------------------------
95
96   character(len=*), parameter  :: myname = 'MCT(MPEU)::FileResolv'
97
98#if SYSUNICOS || CPRCRAY
99   integer, external  :: ishell
100#elif (!defined __GFORTRAN__)
101   integer, external  :: system
102#endif
103   character(len=255) :: path, host, dirn, basen, head, tail, cmd, filen
104
105   integer i, rc
106   logical :: fexists, caching
107
108
109!  Default is cache = .true.
110!  -------------------------
111   if ( present(cache) ) then
112        caching = cache
113   else
114        caching = .TRUE.
115   end if
116
117!  Start by expanding template
118!  ---------------------------
119   call strTemplate ( path, templ, 'GRADS', trim(expid), nymd, nhms, rc )
120   if ( rc .ne. 0 ) then
121        if ( present(stat) ) then
122             stat = 1
123             return
124        else
125             call die ( myname, 'cannot expand template '//trim(templ) )
126        end if
127   end if
128
129
130!  Parse file name
131!  ---------------
132   i = index ( trim(path), ':' )
133   if ( i .gt. 0 ) then
134        host  = path(1:i-1)
135        fname = path(i+1:)
136   else
137        host = ''
138        fname = path
139   end if
140   i = index ( trim(fname), '/', back=.true. )
141   if ( i .gt. 1 ) then
142        dirn  = fname(1:i-1)
143        basen = fname(i+1:) 
144   else if ( i .gt. 0 ) then
145        dirn  = fname(1:i)
146        basen = fname(i+1:) 
147   else
148        dirn  = ''
149        basen = fname 
150   end if
151   i = index ( basen, '.', back=.true. )
152   if ( i .gt. 0 ) then
153      head = basen(1:i-1)
154      tail = basen(i+1:)
155   else
156      head = basen
157      tail = ''
158   end if
159
160!   print *, 'Template = |'//trim(templ)//'|'
161!   print *, '   path  = |'//trim(path)//'|'
162!   print *, '   host  = |'//trim(host)//'|'
163!   print *, '   dirn  = |'//trim(dirn)//'|'
164!   print *, '   basen = |'//trim(basen)//'|'
165!   print *, '   head  = |'//trim(head)//'|'
166!   print *, '   tail  = |'//trim(tail)//'|'
167!   print *, '   fname = |'//trim(fname)//'|'
168
169
170!  If file is remote, bring it here
171!  --------------------------------
172   if ( len_trim(host) .gt. 0 ) then
173      if ( trim(tail) .eq. 'gz' ) then
174           inquire ( file=trim(head),  exist=fexists ) 
175           filen = head
176      else
177           inquire ( file=trim(basen), exist=fexists )
178           filen = basen
179      end if
180      if ( .not. ( fexists .and. caching ) ) then
181         cmd = trim(remote_cp) // ' ' // &
182               trim(host) // ':' // trim(fname) // ' . '
183#if SYSUNICOS || CPRCRAY
184         rc = ishell ( cmd ) 
185#else
186         rc = system ( cmd ) 
187#endif
188
189         if ( rc .eq. 0 ) then
190            fname = basen
191         else
192            if ( present(stat) ) then ! return an error code
193               stat = 2
194               return
195            else ! shut down
196               fname = basen
197               call die ( myname, 'cannot execute: '//trim(cmd) )
198            end if
199         end if
200       else
201         fname = filen
202         call warn(myname,'using cached version of '//trim(filen) )
203       end if
204
205
206!  If not, make sure file exists locally
207!  -------------------------------------
208   else
209
210      inquire ( file=trim(fname), exist=fexists )
211      if ( .not. fexists ) then
212           if ( present(stat) ) then
213              stat = 3
214           else
215              call die(myname,'cannot find '//trim(fname) )
216           end if
217      end if
218 
219   end if 
220
221
222!  If file is gzip'ed, leave original alone and create uncompressed
223!  version in the local directory
224!  ----------------------------------------------------------------
225   if ( trim(tail) .eq. 'gz' ) then
226      inquire ( file=trim(head), exist=fexists ) ! do we have a local copy?
227      if ( .not. ( fexists .and. caching ) ) then
228        if ( len_trim(host) .gt. 0 ) then             ! remove file.gz
229             cmd = trim(gunzip) // ' -f ' // trim(fname) 
230        else                                          ! keep   file.gz
231             cmd = trim(gunzip) // ' -c ' // trim(fname) // ' > ' // trim(head)
232        end if
233#if SYSUNICOS || CPRCRAY
234        rc = ishell ( cmd ) 
235#else
236        rc = system ( cmd ) 
237#endif
238        if ( rc .eq. 0 ) then
239           fname = head             
240        else
241           if ( present(stat) ) then
242              stat = 4
243              return
244           else
245              call die ( myname, 'cannot execute: '//trim(cmd) )
246           end if
247        end if
248       else
249         fname = head             
250         call warn(myname,'using cached version of '//trim(head) )
251       end if
252    end if
253
254
255!   Once more, make sure file exists
256!   --------------------------------
257    inquire ( file=trim(fname), exist=fexists )
258    if ( .not. fexists ) then
259       if ( present(stat) ) then
260          stat = 3
261       else
262          call die(myname,'cannot find '//trim(fname) )
263       end if
264    end if
265 
266
267!   All done
268!   --------       
269    if ( present(stat) ) stat = 0
270
271  end subroutine FileResolv
272
273  end MODULE m_FileResolv
Note: See TracBrowser for help on using the repository browser.