diff options
Diffstat (limited to 'src/Derivatives_6_3_min_err_coeff.F90')
| -rw-r--r-- | src/Derivatives_6_3_min_err_coeff.F90 | 426 |
1 files changed, 426 insertions, 0 deletions
diff --git a/src/Derivatives_6_3_min_err_coeff.F90 b/src/Derivatives_6_3_min_err_coeff.F90 index 703eb4e..ae26440 100644 --- a/src/Derivatives_6_3_min_err_coeff.F90 +++ b/src/Derivatives_6_3_min_err_coeff.F90 @@ -287,3 +287,429 @@ subroutine deriv_gf_6_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) end if end select direction end subroutine deriv_gf_6_3_opt + +subroutine up_deriv_gf_6_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar ) + + implicit none + + DECLARE_CCTK_FUNCTIONS + DECLARE_CCTK_PARAMETERS + + CCTK_REAL, parameter :: zero = 0.0 + integer, parameter :: wp = kind(zero) + CCTK_INT, intent(IN) :: ni, nj, nk + CCTK_REAL, dimension(ni,nj,nk), intent(IN) :: var + CCTK_INT, intent(IN) :: dir + CCTK_INT, intent(IN) :: bb(2) + CCTK_INT, intent(IN) :: gsize + CCTK_REAL, intent(IN) :: delta + CCTK_INT, intent(IN) :: up + CCTK_REAL, dimension(ni,nj,nk), intent(OUT) :: dvar + + CCTK_REAL, dimension(-3:3), save :: a1, a2 + CCTK_REAL, dimension(-3:3), save :: a + CCTK_REAL, dimension(9,6), save :: q1, q2 + CCTK_REAL, dimension(9,6), save :: q + CCTK_REAL :: idel + + CCTK_INT :: il, ir, jl, jr, kl, kr + + logical, save :: first = .true. + + if ( first ) then + a1(-3) = -0.03333333333333333333333333333333333333333_wp + a1(-2) = 0.2500000000000000000000000000000000000000_wp + a1(-1) = -1.000000000000000000000000000000000000000_wp + a1(0) = 0.3333333333333333333333333333333333333333_wp + a1(1) = 0.5000000000000000000000000000000000000000_wp + a1(2) = -0.05000000000000000000000000000000000000000_wp + a1(3) = 0_wp + + q1(1,1) = -1.529782401641145871492417026888416733827_wp + q1(2,1) = 1.875173434574214612019635448027523684006_wp + q1(3,1) = 0.01654806207923748080513710988516743214616_wp + q1(4,1) = -0.5028607772715413996090537489364770622056_wp + q1(5,1) = 0.1042956382142412661862395105494407610836_wp + q1(6,1) = 0.03662604404499391209045870736276191879693_wp + q1(7,1) = 0_wp + q1(8,1) = 0_wp + q1(9,1) = 0_wp + q1(1,2) = -0.4980311697078740570957463452947252270539_wp + q1(2,2) = 0.1198701406809289935902771997003246482977_wp + q1(3,2) = 0.1435237728855054645449658808725554143554_wp + q1(4,2) = 0.3305195343366502157809026121276381376866_wp + q1(5,2) = -0.08093510151416251407907993920061497636080_wp + q1(6,2) = -0.01494717668104810274131940820517799692506_wp + q1(7,2) = 0_wp + q1(8,2) = 0_wp + q1(9,2) = 0_wp + q1(1,3) = 0.1510193840162481602541749755506215314879_wp + q1(2,3) = -0.9553948881729209047544587102401343033294_wp + q1(3,3) = 0.5046108447067502766506824050165990409443_wp + q1(4,3) = 0.2083429547547929960329552908847933822643_wp + q1(5,3) = 0.1359641889806059957290021663880456685165_wp + q1(6,3) = -0.04454248428547652391235612759992531988360_wp + q1(7,3) = 0_wp + q1(8,3) = 0_wp + q1(9,3) = 0_wp + q1(1,4) = 0.1012044551031772450693035010120167087525_wp + q1(2,4) = -0.2092303756284921666519857323651163414844_wp + q1(3,4) = -0.5084563818511371174184254139930350549204_wp + q1(4,4) = 0.2687068482925919014741556260496361261429_wp + q1(5,4) = 0.3188546759663099905683904142802147346506_wp + q1(6,4) = 0.02892077811755014695856160501628382685880_wp + q1(7,4) = 0_wp + q1(8,4) = 0_wp + q1(9,4) = 0_wp + q1(1,5) = -0.03614399304268576976452921364705641609825_wp + q1(2,5) = 0.08686979490791345456798112347556020198327_wp + q1(3,5) = 0.1257842030401363832877174373294422223313_wp + q1(4,5) = -0.9822882337192980168734300444655759205262_wp + q1(5,5) = 0.3656214294782277516821124793703186492319_wp + q1(6,5) = 0.4950000137574403598524650898428590604628_wp + q1(7,5) = -0.05484321442173416275231687190554779738479_wp + q1(8,5) = 0_wp + q1(9,5) = 0_wp + q1(1,6) = -0.01141318406360863692889821914555232596651_wp + q1(2,6) = 0.02049729840293952857599941220163960606616_wp + q1(3,6) = -0.005307030684704263298464084855734448481896_wp + q1(4,6) = 0.1618715440442110368368458160128159110211_wp + q1(5,6) = -0.9382337284956231267046263227657132050941_wp + q1(6,6) = 0.3287596173603342389443163398095933882788_wp + q1(7,6) = 0.4931394260405013584164745097143900824182_wp + q1(8,6) = -0.04931394260405013584164745097143900824182_wp + q1(9,6) = 0_wp + + a2(-3) = 0_wp + a2(-2) = 0.05000000000000000000000000000000000000000_wp + a2(-1) = -0.5000000000000000000000000000000000000000_wp + a2(0) = -0.3333333333333333333333333333333333333333_wp + a2(1) = 1.000000000000000000000000000000000000000_wp + a2(2) = -0.2500000000000000000000000000000000000000_wp + a2(3) = 0.03333333333333333333333333333333333333333_wp + + q2(1,1) = -1.635284636237086966078100959777273060297_wp + q2(2,1) = 2.191680138362037895776687246694092663418_wp + q2(3,1) = -0.2999586417085858029519146887814015472662_wp + q2(4,1) = -0.3973585426756003050233698160476207357348_wp + q2(5,1) = 0.1042956382142412661862395105494407610836_wp + q2(6,1) = 0.03662604404499391209045870736276191879693_wp + q2(7,1) = 0_wp + q2(8,1) = 0_wp + q2(9,1) = 0_wp + q2(1,2) = -0.4261090852993166609415800254745304380753_wp + q2(2,2) = -0.1198701406809289935902771997003246482977_wp + q2(3,2) = 0.4312121105197350491616311601533345702699_wp + q2(4,2) = 0.1866753655195354234725699724872485597294_wp + q2(5,2) = -0.05696107337797671536102449926055004670126_wp + q2(6,2) = -0.01494717668104810274131940820517799692506_wp + q2(7,2) = 0_wp + q2(8,2) = 0_wp + q2(9,2) = 0_wp + q2(1,3) = -0.008331409049041400793408941823041323547141_wp + q2(2,3) = -0.3179917159117626605641230407454828831892_wp + q2(3,3) = -0.5046108447067502766506824050165990409443_wp + q2(4,3) = 1.005096920081240801270874877753107657440_wp + q2(5,3) = -0.1827373971499731263661656683592800415536_wp + q2(6,3) = 0.008574446736286663103505178191295631794744_wp + q2(7,3) = 0_wp + q2(8,3) = 0_wp + q2(9,3) = 0_wp + q2(1,4) = 0.1280751399324364352167190636169803213668_wp + q2(2,4) = -0.3704544846040473075364791079948980171701_wp + q2(3,4) = -0.1053961094122492652071919749185808657060_wp + q2(4,4) = -0.2687068482925919014741556260496361261429_wp + q2(5,4) = 0.7219149484051978427796238533546689238650_wp + q2(6,4) = -0.1323033308580049939259317706134978488270_wp + q2(7,4) = 0.02687068482925919014741556260496361261429_wp + q2(8,4) = 0_wp + q2(9,4) = 0_wp + q2(1,5) = -0.03614399304268576976452921364705641609825_wp + q2(2,5) = 0.1234319378557362297361923714125920669065_wp + q2(3,5) = -0.09358865464680026772155005029274896720786_wp + q2(4,5) = -0.4338560895019563893502613254100979466783_wp + q2(5,5) = -0.3656214294782277516821124793703186492319_wp + q2(6,5) = 1.043432157974781987375633808898337034311_wp + q2(7,5) = -0.2742160721086708137615843595277389869240_wp + q2(8,5) = 0.03656214294782277516821124793703186492319_wp + q2(9,5) = 0_wp + q2(1,6) = -0.01141318406360863692889821914555232596651_wp + q2(2,6) = 0.02049729840293952857599941220163960606616_wp + q2(3,6) = 0.02756893105132916059596754912522489034598_wp + q2(4,6) = -0.03538422637198950652974398787294012194614_wp + q2(5,6) = -0.4450943024551217682881518130513231226759_wp + q2(6,6) = -0.3287596173603342389443163398095933882788_wp + q2(7,6) = 0.9862788520810027168329490194287801648364_wp + q2(8,6) = -0.2465697130202506792082372548571950412091_wp + q2(9,6) = 0.03287596173603342389443163398095933882788_wp + + first = .false. + end if + + idel = 1.0_wp / delta + + upwinding: select case (up) + case (-1) upwinding + a = a1 + case (1) upwinding + a = a2 + end select upwinding + + direction: select case (dir) + case (0) direction + if ( bb(1) == 0 ) then + il = 1 + gsize + else + upwinding_xl: select case (up) + case (-1) upwinding_xl + q = q1 + case (1) upwinding_xl + q = q2 + end select upwinding_xl + + dvar(1,:,:) = ( q(1,1) * var(1,:,:) + q(2,1) * var(2,:,:) + & + q(3,1) * var(3,:,:) + q(4,1) * var(4,:,:) + & + q(5,1) * var(5,:,:) + q(6,1) * var(6,:,:) ) * idel + dvar(2,:,:) = ( q(1,2) * var(1,:,:) + q(2,2) * var(2,:,:) + & + q(3,2) * var(3,:,:) + q(4,2) * var(4,:,:) + & + q(5,2) * var(5,:,:) + q(6,2) * var(6,:,:) ) * idel + dvar(3,:,:) = ( q(1,3) * var(1,:,:) + q(2,3) * var(2,:,:) + & + q(3,3) * var(3,:,:) + q(4,3) * var(4,:,:) + & + q(5,3) * var(5,:,:) + q(6,3) * var(6,:,:) ) * idel + dvar(4,:,:) = ( q(1,4) * var(1,:,:) + q(2,4) * var(2,:,:) + & + q(3,4) * var(3,:,:) + q(4,4) * var(4,:,:) + & + q(5,4) * var(5,:,:) + q(6,4) * var(6,:,:) + & + q(7,4) * var(7,:,:) ) * idel + dvar(5,:,:) = ( q(1,5) * var(1,:,:) + q(2,5) * var(2,:,:) + & + q(3,5) * var(3,:,:) + q(4,5) * var(4,:,:) + & + q(5,5) * var(5,:,:) + q(6,5) * var(6,:,:) + & + q(7,5) * var(7,:,:) + q(8,5) * var(8,:,:) ) * idel + dvar(6,:,:) = ( q(1,6) * var(1,:,:) + q(2,6) * var(2,:,:) + & + q(3,6) * var(3,:,:) + q(4,6) * var(4,:,:) + & + q(5,6) * var(5,:,:) + q(6,6) * var(6,:,:) + & + q(7,6) * var(7,:,:) + q(8,6) * var(8,:,:) + & + q(9,6) * var(9,:,:) ) * idel + + il = 7 + end if + if ( bb(2) == 0 ) then + ir = ni - gsize + else + upwinding_xr: select case (up) + case (-1) upwinding_xr + q = q2 + case (1) upwinding_xr + q = q1 + end select upwinding_xr + + dvar(ni-5,:,:) = - ( q(1,6) * var(ni,:,:) + q(2,6) * var(ni-1,:,:) + & + q(3,6) * var(ni-2,:,:) + q(4,6) * var(ni-3,:,:) + & + q(5,6) * var(ni-4,:,:) + q(6,6) * var(ni-5,:,:) + & + q(7,6) * var(ni-6,:,:) + q(8,6) * var(ni-7,:,:) + & + q(9,6) * var(ni-8,:,:) ) * idel + dvar(ni-4,:,:) = - ( q(1,5) * var(ni,:,:) + q(2,5) * var(ni-1,:,:) + & + q(3,5) * var(ni-2,:,:) + q(4,5) * var(ni-3,:,:) + & + q(5,5) * var(ni-4,:,:) + q(6,5) * var(ni-5,:,:) + & + q(7,5) * var(ni-6,:,:) + & + q(8,5) * var(ni-7,:,:) ) * idel + dvar(ni-3,:,:) = - ( q(1,4) * var(ni,:,:) + q(2,4) * var(ni-1,:,:) + & + q(3,4) * var(ni-2,:,:) + q(4,4) * var(ni-3,:,:) + & + q(5,4) * var(ni-4,:,:) + q(6,4) * var(ni-5,:,:) + & + q(7,4) * var(ni-6,:,:) ) * idel + dvar(ni-2,:,:) = - ( q(1,3) * var(ni,:,:) + q(2,3) * var(ni-1,:,:) + & + q(3,3) * var(ni-2,:,:) + q(4,3) * var(ni-3,:,:) + & + q(5,3) * var(ni-4,:,:) + & + q(6,3) * var(ni-5,:,:) ) * idel + dvar(ni-1,:,:) = - ( q(1,2) * var(ni,:,:) + q(2,2) * var(ni-1,:,:) + & + q(3,2) * var(ni-2,:,:) + q(4,2) * var(ni-3,:,:) + & + q(5,2) * var(ni-4,:,:) + & + q(6,2) * var(ni-5,:,:) ) * idel + dvar(ni,:,:) = - ( q(1,1) * var(ni,:,:) + q(2,1) * var(ni-1,:,:) + & + q(3,1) * var(ni-2,:,:) + q(4,1) * var(ni-3,:,:) + & + q(5,1) * var(ni-4,:,:) + & + q(6,1) * var(ni-5,:,:) ) * idel + + ir = ni - 6 + end if + dvar(il:ir,:,:) = ( a(-3) * var(il-3:ir-3,:,:) + & + a(-2) * var(il-2:ir-2,:,:) + & + a(-1) * var(il-1:ir-1,:,:) + & + a(0) * var(il:ir,:,:) + & + a(1) * var(il+1:ir+1,:,:) + & + a(2) * var(il+2:ir+2,:,:) + & + a(3) * var(il+3:ir+3,:,:) ) * idel + case (1) direction + if ( zero_derivs_y /= 0 ) then + dvar = zero + else + if ( bb(1) == 0 ) then + jl = 1 + gsize + else + upwinding_yl: select case (up) + case (-1) upwinding_yl + q = q1 + case (1) upwinding_yl + q = q2 + end select upwinding_yl + + dvar(:,1,:) = ( q(1,1) * var(:,1,:) + q(2,1) * var(:,2,:) + & + q(3,1) * var(:,3,:) + q(4,1) * var(:,4,:) + & + q(5,1) * var(:,5,:) + q(6,1) * var(:,6,:) ) * idel + dvar(:,2,:) = ( q(1,2) * var(:,1,:) + q(2,2) * var(:,2,:) + & + q(3,2) * var(:,3,:) + q(4,2) * var(:,4,:) + & + q(5,2) * var(:,5,:) + q(6,2) * var(:,6,:) ) * idel + dvar(:,3,:) = ( q(1,3) * var(:,1,:) + q(2,3) * var(:,2,:) + & + q(3,3) * var(:,3,:) + q(4,3) * var(:,4,:) + & + q(5,3) * var(:,5,:) + q(6,3) * var(:,6,:) ) * idel + dvar(:,4,:) = ( q(1,4) * var(:,1,:) + q(2,4) * var(:,2,:) + & + q(3,4) * var(:,3,:) + q(4,4) * var(:,4,:) + & + q(5,4) * var(:,5,:) + q(6,4) * var(:,6,:) + & + q(7,4) * var(:,7,:) ) * idel + dvar(:,5,:) = ( q(1,5) * var(:,1,:) + q(2,5) * var(:,2,:) + & + q(3,5) * var(:,3,:) + q(4,5) * var(:,4,:) + & + q(5,5) * var(:,5,:) + q(6,5) * var(:,6,:) + & + q(7,5) * var(:,7,:) + q(8,5) * var(:,8,:) ) * idel + dvar(:,6,:) = ( q(1,6) * var(:,1,:) + q(2,6) * var(:,2,:) + & + q(3,6) * var(:,3,:) + q(4,6) * var(:,4,:) + & + q(5,6) * var(:,5,:) + q(6,6) * var(:,6,:) + & + q(7,6) * var(:,7,:) + q(8,6) * var(:,8,:) + & + q(9,6) * var(:,9,:) ) * idel + + jl = 7 + end if + if ( bb(2) == 0 ) then + jr = nj - gsize + else + upwinding_yr: select case (up) + case (-1) upwinding_yr + q = q2 + case (1) upwinding_yr + q = q1 + end select upwinding_yr + + dvar(:,nj-5,:) = - ( q(1,6) * var(:,nj,:) + q(2,6) * var(:,nj-1,:) + & + q(3,6) * var(:,nj-2,:) + q(4,6) * var(:,nj-3,:) + & + q(5,6) * var(:,nj-4,:) + q(6,6) * var(:,nj-5,:) + & + q(7,6) * var(:,nj-6,:) + q(8,6) * var(:,nj-7,:) + & + q(9,6) * var(:,nj-8,:) ) * idel + dvar(:,nj-4,:) = - ( q(1,5) * var(:,nj,:) + q(2,5) * var(:,nj-1,:) + & + q(3,5) * var(:,nj-2,:) + q(4,5) * var(:,nj-3,:) + & + q(5,5) * var(:,nj-4,:) + q(6,5) * var(:,nj-5,:) + & + q(7,5) * var(:,nj-6,:) + & + q(8,5) * var(:,nj-7,:) ) * idel + dvar(:,nj-3,:) = - ( q(1,4) * var(:,nj,:) + q(2,4) * var(:,nj-1,:) + & + q(3,4) * var(:,nj-2,:) + q(4,4) * var(:,nj-3,:) + & + q(5,4) * var(:,nj-4,:) + q(6,4) * var(:,nj-5,:) + & + q(7,4) * var(:,nj-6,:) ) * idel + dvar(:,nj-2,:) = - ( q(1,3) * var(:,nj,:) + q(2,3) * var(:,nj-1,:) + & + q(3,3) * var(:,nj-2,:) + q(4,3) * var(:,nj-3,:) + & + q(5,3) * var(:,nj-4,:) + & + q(6,3) * var(:,nj-5,:) ) * idel + dvar(:,nj-1,:) = - ( q(1,2) * var(:,nj,:) + q(2,2) * var(:,nj-1,:) + & + q(3,2) * var(:,nj-2,:) + q(4,2) * var(:,nj-3,:) + & + q(5,2) * var(:,nj-4,:) + & + q(6,2) * var(:,nj-5,:) ) * idel + dvar(:,nj,:) = - ( q(1,1) * var(:,nj,:) + q(2,1) * var(:,nj-1,:) + & + q(3,1) * var(:,nj-2,:) + q(4,1) * var(:,nj-3,:) + & + q(5,1) * var(:,nj-4,:) + & + q(6,1) * var(:,nj-5,:) ) * idel + + jr = nj - 6 + end if + dvar(:,jl:jr,:) = ( a(-3) * var(:,jl-3:jr-3,:) + & + a(-2) * var(:,jl-2:jr-2,:) + & + a(-1) * var(:,jl-1:jr-1,:) + & + a(0) * var(:,jl:jr,:) + & + a(1) * var(:,jl+1:jr+1,:) + & + a(2) * var(:,jl+2:jr+2,:) + & + a(3) * var(:,jl+3:jr+3,:) ) * idel + end if + case (2) direction + if ( zero_derivs_z /= 0 ) then + dvar = zero + else + if ( bb(1) == 0 ) then + kl = 1 + gsize + else + upwinding_zl: select case (up) + case (-1) upwinding_zl + q = q1 + case (1) upwinding_zl + q = q2 + end select upwinding_zl + + dvar(:,:,1) = ( q(1,1) * var(:,:,1) + q(2,1) * var(:,:,2) + & + q(3,1) * var(:,:,3) + q(4,1) * var(:,:,4) + & + q(5,1) * var(:,:,5) + q(6,1) * var(:,:,6) ) * idel + dvar(:,:,2) = ( q(1,2) * var(:,:,1) + q(2,2) * var(:,:,2) + & + q(3,2) * var(:,:,3) + q(4,2) * var(:,:,4) + & + q(5,2) * var(:,:,5) + q(6,2) * var(:,:,6) ) * idel + dvar(:,:,3) = ( q(1,3) * var(:,:,1) + q(2,3) * var(:,:,2) + & + q(3,3) * var(:,:,3) + q(4,3) * var(:,:,4) + & + q(5,3) * var(:,:,5) + q(6,3) * var(:,:,6) ) * idel + dvar(:,:,4) = ( q(1,4) * var(:,:,1) + q(2,4) * var(:,:,2) + & + q(3,4) * var(:,:,3) + q(4,4) * var(:,:,4) + & + q(5,4) * var(:,:,5) + q(6,4) * var(:,:,6) + & + q(7,4) * var(:,:,7) ) * idel + dvar(:,:,5) = ( q(1,5) * var(:,:,1) + q(2,5) * var(:,:,2) + & + q(3,5) * var(:,:,3) + q(4,5) * var(:,:,4) + & + q(5,5) * var(:,:,5) + q(6,5) * var(:,:,6) + & + q(7,5) * var(:,:,7) + q(8,5) * var(:,:,8) ) * idel + dvar(:,:,6) = ( q(1,6) * var(:,:,1) + q(2,6) * var(:,:,2) + & + q(3,6) * var(:,:,3) + q(4,6) * var(:,:,4) + & + q(5,6) * var(:,:,5) + q(6,6) * var(:,:,6) + & + q(7,6) * var(:,:,7) + q(8,6) * var(:,:,8) + & + q(9,6) * var(:,:,9) ) * idel + + kl = 7 + end if + if ( bb(2) == 0 ) then + kr = nk - gsize + else + upwinding_zr: select case (up) + case (-1) upwinding_zr + q = q2 + case (1) upwinding_zr + q = q1 + end select upwinding_zr + + dvar(:,:,nk-5) = - ( q(1,6) * var(:,:,nk) + q(2,6) * var(:,:,nk-1) + & + q(3,6) * var(:,:,nk-2) + q(4,6) * var(:,:,nk-3) + & + q(5,6) * var(:,:,nk-4) + q(6,6) * var(:,:,nk-5) + & + q(7,6) * var(:,:,nk-6) + q(8,6) * var(:,:,nk-7) + & + q(9,6) * var(:,:,nk-8) ) * idel + dvar(:,:,nk-4) = - ( q(1,5) * var(:,:,nk) + q(2,5) * var(:,:,nk-1) + & + q(3,5) * var(:,:,nk-2) + q(4,5) * var(:,:,nk-3) + & + q(5,5) * var(:,:,nk-4) + q(6,5) * var(:,:,nk-5) + & + q(7,5) * var(:,:,nk-6) + & + q(8,5) * var(:,:,nk-7) ) * idel + dvar(:,:,nk-3) = - ( q(1,4) * var(:,:,nk) + q(2,4) * var(:,:,nk-1) + & + q(3,4) * var(:,:,nk-2) + q(4,4) * var(:,:,nk-3) + & + q(5,4) * var(:,:,nk-4) + q(6,4) * var(:,:,nk-5) + & + q(7,4) * var(:,:,nk-6) ) * idel + dvar(:,:,nk-2) = - ( q(1,3) * var(:,:,nk) + q(2,3) * var(:,:,nk-1) + & + q(3,3) * var(:,:,nk-2) + q(4,3) * var(:,:,nk-3) + & + q(5,3) * var(:,:,nk-4) + & + q(6,3) * var(:,:,nk-5) ) * idel + dvar(:,:,nk-1) = - ( q(1,2) * var(:,:,nk) + q(2,2) * var(:,:,nk-1) + & + q(3,2) * var(:,:,nk-2) + q(4,2) * var(:,:,nk-3) + & + q(5,2) * var(:,:,nk-4) + & + q(6,2) * var(:,:,nk-5) ) * idel + dvar(:,:,nk) = - ( q(1,1) * var(:,:,nk) + q(2,1) * var(:,:,nk-1) + & + q(3,1) * var(:,:,nk-2) + q(4,1) * var(:,:,nk-3) + & + q(5,1) * var(:,:,nk-4) + & + q(6,1) * var(:,:,nk-5) ) * idel + + kr = nk - 6 + end if + dvar(:,:,kl:kr) = ( a(-3) * var(:,:,kl-3:kr-3) + & + a(-2) * var(:,:,kl-2:kr-2) + & + a(-1) * var(:,:,kl-1:kr-1) + & + a(0) * var(:,:,kl:kr) + & + a(1) * var(:,:,kl+1:kr+1) + & + a(2) * var(:,:,kl+2:kr+2) + & + a(3) * var(:,:,kl+3:kr+3) ) * idel + + end if + end select direction +end subroutine up_deriv_gf_6_3_opt |