00001 subroutine sourceterm_exsurf_binary_COCP(impt,fnchar,char,sou_ex,dsou_ex)
00002 use phys_constant, only : long
00003 use grid_parameter, only : nrg, ntg, npg
00004 use interface_sourceterm_exsurf_binary_parity
00005 use def_metric, only : psi, alps, bvxd, bvyd, bvzd
00006 use make_array_3d
00007 implicit none
00008 real(long), pointer :: fnc(:,:,:), sou_ex(:,:), dsou_ex(:,:)
00009 integer :: impt, impt_ex
00010 character(len=4) :: fnchar
00011 character(len=2) :: char
00012
00013 if (impt.eq.1) impt_ex = 2
00014 if (impt.eq.2) impt_ex = 1
00015 call copy_from_mpatch_exsurf_binary_COCP(impt_ex)
00016 call copy_def_metric_from_mpt(impt_ex)
00017 call alloc_array3d(fnc,0,nrg,0,ntg,0,npg)
00018 if (fnchar.eq.'psi ') fnc(0:nrg,0:ntg,0:npg) = psi(0:nrg,0:ntg,0:npg)
00019 if (fnchar.eq.'alps') fnc(0:nrg,0:ntg,0:npg) = alps(0:nrg,0:ntg,0:npg)
00020 if (fnchar.eq.'bvxd') fnc(0:nrg,0:ntg,0:npg) = bvxd(0:nrg,0:ntg,0:npg)
00021 if (fnchar.eq.'bvyd') fnc(0:nrg,0:ntg,0:npg) = bvyd(0:nrg,0:ntg,0:npg)
00022 if (fnchar.eq.'bvzd') fnc(0:nrg,0:ntg,0:npg) = bvzd(0:nrg,0:ntg,0:npg)
00023 call sourceterm_exsurf_binary_parity(fnc,sou_ex,dsou_ex,char)
00024 call copy_from_mpatch_exsurf_binary_COCP(impt)
00025 call copy_def_metric_from_mpt(impt)
00026
00027 deallocate(fnc)
00028
00029 end subroutine sourceterm_exsurf_binary_COCP
