00001 subroutine calc_qua_loc_spin_peos
00002 use phys_constant, only : long, pi
00003 use grid_parameter, only : nrg, ntg, npg, nrf, ntf, npf
00004 use coordinate_grav_r, only : hrg, rg
00005 use def_matter_parameter, only : radi
00006 use def_matter, only : rs
00007 use make_array_1d
00008 use make_array_2d
00009 use def_quantities, only : qua_loc_spin, qua_loc_spin_surf
00010 use interface_source_qua_loc_spin_peos_fluid
00011 use interface_source_qua_loc_spin_peos
00012 use interface_surf_int_grav
00013 use interface_surf_int_fluid_rg
00014 implicit none
00015 real(long) :: fac8pi, qls
00016 real(long) :: int_qua_loc_spin
00017 real(long),pointer :: soug_qua_loc_spin(:,:), souf_qua_loc_spin(:,:)
00018 integer :: irg, irs, ii
00019
00020 call alloc_array2d(soug_qua_loc_spin, 1, ntg, 1, npg)
00021 call alloc_array2d(souf_qua_loc_spin, 1, ntf, 1, npf)
00022
00023 fac8pi = 0.125d0/pi
00024
00025 do irs = nrf-5, nrf
00026 call source_qua_loc_spin_peos_fluid(souf_qua_loc_spin, irs)
00027 call surf_int_fluid_rg(souf_qua_loc_spin, int_qua_loc_spin, irs)
00028
00029 qls = fac8pi*radi**2*int_qua_loc_spin
00030 write(6,'(a4,i3,a8,1p,e23.15,a30,1p,e23.15)') 'irs=', irs, ' rs*rg=', &
00031 & rs(ntf/2,0)*rg(irs), 'Quasi local spin NS =', qls
00032
00033 if (irs==nrf) qua_loc_spin_surf = qls
00034 end do
00035
00036 call calc_vector_x_grav(1)
00037 call calc_vector_phi_grav(1)
00038
00039 do irs=nrf+1, nrf+10
00040 soug_qua_loc_spin = 0.0d0
00041 call source_qua_loc_spin_peos(soug_qua_loc_spin, irs)
00042 call surf_int_grav(soug_qua_loc_spin, int_qua_loc_spin, irs)
00043
00044 qls = fac8pi*radi**2*int_qua_loc_spin
00045 write(6,'(a4,i3,a8,1p,e23.15,a30,1p,e23.15)') 'irs=', irs, ' hrg=', &
00046 & hrg(irs), 'Quasi local spin NS =', qls
00047
00048 if (irs==nrf+1) qua_loc_spin = qls
00049 end do
00050
00051 deallocate(soug_qua_loc_spin)
00052 deallocate(souf_qua_loc_spin)
00053
00054 end subroutine calc_qua_loc_spin_peos
