Cocal: /home/uryu/Cocal_svn_checkinout/Cocal/code/Subroutine/source_MoC

00001 subroutine source_MoC_WL(souvec)
00002   use grid_parameter, only : nrg, ntg, npg, nrf, ntf, npf
00003   use interface_sourceterm_MoC_CF_drot_SFC
00004   use interface_sourceterm_MoC_CF_with_divshift
00005   use interface_sourceterm_MoC_WL_drot_SFC
00006   use interface_sourceterm_MoC_WL
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(:,:,:,:)
00013   real(8), pointer :: sou(:,:,:), souf(:,:,:), souvecf(:,:,:,:)
00014   real(8), pointer :: souvecf1(:,:,:,:), souvecf2(:,:,:,:)
00015   real(8), pointer :: souvec1(:,:,:,:), souvec2(:,:,:,:), 
00016                      souvec3(:,:,:,:)
00017   integer :: ia
00018 !
00019   call alloc_array3d(sou,0,nrg,0,ntg,0,npg)
00020   call alloc_array3d(souf,0,nrf,0,ntf,0,npf)
00021   call alloc_array4d(souvecf,0,nrf,0,ntf,0,npf,1,3)
00022   call alloc_array4d(souvecf1,0,nrf,0,ntf,0,npf,1,3)
00023   call alloc_array4d(souvecf2,0,nrf,0,ntf,0,npf,1,3)
00024   call alloc_array4d(souvec1,0,nrg,0,ntg,0,npg,1,3)
00025   call alloc_array4d(souvec2,0,nrg,0,ntg,0,npg,1,3)
00026   call alloc_array4d(souvec3,0,nrg,0,ntg,0,npg,1,3)
00027 !
00028   call sourceterm_MoC_CF_drot_SFC(souvecf1)
00029 !!  call sourceterm_MoC_WL_corot(souvec3)
00030   call sourceterm_MoC_WL_drot_SFC(souvecf2)
00031   souvecf(0:nrf,0:ntf,0:npf,1:3) = souvecf1(0:nrf,0:ntf,0:npf,1:3) &
00032   &                              + souvecf2(0:nrf,0:ntf,0:npf,1:3)
00033   do ia = 1, 3
00034     souf(0:nrf,0:ntf,0:npf) = souvecf(0:nrf,0:ntf,0:npf,ia)
00035     call interpo_fl2gr_midpoint(souf,sou)
00036     call correct_matter_source_midpoint(sou)
00037     souvec1(0:nrg,0:ntg,0:npg,ia) = sou(0:nrg,0:ntg,0:npg)
00038   end do
00039 !
00040   call sourceterm_MoC_CF_with_divshift(souvec2)
00041   call sourceterm_MoC_WL(souvec3)
00042   souvec(0:nrg,0:ntg,0:npg,1:3) = souvec1(0:nrg,0:ntg,0:npg,1:3) &
00043   &                             + souvec2(0:nrg,0:ntg,0:npg,1:3) &
00044   &                             + souvec3(0:nrg,0:ntg,0:npg,1:3)
00045 !
00046   deallocate(sou)
00047   deallocate(souf)
00048   deallocate(souvecf)
00049   deallocate(souvecf1)
00050   deallocate(souvecf2)
00051   deallocate(souvec1)
00052   deallocate(souvec2)
00053   deallocate(souvec3)
00054 !
00055 end subroutine source_MoC_WL
/home/uryu/Cocal_svn_checkinout/Cocal/code/Subroutine/source_MoC_WL.f90
