Skip to content

Commit 2c59868

Browse files
yantoscayantosca
committed
Remove commented-out BLAS calls in runge_kutta* integrators
int/runge_kutta_adj.f90 int/runge_kutta_tlm.f90 - Removed commented-out calls to BLAS routines Signed-off-by: Bob Yantosca <[email protected]>
1 parent 758f078 commit 2c59868

File tree

2 files changed

+0
-34
lines changed

2 files changed

+0
-34
lines changed

‎int/runge_kutta_adj.f90‎

Lines changed: 0 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -813,29 +813,22 @@ SUBROUTINE rk_DPush( T, H, Y, Zstage, NewIt, E1, E2 )!, Jcb )
813813
END IF
814814
chk_H( stack_ptr ) = H
815815
chk_T( stack_ptr ) = T
816-
! CALL WCOPY(NVAR,Y,1,chk_Y(1,stack_ptr),1)
817-
! CALL WCOPY(NVAR*3,Zstage,1,chk_Z(1,stack_ptr),1)
818816
chk_Y(1:N,stack_ptr) = Y(1:N)
819817
chk_Z(1:3*N,stack_ptr) = Zstage(1:3*N)
820818
chk_NiT( stack_ptr ) = NewIt
821819
IF (SaveLU) THEN
822820
#ifdef FULL_ALGEBRA
823-
! CALL WCOPY(NVAR*NVAR, E1,1,chk_E1(1,stack_ptr),1)
824-
! CALL WCOPYCmplx(NVAR*NVAR, E2,1,chk_E2(1,stack_ptr),1)
825821
DO j=1,NVAR
826822
DO i=1,NVAR
827823
chk_E1(NVAR*(j-1)+i,stack_ptr) = E1(i,j)
828824
chk_E2(NVAR*(j-1)+i,stack_ptr) = E2(i,j)
829825
END DO
830826
END DO
831827
#else
832-
! CALL WCOPY(LU_NONZERO, E1,1,chk_E1(1,stack_ptr),1)
833-
! CALL WCOPYCmplx(LU_NONZERO, E2,1,chk_E2(1,stack_ptr),1)
834828
chk_E1(1:LU_NONZERO,stack_ptr) = E1(1:LU_NONZERO)
835829
chk_E2(1:LU_NONZERO,stack_ptr) = E2(1:LU_NONZERO)
836830
#endif
837831
END IF
838-
!CALL WCOPY(LU_NONZERO,Jcb,1,chk_J(1,stack_ptr),1)
839832

840833
END SUBROUTINE rk_DPush
841834

@@ -863,29 +856,22 @@ SUBROUTINE rk_DPop( T, H, Y, Zstage, NewIt, E1, E2 ) !, Jcb )
863856
END IF
864857
H = chk_H( stack_ptr )
865858
T = chk_T( stack_ptr )
866-
! CALL WCOPY(NVAR,chk_Y(1,stack_ptr),1,Y,1)
867859
Y(1:NVAR) = chk_Y(1:NVAR,stack_ptr)
868-
! CALL WCOPY(NVAR*3,chk_Z(1,stack_ptr),1,Zstage,1)
869860
Zstage(1:3*NVAR) = chk_Z(1:3*NVAR,stack_ptr)
870861
NewIt = chk_NiT( stack_ptr )
871862
IF (SaveLU) THEN
872863
#ifdef FULL_ALGEBRA
873-
! CALL WCOPY(NVAR*NVAR,chk_E1(1,stack_ptr),1, E1,1)
874-
! CALL WCOPYCmplx(NVAR*NVAR,chk_E2(1,stack_ptr),1, E2,1)
875864
DO j=1,NVAR
876865
DO i=1,NVAR
877866
E1(i,j) = chk_E1(NVAR*(j-1)+i,stack_ptr)
878867
E2(i,j) = chk_E2(NVAR*(j-1)+i,stack_ptr)
879868
END DO
880869
END DO
881870
#else
882-
! CALL WCOPY(LU_NONZERO,chk_E1(1,stack_ptr),1, E1,1)
883-
! CALL WCOPYCmplx(LU_NONZERO,chk_E2(1,stack_ptr),1, E2,1)
884871
E1(1:LU_NONZERO) = chk_E1(1:LU_NONZERO,stack_ptr)
885872
E2(1:LU_NONZERO) = chk_E2(1:LU_NONZERO,stack_ptr)
886873
#endif
887874
END IF
888-
!CALL WCOPY(LU_NONZERO,chk_J(1,stack_ptr),1,Jcb,1)
889875

890876
stack_ptr = stack_ptr - 1
891877

@@ -906,9 +892,6 @@ SUBROUTINE rk_CPush(T, H, Y, dY, d2Y )
906892
END IF
907893
chk_H( stack_ptr ) = H
908894
chk_T( stack_ptr ) = T
909-
! CALL WCOPY(NVAR,Y,1,chk_Y(1,stack_ptr),1)
910-
! CALL WCOPY(NVAR,dY,1,chk_dY(1,stack_ptr),1)
911-
! CALL WCOPY(NVAR,d2Y,1,chk_d2Y(1,stack_ptr),1)
912895
chk_Y(1:NVAR,stack_ptr) = Y(1:NVAR)
913896
chk_dY(1:NVAR,stack_ptr) = dY(1:NVAR)
914897
chk_d2Y(1:NVAR,stack_ptr)= d2Y(1:NVAR)
@@ -930,9 +913,6 @@ SUBROUTINE rk_CPop( T, H, Y, dY, d2Y )
930913
END IF
931914
H = chk_H( stack_ptr )
932915
T = chk_T( stack_ptr )
933-
! CALL WCOPY(NVAR,chk_Y(1,stack_ptr),1,Y,1)
934-
! CALL WCOPY(NVAR,chk_dY(1,stack_ptr),1,dY,1)
935-
! CALL WCOPY(NVAR,chk_d2Y(1,stack_ptr),1,d2Y,1)
936916
Y(1:NVAR) = chk_Y(1:NVAR,stack_ptr)
937917
dY(1:NVAR) = chk_dY(1:NVAR,stack_ptr)
938918
d2Y(1:NVAR) = chk_d2Y(1:NVAR,stack_ptr)
@@ -1221,9 +1201,6 @@ SUBROUTINE RK_FwdIntegrator( N,Tstart,Tend,Y,AdjointType,IERR )
12211201
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
12221202
accept:IF (Err < ONE) THEN !~~~> STEP IS ACCEPTED
12231203
IF (AdjointType == KPP_ROOT_discrete) THEN ! Save stage solution
1224-
! CALL WCOPY(N,Z1,1,Zstage(1),1)
1225-
! CALL WCOPY(N,Z2,1,Zstage(N+1),1)
1226-
! CALL WCOPY(N,Z3,1,Zstage(2*N+1),1)
12271204
Zstage(1:N) = Z1(1:N)
12281205
Zstage(N+1:2*N) = Z2(1:N)
12291206
Zstage(2*N+1:3*N) = Z3(1:N)
@@ -1403,7 +1380,6 @@ SUBROUTINE rk_DadjInt( NADJ,Lambda,Tstart,Tend,T,IERR )
14031380
Jbig(i,i) = Jbig(i,i) + ONE
14041381
END DO
14051382
CALL DGETRF(3*N,3*N,Jbig,3*N,IPbig,ISING)
1406-
! CALL WGEFA(3*N,Jbig,IPbig,ISING)
14071383
IF (ISING /= 0) THEN
14081384
PRINT*,'Big guy is singular'; STOP
14091385
END IF
@@ -1440,7 +1416,6 @@ SUBROUTINE rk_DadjInt( NADJ,Lambda,Tstart,Tend,T,IERR )
14401416
DO i=1, 3*N
14411417
Jbig(i,i) = ONE + Jbig(i,i)
14421418
END DO
1443-
! CALL DGETRF(3*N,3*N,Jbig,3*N,IPbig,ISING)
14441419
CALL WGEFA(3*N,Jbig,IPbig,ISING)
14451420
IF (ISING /= 0) THEN
14461421
PRINT*,'Big guy is singular'; STOP
@@ -1453,9 +1428,6 @@ SUBROUTINE rk_DadjInt( NADJ,Lambda,Tstart,Tend,T,IERR )
14531428
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
14541429
Adj:DO iadj = 1, NADJ
14551430
!~~~> Starting values for Newton iteration
1456-
! CALL WCOPY(N,Lambda(1,iadj),1,U1(1,iadj),1)
1457-
! CALL WCOPY(N,Lambda(1,iadj),1,U2(1,iadj),1)
1458-
! CALL WCOPY(N,Lambda(1,iadj),1,U3(1,iadj),1)
14591431
U1(1:N,iadj) = 0.0_dp
14601432
U2(1:N,iadj) = 0.0_dp
14611433
U3(1:N,iadj) = 0.0_dp
@@ -1547,7 +1519,6 @@ SUBROUTINE rk_DadjInt( NADJ,Lambda,Tstart,Tend,T,IERR )
15471519
X(N+1:2*N) = -G2(1:N)
15481520
X(2*N+1:3*N) = -G3(1:N)
15491521
CALL DGETRS('T',3*N,1,Jbig,3*N,IPbig,X,3*N,ISING)
1550-
! CALL WGESL('T',3*N,Jbig,IPbig,X)
15511522
Lambda(1:N,iadj) = Lambda(1:N,iadj)+X(1:N)+X(N+1:2*N)+X(2*N+1:3*N)
15521523
#else
15531524
! Commented lines for sparse big algebra:
@@ -1560,7 +1531,6 @@ SUBROUTINE rk_DadjInt( NADJ,Lambda,Tstart,Tend,T,IERR )
15601531
X(1:N) = -G1(1:N)
15611532
X(N+1:2*N) = -G2(1:N)
15621533
X(2*N+1:3*N) = -G3(1:N)
1563-
! CALL DGETRS('T',3*N,1,Jbig,3*N,IPbig,X,3*N,ISING)
15641534
CALL WGESL('T',3*N,Jbig,IPbig,X)
15651535
Lambda(1:N,iadj) = Lambda(1:N,iadj)+X(1:N)+X(N+1:2*N)+X(2*N+1:3*N)
15661536
#endif

‎int/runge_kutta_tlm.f90‎

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -857,7 +857,6 @@ SUBROUTINE RK_IntegratorTLM( N,NTLM,T,Tend,Y,Y_tlm,IERR )
857857
Jbig(i,i) = ONE + Jbig(i,i)
858858
END DO
859859
!~~~> Solve the big system
860-
! CALL DGETRF(3*NVAR,3*NVAR,Jbig,3*NVAR,IPbig,j)
861860
CALL WGEFA(3*N,Jbig,IPbig,info)
862861
IF (info /= 0) THEN
863862
PRINT*,'Big big guy is singular'; STOP
@@ -869,7 +868,6 @@ SUBROUTINE RK_IntegratorTLM( N,NTLM,T,Tend,Y,Y_tlm,IERR )
869868
Zbig(2*NVAR+j) = Y_tlm(j,itlm)
870869
END DO
871870
Zbig = MATMUL(Ebig,Zbig)
872-
!CALL DGETRS ('N',3*NVAR,1,Jbig,3*NVAR,IPbig,Zbig,3*NVAR,ISING)
873871
CALL WGESL('N',3*N,Jbig,IPbig,Zbig)
874872
DO j=1,NVAR
875873
Z1_tlm(j,itlm) = Zbig(j)
@@ -911,7 +909,6 @@ SUBROUTINE RK_IntegratorTLM( N,NTLM,T,Tend,Y,Y_tlm,IERR )
911909
DO i=1, 3*N
912910
Jbig(i,i) = ONE + Jbig(i,i)
913911
END DO
914-
! CALL DGETRF(3*N,3*N,Jbig,3*N,IPbig,info)
915912
CALL WGEFA(3*N,Jbig,IPbig,info)
916913
IF (info /= 0) THEN
917914
PRINT*,'Big guy is singular'; STOP
@@ -931,7 +928,6 @@ SUBROUTINE RK_IntegratorTLM( N,NTLM,T,Tend,Y,Y_tlm,IERR )
931928
! Compute RHS
932929
CALL RK_PrepareRHS_TLMdirect(N,H,Jac1,Jac2,Jac3,Y_tlm(1,itlm),Zbig)
933930
! Solve the system
934-
! CALL DGETRS('N',3*N,1,Jbig,3*N,IPbig,Zbig,3*N,ISING)
935931
CALL WGESL('N',3*N,Jbig,IPbig,Zbig)
936932
Z1_tlm(1:NVAR,itlm) = Zbig(1:NVAR)
937933
Z2_tlm(1:NVAR,itlm) = Zbig(NVAR+1:2*NVAR)

0 commit comments

Comments
 (0)