1!-------------------------------------------------------------------------------
2
3! This file is part of Code_Saturne, a general-purpose CFD tool.
4!
5! Copyright (C) 1998-2021 EDF S.A.
6!
7! This program is free software; you can redistribute it and/or modify it under
8! the terms of the GNU General Public License as published by the Free Software
9! Foundation; either version 2 of the License, or (at your option) any later
10! version.
11!
12! This program is distributed in the hope that it will be useful, but WITHOUT
13! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
14! FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
15! details.
16!
17! You should have received a copy of the GNU General Public License along with
18! this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
19! Street, Fifth Floor, Boston, MA 02110-1301, USA.
20
21!-------------------------------------------------------------------------------
22
23!> \file cs_f_interfaces.f90
24!> Definition of explicit interfaces for Fortran functions
25
26module cs_f_interfaces
27
28  !=============================================================================
29
30  use, intrinsic :: iso_c_binding
31
32  use cs_c_bindings, only: var_cal_opt
33
34  implicit none
35
36  !=============================================================================
37
38  interface
39
40    !---------------------------------------------------------------------------
41
42    subroutine diften &
43      (idtvar, ivar, vcopt,                                                    &
44      inc, iccocg,                                                             &
45      pvar, pvara, coefap, coefbp, cofafp, cofbfp,                             &
46      viscf, viscb, viscel,                                                    &
47      weighf, weighb,                                                          &
48      smbrp)
49      use mesh
50      use cs_c_bindings, only: var_cal_opt
51      integer :: idtvar, ivar
52      type(var_cal_opt) :: vcopt
53      integer :: inc, iccocg
54      double precision, dimension(ncelet) :: pvar, pvara
55      double precision, dimension(nfabor) :: coefap, coefbp, cofafp, cofbfp
56      double precision, dimension(nfac) :: viscf
57      double precision, dimension(nfabor) :: viscb
58      double precision, dimension(6,ncelet), target :: viscel
59      double precision, dimension(2,nfac) :: weighf
60      double precision, dimension(nfabor) :: weighb
61      double precision, dimension(ncelet) :: smbrp
62    end subroutine diften
63
64    !---------------------------------------------------------------------------
65
66    subroutine itrmav &
67     (f_id, init, inc, imrgra, iccocg, nswrgp, imligp, ircflp,                 &
68     iphydp, iwgrp, iwarnp, epsrgp, climgp, extrap, frcxt,                     &
69     pvar, coefap, coefbp, cofafp, cofbfp, viscf, viscb, viscel,               &
70     weighf, weighb, flumas, flumab)
71      use mesh
72      integer :: f_id, init, inc, imrgra
73      integer :: iccocg, nswrgp, imligp, ircflp
74      integer :: iwarnp, iphydp
75      double precision :: epsrgp , climgp , extrap
76      double precision, dimension(ncelet) :: pvar
77      double precision, dimension(nfabor) :: coefap, coefbp, cofafp, cofbfp
78      double precision, dimension(nfac) :: viscf(nfac)
79      double precision, dimension(nfabor) :: viscb(nfabor)
80      double precision, dimension(6, ncelet), target :: viscel
81      double precision, dimension(2,nfac) :: weighf
82      double precision, dimension(nfabor) :: weighb
83      double precision, dimension(nfac) :: flumas
84      double precision, dimension(nfabor) :: flumab
85      double precision, dimension(3, ncelet) :: frcxt
86    end subroutine itrmav
87
88    !---------------------------------------------------------------------------
89
90    subroutine itrgrv &
91      (f_id, init, inc, imrgra, iccocg, nswrgp, imligp, ircflp,                &
92      iphydp, iwgrp, iwarnp,                                                   &
93      epsrgp, climgp, extrap, frcxt,                                           &
94      pvar, coefap, coefbp, cofafp, cofbfp, viscf, viscb, viscel,              &
95      weighf, weighb, diverg)
96      use mesh
97      integer :: f_id, init, inc, imrgra, iccocg, nswrgp, imligp, ircflp
98      integer :: iwgrp, iwarnp , iphydp
99      double precision :: epsrgp, climgp, extrap
100      double precision, dimension(ncelet) :: pvar
101      double precision, dimension(nfabor) :: coefap, coefbp, cofafp, cofbfp
102      double precision, dimension(nfac) :: viscf
103      double precision, dimension(nfabor) :: viscb
104      double precision, dimension(6,ncelet), target :: viscel
105      double precision, dimension(2,nfac) :: weighf
106      double precision, dimension(nfabor) :: weighb
107      double precision, dimension(ncelet) :: diverg
108      double precision, dimension(3,ncelet) :: frcxt
109    end subroutine itrgrv
110
111    !---------------------------------------------------------------------------
112
113    subroutine matrix &
114      (iconvp, idiffp, ndircp, isym, thetap, imucpp, coefbp, cofbfp,           &
115      rovsdt, i_massflux, b_massflux, i_visc, b_visc, xcpp, da, xa)
116      use mesh
117      integer :: iconvp, idiffp, ndircp, isym, imucpp
118      double precision :: thetap
119      double precision, dimension(ncelet) :: rovsdt, xcpp, da
120      double precision, dimension(nfabor) :: coefbp, cofbfp, b_massflux, b_visc
121      double precision, dimension(nfac) :: i_massflux, i_visc
122      double precision, dimension(2,nfac) :: xa
123    end subroutine matrix
124
125    !---------------------------------------------------------------------------
126
127    subroutine matrdt &
128      (iconvp, idiffp, isym, coefbp, cofbfp,                                   &
129      i_massflux, b_massflux, i_visc, b_visc, da)
130      use mesh
131      integer :: iconvp, idiffp, isym
132      double precision, dimension(ncelet) :: da
133      double precision, dimension(nfabor) :: coefbp, cofbfp, b_massflux, b_visc
134      double precision, dimension(nfac) :: i_massflux, i_visc
135    end subroutine matrdt
136
137    !---------------------------------------------------------------------------
138
139    subroutine post_boundary_thermal_flux &
140      (nfbrps, lstfbr, bflux)
141      use dimens
142      use mesh
143      integer, intent(in)                                        :: nfbrps
144      integer, dimension(nfbrps), intent(in)                     :: lstfbr
145      double precision, dimension(nfbrps), intent(out)           :: bflux
146    end subroutine post_boundary_thermal_flux
147
148    !---------------------------------------------------------------------------
149
150    subroutine post_boundary_nusselt &
151      (nfbrps, lstfbr, bnussl)
152      use dimens
153      use mesh
154      integer, intent(in)                                        :: nfbrps
155      integer, dimension(nfbrps), intent(in)                     :: lstfbr
156      double precision, dimension(nfbrps), intent(out)           :: bnussl
157    end subroutine post_boundary_nusselt
158
159    !---------------------------------------------------------------------------
160
161    subroutine post_stress &
162      (nfbrps, lstfbr, stress)
163      use dimens
164      use mesh
165      integer, intent(in)                                 :: nfbrps
166      integer, dimension(nfbrps), intent(in)              :: lstfbr
167      double precision, dimension(3, nfbrps), intent(out) :: stress
168    end subroutine post_stress
169
170    !---------------------------------------------------------------------------
171
172    subroutine turrij &
173      (nvar, nscal, ncepdp, ncesmp, icepdc, icetsm, itypsm,                    &
174      dt, tslagr,                                                              &
175      ckupdc, smacel)
176      use lagran, only: ntersl
177      use mesh
178      integer :: nvar, nscal, ncepdp, ncesmp
179      integer, dimension(ncepdp) :: icepdc
180      integer, dimension(ncesmp) :: icetsm
181      integer, dimension(ncesmp,nvar), target :: itypsm
182      double precision, dimension(ncelet) :: dt
183      double precision, dimension(ncelet,ntersl), target :: tslagr
184      double precision, dimension(ncepdp,6) :: ckupdc
185      double precision, dimension(ncesmp,nvar), target ::  smacel
186    end subroutine turrij
187
188    !---------------------------------------------------------------------------
189
190    subroutine vitens &
191     (w1, iwarnp, weighf, weighb, viscf, viscb)
192      use mesh
193      integer :: iwarnp
194      double precision, dimension(6, ncelet), target :: w1
195      double precision, dimension(2, nfac) :: weighf
196      double precision, dimension(nfabor) :: weighb
197      double precision, dimension(nfac) :: viscf
198      double precision, dimension(nfabor) :: viscb
199    end subroutine vitens
200
201    !---------------------------------------------------------------------------
202
203    subroutine vistnv &
204      (imvisf, w1, viscf, viscb)
205      use mesh
206      integer :: imvisf
207      double precision, dimension(6,ncelet), target :: w1
208      double precision, dimension(3,3,nfac) :: viscf
209      double precision, dimension(nfabor) :: viscb
210    end subroutine vistnv
211
212    !---------------------------------------------------------------------------
213
214  end interface
215
216  !=============================================================================
217
218end module cs_f_interfaces
219