source: XMLIO_V2/dev/common/src/xmlio/fortran/macro.inc @ 219

Last change on this file since 219 was 219, checked in by hozdoba, 13 years ago

Préparation nouvelle arborescence
File size: 5.1 KB
Line 
1#define iarg_bool(name) ,name
2#define iarg_double(name) ,name
3#define iarg_int(name) ,name
4#define iarg_StdString(name) ,name iarg_int(name##_size)
5
6#define iarg_ARRAY1(name) ,name iarg_int(name##_extent1)
7#define iarg_ARRAY2(name) iarg_ARRAY1(name) iarg_int(name##_extent2)
8#define iarg_ARRAY3(name) iarg_ARRAY2(name) iarg_int(name##_extent3)
9#define iarg_ARRAY(type, numdim) iarg_ARRAY##numdim
10
11//--------------------------------
12
13#define arg_bool(name) ,name##_
14#define arg_double(name) ,name##_
15#define arg_int(name) ,name##_
16#define arg_StdString(name) ,name##_
17#define arg_ARRAY_(name) ,name##_
18#define arg_ARRAY(type, numdim) arg##_ARRAY_
19
20//---------------------------------
21
22#define dec_bool(name) \
23   LOGICAL (kind = C_BOOL) :: name;
24
25#define dec_int(name) \
26   INTEGER (kind = C_INT) :: name;
27   
28#define dec_double(name) \
29   REAL (kind = C_DOUBLE) :: name;
30
31#define dec_StdString(name) \
32   CHARACTER(kind = C_CHAR), DIMENSION(*) :: name; \
33   dec_int(name##_size)
34
35#define dec_double1(name) \
36   REAL(kind = C_DOUBLE), DIMENSION(*) :: name; \
37   dec_int(name##_extent1)
38#define dec_double2(name) dec_double1(name) dec_int(name##_extent2)
39#define dec_double3(name) dec_double2(name) dec_int(name##_extent3)
40
41#define dec_bool1(name) \
42   LOGICAL(kind = C_BOOL), DIMENSION(*) :: name; \
43   dec_int(name##_extent1)
44#define dec_bool2(name) dec_bool1(name) dec_int(name##_extent2)
45#define dec_bool3(name) dec_bool2(name) dec_int(name##_extent3)
46
47#define dec_int1(name) \
48   INTEGER(kind = C_INT), DIMENSION(*) :: name; \
49   dec_int(name##_extent1)
50#define dec_int2(name) dec_int1(name) dec_int(name##_extent2)
51#define dec_int3(name) dec_int2(name) dec_int(name##_extent3)
52
53#define dec_ARRAY(type, numdim) dec_##type##numdim
54
55//---------------------------------
56
57
58#define def_bool(name) \
59   LOGICAL(kind = 1),  OPTIONAL, INTENT(IN) :: name##_
60
61#define def_int(name) \
62   INTEGER,  OPTIONAL, INTENT(IN) :: name##_
63   
64#define def_double(name) \
65   REAL(kind=8),  OPTIONAL, INTENT(IN) :: name##_
66
67#define def_StdString(name) \
68   CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name##_
69
70
71#define def_double1(name) \
72   REAL(kind = 8), dimension(*), OPTIONAL, INTENT(IN) :: name##_(:)
73#define def_double2(name) \
74   REAL(kind = 8), dimension(*), OPTIONAL, INTENT(IN) :: name##_(:,:)
75#define def_double3(name) \
76   REAL(kind = 8), dimension(*), OPTIONAL, INTENT(IN) :: name##_(:,:,:)
77
78//-
79
80#define def_bool1(name) \
81   LOGICAL(kind = 1), dimension(*), OPTIONAL, INTENT(IN) :: name##_(:)
82#define def_bool2(name) \
83   LOGICAL(kind = 1), dimension(*), OPTIONAL, INTENT(IN) :: name##_(:,:)
84#define def_bool3(name) \
85   LOGICAL(kind = 1), dimension(*), OPTIONAL, INTENT(IN) :: name##_(:,:,:)
86
87//-
88
89#define def_int1(name) \
90   INTEGER, dimension(*), OPTIONAL, INTENT(IN) :: name##_(:)
91#define def_int2(name) \
92   INTEGER, dimension(*), OPTIONAL, INTENT(IN) :: name##_(:,:)
93#define def_int3(name) \
94   INTEGER, dimension(*), OPTIONAL, INTENT(IN) :: name##_(:,:,:)
95
96#define def_ARRAY(type, numdim) def_##type##numdim
97
98//---------------------------------
99
100#define ip_simple(class, name) \
101   IF (PRESENT(name##_)) THEN; \
102      CALL xios_set_##class##_##name(class##_hdl%daddr, ftype, name##_); \
103   END IF;
104
105#define ip_bool(class, name) ip_simple(class, name)
106#define ip_int(class, name) ip_simple(class, name)
107#define ip_double(class, name) ip_simple(class, name)
108
109#define ip_StdString(class, name) \
110   IF (PRESENT(name##_)) THEN; \
111      CALL xios_set_##class##_##name(class##_hdl%daddr, ftype, name##_, len(name##_)); \
112   END IF;
113
114#define ip_ARRAY1(class, name) \
115   IF (PRESENT(name##_)) THEN; \
116      CALL xios_set_##class##_##name(class##_hdl%daddr, ftype, name##_, size(name##_, 1)); \
117   END IF;
118
119#define ip_ARRAY2(class, name) \
120   IF (PRESENT(name##_)) THEN; \
121      CALL xios_set_##class##_##name(class##_hdl%daddr, ftype, name##_, size(name##_, 1), size(name##_, 2)); \
122   END IF;
123
124#define ip_ARRAY3(class, name) \
125    IF (PRESENT(name##_)) THEN; \
126      CALL xios_set_##class##_##name(class##_hdl%daddr, ftype, name##_, size(name##_, 1), size(name##_, 3), size(name##_, 3)); \
127   END IF;
128
129#define ip_ARRAY(type, numdim) ip_ARRAY##numdim
130
131//---------------------------------
132
133#define  DECLARE_INTERFACE(class, type, name)                                           \
134   SUBROUTINE xios_set_##class##_##name(class##_hdl, ftype iarg_##type(name)) BIND(C);  \
135   USE ISO_C_BINDING;                                                                   \
136   INTEGER  (kind = C_INTPTR_T), VALUE :: class##_hdl;                                  \
137   INTEGER  (kind = C_INT), VALUE      :: ftype;                                        \
138   dec_##type(name)                                                                     \
139   END SUBROUTINE xios_set_##class##_##name;                                            \
140//   SUBROUTINE xios_get_##class##_##name(class##_hdl iarg_##type(name)) BIND(C); \
141//   USE ISO_C_BINDING;                                                           \
142//   INTEGER  (kind = C_INTPTR_T), VALUE :: class##_hdl;                          \
143//   dec_##type(name)                                                             \
144//   END SUBROUTINE xios_get_##class##_##name
145
Note: See TracBrowser for help on using the repository browser.