libsim Versione 7.2.4
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
21module vdf4f
22
23
24USE iso_c_binding, ONLY: c_int, c_float, c_double, c_ptr, c_size_t,c_char
25
26implicit none
27private
28
29Interface
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
159End Interface
160
161public 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
170interface vdf4f_write
171#if SIZEOF_SIZE_T == 8
172 module procedure vdf4f_write_amd64
173#endif
174 module procedure vdf4f_write_i386
175end interface
176
177
178interface vdf4f_create_metadata
179#if SIZEOF_SIZE_T == 8
180 module procedure create_metadata_amd64
181#endif
182 module procedure create_metadata_i386
183end interface
184
185
186interface 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
191end interface
192
193interface 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
198end interface
199
200interface 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
205end interface
206
207
208interface 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
213end interface
214
215interface 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
220end interface
221
222
223interface 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
228end interface vdf4f_write_2d_xy
229
230
231contains
232
233integer function vdf4f_write_i386(volume, xyzdim, ntime,nvar,varnames, rzscan)
234
235Real,intent(in) :: volume(:,:,:,:,:)
236Integer(C_SIZE_T),intent(in) :: xyzdim(3)
237integer(C_SIZE_T),intent(in) :: nvar, ntime
238Character(len=*),intent(in) :: varnames(nvar)
239Integer, 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
245integer(C_SIZE_T) :: len_c
246Character(len=LEN(varnames)+1) :: varnames_c(nvar)
247integer(C_SIZE_T) :: i
248
249!nvar_c=nvar
250!ntime_c=ntime
251!xyzdim_c=xyzdim
252
253len_c=len(varnames)+1
254do i=1, nvar
255 varnames_c(i)=trim(varnames(i))//char(0) ! future : C_NULL_CHAR
256end do
257
258vdf4f_write_i386 = vdf4f_write_c(volume, xyzdim, ntime, nvar, varnames_c, len_c, rzscan)
259
260return
261
262end function vdf4f_write_i386
263
264
265integer function vdf4f_write_amd64(volume, xyzdim, ntime,nvar,varnames,rzscan)
266
267
268Real,intent(in) :: volume(:,:,:,:,:)
269Integer,intent(in) :: xyzdim(3)
270Integer,intent(in) :: nvar,ntime
271Character(len=*),intent(in) :: varnames(nvar)
272integer, intent(in) :: rzscan
273
274
275Integer(C_SIZE_T) :: nvar_c
276Integer(C_SIZE_T) :: xyzdim_c(3)
277Integer(C_SIZE_T) :: ntime_c
278Integer(C_SIZE_T) :: len_c
279Character(len=LEN(varnames)+1) :: varnames_c(nvar)
280integer :: i
281
282
283nvar_c=nvar
284ntime_c=ntime
285xyzdim_c=xyzdim
286
287len_c=len(varnames)+1
288do i=1, nvar
289 varnames_c(i)=trim(varnames(i))//char(0) ! future : C_NULL_CHAR
290end do
291
292vdf4f_write_amd64 = vdf4f_write_c(volume, xyzdim_c, ntime_c, nvar_c, varnames_c, len_c, rzscan)
293
294return
295
296end function vdf4f_write_amd64
297
298
299
300Integer Function create_metadata_i386(xyzdim, vdctype)
301Integer(C_SIZE_T),intent(in) :: xyzdim(3)
302Integer(C_INT), Intent(IN), VALUE :: vdctype
303
304create_metadata_i386 = create_metadata_c(xyzdim, vdctype)
305End Function create_metadata_i386
306
307Integer Function create_metadata_amd64(xyzdim, vdctype)
308Integer,intent(in) :: xyzdim(3)
309Integer(C_INT), Intent(IN), VALUE :: vdctype
310Integer(C_SIZE_T) :: xyzdim_c(3)
311xyzdim_c=xyzdim
312create_metadata_amd64 = create_metadata_c(xyzdim_c,vdctype)
313End Function create_metadata_amd64
314
315Integer function vdf4f_create_metadata_from_file(filename)
316Character(len=*), Intent(IN) :: filename
317vdf4f_create_metadata_from_file = create_metadata_from_file_c(trim(filename)//char(0)) ! future : C_NULL_CHAR
318end function vdf4f_create_metadata_from_file
319
320Integer function vdf4f_create_writer(filename)
321Character(len=*), Intent(IN) :: filename
322vdf4f_create_writer = create_writer_c(trim(filename)//char(0)) ! future : C_NULL_CHAR
323end function vdf4f_create_writer
324
325Integer Function set_num_timesteps_i386(ntime )
326Integer(C_SIZE_T), Intent(IN), VALUE :: ntime
327set_num_timesteps_i386 = set_num_timesteps_c(ntime)
328end Function set_num_timesteps_i386
329
330Integer Function set_num_timesteps_amd64(ntime )
331Integer, Intent(IN) :: ntime
332Integer(C_SIZE_T) :: ntime_c
333ntime_c=ntime
334set_num_timesteps_amd64 = set_num_timesteps_c(ntime_c)
335end Function set_num_timesteps_amd64
336
337
338Integer Function set_variables_names_i386(nvar, varnames)
339Integer(C_SIZE_T), Intent(IN), VALUE :: nvar
340Character(len=*), Intent(IN) :: varnames(nvar)
341
342integer(C_SIZE_T) :: len_c
343Character(len=LEN(varnames)+1) :: varnames_c(nvar)
344integer(C_SIZE_T) :: i
345
346len_c=len(varnames)+1
347do i=1, nvar
348 varnames_c(i)=trim(varnames(i))//char(0) ! future : C_NULL_CHAR
349end do
350
351set_variables_names_i386 = set_variables_names_c(nvar, varnames_c, len_c)
352
353end Function set_variables_names_i386
354
355Integer Function set_variables_names_amd64(nvar, varnames)
356Integer :: nvar
357Integer(C_SIZE_T) :: nvar_c
358Character(len=*), Intent(IN) :: varnames(nvar)
359
360integer(C_SIZE_T) :: len_c
361Character(len=LEN(varnames)+1) :: varnames_c(nvar)
362integer :: i
363
364len_c=len(varnames)+1
365do i=1, nvar
366 varnames_c(i)=trim(varnames(i))//char(0) ! future : C_NULL_CHAR
367end do
368
369nvar_c=nvar
370
371set_variables_names_amd64 = set_variables_names_c(nvar_c, varnames_c, len_c)
372
373end Function set_variables_names_amd64
374
375
376Integer function vdf4f_set_comment(comment)
377Character(len=*),intent(in) :: comment
378vdf4f_set_comment = vdf4f_set_comment_c(trim(comment)//char(0)) ! future : C_NULL_CHAR
379end function vdf4f_set_comment
380
381Integer function vdf4f_set_ts_comment_i386(ts,comment)
382Integer(C_SIZE_T), Intent(IN), VALUE :: ts
383Character(len=*),intent(in) :: comment
384vdf4f_set_ts_comment_i386 = vdf4f_set_ts_comment_c(ts,trim(comment)//char(0)) ! future : C_NULL_CHAR
385end function vdf4f_set_ts_comment_i386
386
387
388Integer function vdf4f_set_ts_comment_amd64(ts,comment)
389Integer :: ts
390Integer(C_SIZE_T) :: ts_c
391Character(len=*),intent(in) :: comment
392ts_c=ts
393vdf4f_set_ts_comment_amd64 = vdf4f_set_ts_comment_c(ts_c,trim(comment)//char(0)) ! future : C_NULL_CHAR
394end function vdf4f_set_ts_comment_amd64
395
396
397Integer function vdf4f_set_v_comment_i386(ts,var,comment)
398Integer(C_SIZE_T), Intent(IN), VALUE :: ts
399Character(len=*),intent(in) :: var
400Character(len=*),intent(in) :: comment
401vdf4f_set_v_comment_i386 = vdf4f_set_v_comment_c(ts, trim(var)//char(0), trim(comment)//char(0)) ! future : C_NULL_CHAR
402end function vdf4f_set_v_comment_i386
403
404Integer function vdf4f_set_v_comment_amd64(ts,var,comment)
405Integer :: ts
406Integer(C_SIZE_T) :: ts_c
407Character(len=*),intent(in) :: var
408Character(len=*),intent(in) :: comment
409
410ts_c=ts
411
412vdf4f_set_v_comment_amd64 = vdf4f_set_v_comment_c(ts_c, trim(var)//char(0), trim(comment)//char(0)) ! future : C_NULL_CHAR
413end function vdf4f_set_v_comment_amd64
414
415Integer function vdf4f_set_grid_extents(extents)
416Doubleprecision, Intent(IN) :: extents(6)
417vdf4f_set_grid_extents = vdf4f_set_grid_extents_c(extents)
418end function vdf4f_set_grid_extents
419
420Integer function vdf4f_set_coord_system_type(coordsystemtype)
421Character(len=*), Intent(IN) :: coordsystemtype
422vdf4f_set_coord_system_type = vdf4f_set_coord_system_type_c(trim(coordsystemtype)//char(0)) ! future : C_NULL_CHAR
423end function vdf4f_set_coord_system_type
424
425Integer function vdf4f_set_grid_type(gridtype)
426Character(len=*), Intent(IN) :: gridtype
427vdf4f_set_grid_type = vdf4f_set_grid_type_c(trim(gridtype)//char(0)) ! future : C_NULL_CHAR
428end function vdf4f_set_grid_type
429
430Integer function vdf4f_set_map_projection(mapprojection)
431Character(len=*), Intent(IN) :: mapprojection
432vdf4f_set_map_projection = vdf4f_set_map_projection_c(trim(mapprojection)//char(0)) ! future : C_NULL_CHAR
433end function vdf4f_set_map_projection
434
435
436function vdf4f_get_err_msg()
437
438integer, parameter :: lenfun=255
439character(len=lenfun) :: vdf4f_get_err_msg
440Integer(C_SIZE_T) :: len
441Character(len=lenfun) :: errmsg
442
443integer :: ier
444
445len = lenfun
446ier = get_err_msg_c(errmsg,len)
447vdf4f_get_err_msg=errmsg(:min(len,lenfun))
448
449return
450end function vdf4f_get_err_msg
451
452
453Integer function vdf4f_write_metadata(filename)
454Character(len=*), Intent(IN) :: filename
455vdf4f_write_metadata = write_metadata_c(trim(filename)//char(0)) ! future : C_NULL_CHAR
456end function vdf4f_write_metadata
457
458
459Integer function vdf4f_set_missing_value(missingv)
460doubleprecision, Intent(IN) :: missingv
461vdf4f_set_missing_value = set_missing_value_c(missingv)
462end function vdf4f_set_missing_value
463
464Integer function vdf4f_get_missing_value(missingv)
465doubleprecision, Intent(OUT) :: missingv
466vdf4f_get_missing_value = get_missing_value_c(missingv)
467end function vdf4f_get_missing_value
468
469
470Integer Function set_variables_2d_xy_i386(nvar, varnames)
471Integer(C_SIZE_T), Intent(IN), VALUE :: nvar
472Character(len=*), Intent(IN) :: varnames(nvar)
473
474integer(C_SIZE_T) :: len_c
475Character(len=LEN(varnames)+1) :: varnames_c(nvar)
476integer(C_SIZE_T) :: i
477
478len_c=len(varnames)+1
479do i=1, nvar
480 varnames_c(i)=trim(varnames(i))//char(0) ! future : C_NULL_CHAR
481end do
482
483set_variables_2d_xy_i386 = set_variables_2d_xy_c(nvar, varnames_c, len_c)
484
485end Function set_variables_2d_xy_i386
486
487Integer Function set_variables_2d_xy_amd64(nvar, varnames)
488Integer :: nvar
489Integer(C_SIZE_T) :: nvar_c
490Character(len=*), Intent(IN) :: varnames(nvar)
491
492integer(C_SIZE_T) :: len_c
493Character(len=LEN(varnames)+1) :: varnames_c(nvar)
494integer :: i
495
496len_c=len(varnames)+1
497do i=1, nvar
498 varnames_c(i)=trim(varnames(i))//char(0) ! future : C_NULL_CHAR
499end do
500
501nvar_c=nvar
502
503set_variables_2d_xy_amd64 = set_variables_2d_xy_c(nvar_c, varnames_c, len_c)
504
505end Function set_variables_2d_xy_amd64
506
507
508
509integer function vdf4f_write_2d_xy_i386(volume, xydim, ntime,nvar,varnames)
510
511Real,intent(in) :: volume(:,:,:,:)
512Integer(C_SIZE_T),intent(in) :: xydim(2)
513integer(C_SIZE_T),intent(in) :: nvar, ntime
514Character(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
519integer(C_SIZE_T) :: len_c
520Character(len=LEN(varnames)+1) :: varnames_c(nvar)
521integer(C_SIZE_T) :: i
522
523!nvar_c=nvar
524!ntime_c=ntime
525!xydim_c=xydim
526
527len_c=len(varnames)+1
528do i=1, nvar
529 varnames_c(i)=trim(varnames(i))//char(0) ! future : C_NULL_CHAR
530end do
531
532vdf4f_write_2d_xy_i386 = vdf4f_write_2d_xy_c(volume, xydim, ntime, nvar, varnames_c, len_c)
533
534return
535
536end function vdf4f_write_2d_xy_i386
537
538
539integer function vdf4f_write_2d_xy_amd64(volume, xydim, ntime,nvar,varnames)
540
541Real,intent(in) :: volume(:,:,:,:)
542Integer,intent(in) :: xydim(2)
543Integer,intent(in) :: nvar,ntime
544Character(len=*),intent(in) :: varnames(nvar)
545
546Integer(C_SIZE_T) :: nvar_c
547Integer(C_SIZE_T) :: xydim_c(2)
548Integer(C_SIZE_T) :: ntime_c
549Integer(C_SIZE_T) :: len_c
550Character(len=LEN(varnames)+1) :: varnames_c(nvar)
551integer :: i
552
553nvar_c=nvar
554ntime_c=ntime
555xydim_c=xydim
556
557len_c=len(varnames)+1
558do i=1, nvar
559 varnames_c(i)=trim(varnames(i))//char(0) ! future : C_NULL_CHAR
560end do
561
562vdf4f_write_2d_xy_amd64 = vdf4f_write_2d_xy_c(volume, xydim_c, ntime_c, nvar_c, varnames_c, len_c)
563
564return
565
566end function vdf4f_write_2d_xy_amd64
567
568
569end module vdf4f
interface to different architectures (cast some type)
Definition vdf4f.F03:358

Generated with Doxygen.