SABER
interpolatorbump_interface.F90
Go to the documentation of this file.
1 ! (C) Copyright 2020- UCAR
2 !
3 ! This software is licensed under the terms of the Apache Licence Version 2.0
4 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
5 
7 
8 use atlas_module
9 use fckit_configuration_module, only: fckit_configuration
10 use fckit_mpi_module, only: fckit_mpi_comm
11 use iso_c_binding
12 use missing_values_mod
14 use type_fieldset
15 
16 private
17 ! ------------------------------------------------------------------------------
18 contains
19 !-------------------------------------------------------------------------------
20 !> Create Bump Interpolator (abbreviated as bint)
21 !!
22 subroutine bint_create_c(c_key_bint, c_comm, c_fspace1, c_fspace2, c_masks, &
23  c_config) bind(c, name='bint_create_f90')
24 implicit none
25 
26 ! Passed variables
27 integer(c_int), intent(inout) :: c_key_bint !<< bump interpolator
28 type(c_ptr), value, intent(in) :: c_comm !<< MPI Communicator
29 type(c_ptr), intent(in),value :: c_fspace1 !<< source grid (atlas functionspace)
30 type(c_ptr), intent(in),value :: c_fspace2 !<< target grid (atlas functionspace)
31 type(c_ptr), intent(in),value :: c_masks !<< masks and other metadata
32 type(c_ptr), value, intent(in) :: c_config !<< Configuration
33 
34 ! local variables
35 type(bump_interpolator), pointer :: bint
36 type(fckit_mpi_comm) :: f_comm
37 type(fckit_configuration) :: f_config
38 type(atlas_functionspace) :: fspace1, fspace2
39 type(fieldset_type) :: masks
40 
41 f_comm = fckit_mpi_comm(c_comm)
42 f_config = fckit_configuration(c_config)
43 
45 call bump_interpolator_registry%add(c_key_bint)
46 call bump_interpolator_registry%get(c_key_bint, bint)
47 
48 fspace1 = atlas_functionspace(c_fspace1)
49 fspace2 = atlas_functionspace(c_fspace2)
50 
51 if (c_associated(c_masks)) then
52  masks = atlas_fieldset(c_masks)
53  call bint%init(f_config, f_comm, fspace1, fspace2, masks)
54 else
55  call bint%init(f_config, f_comm, fspace1, fspace2)
56 endif
57 
58 end subroutine bint_create_c
59 
60 !-------------------------------------------------------------------------------
61 !> Apply Bump Interpolator
62 !!
63 subroutine bint_apply_c(c_key_bint, c_infields, c_outfields) bind(c, name='bint_apply_f90')
64 
65 implicit none
66 
67 ! Passed variables
68 integer(c_int), intent(in) :: c_key_bint !<< key to bump interpolator
69 type(c_ptr), intent(in), value :: c_infields !<< input fields
70 type(c_ptr), intent(in), value :: c_outfields !<< output fields
71 
72 ! Local variables
73 type(bump_interpolator), pointer :: bint
74 type(fieldset_type) :: infields, outfields
75 
76 call bump_interpolator_registry%get(c_key_bint, bint)
77 infields = atlas_fieldset(c_infields)
78 outfields = atlas_fieldset(c_outfields)
79 
80 call bint%apply(infields, outfields)
81 
82 end subroutine bint_apply_c
83 
84 !-------------------------------------------------------------------------------
85 !> Apply Bump Interpolator Adjoint
86 !!
87 subroutine bint_apply_ad_c(c_key_bint, c_fields2, c_fields1) bind(c, name='bint_apply_ad_f90')
88 
89 implicit none
90 
91 ! Passed variables
92 integer(c_int), intent(in) :: c_key_bint !<< key to bump interpolator
93 type(c_ptr), intent(in), value :: c_fields2 !<< input fields
94 type(c_ptr), intent(in), value :: c_fields1 !<< output fields
95 
96 ! Local variables
97 type(bump_interpolator), pointer :: bint
98 type(fieldset_type) :: fields_grid2, fields_grid1
99 
100 call bump_interpolator_registry%get(c_key_bint, bint)
101 fields_grid2 = atlas_fieldset(c_fields2)
102 fields_grid1 = atlas_fieldset(c_fields1)
103 
104 call bint%apply_ad(fields_grid2, fields_grid1)
105 
106 end subroutine bint_apply_ad_c
107 
108 ! ------------------------------------------------------------------------------
109 !> Delete bump_interpolator
110 subroutine bint_delete_c(c_key_bint) bind(c, name='bint_delete_f90')
111 
112 implicit none
113 
114 ! Passed variables
115 integer(c_int), intent(inout) :: c_key_bint
116 
117 ! Local variables
118 type(bump_interpolator), pointer :: bint
119 
120 call bump_interpolator_registry%get(c_key_bint, bint)
121 
122 call bint%delete()
123 
124 call bump_interpolator_registry%remove(c_key_bint)
125 
126 end subroutine bint_delete_c
127 
128 ! ------------------------------------------------------------------------------
129 
bump_interpolation_mod
Bump Interpolation module.
Definition: bump_interpolation_mod.F90:12
interpolatorbump_interface
Definition: interpolatorbump_interface.F90:6
interpolatorbump_interface::bint_create_c
subroutine bint_create_c(c_key_bint, c_comm, c_fspace1, c_fspace2, c_masks, c_config)
Create Bump Interpolator (abbreviated as bint)
Definition: interpolatorbump_interface.F90:24
bump_interpolation_mod::bump_interpolator
Definition: bump_interpolation_mod.F90:49
interpolatorbump_interface::bint_apply_ad_c
subroutine bint_apply_ad_c(c_key_bint, c_fields2, c_fields1)
Apply Bump Interpolator Adjoint.
Definition: interpolatorbump_interface.F90:88
type_fieldset
Random numbers generator derived type.
Definition: type_fieldset.F90:9
interpolatorbump_interface::bint_apply_c
subroutine bint_apply_c(c_key_bint, c_infields, c_outfields)
Apply Bump Interpolator.
Definition: interpolatorbump_interface.F90:64
type_fieldset::fieldset_type
Definition: type_fieldset.F90:18
interpolatorbump_interface::bint_delete_c
subroutine bint_delete_c(c_key_bint)
Delete bump_interpolator.
Definition: interpolatorbump_interface.F90:111
bump_interpolation_mod::bump_interpolator_registry
type(registry_t), public bump_interpolator_registry
Registry for bump_interpolator objects.
Definition: bump_interpolation_mod.F90:99