Line data Source code
1 : ! ***********************************************************************
2 : !
3 : ! Copyright (C) 2010 The MESA Team
4 : !
5 : ! This program is free software: you can redistribute it and/or modify
6 : ! it under the terms of the GNU Lesser General Public License
7 : ! as published by the Free Software Foundation,
8 : ! either version 3 of the License, or (at your option) any later version.
9 : !
10 : ! This program is distributed in the hope that it will be useful,
11 : ! but WITHOUT ANY WARRANTY; without even the implied warranty of
12 : ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13 : ! See the GNU Lesser General Public License for more details.
14 : !
15 : ! You should have received a copy of the GNU Lesser General Public License
16 : ! along with this program. If not, see <https://www.gnu.org/licenses/>.
17 : !
18 : ! ***********************************************************************
19 :
20 : module other_remove_surface
21 :
22 : ! consult star/other/README for general usage instructions
23 : ! control name: use_other_remove_surface = .true.
24 : ! procedure pointer: s% other_remove_surface => my_routine
25 :
26 : implicit none
27 :
28 : contains
29 :
30 0 : subroutine default_other_remove_surface(id, ierr, k)
31 : use star_def
32 : integer, intent(in) :: id
33 : integer, intent(out) :: ierr
34 : integer, intent(out) :: k
35 :
36 : type(star_info), pointer :: s
37 : ierr = 0
38 0 : call star_ptr(id, s, ierr)
39 0 : if (ierr /= 0) return
40 :
41 0 : k = 0 ! The cell to remove down to.
42 0 : end subroutine default_other_remove_surface
43 :
44 : end module other_remove_surface
45 :
|