Yet Another eXchange Tool  0.9.0
xt_config_f.f90
Go to the documentation of this file.
1 
13 
14 !
15 ! Keywords:
16 ! Maintainer: Jörg Behrens <behrens@dkrz.de>
17 ! Moritz Hanke <hanke@dkrz.de>
18 ! Thomas Jahns <jahns@dkrz.de>
19 ! URL: https://doc.redmine.dkrz.de/yaxt/html/
20 !
21 ! Redistribution and use in source and binary forms, with or without
22 ! modification, are permitted provided that the following conditions are
23 ! met:
24 !
25 ! Redistributions of source code must retain the above copyright notice,
26 ! this list of conditions and the following disclaimer.
27 !
28 ! Redistributions in binary form must reproduce the above copyright
29 ! notice, this list of conditions and the following disclaimer in the
30 ! documentation and/or other materials provided with the distribution.
31 !
32 ! Neither the name of the DKRZ GmbH nor the names of its contributors
33 ! may be used to endorse or promote products derived from this software
34 ! without specific prior written permission.
35 !
36 ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
37 ! IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
38 ! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
39 ! PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
40 ! OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
41 ! EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
42 ! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
43 ! PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
44 ! LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
45 ! NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
46 ! SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
47 !
49  use, INTRINSIC :: iso_c_binding, only: c_ptr, c_null_ptr, c_int, &
50  c_char, c_null_char
51  IMPLICIT NONE
52  PRIVATE
53  ! note: this type must not be extended to contain any other
54  ! components, its memory pattern has to match void * exactly, which
55  ! it does because of C constraints
56  TYPE, BIND(C), PUBLIC :: xt_config
57 #ifndef __G95__
58  PRIVATE
59 #endif
60  TYPE(c_ptr) :: cptr = c_null_ptr
61  END TYPE xt_config
62 
63  INTERFACE
64  ! this function must not be implemented in Fortran because
65  ! PGI 11.x chokes on that
66  FUNCTION xt_config_f2c(config) bind(c, name='xt_config_f2c') RESULT(p)
67  IMPORT :: c_ptr, xt_config
68  IMPLICIT NONE
69  TYPE(xt_config), INTENT(in) :: config
70  TYPE(c_ptr) :: p
71  END FUNCTION xt_config_f2c
72  END INTERFACE
73 
75  PUBLIC :: xt_config_f2c
76  PUBLIC :: xt_exchanger_id_by_name
78  INTEGER, PUBLIC, PARAMETER :: &
84 
85 CONTAINS
86 
87  FUNCTION xt_config_new() RESULT(config)
88  TYPE(xt_config) :: config
89  INTERFACE
90  FUNCTION xt_config_new_c() RESULT(config) &
91  bind(c, name='xt_config_new')
92  IMPORT :: c_ptr
93  IMPLICIT NONE
94  TYPE(c_ptr) :: config
95  END FUNCTION xt_config_new_c
96  END INTERFACE
97  config%cptr = xt_config_new_c()
98  END FUNCTION xt_config_new
99 
100  SUBROUTINE xt_config_delete(config)
101  TYPE(xt_config), INTENT(in) :: config
102  INTERFACE
103  SUBROUTINE xt_config_delete_c(config) bind(c, name='xt_config_delete')
104  IMPORT :: c_ptr
105  IMPLICIT NONE
106  TYPE(c_ptr), VALUE, INTENT(in) :: config
107  END SUBROUTINE xt_config_delete_c
108  END INTERFACE
109  CALL xt_config_delete_c(config%cptr)
110  END SUBROUTINE xt_config_delete
111 
112  SUBROUTINE xt_config_set_exchange_method(config, method)
113  TYPE(xt_config), INTENT(inout) :: config
114  INTEGER, INTENT(in) :: method
115  INTEGER(c_int) :: method_c
116  INTERFACE
117  SUBROUTINE xt_config_set_exchange_method_c(config, method) &
118  bind(c, name='xt_config_set_exchange_method')
119  IMPORT :: c_int, c_ptr
120  TYPE(c_ptr), VALUE :: config
121  INTEGER(c_int), VALUE :: method
122  END SUBROUTINE xt_config_set_exchange_method_c
123  END INTERFACE
124  method_c = int(method, c_int)
125  CALL xt_config_set_exchange_method_c(config%cptr, method_c)
126  END SUBROUTINE xt_config_set_exchange_method
127 
128  FUNCTION xt_config_get_exchange_method(config) RESULT(method)
129  TYPE(xt_config), INTENT(in) :: config
130  INTEGER :: method
131  INTERFACE
132  FUNCTION xt_config_get_exchange_method_c(config) RESULT(method) &
133  bind(c, name='xt_config_get_exchange_method')
134  IMPORT :: c_int, c_ptr
135  TYPE(c_ptr), VALUE :: config
136  INTEGER(c_int) :: method
137  END FUNCTION xt_config_get_exchange_method_c
138  END INTERFACE
139  method = int(xt_config_get_exchange_method_c(config%cptr))
140  END FUNCTION xt_config_get_exchange_method
141 
142  FUNCTION xt_exchanger_id_by_name(name) RESULT(exchanger_id)
143  CHARACTER(len=*), INTENT(in) :: name
144  INTEGER :: exchanger_id
145  INTERFACE
146  FUNCTION xt_exchanger_id_by_name_c(name) RESULT(exchanger_id) &
147  bind(c, name='xt_exchanger_id_by_name')
148  IMPORT :: c_char, c_int
149  CHARACTER(len=1, kind=c_char), INTENT(in) :: name(*)
150  INTEGER(c_int) :: exchanger_id
151  END FUNCTION xt_exchanger_id_by_name_c
152  END INTERFACE
153  INTEGER(c_int) :: c_id
154  CHARACTER(len=1) :: name_c(len(name)+1)
155  INTEGER :: i, nlen
156  nlen = len(name)
157  DO i = 1, nlen
158  name_c(i) = name(i:i)
159  END DO
160  name_c(nlen+1) = c_null_char
161  c_id = xt_exchanger_id_by_name_c(name_c)
162  exchanger_id = int(c_id)
163  END FUNCTION xt_exchanger_id_by_name
164 
165 END MODULE xt_config_f
166 !
167 ! Local Variables:
168 ! f90-continuation-indent: 5
169 ! coding: utf-8
170 ! indent-tabs-mode: nil
171 ! show-trailing-whitespace: t
172 ! require-trailing-newline: t
173 ! End:
174 !
int xt_exchanger_id_by_name(const char *name)
Definition: xt_config.c:103
void xt_config_delete(Xt_config config)
Definition: xt_config.c:76
void xt_config_set_exchange_method(Xt_config config, int method)
Definition: xt_config.c:125
@ xt_exchanger_irecv_isend
Definition: xt_config.h:75
@ xt_exchanger_irecv_send
Definition: xt_config.h:74
@ xt_exchanger_irecv_isend_packed
Definition: xt_config.h:76
@ xt_exchanger_neigh_alltoall
Definition: xt_config.h:78
@ xt_exchanger_mix_isend_irecv
Definition: xt_config.h:77
Xt_config xt_config_new(void)
Definition: xt_config.c:69
int xt_config_get_exchange_method(Xt_config config)
Definition: xt_config.c:111