source: XIOS/trunk/src/fortran/iaxis.F90 @ 312

Last change on this file since 312 was 312, checked in by ymipsl, 12 years ago

suppress old fortran interface

YM

File size: 7.8 KB
Line 
1#include "xios_fortran_prefix.hpp"
2
3MODULE IAXIS
4   USE, INTRINSIC :: ISO_C_BINDING
5   USE AXIS_INTERFACE
6   USE AXISGROUP_INTERFACE
7
8   TYPE txios(axis)
9      INTEGER(kind = C_INTPTR_T) :: daddr
10   END TYPE txios(axis)
11   
12   TYPE txios(axisgroup)
13      INTEGER(kind = C_INTPTR_T) :: daddr
14   END TYPE txios(axisgroup)
15   
16
17         
18   CONTAINS ! Fonctions disponibles pour les utilisateurs.
19
20
21
22   SUBROUTINE xios(set_axis_attr)(axis_id, name, standard_name, long_name, unit, size, value)
23      IMPLICIT NONE
24      TYPE(txios(axis))                                     :: axis_hdl
25      CHARACTER(len = *)                        , INTENT(IN) :: axis_id
26      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name
27      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name
28      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name
29      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit
30      INTEGER                         , OPTIONAL, INTENT(IN) :: size
31      REAL(kind=8), dimension(*), OPTIONAL, INTENT(IN) :: value(:)
32     
33      CALL xios(get_axis_handle)(axis_id,axis_hdl)
34      CALL xios(set_axis_attr_hdl_)(axis_hdl, name, standard_name, long_name, unit, size, value)
35
36   END SUBROUTINE xios(set_axis_attr)
37   
38
39   SUBROUTINE xios(set_axis_attr_hdl)(axis_hdl, name, standard_name, long_name, unit, size, value)
40      IMPLICIT NONE
41      TYPE(txios(axis))                        , INTENT(IN) :: axis_hdl
42      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name
43      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name
44      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name
45      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit
46      INTEGER                         , OPTIONAL, INTENT(IN) :: size
47      REAL(kind=8), dimension(*), OPTIONAL, INTENT(IN) :: value(:)
48
49      CALL xios(set_axis_attr_hdl_)(axis_hdl, name, standard_name, long_name, unit, size, value)
50
51   END SUBROUTINE xios(set_axis_attr_hdl)
52   
53   
54   SUBROUTINE xios(set_axis_attr_hdl_)(axis_hdl, name_, standard_name_, long_name_, unit_, size_, value_)
55      IMPLICIT NONE
56      TYPE(txios(axis))                        , INTENT(IN) :: axis_hdl
57      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name_
58      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name_
59      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name_
60      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit_
61      INTEGER                         , OPTIONAL, INTENT(IN) :: size_
62      REAL(kind=8), dimension(*), OPTIONAL, INTENT(IN) :: value_(:)
63     
64      IF (PRESENT(name_))           THEN
65         CALL cxios_set_axis_name(axis_hdl%daddr, name_, len(name_))
66      END IF
67      IF (PRESENT(standard_name_))  THEN
68         CALL cxios_set_axis_standard_name(axis_hdl%daddr, standard_name_, len(standard_name_))
69      END IF
70      IF (PRESENT(long_name_))      THEN
71         CALL cxios_set_axis_long_name(axis_hdl%daddr, long_name_, len(long_name_))
72      END IF
73      IF (PRESENT(unit_))           THEN
74         CALL cxios_set_axis_unit(axis_hdl%daddr, unit_, len(unit_))
75      END IF
76      IF (PRESENT(size_))           THEN
77         CALL cxios_set_axis_size(axis_hdl%daddr, size_)
78      END IF
79      IF (PRESENT(value_))         THEN
80         CALL cxios_set_axis_zvalue(axis_hdl%daddr, value_, size(value_, 1))
81      END IF
82     
83   END SUBROUTINE xios(set_axis_attr_hdl_)
84
85   
86   SUBROUTINE xios(set_axisgroup_attr)(axisgroup_id, name, standard_name, long_name, unit, size, value)
87      IMPLICIT NONE
88      TYPE(txios(axisgroup))                                :: axisgroup_hdl
89      CHARACTER(len = *)                        , INTENT(IN) :: axisgroup_id
90      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name
91      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name
92      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name
93      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit
94      INTEGER                         , OPTIONAL, INTENT(IN) :: size
95      REAL(kind=8), dimension(*), OPTIONAL, INTENT(IN) :: value(:)
96
97      CALL xios(get_axisgroup_handle)(axisgroup_id,axisgroup_hdl)
98      CALL xios(set_axisgroup_attr_hdl_)(axisgroup_hdl, name, standard_name, long_name, unit, size, value)
99
100   END SUBROUTINE xios(set_axisgroup_attr)
101   
102
103   SUBROUTINE xios(set_axisgroup_attr_hdl)(axisgroup_hdl, name, standard_name, long_name, unit, size, value)
104      IMPLICIT NONE
105      TYPE(txios(axisgroup))                   , INTENT(IN) :: axisgroup_hdl
106      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name
107      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name
108      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name
109      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit
110      INTEGER                         , OPTIONAL, INTENT(IN) :: size
111      REAL(kind=8), dimension(*), OPTIONAL, INTENT(IN) :: value(:)
112
113      CALL xios(set_axisgroup_attr_hdl_)(axisgroup_hdl, name, standard_name, long_name, unit, size, value)     
114
115   END SUBROUTINE xios(set_axisgroup_attr_hdl)
116
117     
118   SUBROUTINE xios(set_axisgroup_attr_hdl_)(axisgroup_hdl, name_, standard_name_, long_name_, unit_, size_, value_)
119      IMPLICIT NONE
120      TYPE(txios(axisgroup))                   , INTENT(IN) :: axisgroup_hdl
121      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name_
122      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name_
123      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name_
124      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit_
125      INTEGER                         , OPTIONAL, INTENT(IN) :: size_
126      REAL(kind=8), dimension(*), OPTIONAL, INTENT(IN) :: value_(:)
127     
128      IF (PRESENT(name_))           THEN
129         CALL cxios_set_axisgroup_name(axisgroup_hdl%daddr, name_, len(name_))
130      END IF
131      IF (PRESENT(standard_name_))  THEN
132         CALL cxios_set_axisgroup_standard_name(axisgroup_hdl%daddr, standard_name_, len(standard_name_))
133      END IF
134      IF (PRESENT(long_name_))      THEN
135         CALL cxios_set_axisgroup_long_name(axisgroup_hdl%daddr, long_name_, len(long_name_))
136      END IF
137      IF (PRESENT(unit_))           THEN
138         CALL cxios_set_axisgroup_unit(axisgroup_hdl%daddr, unit_, len(unit_))
139      END IF
140      IF (PRESENT(size_))           THEN
141         CALL cxios_set_axisgroup_size(axisgroup_hdl%daddr, size_)
142      END IF
143      IF (PRESENT(value_))         THEN
144         CALL cxios_set_axisgroup_zvalue(axisgroup_hdl%daddr, value_, size(value_, 1))
145      END IF
146   END SUBROUTINE xios(set_axisgroup_attr_hdl_)
147   
148
149   SUBROUTINE xios(get_axis_handle)(idt,ret)
150      IMPLICIT NONE
151      CHARACTER(len = *), INTENT(IN) :: idt     
152      TYPE(txios(axis)) , INTENT(OUT):: ret
153      CALL cxios_axis_handle_create(ret%daddr, idt, len(idt))           
154   END SUBROUTINE xios(get_axis_handle)
155   
156   SUBROUTINE xios(get_axisgroup_handle)(idt,ret)
157      IMPLICIT NONE
158      CHARACTER(len = *)    , INTENT(IN) :: idt     
159      TYPE(txios(axisgroup)), INTENT(OUT):: ret
160
161      CALL cxios_axisgroup_handle_create(ret%daddr, idt, len(idt))           
162
163   END SUBROUTINE xios(get_axisgroup_handle)
164
165   LOGICAL FUNCTION xios(is_valid_axis)(idt)
166      IMPLICIT NONE
167      CHARACTER(len  = *)    , INTENT(IN) :: idt
168      LOGICAL  (kind = 1)                 :: val
169     
170      CALL cxios_axis_valid_id(val, idt, len(idt))
171      xios(is_valid_axis) = val
172
173   END FUNCTION  xios(is_valid_axis)
174
175   LOGICAL FUNCTION xios(is_valid_axisgroup)(idt)
176      IMPLICIT NONE
177      CHARACTER(len  = *)    , INTENT(IN) :: idt
178      LOGICAL  (kind = 1)                 :: val
179
180      CALL cxios_axisgroup_valid_id(val, idt, len(idt))
181      xios(is_valid_axisgroup) = val
182
183   END FUNCTION  xios(is_valid_axisgroup)
184
185END MODULE IAXIS
Note: See TracBrowser for help on using the repository browser.