source: XMLIO_V2/dev/dev_rv/src4/xmlio/fortran/axis.f90 @ 242

Last change on this file since 242 was 242, checked in by hozdoba, 10 years ago

Ajout d'une partie d'Interface fortran pour la version 4

File size: 6.1 KB
Line 
1MODULE AXIS
2   USE, INTRINSIC :: ISO_C_BINDING
3   USE AXIS_INTERFACE
4   USE AXISGROUP_INTERFACE
5   
6   TYPE XAxisHandle
7      INTEGER(kind = C_INTPTR_T) :: daddr
8   END TYPE XAxisHandle
9   
10   TYPE XAxisGroupHandle
11      INTEGER(kind = C_INTPTR_T) :: daddr
12   END TYPE XAxisGroupHandle
13   
14   !----------------------------------------------------------------------------
15   INTERFACE set_axis_attributes
16      MODULE PROCEDURE set_axis_attributes_id,set_axis_attributes_hdl
17   END INTERFACE 
18   
19   INTERFACE set_axis_group_attributes
20      MODULE PROCEDURE set_axisgroup_attributes_id,set_axisgroup_attributes_hdl
21   END INTERFACE 
22   !----------------------------------------------------------------------------
23     
24   CONTAINS ! Fonctions disponibles pour les utilisateurs.
25
26   SUBROUTINE set_axis_attributes_id(axis_id, name_, standard_name_, long_name_, unit_, size_, zvalue_)
27      IMPLICIT NONE
28      TYPE(XAxisHandle)                                      :: axis_hdl
29      CHARACTER(len = *)                        , INTENT(IN) :: axis_id
30      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name_
31      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name_
32      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name_
33      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit_
34      INTEGER                         , OPTIONAL, INTENT(IN) :: size_
35      REAL    (kind = 8), dimension(*), OPTIONAL, INTENT(IN) :: zvalue_(:)
36     
37      CALL axis_handle_create(axis_hdl, axis_id)
38      CALL set_axis_attributes_hdl(axis_hdl, name_, standard_name_, long_name_, unit_, size_, zvalue_)
39
40   END SUBROUTINE set_axis_attributes_id
41
42   SUBROUTINE set_axis_attributes_hdl(axis_hdl, name_, standard_name_, long_name_, unit_, size_, zvalue_)
43      IMPLICIT NONE
44      TYPE(XAxisHandle)                         , INTENT(IN) :: axis_hdl
45      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name_
46      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name_
47      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name_
48      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit_
49      INTEGER                         , OPTIONAL, INTENT(IN) :: size_
50      REAL    (kind = 8), dimension(*), OPTIONAL, INTENT(IN) :: zvalue_(:)
51     
52      IF (PRESENT(name_))           THEN
53         CALL xios_set_axis_name(axis_hdl%daddr, name_, len(name_))
54      END IF
55      IF (PRESENT(standard_name_))  THEN
56         CALL xios_set_axis_standard_name(axis_hdl%daddr, standard_name_, len(standard_name_))
57      END IF
58      IF (PRESENT(long_name_))      THEN
59         CALL xios_set_axis_long_name(axis_hdl%daddr, long_name_, len(long_name_))
60      END IF
61      IF (PRESENT(unit_))           THEN
62         CALL xios_set_axis_unit(axis_hdl%daddr, unit_, len(unit_))
63      END IF
64      IF (PRESENT(size_))           THEN
65         CALL xios_set_axis_size(axis_hdl%daddr, size_)
66      END IF
67      IF (PRESENT(zvalue_))         THEN
68         CALL xios_set_axis_zvalue(axis_hdl%daddr, zvalue_, size(zvalue_, 1))
69      END IF
70   END SUBROUTINE set_axis_attributes_hdl
71   
72   SUBROUTINE set_axisgroup_attributes_id(axisgroup_id, name_, standard_name_, long_name_, unit_, size_, zvalue_)
73      IMPLICIT NONE
74      TYPE(XAxisGroupHandle)                                 :: axisgroup_hdl
75      CHARACTER(len = *)                        , INTENT(IN) :: axisgroup_id
76      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name_
77      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name_
78      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name_
79      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit_
80      INTEGER                         , OPTIONAL, INTENT(IN) :: size_
81      REAL    (kind = 8), dimension(*), OPTIONAL, INTENT(IN) :: zvalue_(:)
82     
83      CALL axisgroup_handle_create(axisgroup_hdl, axisgroup_id)
84      CALL set_axisgroup_attributes_hdl(axisgroup_hdl, name_, standard_name_, long_name_, unit_, size_, zvalue_)
85
86   END SUBROUTINE set_axisgroup_attributes_id
87   
88   SUBROUTINE set_axisgroup_attributes_hdl(axisgroup_hdl, name_, standard_name_, long_name_, unit_, size_, zvalue_)
89      IMPLICIT NONE
90      TYPE(XAxisGroupHandle)                    , INTENT(IN) :: axisgroup_hdl
91      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name_
92      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name_
93      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name_
94      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit_
95      INTEGER                         , OPTIONAL, INTENT(IN) :: size_
96      REAL    (kind = 8), dimension(*), OPTIONAL, INTENT(IN) :: zvalue_(:)
97     
98      IF (PRESENT(name_))           THEN
99         CALL xios_set_axisgroup_name(axisgroup_hdl%daddr, name_, len(name_))
100      END IF
101      IF (PRESENT(standard_name_))  THEN
102         CALL xios_set_axisgroup_standard_name(axisgroup_hdl%daddr, standard_name_, len(standard_name_))
103      END IF
104      IF (PRESENT(long_name_))      THEN
105         CALL xios_set_axisgroup_long_name(axisgroup_hdl%daddr, long_name_, len(long_name_))
106      END IF
107      IF (PRESENT(unit_))           THEN
108         CALL xios_set_axisgroup_unit(axisgroup_hdl%daddr, unit_, len(unit_))
109      END IF
110      IF (PRESENT(size_))           THEN
111         CALL xios_set_axisgroup_size(axisgroup_hdl%daddr, size_)
112      END IF
113      IF (PRESENT(zvalue_))         THEN
114         CALL xios_set_axisgroup_zvalue(axisgroup_hdl%daddr, zvalue_, size(zvalue_, 1))
115      END IF
116   END SUBROUTINE set_axisgroup_attributes_hdl
117
118   SUBROUTINE axis_handle_create(ret, idt)
119      IMPLICIT NONE
120      TYPE(XAxisHandle) , INTENT(OUT):: ret
121      CHARACTER(len = *), INTENT(IN) :: idt     
122      CALL xios_axis_handle_create(ret%daddr, idt, len(idt))           
123   END SUBROUTINE axis_handle_create
124   
125   SUBROUTINE axisgroup_handle_create(ret, idt)
126      IMPLICIT NONE
127      TYPE(XAxisGroupHandle), INTENT(OUT):: ret
128      CHARACTER(len = *)    , INTENT(IN) :: idt     
129      CALL xios_axis_handle_create(ret%daddr, idt, len(idt))           
130   END SUBROUTINE axisgroup_handle_create
131
132END MODULE AXIS
Note: See TracBrowser for help on using the repository browser.