libsim  Versione 7.2.6
vdf4f.F03
1 ! Copyright (C) 2011 ARPA-SIM <urpsim@smr.arpa.emr.it>
2 ! authors:
3 ! Davide Cesari <dcesari@arpa.emr.it>
4 ! Paolo Patruno <ppatruno@arpa.emr.it>
5 
6 ! This program is free software; you can redistribute it and/or
7 ! modify it under the terms of the GNU General Public License as
8 ! published by the Free Software Foundation; either version 2 of
9 ! the License, or (at your option) any later version.
10 
11 ! This program is distributed in the hope that it will be useful,
12 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ! GNU General Public License for more details.
15 
16 ! You should have received a copy of the GNU General Public License
17 ! along with this program. If not, see <http://www.gnu.org/licenses/>.
18 
19 #include "config.h"
20 
21 module vdf4f
22 
23 
24 USE iso_c_binding, ONLY: c_int, c_float, c_double, c_ptr, c_size_t,c_char
25 
26 implicit none
27 private
28 
29 Interface
30 
31 
32  Integer(C_INT) Function create_metadata_c(xyzdim,vdctype) BIND(C)
33  import
34  Integer(C_SIZE_T), Intent(IN) :: xyzdim(3)
35  Integer(C_INT), Intent(IN), VALUE :: vdctype
36  End Function create_metadata_c
37 
38  Integer(C_INT) Function create_writer_c(filename) BIND(C)
39  import
40  Character(C_CHAR), Intent(IN) :: filename
41  End Function create_writer_c
42 
43  Integer(C_INT) Function create_metadata_from_file_c(filename) BIND(C)
44  import
45  Character(C_CHAR), Intent(IN) :: filename
46  End Function create_metadata_from_file_c
47 
48  Integer(C_INT) Function set_num_timesteps_c(ntime ) BIND(C)
49  import
50  Integer(C_SIZE_T), Intent(IN), VALUE :: ntime
51  end Function set_num_timesteps_c
52 
53 
54  Integer(C_INT) Function set_variables_names_c(nvar, varnames, len ) BIND(C)
55  import
56  Integer(C_SIZE_T), Intent(IN), VALUE :: nvar
57  Character(C_CHAR), Intent(IN) :: varnames(nvar)
58  Integer(C_SIZE_T), Intent(IN), VALUE :: len
59  end Function set_variables_names_c
60 
61  Integer(C_INT) function vdf4f_set_comment_c(comment) BIND(C)
62  import
63  Character(C_CHAR), Intent(IN) :: comment
64  end function vdf4f_set_comment_c
65 
66  Integer(C_INT) function vdf4f_set_ts_comment_c(ts,comment) BIND(C)
67  import
68  Integer(C_SIZE_T), Intent(IN), VALUE :: ts
69  Character(C_CHAR), Intent(IN) :: comment
70  end function vdf4f_set_ts_comment_c
71 
72  Integer(C_INT) function vdf4f_set_v_comment_c(ts,var,comment) BIND(C)
73  import
74  Integer(C_SIZE_T), Intent(IN), VALUE :: ts
75  Character(C_CHAR), Intent(IN) :: var
76  Character(C_CHAR), Intent(IN) :: comment
77  end function vdf4f_set_v_comment_c
78 
79  Integer(C_INT) function vdf4f_set_grid_extents_c(extents) BIND(C)
80  import
81  Real(C_DOUBLE), Intent(IN) :: extents(6)
82  end function vdf4f_set_grid_extents_c
83 
84  Integer(C_INT) function vdf4f_set_coord_system_type_c(coordsystemtype) BIND(C)
85  import
86  Character(C_CHAR), Intent(IN) :: coordsystemtype
87  end function vdf4f_set_coord_system_type_c
88 
89  Integer(C_INT) function vdf4f_set_grid_type_c(gridtype) BIND(C)
90  import
91  Character(C_CHAR), Intent(IN) :: gridtype
92  end function vdf4f_set_grid_type_c
93 
94  Integer(C_INT) function vdf4f_set_map_projection_c(mapprojection) BIND(C)
95  import
96  Character(C_CHAR), Intent(IN) :: mapprojection
97  end function vdf4f_set_map_projection_c
98 
99 ! int set_grid_permutation(long permutation[3], char **errmsg);
100 
101  Integer(C_INT) function write_metadata_c(filename) BIND(C)
102  import
103  Character(C_CHAR), Intent(IN) :: filename
104  end function write_metadata_c
105 
106  Integer(C_INT) Function vdf4f_write_c(volume, xyzdim, ntime,nvar,varnames,len, rzscan) BIND(C)
107  import
108  Integer(C_SIZE_T), Intent(IN) :: xyzdim(3)
109  Integer(C_SIZE_T), Intent(IN), VALUE :: ntime
110  Integer(C_SIZE_T), Intent(IN), VALUE :: nvar
111  Real(C_FLOAT), Intent(IN) :: volume(xyzdim(1),xyzdim(2),xyzdim(3),ntime,nvar)
112  Character(C_CHAR), Intent(IN) :: varnames(nvar)
113  Integer(C_SIZE_T), Intent(IN), VALUE :: len
114  Integer(C_INT), Intent(IN), VALUE :: rzscan
115  End Function vdf4f_write_c
116 
117  Integer(C_INT) function destroy_metadata_c() BIND(C)
118  import
119  end function destroy_metadata_c
120 
121  Integer(C_INT) function destroy_writer_c() BIND(C)
122  import
123  end function destroy_writer_c
124 
125  Integer(C_INT) function get_err_msg_c(errmsg,len) BIND(C)
126  import
127  Character(C_CHAR), Intent(OUT) :: errmsg
128  Integer(C_SIZE_T), Intent(OUT) :: len
129  end function get_err_msg_c
130 
131  Integer(C_INT) function set_missing_value_c(missingv ) BIND(C)
132  import
133  Real(C_DOUBLE), VALUE :: missingv
134  end function set_missing_value_c
135 
136  Integer(C_INT) function get_missing_value_c(missingv ) BIND(C)
137  import
138  Real(C_DOUBLE), Intent(OUT) :: missingv
139  end function get_missing_value_c
140 
141  Integer(C_INT) Function set_variables_2d_xy_c(nvar, varnames, len ) BIND(C)
142  import
143  Integer(C_SIZE_T), Intent(IN), VALUE :: nvar
144  Character(C_CHAR), Intent(IN) :: varnames(nvar)
145  Integer(C_SIZE_T), Intent(IN), VALUE :: len
146  end Function set_variables_2d_xy_c
147 
148 
149  Integer(C_INT) Function vdf4f_write_2d_xy_c(volume, xydim, ntime,nvar,varnames,len) BIND(C)
150  import
151  Integer(C_SIZE_T), Intent(IN) :: xydim(2)
152  Integer(C_SIZE_T), Intent(IN), VALUE :: ntime
153  Integer(C_SIZE_T), Intent(IN), VALUE :: nvar
154  Real(C_FLOAT), Intent(IN) :: volume(xydim(1),xydim(2),ntime,nvar)
155  Character(C_CHAR), Intent(IN) :: varnames(nvar)
156  Integer(C_SIZE_T), Intent(IN), VALUE :: len
157  End Function vdf4f_write_2d_xy_c
158 
159 End Interface
160 
161 public vdf4f_write, vdf4f_create_metadata, vdf4f_create_metadata_from_file, vdf4f_create_writer,&
162  vdf4f_set_num_timesteps, vdf4f_set_variables_names, &
163  vdf4f_set_comment, vdf4f_set_ts_comment, vdf4f_set_v_comment, vdf4f_set_grid_extents, &
164  vdf4f_set_coord_system_type, vdf4f_set_grid_type, &
165  vdf4f_set_map_projection, vdf4f_write_metadata, destroy_metadata_c, destroy_writer_c, vdf4f_get_err_msg, &
166  vdf4f_set_missing_value, vdf4f_get_missing_value, vdf4f_set_variables_2d_xy, vdf4f_write_2d_xy
167 
169 
170 interface vdf4f_write
171 #if SIZEOF_SIZE_T == 8
172  module procedure vdf4f_write_amd64
173 #endif
174  module procedure vdf4f_write_i386
175 end interface
176 
177 
178 interface vdf4f_create_metadata
179 #if SIZEOF_SIZE_T == 8
180  module procedure create_metadata_amd64
181 #endif
182  module procedure create_metadata_i386
183 end interface
184 
185 
186 interface vdf4f_set_num_timesteps
187 #if SIZEOF_SIZE_T == 8
188  module procedure set_num_timesteps_amd64
189 #endif
190  module procedure set_num_timesteps_i386
191 end interface
192 
193 interface vdf4f_set_variables_names
194 #if SIZEOF_SIZE_T == 8
195  module procedure set_variables_names_amd64
196 #endif
197  module procedure set_variables_names_i386
198 end interface
199 
200 interface vdf4f_set_ts_comment
201 #if SIZEOF_SIZE_T == 8
202  module procedure vdf4f_set_ts_comment_amd64
203 #endif
204  module procedure vdf4f_set_ts_comment_i386
205 end interface
206 
207 
208 interface vdf4f_set_v_comment
209 #if SIZEOF_SIZE_T == 8
210  module procedure vdf4f_set_v_comment_amd64
211 #endif
212  module procedure vdf4f_set_v_comment_i386
213 end interface
214 
215 interface vdf4f_set_variables_2d_xy
216 #if SIZEOF_SIZE_T == 8
217  module procedure set_variables_2d_xy_amd64
218 #endif
219  module procedure set_variables_2d_xy_i386
220 end interface
221 
222 
223 interface vdf4f_write_2d_xy
224 #if SIZEOF_SIZE_T == 8
225  module procedure vdf4f_write_2d_xy_amd64
226 #endif
227  module procedure vdf4f_write_2d_xy_i386
228 end interface vdf4f_write_2d_xy
229 
230 
231 contains
232 
233 integer function vdf4f_write_i386(volume, xyzdim, ntime,nvar,varnames, rzscan)
234 
235 Real,intent(in) :: volume(:,:,:,:,:)
236 Integer(C_SIZE_T),intent(in) :: xyzdim(3)
237 integer(C_SIZE_T),intent(in) :: nvar, ntime
238 Character(len=*),intent(in) :: varnames(nvar)
239 Integer, intent(in) :: rzscan
240 
241 
242 !integer(C_SIZE_T) :: nvar_c
243 !integer(C_SIZE_T) :: xyzdim_c(3)
244 !integer(C_SIZE_T) :: ntime_c
245 integer(C_SIZE_T) :: len_c
246 Character(len=LEN(varnames)+1) :: varnames_c(nvar)
247 integer(C_SIZE_T) :: i
248 
249 !nvar_c=nvar
250 !ntime_c=ntime
251 !xyzdim_c=xyzdim
252 
253 len_c=len(varnames)+1
254 do i=1, nvar
255  varnames_c(i)=trim(varnames(i))//char(0) ! future : C_NULL_CHAR
256 end do
257 
258 vdf4f_write_i386 = vdf4f_write_c(volume, xyzdim, ntime, nvar, varnames_c, len_c, rzscan)
259 
260 return
261 
262 end function vdf4f_write_i386
263 
264 
265 integer function vdf4f_write_amd64(volume, xyzdim, ntime,nvar,varnames,rzscan)
266 
267 
268 Real,intent(in) :: volume(:,:,:,:,:)
269 Integer,intent(in) :: xyzdim(3)
270 Integer,intent(in) :: nvar,ntime
271 Character(len=*),intent(in) :: varnames(nvar)
272 integer, intent(in) :: rzscan
273 
274 
275 Integer(C_SIZE_T) :: nvar_c
276 Integer(C_SIZE_T) :: xyzdim_c(3)
277 Integer(C_SIZE_T) :: ntime_c
278 Integer(C_SIZE_T) :: len_c
279 Character(len=LEN(varnames)+1) :: varnames_c(nvar)
280 integer :: i
281 
282 
283 nvar_c=nvar
284 ntime_c=ntime
285 xyzdim_c=xyzdim
286 
287 len_c=len(varnames)+1
288 do i=1, nvar
289  varnames_c(i)=trim(varnames(i))//char(0) ! future : C_NULL_CHAR
290 end do
291 
292 vdf4f_write_amd64 = vdf4f_write_c(volume, xyzdim_c, ntime_c, nvar_c, varnames_c, len_c, rzscan)
293 
294 return
295 
296 end function vdf4f_write_amd64
297 
298 
299 
300 Integer Function create_metadata_i386(xyzdim, vdctype)
301 Integer(C_SIZE_T),intent(in) :: xyzdim(3)
302 Integer(C_INT), Intent(IN), VALUE :: vdctype
303 
304 create_metadata_i386 = create_metadata_c(xyzdim, vdctype)
305 End Function create_metadata_i386
306 
307 Integer Function create_metadata_amd64(xyzdim, vdctype)
308 Integer,intent(in) :: xyzdim(3)
309 Integer(C_INT), Intent(IN), VALUE :: vdctype
310 Integer(C_SIZE_T) :: xyzdim_c(3)
311 xyzdim_c=xyzdim
312 create_metadata_amd64 = create_metadata_c(xyzdim_c,vdctype)
313 End Function create_metadata_amd64
314 
315 Integer function vdf4f_create_metadata_from_file(filename)
316 Character(len=*), Intent(IN) :: filename
317 vdf4f_create_metadata_from_file = create_metadata_from_file_c(trim(filename)//char(0)) ! future : C_NULL_CHAR
318 end function vdf4f_create_metadata_from_file
319 
320 Integer function vdf4f_create_writer(filename)
321 Character(len=*), Intent(IN) :: filename
322 vdf4f_create_writer = create_writer_c(trim(filename)//char(0)) ! future : C_NULL_CHAR
323 end function vdf4f_create_writer
324 
325 Integer Function set_num_timesteps_i386(ntime )
326 Integer(C_SIZE_T), Intent(IN), VALUE :: ntime
327 set_num_timesteps_i386 = set_num_timesteps_c(ntime)
328 end Function set_num_timesteps_i386
329 
330 Integer Function set_num_timesteps_amd64(ntime )
331 Integer, Intent(IN) :: ntime
332 Integer(C_SIZE_T) :: ntime_c
333 ntime_c=ntime
334 set_num_timesteps_amd64 = set_num_timesteps_c(ntime_c)
335 end Function set_num_timesteps_amd64
336 
337 
338 Integer Function set_variables_names_i386(nvar, varnames)
339 Integer(C_SIZE_T), Intent(IN), VALUE :: nvar
340 Character(len=*), Intent(IN) :: varnames(nvar)
341 
342 integer(C_SIZE_T) :: len_c
343 Character(len=LEN(varnames)+1) :: varnames_c(nvar)
344 integer(C_SIZE_T) :: i
345 
346 len_c=len(varnames)+1
347 do i=1, nvar
348  varnames_c(i)=trim(varnames(i))//char(0) ! future : C_NULL_CHAR
349 end do
350 
351 set_variables_names_i386 = set_variables_names_c(nvar, varnames_c, len_c)
352 
353 end Function set_variables_names_i386
354 
355 Integer Function set_variables_names_amd64(nvar, varnames)
356 Integer :: nvar
357 Integer(C_SIZE_T) :: nvar_c
358 Character(len=*), Intent(IN) :: varnames(nvar)
359 
360 integer(C_SIZE_T) :: len_c
361 Character(len=LEN(varnames)+1) :: varnames_c(nvar)
362 integer :: i
363 
364 len_c=len(varnames)+1
365 do i=1, nvar
366  varnames_c(i)=trim(varnames(i))//char(0) ! future : C_NULL_CHAR
367 end do
368 
369 nvar_c=nvar
370 
371 set_variables_names_amd64 = set_variables_names_c(nvar_c, varnames_c, len_c)
372 
373 end Function set_variables_names_amd64
374 
375 
376 Integer function vdf4f_set_comment(comment)
377 Character(len=*),intent(in) :: comment
378 vdf4f_set_comment = vdf4f_set_comment_c(trim(comment)//char(0)) ! future : C_NULL_CHAR
379 end function vdf4f_set_comment
380 
381 Integer function vdf4f_set_ts_comment_i386(ts,comment)
382 Integer(C_SIZE_T), Intent(IN), VALUE :: ts
383 Character(len=*),intent(in) :: comment
384 vdf4f_set_ts_comment_i386 = vdf4f_set_ts_comment_c(ts,trim(comment)//char(0)) ! future : C_NULL_CHAR
385 end function vdf4f_set_ts_comment_i386
386 
387 
388 Integer function vdf4f_set_ts_comment_amd64(ts,comment)
389 Integer :: ts
390 Integer(C_SIZE_T) :: ts_c
391 Character(len=*),intent(in) :: comment
392 ts_c=ts
393 vdf4f_set_ts_comment_amd64 = vdf4f_set_ts_comment_c(ts_c,trim(comment)//char(0)) ! future : C_NULL_CHAR
394 end function vdf4f_set_ts_comment_amd64
395 
396 
397 Integer function vdf4f_set_v_comment_i386(ts,var,comment)
398 Integer(C_SIZE_T), Intent(IN), VALUE :: ts
399 Character(len=*),intent(in) :: var
400 Character(len=*),intent(in) :: comment
401 vdf4f_set_v_comment_i386 = vdf4f_set_v_comment_c(ts, trim(var)//char(0), trim(comment)//char(0)) ! future : C_NULL_CHAR
402 end function vdf4f_set_v_comment_i386
403 
404 Integer function vdf4f_set_v_comment_amd64(ts,var,comment)
405 Integer :: ts
406 Integer(C_SIZE_T) :: ts_c
407 Character(len=*),intent(in) :: var
408 Character(len=*),intent(in) :: comment
409 
410 ts_c=ts
411 
412 vdf4f_set_v_comment_amd64 = vdf4f_set_v_comment_c(ts_c, trim(var)//char(0), trim(comment)//char(0)) ! future : C_NULL_CHAR
413 end function vdf4f_set_v_comment_amd64
414 
415 Integer function vdf4f_set_grid_extents(extents)
416 Doubleprecision, Intent(IN) :: extents(6)
417 vdf4f_set_grid_extents = vdf4f_set_grid_extents_c(extents)
418 end function vdf4f_set_grid_extents
419 
420 Integer function vdf4f_set_coord_system_type(coordsystemtype)
421 Character(len=*), Intent(IN) :: coordsystemtype
422 vdf4f_set_coord_system_type = vdf4f_set_coord_system_type_c(trim(coordsystemtype)//char(0)) ! future : C_NULL_CHAR
423 end function vdf4f_set_coord_system_type
424 
425 Integer function vdf4f_set_grid_type(gridtype)
426 Character(len=*), Intent(IN) :: gridtype
427 vdf4f_set_grid_type = vdf4f_set_grid_type_c(trim(gridtype)//char(0)) ! future : C_NULL_CHAR
428 end function vdf4f_set_grid_type
429 
430 Integer function vdf4f_set_map_projection(mapprojection)
431 Character(len=*), Intent(IN) :: mapprojection
432 vdf4f_set_map_projection = vdf4f_set_map_projection_c(trim(mapprojection)//char(0)) ! future : C_NULL_CHAR
433 end function vdf4f_set_map_projection
434 
435 
436 function vdf4f_get_err_msg()
437 
438 integer, parameter :: lenfun=255
439 character(len=lenfun) :: vdf4f_get_err_msg
440 Integer(C_SIZE_T) :: len
441 Character(len=lenfun) :: errmsg
442 
443 integer :: ier
444 
445 len = lenfun
446 ier = get_err_msg_c(errmsg,len)
447 vdf4f_get_err_msg=errmsg(:min(len,lenfun))
448 
449 return
450 end function vdf4f_get_err_msg
451 
452 
453 Integer function vdf4f_write_metadata(filename)
454 Character(len=*), Intent(IN) :: filename
455 vdf4f_write_metadata = write_metadata_c(trim(filename)//char(0)) ! future : C_NULL_CHAR
456 end function vdf4f_write_metadata
457 
458 
459 Integer function vdf4f_set_missing_value(missingv)
460 doubleprecision, Intent(IN) :: missingv
461 vdf4f_set_missing_value = set_missing_value_c(missingv)
462 end function vdf4f_set_missing_value
463 
464 Integer function vdf4f_get_missing_value(missingv)
465 doubleprecision, Intent(OUT) :: missingv
466 vdf4f_get_missing_value = get_missing_value_c(missingv)
467 end function vdf4f_get_missing_value
468 
469 
470 Integer Function set_variables_2d_xy_i386(nvar, varnames)
471 Integer(C_SIZE_T), Intent(IN), VALUE :: nvar
472 Character(len=*), Intent(IN) :: varnames(nvar)
473 
474 integer(C_SIZE_T) :: len_c
475 Character(len=LEN(varnames)+1) :: varnames_c(nvar)
476 integer(C_SIZE_T) :: i
477 
478 len_c=len(varnames)+1
479 do i=1, nvar
480  varnames_c(i)=trim(varnames(i))//char(0) ! future : C_NULL_CHAR
481 end do
482 
483 set_variables_2d_xy_i386 = set_variables_2d_xy_c(nvar, varnames_c, len_c)
484 
485 end Function set_variables_2d_xy_i386
486 
487 Integer Function set_variables_2d_xy_amd64(nvar, varnames)
488 Integer :: nvar
489 Integer(C_SIZE_T) :: nvar_c
490 Character(len=*), Intent(IN) :: varnames(nvar)
491 
492 integer(C_SIZE_T) :: len_c
493 Character(len=LEN(varnames)+1) :: varnames_c(nvar)
494 integer :: i
495 
496 len_c=len(varnames)+1
497 do i=1, nvar
498  varnames_c(i)=trim(varnames(i))//char(0) ! future : C_NULL_CHAR
499 end do
500 
501 nvar_c=nvar
502 
503 set_variables_2d_xy_amd64 = set_variables_2d_xy_c(nvar_c, varnames_c, len_c)
504 
505 end Function set_variables_2d_xy_amd64
506 
507 
508 
509 integer function vdf4f_write_2d_xy_i386(volume, xydim, ntime,nvar,varnames)
510 
511 Real,intent(in) :: volume(:,:,:,:)
512 Integer(C_SIZE_T),intent(in) :: xydim(2)
513 integer(C_SIZE_T),intent(in) :: nvar, ntime
514 Character(len=*),intent(in) :: varnames(nvar)
515 
516 !integer(C_SIZE_T) :: nvar_c
517 !integer(C_SIZE_T) :: xydim_c(2)
518 !integer(C_SIZE_T) :: ntime_c
519 integer(C_SIZE_T) :: len_c
520 Character(len=LEN(varnames)+1) :: varnames_c(nvar)
521 integer(C_SIZE_T) :: i
522 
523 !nvar_c=nvar
524 !ntime_c=ntime
525 !xydim_c=xydim
526 
527 len_c=len(varnames)+1
528 do i=1, nvar
529  varnames_c(i)=trim(varnames(i))//char(0) ! future : C_NULL_CHAR
530 end do
531 
532 vdf4f_write_2d_xy_i386 = vdf4f_write_2d_xy_c(volume, xydim, ntime, nvar, varnames_c, len_c)
533 
534 return
535 
536 end function vdf4f_write_2d_xy_i386
537 
538 
539 integer function vdf4f_write_2d_xy_amd64(volume, xydim, ntime,nvar,varnames)
540 
541 Real,intent(in) :: volume(:,:,:,:)
542 Integer,intent(in) :: xydim(2)
543 Integer,intent(in) :: nvar,ntime
544 Character(len=*),intent(in) :: varnames(nvar)
545 
546 Integer(C_SIZE_T) :: nvar_c
547 Integer(C_SIZE_T) :: xydim_c(2)
548 Integer(C_SIZE_T) :: ntime_c
549 Integer(C_SIZE_T) :: len_c
550 Character(len=LEN(varnames)+1) :: varnames_c(nvar)
551 integer :: i
552 
553 nvar_c=nvar
554 ntime_c=ntime
555 xydim_c=xydim
556 
557 len_c=len(varnames)+1
558 do i=1, nvar
559  varnames_c(i)=trim(varnames(i))//char(0) ! future : C_NULL_CHAR
560 end do
561 
562 vdf4f_write_2d_xy_amd64 = vdf4f_write_2d_xy_c(volume, xydim_c, ntime_c, nvar_c, varnames_c, len_c)
563 
564 return
565 
566 end function vdf4f_write_2d_xy_amd64
567 
568 
569 end module vdf4f
interface to different architectures (cast some type)
Definition: vdf4f.F03:368

Generated with Doxygen.