00001 subroutine adjust_B2DR(flag_st)
00002 use phys_constant, only : long
00003 use grid_parameter, only : nrf, ntfeq, npfxzp
00004 use def_matter, only : omef
00005 use def_matter_parameter, only : ome, B2DR, DRAT_B2DR
00006 use make_array_1d
00007 use interface_search_max_radial
00008 implicit none
00009 integer :: flag_st, ii
00010 integer, save :: count_st
00011 real(long), save :: x_st(0:2), f_st(0:1)
00012 real(long) :: delta, dfdx, error_st, diff_st
00013 real(long) :: DRAT_adjust, DRAT_hope, small = 1.0d-10
00014 real(long) :: facp(5) = (/ 1.0d-1, 2.0d-1, 4.0d-1, 7.0d-1, 1.0d-0 /)
00015 character(len=6) :: charge_type
00016 real(long), pointer :: omef_x(:)
00017 real(long) :: omef_max, x_omax
00018 integer :: irf_omax
00019
00020
00021
00022 call alloc_array1d(omef_x,0,nrf)
00023 omef_x(0:nrf)=omef(0:nrf,ntfeq,npfxzp)
00024 irf_omax = maxloc(omef_x,DIM=1) - 1
00025
00026
00027
00028 call search_max_radial(irf_omax,omef_x,omef_max,x_omax)
00029 deallocate(omef_x)
00030 DRAT_adjust = omef_max/ome
00031 DRAT_hope = DRAT_B2DR
00032
00033 if (flag_st.ne.0) then
00034 x_st(0) = x_st(1)
00035 f_st(0) = f_st(1)
00036 end if
00037
00038 diff_st = DRAT_adjust - DRAT_hope
00039 error_st = dabs(diff_st/DRAT_hope)
00040 write(6,'(1a20,2(7x,i5))') '-- DRAT flag # -- ',flag_st
00041 write(6,'(1a20,1p,2e12.4)')'-- DRAT and B2DR -- ',DRAT_adjust, B2DR
00042
00043 if (error_st.gt.small) then
00044 x_st(1) = B2DR
00045 f_st(1) = diff_st
00046 else
00047 write(6,'(1a24)') ' -- B2DR converged -- '
00048 return
00049 end if
00050
00051 if (flag_st.eq.0) then
00052 count_st = 1
00053 delta = 0.1*B2DR
00054 if (delta.eq.0.0d0) delta = 0.1d0
00055 else
00056 count_st = count_st + 1
00057 dfdx = (f_st(1) - f_st(0))/(x_st(1) - x_st(0))
00058 delta = - f_st(1)/dfdx
00059 flag_st = +1
00060 if (delta.lt.0.0d0) flag_st = -1
00061 end if
00062
00063 ii = min0(5,count_st)
00064 x_st(2) = x_st(1) + delta*facp(ii)
00065 B2DR = x_st(2)
00066
00067 if (flag_st.eq.0) flag_st = +1
00068
00069 write(6,'(1a6,1p,3e12.4)')'B2DR', x_st(0),x_st(1),x_st(2)
00070 write(6,'(1a6,1p,3e12.4)')'B2DR', f_st(0),f_st(1)
00071 write(6,'(1a6,1p,3e12.4)')'B2DR', delta, dfdx
00072
00073 return
00074 end subroutine adjust_B2DR
