source: XMLIO_V2/dev/dev_rv/src/fortran/macro.inc @ 141

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

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