00001 subroutine source_MoC_CF_gp4th(souvec)
00002 use grid_parameter, only : nrg, ntg, npg, nrf, ntf, npf
00003
00004 use interface_sourceterm_MoC_CF_drot_SFC
00005
00006 use interface_sourceterm_MoC_CF_with_divshift_r3rd_ns
00007 use interface_interpo_fl2gr_midpoint
00008 use interface_correct_matter_source_midpoint
00009 use make_array_3d
00010 use make_array_4d
00011 implicit none
00012 real(8), pointer :: souvec(:,:,:,:), sou(:,:,:), souf(:,:,:)
00013 real(8), pointer :: souvec1(:,:,:,:), souvec2(:,:,:,:), souvecf(:,:,:,:)
00014 integer :: ipg, itg, irg, ia
00015
00016 call alloc_array3d(sou,0,nrg,0,ntg,0,npg)
00017 call alloc_array3d(souf,0,nrf,0,ntf,0,npf)
00018 call alloc_array4d(souvec1,0,nrg,0,ntg,0,npg,1,3)
00019 call alloc_array4d(souvec2,0,nrg,0,ntg,0,npg,1,3)
00020 call alloc_array4d(souvecf,0,nrf,0,ntf,0,npf,1,3)
00021
00022
00023 call sourceterm_MoC_CF_drot_SFC(souvecf)
00024 do ia = 1, 3
00025
00026 souf(0:nrf,0:ntf,0:npf) = souvecf(0:nrf,0:ntf,0:npf,ia)
00027 call interpo_fl2gr_midpoint(souf,sou)
00028 call correct_matter_source_midpoint(sou)
00029 souvec1(0:nrg,0:ntg,0:npg,ia) = sou(0:nrg,0:ntg,0:npg)
00030 end do
00031
00032 call sourceterm_MoC_CF_with_divshift_r3rd_ns(souvec2)
00033
00034 souvec(0:nrg,0:ntg,0:npg,1:3) = souvec1(0:nrg,0:ntg,0:npg,1:3) &
00035 & + souvec2(0:nrg,0:ntg,0:npg,1:3)
00036
00037 deallocate(sou)
00038 deallocate(souf)
00039 deallocate(souvec1)
00040 deallocate(souvec2)
00041 deallocate(souvecf)
00042
00043 end subroutine source_MoC_CF_gp4th