00001 subroutine source_MWtemp_WL(sou)
00002 use grid_parameter, only : nrg, ntg, npg, nrf, ntf, npf, ntgeq
00003 use coordinate_grav_r, only : hrg
00004 use interface_sourceterm_MWtemp_CF
00005 use interface_sourceterm_MWtemp_WL
00006 use interface_sourceterm_MWtemp_current
00007 use interface_interpo_fl2gr_midpoint
00008 use interface_correct_matter_source_midpoint
00009 use interface_correct_MW_source_C0At
00010 use make_array_3d
00011 implicit none
00012 real(8), pointer :: sou(:,:,:)
00013 real(8), pointer :: souf(:,:,:), sou1(:,:,:), sou2(:,:,:), sou3(:,:,:)
00014 integer :: irg, itg, ipg
00015
00016 call alloc_array3d(sou1,0,nrg,0,ntg,0,npg)
00017 call alloc_array3d(sou2,0,nrg,0,ntg,0,npg)
00018 call alloc_array3d(sou3,0,nrg,0,ntg,0,npg)
00019 call alloc_array3d(souf,0,nrf,0,ntf,0,npf)
00020 call sourceterm_MWtemp_CF(sou1)
00021 call correct_MW_source_C0At(sou1,2)
00022 call sourceterm_MWtemp_WL(sou2)
00023 call correct_MW_source_C0At(sou2,3)
00024 call sourceterm_MWtemp_current(souf)
00025 call interpo_fl2gr_midpoint(souf,sou3)
00026 call correct_matter_source_midpoint(sou3)
00027 sou(0:nrg,0:ntg,0:npg) = sou1(0:nrg,0:ntg,0:npg) &
00028 & + sou2(0:nrg,0:ntg,0:npg) &
00029 & + sou3(0:nrg,0:ntg,0:npg)
00030
00031 itg = ntgeq; ipg = 2
00032 open(15,file='test_vec_sou',status='unknown')
00033 do irg = 1, nrg
00034 write(15,'(1p,9e20.12)') hrg(irg), sou1(irg,itg,ipg) &
00035 & , sou2(irg,itg,ipg) &
00036 & , sou3(irg,itg,ipg)
00037 end do
00038 close(15)
00039
00040 deallocate(sou1)
00041 deallocate(sou2)
00042 deallocate(sou3)
00043 deallocate(souf)
00044
00045 end subroutine source_MWtemp_WL
