1module ramDisk_mod
2 ! MODULE ramDisk_mod (prefix='ram' category='8. Low-level utilities and constants')
3 !
4 !:Purpose: To control the file manipulations/enquiries on the RAM disk.
5 !
6 use utilities_mod
7 use clibInterfaces_mod
8 implicit none
9 save
10 private
11
12 ! public procedures
13 public :: ram_setup, ram_fullWorkingPath, ram_remove, ram_getRamDiskDir
14
15 character(len=256) :: ram_disk_dir
16
17 logical :: ram_disk_dir_exists
18 logical :: initialized = .false.
19
20contains
21
22 !--------------------------------------------------------------------------
23 ! ram_setup
24 !--------------------------------------------------------------------------
25 subroutine ram_setup()
26 implicit none
27
28 ! Locals:
29 integer :: length_ram_disk_dir, status
30
31 !
32 !- Determine the ramdisk directory, if available
33 !
34 status = 0
35 call get_environment_variable('MIDAS_RAMDISKDIR',ram_disk_dir,length_ram_disk_dir,status,.true.)
36
37 if (status.gt.1) then
38 write(*,*) 'ram_setup: Problem when getting the environment variable MIDAS_RAMDISKDIR'
39 end if
40 if (status.eq.1) then
41 write(*,*) 'ram_setup: The environment variable MIDAS_RAMDISKDIR has not been detected!'
42 write(*,*) ' Assume all files in current working directory'
43 ram_disk_dir_exists = .false.
44 ram_disk_dir = 'DOES_NOT_EXIST'
45 else
46 write(*,*)
47 write(*,*) 'ram_setup: The environment variable MIDAS_RAMDISKDIR has correctly been detected'
48 write(*,*) 'ram_setup: Files will first be opened from directory: ', trim(ram_disk_dir)
49 ram_disk_dir_exists = .true.
50 end if
51
52 initialized = .true.
53
54 end subroutine ram_setup
55
56 !--------------------------------------------------------------------------
57 ! ram_fullWorkingPath
58 !--------------------------------------------------------------------------
59 function ram_fullWorkingPath(fileName, noAbort_opt, copyToRamDisk_opt) result(fullWorkingPath)
60 !
61 !:Purpose: Given a filename, return the full path by either adding the
62 ! current working directory or the ram disk directory. By default,
63 ! will copy the file to the ram disk directory, if it exists.
64 !
65 implicit none
66
67 ! Arguments:
68 logical, optional, intent(in) :: noAbort_opt
69 logical, optional, intent(in) :: copyToRamDisk_opt
70 character(len=*) , intent(in) :: fileName
71 ! Result:
72 character(len=512) :: fullWorkingPath
73
74 ! Locals:
75 logical :: fileExists, noAbort, copyToRamDisk
76 character(len=256) :: fileName2, subDirectory
77 integer :: status
78
79 if ( .not. initialized ) then
80 call ram_setup()
81 end if
82
83 if ( present(noAbort_opt) ) then
84 noAbort = noAbort_opt
85 else
86 noAbort = .false.
87 end if
88
89 if ( present(copyToRamDisk_opt) ) then
90 copyToRamDisk = copyToRamDisk_opt
91 else
92 copyToRamDisk = .true.
93 end if
94
95 ! this should make it safe for calls where input and output are the same variable
96 fileName2 = trim(fileName)
97
98 ! first look for file in the ram disk directory
99 if ( ram_disk_dir_exists ) then
100 fullWorkingPath = trim(ram_disk_dir) // '/' // trim(fileName2)
101 else
102 fullWorkingPath = trim(fileName2)
103 end if
104 inquire(file=trim(fullWorkingPath),exist=fileExists)
105
106 ! treat case when no ramdisk exists
107 if ( .not. ram_disk_dir_exists ) then
108 if ( fileExists ) then
109 return
110 else
111 if ( noAbort ) then
112 fullWorkingPath = ' '
113 return
114 else
115 write(*,*) 'ram_fullWorkingPath: file name = ', trim(fileName2)
116 call utl_abort('ram_fullWorkingPath: this file cannot be found on disk.')
117 end if
118 end if
119 end if
120
121 ! treat the case when ramdisk DOES exists
122 if ( fileExists ) then
123 write(*,*) 'ram_fullWorkingPath: this file found on ram disk: ', trim(fileName2)
124 else
125 ! not found on ram disk, so now look in working directory
126 inquire(file='./' // trim(fileName2),exist=fileExists)
127
128 if ( .not. fileExists ) then
129 if ( noAbort ) then
130 fullWorkingPath = ' '
131 else
132 write(*,*) 'ram_fullWorkingPath: file name = ', trim(fileName2)
133 write(*,*) 'ram_fullWorkingPath: ram disk directory = ', trim(ram_disk_dir)
134 call utl_abort('ram_fullWorkingPath: this file cannot be found.')
135 end if
136 else
137
138 if ( copyToRamDisk ) then
139 ! copy the file from disk to the ramdisk
140 if ( index(trim(filename2),'/') /= 0 ) then
141 status = clib_dirname(trim(filename2),subDirectory)
142 status = clib_mkdir_r(trim(ram_disk_dir) // '/' // trim(subDirectory))
143 if ( status /= clib_ok ) then
144 call utl_abort('ram_fullWorkingPath: problem with mkdir')
145 end if
146 status = clib_isdir(trim(ram_disk_dir) // '/' // trim(subDirectory))
147 if ( status /= clib_ok ) then
148 call utl_abort('ram_fullWorkingPath: problem with checking existence of directory')
149 end if
150 end if
151
152 ! copy the file from disk to the ramdisk
153 status = utl_copyFile(trim(fileName2), trim(ram_disk_dir) // '/' // trim(fileName2))
154
155 fullWorkingPath = trim(ram_disk_dir) // '/' // trim(fileName2)
156 write(*,*) 'ram_fullWorkingPath: file copied to ramdisk: ', trim(fullWorkingPath)
157 else
158 fullWorkingPath = trim(fileName2)
159 write(*,*) 'ram_fullWorkingPath: file left on disk, as requested: ', trim(fullWorkingPath)
160 end if
161
162 end if
163
164 end if
165
166 end function ram_fullWorkingPath
167
168 !--------------------------------------------------------------------------
169 ! ram_remove
170 !--------------------------------------------------------------------------
171 function ram_remove(fullWorkingPath) result(returnCode)
172 !
173 !:Purpose: Given the full path+filename, remove the file only if
174 ! it is located on the ram disk (to free up memory)
175 !
176 implicit none
177
178 ! Arguments:
179 character(len=*), intent(in) :: fullWorkingPath
180 ! Result:
181 integer :: returnCode
182
183 ! Locals:
184 logical :: fileExists
185
186 if ( .not. initialized ) then
187 call ram_setup()
188 end if
189
190 inquire(file=trim(fullWorkingPath),exist=fileExists)
191 if ( .not. fileExists) then
192 write(*,*) 'ram_Remove: file does not exist: ',trim(fullWorkingPath)
193 returnCode = 0
194 return
195 end if
196
197 if ( .not. ram_disk_dir_exists ) then
198 write(*,*) 'ram_remove: no ram disk in use.'
199 returnCode = 0
200 return
201 end if
202
203 if ( index(trim(fullWorkingPath), trim(ram_disk_dir)) == 1 ) then
204 write(*,*) 'ram_remove: removing file that is on the ram disk: ', trim(fullWorkingPath)
205 returnCode = clib_remove(fullWorkingPath)
206 else
207 write(*,*) 'ram_remove: this file not on ram disk: ', trim(fullWorkingPath)
208 returnCode = 0
209 end if
210
211 end function ram_remove
212
213
214 function ram_getRamDiskDir() result(fullWorkingPath)
215
216 implicit none
217
218 ! Result:
219 character(len=512) :: fullWorkingPath
220
221 if ( ram_disk_dir_exists ) then
222 fullWorkingPath = trim(ram_disk_dir) // '/'
223 else
224 fullWorkingPath = ' '
225 end if
226
227 end function ram_getRamDiskDir
228
229end module ramDisk_mod
