Yet Another eXchange Tool 0.11.3
Loading...
Searching...
No Matches
xt_request_f.f90
Go to the documentation of this file.
1!>
2!! @file xt_request_f.f90
3!! @brief xt_request-related procedures of Fortran interface
4!!
5!! @copyright Copyright (C) 2016 Jörg Behrens <behrens@dkrz.de>
6!! Moritz Hanke <hanke@dkrz.de>
7!! Thomas Jahns <jahns@dkrz.de>
8!!
9!! @author Jörg Behrens <behrens@dkrz.de>
10!! Moritz Hanke <hanke@dkrz.de>
11!! Thomas Jahns <jahns@dkrz.de>
12!!
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://dkrz-sw.gitlab-pages.dkrz.de/yaxt/
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!
48
49#include "fc_feature_defs.inc"
50MODULE xt_requests
51 USE iso_c_binding, ONLY: c_null_ptr, c_ptr, c_associated, c_int
52 IMPLICIT NONE
53 PRIVATE
54
55 TYPE, BIND(C), PUBLIC :: xt_request
56#ifndef __G95__
57 PRIVATE
58#endif
59 TYPE(c_ptr) :: cptr = c_null_ptr
60 END TYPE xt_request
61
62 PUBLIC :: xt_request_init, xt_request_wait, xt_request_test, xt_request_f2c, &
63 xt_is_null
64
65 INTERFACE
66 ! this function must not be implemented in Fortran because
67 ! PGI 11.x chokes on that
68 FUNCTION xt_request_f2c(request) bind(c, name='xt_request_f2c') RESULT(p)
69 IMPORT :: c_ptr, xt_request
70 IMPLICIT NONE
71 TYPE(xt_request), INTENT(in) :: request
72 TYPE(c_ptr) :: p
73 END FUNCTION xt_request_f2c
74
75 SUBROUTINE xt_request_wait(request) bind(C, name='xt_request_wait')
76 IMPORT :: xt_request
77 TYPE(xt_request), INTENT(inout) :: request
78 END SUBROUTINE xt_request_wait
79
80 END INTERFACE
81
82 TYPE(xt_request), PARAMETER, PUBLIC :: xt_request_null = xt_request(c_null_ptr)
83
84 INTERFACE xt_is_null
85 MODULE PROCEDURE xt_request_is_null
86 END INTERFACE xt_is_null
87
88CONTAINS
89
90 SUBROUTINE xt_request_init(request, cptr)
91 TYPE(xt_request),INTENT(out) :: request
92 TYPE(c_ptr), INTENT(in) :: cptr
93 request%cptr = cptr
94 END SUBROUTINE xt_request_init
95
96
97 SUBROUTINE xt_request_test(request, flag)
98 TYPE(xt_request), INTENT(inout) :: request
99 LOGICAL, INTENT(out) :: flag
100 INTEGER(c_int) :: flag_c
101 INTERFACE
102 SUBROUTINE xt_request_test_c(request_c, flag_c) &
103 bind(c, name='xt_request_test')
104 import:: c_ptr, c_int
105 TYPE(c_ptr), INTENT(inout) :: request_c
106 INTEGER(c_int), INTENT(out) :: flag_c
107 END SUBROUTINE xt_request_test_c
108 END INTERFACE
109 CALL xt_request_test_c(request%cptr, flag_c)
110 flag = flag_c /= 0
111 END SUBROUTINE xt_request_test
112
113 FUNCTION xt_request_is_null(request) RESULT(p)
114 TYPE(xt_request), INTENT(in) :: request
115 LOGICAL :: p
116 p = .NOT. c_associated(request%cptr)
117 END FUNCTION xt_request_is_null
118
119END MODULE xt_requests
120!
121! Local Variables:
122! f90-continuation-indent: 5
123! coding: utf-8
124! indent-tabs-mode: nil
125! show-trailing-whitespace: t
126! require-trailing-newline: t
127! End:
128!
void xt_request_wait(Xt_request *request)
Definition xt_request.c:57
void xt_request_test(Xt_request *request, int *flag)
Definition xt_request.c:66
Xt_request xt_request_f2c(struct xt_request_f *p)
Definition yaxt_f2c.c:195