source: XIOS3/trunk/src/interface/fortran/icontext.F90

Last change on this file was 2620, checked in by jderouillat, 4 months ago

Modify fortran-C interfaces to manage logical-bool conversion, the optimizations of OneAPI could produce bugs regarding the logical-bool encodings.
  • Property copyright set to
    Software name : XIOS (Xml I/O Server)
    http://forge.ipsl.jussieu.fr/ioserver
    Creation date : January 2009
    Licence : CeCCIL version2
    see license file in root directory : Licence_CeCILL_V2-en.txt
    or http://www.cecill.info/licences/Licence_CeCILL_V2-en.html
    Holder : CEA/LSCE (Laboratoire des Sciences du CLimat et de l'Environnement)
    CNRS/IPSL (Institut Pierre Simon Laplace)
    Project Manager : Yann Meurdesoif
    yann.meurdesoif@cea.fr
File size: 2.7 KB
Line 
1#include "xios_fortran_prefix.hpp"
2
3MODULE ICONTEXT
4   USE, INTRINSIC :: ISO_C_BINDING
5   USE CONTEXT_INTERFACE
6   USE IDATE
7   USE IDURATION
8!   USE icontext_attr
9   USE LOGICAL_BOOL_CONVERSION
10
11
12   TYPE txios(context)
13      INTEGER(kind = C_INTPTR_T) :: daddr
14   END TYPE txios(context)
15
16   INTERFACE xios(set_current_context)
17      MODULE PROCEDURE xios(set_current_context_hdl), xios(set_current_context_id)
18   END INTERFACE xios(set_current_context)
19
20   INTERFACE xios(get_current_context)
21      MODULE PROCEDURE xios(get_current_context_hdl), xios(get_current_context_id)
22   END INTERFACE xios(get_current_context)
23
24   CONTAINS ! Fonctions disponibles pour les utilisateurs.
25
26   SUBROUTINE xios(get_context_handle)(idt,ret)
27      IMPLICIT NONE
28      CHARACTER(len = *)  , INTENT(IN)  :: idt
29      TYPE(txios(context)), INTENT(OUT):: ret
30
31      CALL cxios_context_handle_create(ret%daddr, idt, len(idt))
32   END SUBROUTINE xios(get_context_handle)
33
34   SUBROUTINE xios(get_current_context_hdl)(context)
35      IMPLICIT NONE
36
37      TYPE(txios(context)), INTENT(OUT) :: context
38
39      CALL cxios_context_get_current(context%daddr)
40
41   END SUBROUTINE xios(get_current_context_hdl)
42
43   SUBROUTINE xios(get_current_context_id)(idt)
44      IMPLICIT NONE
45      CHARACTER(len = *) , INTENT(OUT) :: idt
46      TYPE(txios(context)) :: context
47
48      CALL cxios_context_get_current(context%daddr)
49      CALL cxios_context_get_id(context%daddr, idt, len(idt))
50
51   END SUBROUTINE xios(get_current_context_id)
52   
53   SUBROUTINE xios(set_current_context_hdl)(context, withswap)
54      IMPLICIT NONE
55
56      TYPE(txios(context))          , INTENT(IN) :: context
57      LOGICAL             , OPTIONAL, INTENT(IN) :: withswap
58      LOGICAL (kind = 1)                         :: wswap
59
60      IF (PRESENT(withswap)) THEN
61         wswap = withswap
62      ELSE
63         wswap = .FALSE.
64      END IF
65      CALL xios_logical_to_bool_0d(wswap)
66      CALL cxios_context_set_current(context%daddr, wswap)
67
68   END SUBROUTINE xios(set_current_context_hdl)
69
70   SUBROUTINE xios(set_current_context_id)(idt)
71      IMPLICIT NONE
72
73      CHARACTER(len = *) , INTENT(IN) :: idt
74      LOGICAL           :: withswap
75      TYPE(xios_context):: ret
76
77      CALL xios(get_context_handle)(idt,ret)
78      CALL xios(set_current_context_hdl)(ret, withswap)
79    END SUBROUTINE xios(set_current_context_id)
80
81   LOGICAL FUNCTION xios(is_valid_context)(idt)
82      IMPLICIT NONE
83      CHARACTER(len  = *)    , INTENT(IN) :: idt
84      LOGICAL  (kind = 1)                 :: val
85
86      CALL cxios_context_valid_id(val, idt, len(idt));
87      CALL xios_bool_to_logical_0d(val)
88      xios(is_valid_context) = val
89
90   END FUNCTION  xios(is_valid_context)
91
92
93END MODULE ICONTEXT
Note: See TracBrowser for help on using the repository browser.