src/eccd.f90: remove caching functionality from eccdeff
The caching is cool, but it's implemented using static variables and therefore not thread-safe. Since the savings are pretty modest (about 20% of the total eccdeff calls, itself 3% of the total execution) let's just drop it.
This commit is contained in:
parent
ae6ac735e8
commit
9d09c99314
22
src/eccd.f90
22
src/eccd.f90
@ -718,7 +718,6 @@ contains
|
||||
! sfd(1),...,sfd(4) - coefficients of the polynomial expansion of the
|
||||
! "Spitzer"-function (the same as in the Hirshman paper)
|
||||
!=======================================================================
|
||||
use const_and_precisions, only : mc2_
|
||||
IMPLICIT NONE
|
||||
REAL(wp_), INTENT(in) :: mu,Zeff,fc
|
||||
INTEGER :: n,i,j
|
||||
@ -732,22 +731,6 @@ contains
|
||||
alp23,alp24,alp20, &
|
||||
alp34,alp30,alp40
|
||||
REAL(wp_) :: bet0,bet1,bet2,bet3,bet4,d0
|
||||
LOGICAL :: renew,rel,newmu,newZ,newfc
|
||||
REAL(wp_), SAVE :: sfdx(1:4) = 0
|
||||
REAL(wp_), SAVE :: mu_old =-1, Zeff_old =-1, fc_old =-1
|
||||
|
||||
rel = mu < mc2_
|
||||
newmu = abs(mu -mu_old ) > delta*mu
|
||||
newZ = abs(Zeff-Zeff_old) > delta*Zeff
|
||||
newfc = abs(fc -fc_old ) > delta*fc
|
||||
SELECT CASE(adj_appr(1))
|
||||
CASE ('l','c')
|
||||
renew = (newmu .and. rel) .OR. newZ .OR. newfc
|
||||
END SELECT
|
||||
IF (.not.renew) THEN
|
||||
sfd(:) = sfdx(:)
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
tn(:) = 0
|
||||
IF (adj_appr(4) == 'r') THEN
|
||||
@ -839,11 +822,6 @@ contains
|
||||
sfd(2) = bet2-alp20*d0-alp24*sfd(4)-alp23*sfd(3)
|
||||
sfd(1) = bet1-alp10*d0-alp14*sfd(4)-alp13*sfd(3)-alp12*sfd(2)
|
||||
|
||||
fc_old = fc
|
||||
mu_old = mu
|
||||
Zeff_old = Zeff
|
||||
sfdx(1:4) = sfd(1:4)
|
||||
|
||||
END SUBROUTINE SpitzFuncCoeff
|
||||
|
||||
SUBROUTINE SpitzFunc_HighSpeedLimit(Zeff,fc,u,q,gam, K,dKdu)
|
||||
|
Loading…
Reference in New Issue
Block a user