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 178952 : 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 178952 : abort_on_failure = .true.
68 178952 : if (present(iflag)) then
69 165896 : if (iflag==1) abort_on_failure = .false.
70 : end if
71 178952 : 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 178952 : klen = len_trim(fulpath)
78 178952 : i = index(fulpath, '/', back=.true.)
79 :
80 178952 : 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 178952 : return
87 : end if
88 : end if
89 :
90 178952 : locfn = fulpath(i+1:klen)
91 178952 : if (len_trim(locfn) == 0) then
92 0 : call endrun ('(GETFIL): local filename has zero length')
93 178952 : else if (masterproc) then
94 241 : write(iulog,*)'(GETFIL): attempting to find local file ', trim(locfn)
95 : end if
96 :
97 178952 : inquire(file=locfn, exist=lexist_in)
98 178952 : if (present(lexist)) lexist = lexist_in
99 178952 : 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 175880 : 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 175880 : locfn = trim(fulpath)
117 175880 : inquire(file=locfn, exist=lexist_in)
118 175880 : if (present(lexist)) lexist = lexist_in
119 175880 : if (lexist_in) then
120 175880 : if (masterproc) write(iulog,*)'(GETFIL): using ',trim(fulpath)
121 175880 : 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 178952 : 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
|
