Line data Source code
1 : ! ***********************************************************************
2 : !
3 : ! Copyright (C) 2012 Bill Paxton, Pablo Marchant & 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 mod_other_implicit_rlo
21 :
22 : ! NOTE: remember to set one of these to true:
23 : ! use_other_check_implicit_rlo_mdot = .true.
24 : ! use_other_implicit_function_to_solve = .true.
25 :
26 : use const_def, only: dp
27 :
28 : implicit none
29 :
30 : contains
31 :
32 0 : integer function null_other_check_implicit_rlo(binary_id, new_mdot)
33 : use binary_def, only : binary_info, binary_ptr
34 : use const_def, only: dp
35 : use star_def
36 : integer, intent(in) :: binary_id
37 : real(dp), intent(out) :: new_mdot
38 : integer :: ierr
39 : type (binary_info), pointer :: b
40 : ierr = 0
41 0 : call binary_ptr(binary_id, b, ierr)
42 0 : if (ierr /= 0) then
43 0 : write(*,*) 'failed in binary_ptr'
44 0 : return
45 : end if
46 0 : new_mdot = 0d0
47 0 : null_other_check_implicit_rlo = keep_going
48 0 : write(*,*) "WARNING: using null_other_check_implicit_rlo"
49 0 : end function null_other_check_implicit_rlo
50 :
51 0 : subroutine null_other_implicit_function_to_solve(binary_id, &
52 : function_to_solve, use_sum, detached, ierr)
53 0 : use binary_def, only : binary_info, binary_ptr
54 : use const_def, only: dp
55 : integer, intent(in) :: binary_id
56 : real(dp), intent(out) :: function_to_solve
57 : logical, intent(out) :: use_sum, detached
58 : integer, intent(out) :: ierr
59 : type (binary_info), pointer :: b
60 : ierr = 0
61 0 : call binary_ptr(binary_id, b, ierr)
62 0 : if (ierr /= 0) then
63 0 : write(*,*) 'failed in binary_ptr'
64 : return
65 : end if
66 0 : function_to_solve = 0d0
67 0 : use_sum = .false.
68 0 : write(*,*) "WARNING: using null_other_implicit_function_to_solve"
69 0 : end subroutine null_other_implicit_function_to_solve
70 :
71 : end module mod_other_implicit_rlo
72 :
|