Related
Hi I'm brand new in coding, and I am getting stuck every new line of code I try to write but hey its a learning process.
I'm doing a strategy based on the MACD variables.
-MACD_Line is either positive or negative.
-Signal_Line is either positive or negative.
-Histogram is either positive or negative.
Based on the historical prices there are 6 possibilities of combined signals either: ---, -++, --+, +--, ++- or +++.
What I want to do is pre-set different position sizes depending on these 6 possible output signals.
So for example: if "---" then short 50% of equity,
if "+++" then long 100% of equity,
if "-++" then short 25% of equity.
Therefore the equity position would change after one of the initial 3 variables changes.
My attempt:
strategy("HIST", overlay= false, initial_capital = 1, default_qty_type= strategy.percent_of_equity, default_qty_value= 100 )
//time inputs
startDate = input(title="Start Date", type=input.integer, defval=1, minval=1, maxval=31)
startMonth = input(title="Start Month", type=input.integer, defval=1, minval=1, maxval=12)
startYear = input(title="Start Year", type=input.integer, defval=2014, minval=1800, maxval=2100)
endDate = input(title="End Date", type=input.integer, defval=29, minval=1, maxval=31)
endMonth = input(title="End Month", type=input.integer, defval=3, minval=1, maxval=12)
endYear = input(title="End Year", type=input.integer, defval=2021, minval=1800, maxval=2100)
inDateRange = (time >= timestamp(syminfo.timezone, startYear, startMonth, startDate, 0, 0)) and
(time < timestamp(syminfo.timezone, endYear, endMonth, endDate, 0, 0))
//variable
ema26= ema(close,26)
ema12= ema(close,12 )
macdl= ema12-ema26
signal= ema(macdl, 9)
hist= macdl-signal
enterLong = crossover(macdl,0)
enterShort = crossunder(macdl,0)
s000 = if (hist <= 0 and macdl <= 0 and signal <=0)
s001 = if (hist > 0 and macdl <= 0 and signal <= 0)
s011 = if (hist > 0 and macdl > 0 and signal <= 0)
s111 = if (hist > 0 and macdl > 0 and signal > 0)
s011 = if (hist <= 0 and macdl > 0 signal > 0)
s001 = if (hist <= 0 and macdl <= 0 signal > 0)
if (inDateRange and s111)
strategy.entry(id="+", long=true)
if (inDateRange and s000)
strategy.entry(id="-", long=false)
if (not inDateRange)
strategy.close_all()
This should get you started in the right direction. You'll need to finish coding all the conditions yourself. See comments in code:
//#version=4
strategy("HIST", overlay= false, initial_capital = 1, default_qty_type= strategy.percent_of_equity, default_qty_value= 100 )
//time inputs
startDate = input(title="Start Date", type=input.integer, defval=1, minval=1, maxval=31)
startMonth = input(title="Start Month", type=input.integer, defval=1, minval=1, maxval=12)
startYear = input(title="Start Year", type=input.integer, defval=2014, minval=1800, maxval=2100)
endDate = input(title="End Date", type=input.integer, defval=29, minval=1, maxval=31)
endMonth = input(title="End Month", type=input.integer, defval=3, minval=1, maxval=12)
endYear = input(title="End Year", type=input.integer, defval=2021, minval=1800, maxval=2100)
inDateRange = (time >= timestamp(syminfo.timezone, startYear, startMonth, startDate, 0, 0)) and
(time < timestamp(syminfo.timezone, endYear, endMonth, endDate, 0, 0))
//variable
ema26= ema(close,26)
ema12= ema(close,12 )
macdl= ema12-ema26
signal= ema(macdl, 9)
hist= macdl-signal
enterLong = crossover(macdl,0)
enterShort = crossunder(macdl,0)
// Two last var names clashed with others, so used "X" in them.
s000 = hist <= 0 and macdl <= 0 and signal <= 0
s001 = hist > 0 and macdl <= 0 and signal <= 0
s011 = hist > 0 and macdl > 0 and signal <= 0
s111 = hist > 0 and macdl > 0 and signal > 0
s01X = hist <= 0 and macdl > 0 and signal > 0
s00X = hist <= 0 and macdl <= 0 and signal > 0
// Detect changes in conditions.
f_changeIn(_cond) => _cond and not _cond[1]
c000 = f_changeIn(s000)
c001 = f_changeIn(s001)
c011 = f_changeIn(s011)
c111 = f_changeIn(s111)
c01X = f_changeIn(s01X)
c00X = f_changeIn(s00X)
// Functions calculates position size from a % (0 - 1.0).
f_positionSize(_percentEquity) => strategy.equity * _percentEquity / close
// Generate orders on trasitions into conditions.
float positionSize = na
if inDateRange
if c000
positionSize := f_positionSize(0.5)
strategy.entry(id="+", long=false, qty = positionSize)
else if c011
positionSize := f_positionSize(1.0)
strategy.entry(id="+", long=false, qty = positionSize)
else if c111
positionSize := f_positionSize(1.0)
strategy.entry(id="+", long=true, qty = positionSize)
else
strategy.close_all()
// For debugging.
plot(positionSize, "Position size", color.orange, 2, plot.style_circles)
I'm trying to implemenet an assignment problem. I have the following problem when trying to multiply two variables in linear programming (using glpk gusek) in my goal function:
minimize PATH_COST: sum{k in Rodzaj_Transportu}(sum{z in numery_Zlecen}Koszty_Suma[k,z])*y[k,z]; #y is a binary variable; Koszty_Suma is total cost for ordez z and car type k
The following error is arising: "model.mod:47: multiplication of linear forms not allowed".
Code (.dat file):
data;
set numery_Zlecen := 1, 2, 3; #order numbers
set Miasta := '*some data: *' #cities.
#order numer (from city to city)
set Zlecenie[1] := Warszawa Paris;
set Zlecenie[2] := Berlin Praha;
set Zlecenie[3] := Praha Amsterdam;
#number of packages for transport for a particular order
param Ilosc_Wyrobow :=
1 10
2 50
3 110;
param Godziny_Pracy := 9; #number of working hours during the day
param Pojemnosc_Samochodu := 35; #capacity of the car (how many packages it can take)
param Srednia_Predkosc := 80; #average car speed
param Spalenie_Paliwa := 0.25; #fuel combustion
param Wynagrodzenie_za_Godzine := 20; #salary for one working hour
param Cena_Noclegu := 100; #price of accommodation
param Dystans: '*some data: *' #km between cities.
param Koszt_Paliwa : '*some data: *' #fuel consumption depends on country.
end;
Code (.mod file):
#INDEXY
#=====================================================================
set Miasta; #i,j
set numery_Zlecen; #z
set Zlecenie{numery_Zlecen} dimen 2; #p,q
set Rodzaj_Transportu; #k
#PARAMETRY
#=====================================================================
param Dystans {Miasta,Miasta};
param Ilosc_Wyrobow{numery_Zlecen};
param Godziny_Pracy >= 0;
param Pojemnosc_Samochodu {Rodzaj_Transportu}>= 0;
param Srednia_Predkosc >=0;
param Spalenie_Paliwa >=0;
param Koszt_Paliwa {Miasta,Miasta};
param Wynagrodzenie_za_Godzine >= 0;
param Cena_Noclegu >= 0;
#ZMIENE
#=====================================================================
var x{Miasta,Miasta,numery_Zlecen} <= 1, >= 0; #variable x equal 1 when we're going the path from city A to city B; otherwise it equals 0
var y{Rodzaj_Transportu,numery_Zlecen} binary <=1, >=0; #variable that shows what types of car/s we are using for order (can be 0 or 1)
var Koszty_Suma{Rodzaj_Transportu,numery_Zlecen}; #total costs
var Koszty_Transportu{numery_Zlecen}; #transport costs
var Koszty_Odpoczynku{numery_Zlecen}; #rest costs
var Koszty_Wynagrodzenia{numery_Zlecen}; #salary costs
#FUNKCjA CELU
#=====================================================================
minimize PATH_COST: sum{k in Rodzaj_Transportu}(sum{z in numery_Zlecen}Koszty_Suma[k,z])*y[k,z];
#OGRANICZENIA (constraints)
#=====================================================================
s.t. SOURCE{z in numery_Zlecen, (p,q) in Zlecenie[z], i in Miasta: i = p && p != q}:
sum {j in Miasta} (x[i ,j ,z ]) - sum {j in Miasta}( x[j ,i ,z ]) = 1;
s.t. INTERNAL {z in numery_Zlecen, (p,q) in Zlecenie[z],i in Miasta: i != p && i != q && p != q }:
sum {j in Miasta} (x[i ,j ,z ]) - sum {j in Miasta}( x[j ,i ,z ]) = 0;
s.t. OGR_KM_DZIEN{z in numery_Zlecen,(p,q) in Zlecenie[z], j in Miasta, i in Miasta: i != q}:
if (Dystans[i,j] > (Godziny_Pracy*Srednia_Predkosc)) and i != q then x[i,j,z] = 0;
s.t. OGR_KOSZTY_SUMA{z in numery_Zlecen, k in Rodzaj_Transportu}:
Koszty_Suma[k,z] = (Koszty_Transportu[z] + Koszty_Odpoczynku[z] + Koszty_Wynagrodzenia[z])*ceil(Ilosc_Wyrobow[z]/Pojemnosc_Samochodu[k]);
s.t. OGR_KOSZTY_TRANSPORTU{z in numery_Zlecen}:
Koszty_Transportu[z] = (sum{i in Miasta} (sum{j in Miasta} ( Dystans[i,j]*x[i,j, z]*Koszt_Paliwa[i,j] ) ))*Spalenie_Paliwa;
s.t. OGR_KOSZTY_ODPOCZYNKU{z in numery_Zlecen}:
Koszty_Odpoczynku[z] =
(sum{i in Miasta} (sum{j in Miasta} ( Dystans[i,j]*x[i,j, z] ) ))/(Godziny_Pracy*Srednia_Predkosc) * Cena_Noclegu;
s.t. OGR_KOSZTY_WYNAGRODZENIA{z in numery_Zlecen}:
Koszty_Wynagrodzenia[z] =
((sum{i in Miasta} (sum{j in Miasta} ( Dystans[i,j]*x[i,j, z] ) ))/(Srednia_Predkosc)) * Wynagrodzenie_za_Godzine;
s.t. OGR_Y_JEDEN{z in numery_Zlecen}:
sum{k in Rodzaj_Transportu}(y[k,z]) = 1;
solve;
How is it possible to get rid of this error? Any hints how to solve this kind of problem are welcome.
First I think the parentheses are incorrect (note that y[k,z] depends on z). The expression
sum{k in Rodzaj_Transportu}(sum{z in numery_Zlecen}Koszty_Suma[k,z])*y[k,z];
is not mathematically correct. So, I assume what you meant is:
sum{k in Rodzaj_Transportu}(sum{z in numery_Zlecen}Koszty_Suma[k,z]*y[k,z]);
Let me restate the problem a little bit. I assume we can write this as:
sum((i,j), x[i,j]*y[i,j])
with y a binary variable and x a continuous variable. I also assume 0 <= x[i,j] <= U[i,j]. (U is an upper bound).
Here is a way to linearize this quadratic term. We can introduce a variable z[i,j]=x[i,j]*y[i,j] using the following inequalities:
z[i,j] <= U[i,j]*y[i,j]
z[i,j] <= x[i,j]
z[i,j] >= x[i,j]-U[i,j]*(1-y[i,j])
0 <= z[i,j] <= U[i,j]
Now you just can minimize sum((i,j),z[i,j]). For a similar linearization see link.
I was writing code to use Fortran Eispack routines (compute eigenvalues and eigenvectors, just to check if the values would be different from the ones I got from Matlab), but every time it calls the qzhes subroutine the program hangs.
I load matrixes from files.
Tried commenting the call, and it works without an issue.
I just learned Fortran, and with the help of the internet I wrote this code (which compiles and run):
program qz
IMPLICIT NONE
INTEGER:: divm, i, divg
INTEGER(kind=4) :: dimen
LOGICAL :: matz
REAL(kind = 8), DIMENSION(:,:), ALLOCATABLE:: ma
REAL(kind = 8), DIMENSION(:), ALLOCATABLE:: tabm
REAL(kind = 8), DIMENSION(:,:), ALLOCATABLE:: ga
REAL(kind = 8), DIMENSION(:), ALLOCATABLE:: tabg
REAL(kind = 8), DIMENSION(:,:), ALLOCATABLE:: zet
divm = 1
divg = 2
dimen = 20
matz = .TRUE.
ALLOCATE(ma(1:dimen,1:dimen))
ALLOCATE(tabm(1:dimen))
ALLOCATE(ga(1:dimen,1:dimen))
ALLOCATE(tabg(1:dimen))
OPEN(divm, FILE='Em.txt')
DO i=1,dimen
READ (divm,*) tabm
ma(1:dimen,i)=tabm
END DO
CLOSE(divm)
OPEN(divg, FILE='Gje.txt')
DO i=1,dimen
READ (divg,*) tabg
ga(1:dimen,i)=tabg
END DO
CLOSE(divg)
call qzhes(dimen, ma, ga, matz, zet)
OPEN(divm, FILE='Em2.txt')
DO i=1,dimen
tabm = ma(1:dimen,i)
WRITE (divm,*) tabm
END DO
CLOSE(divm)
OPEN(divg, FILE='Gje2.txt')
DO i=1,dimen
tabg = ga(1:dimen,i)
WRITE (divg,*) tabg
END DO
CLOSE(divg)
end program qz
...//EISPACK subrotines//...
Matrixes:
Gje.txt:https://drive.google.com/file/d/0BxH3QOkswLy_c2hmTGpGVUI3NzQ/view?usp=sharing
Em.txt:https://drive.google.com/file/d/0BxH3QOkswLy_OEtJUGQwN3ZXX2M/view?usp=sharing
Edit:
subroutine qzhes ( n, a, b, matz, z )
!*****************************************************************************80
!
!! QZHES carries out transformations for a generalized eigenvalue problem.
!
! Discussion:
!
! This subroutine is the first step of the QZ algorithm
! for solving generalized matrix eigenvalue problems.
!
! This subroutine accepts a pair of real general matrices and
! reduces one of them to upper Hessenberg form and the other
! to upper triangular form using orthogonal transformations.
! it is usually followed by QZIT, QZVAL and, possibly, QZVEC.
!
! Licensing:
!
! This code is distributed under the GNU LGPL license.
!
! Modified:
!
! 18 October 2009
!
! Author:
!
! Original FORTRAN77 version by Smith, Boyle, Dongarra, Garbow, Ikebe,
! Klema, Moler.
! FORTRAN90 version by John Burkardt.
!
! Reference:
!
! James Wilkinson, Christian Reinsch,
! Handbook for Automatic Computation,
! Volume II, Linear Algebra, Part 2,
! Springer, 1971,
! ISBN: 0387054146,
! LC: QA251.W67.
!
! Brian Smith, James Boyle, Jack Dongarra, Burton Garbow,
! Yasuhiko Ikebe, Virginia Klema, Cleve Moler,
! Matrix Eigensystem Routines, EISPACK Guide,
! Lecture Notes in Computer Science, Volume 6,
! Springer Verlag, 1976,
! ISBN13: 978-3540075462,
! LC: QA193.M37.
!
! Parameters:
!
! Input, integer ( kind = 4 ) N, the order of the matrices.
!
! Input/output, real ( kind = 8 ) A(N,N). On input, the first real general
! matrix. On output, A has been reduced to upper Hessenberg form. The
! elements below the first subdiagonal have been set to zero.
!
! Input/output, real ( kind = 8 ) B(N,N). On input, a real general matrix.
! On output, B has been reduced to upper triangular form. The elements
! below the main diagonal have been set to zero.
!
! Input, logical MATZ, should be TRUE if the right hand transformations
! are to be accumulated for later use in computing eigenvectors.
!
! Output, real ( kind = 8 ) Z(N,N), contains the product of the right hand
! transformations if MATZ is TRUE.
!
implicit none
integer ( kind = 4 ) n
real ( kind = 8 ) a(n,n)
real ( kind = 8 ) b(n,n)
integer ( kind = 4 ) i
integer ( kind = 4 ) j
integer ( kind = 4 ) k
integer ( kind = 4 ) l
integer ( kind = 4 ) l1
integer ( kind = 4 ) lb
logical matz
integer ( kind = 4 ) nk1
integer ( kind = 4 ) nm1
real ( kind = 8 ) r
real ( kind = 8 ) rho
real ( kind = 8 ) s
real ( kind = 8 ) t
real ( kind = 8 ) u1
real ( kind = 8 ) u2
real ( kind = 8 ) v1
real ( kind = 8 ) v2
real ( kind = 8 ) z(n,n)
!
! Set Z to the identity matrix.
!
if ( matz ) then
z(1:n,1:n) = 0.0D+00
do i = 1, n
z(i,i) = 1.0D+00
end do
end if
!
! Reduce B to upper triangular form.
!
if ( n <= 1 ) then
return
end if
nm1 = n - 1
do l = 1, n - 1
l1 = l + 1
s = sum ( abs ( b(l+1:n,l) ) )
if ( s /= 0.0D+00 ) then
s = s + abs ( b(l,l) )
b(l:n,l) = b(l:n,l) / s
r = sqrt ( sum ( b(l:n,l)**2 ) )
r = sign ( r, b(l,l) )
b(l,l) = b(l,l) + r
rho = r * b(l,l)
do j = l + 1, n
t = dot_product ( b(l:n,l), b(l:n,j) )
b(l:n,j) = b(l:n,j) - t * b(l:n,l) / rho
end do
do j = 1, n
t = dot_product ( b(l:n,l), a(l:n,j) )
a(l:n,j) = a(l:n,j) - t * b(l:n,l) / rho
end do
b(l,l) = - s * r
b(l+1:n,l) = 0.0D+00
end if
end do
!
! Reduce A to upper Hessenberg form, while keeping B triangular.
!
if ( n == 2 ) then
return
end if
do k = 1, n - 2
nk1 = nm1 - k
do lb = 1, nk1
l = n - lb
l1 = l + 1
!
! Zero A(l+1,k).
!
s = abs ( a(l,k) ) + abs ( a(l1,k) )
if ( s /= 0.0D+00 ) then
u1 = a(l,k) / s
u2 = a(l1,k) / s
r = sign ( sqrt ( u1**2 + u2**2 ), u1 )
v1 = - ( u1 + r) / r
v2 = - u2 / r
u2 = v2 / v1
do j = k, n
t = a(l,j) + u2 * a(l1,j)
a(l,j) = a(l,j) + t * v1
a(l1,j) = a(l1,j) + t * v2
end do
a(l1,k) = 0.0D+00
do j = l, n
t = b(l,j) + u2 * b(l1,j)
b(l,j) = b(l,j) + t * v1
b(l1,j) = b(l1,j) + t * v2
end do
!
! Zero B(l+1,l).
!
s = abs ( b(l1,l1) ) + abs ( b(l1,l) )
if ( s /= 0.0 ) then
u1 = b(l1,l1) / s
u2 = b(l1,l) / s
r = sign ( sqrt ( u1**2 + u2**2 ), u1 )
v1 = -( u1 + r ) / r
v2 = -u2 / r
u2 = v2 / v1
do i = 1, l1
t = b(i,l1) + u2 * b(i,l)
b(i,l1) = b(i,l1) + t * v1
b(i,l) = b(i,l) + t * v2
end do
b(l1,l) = 0.0D+00
do i = 1, n
t = a(i,l1) + u2 * a(i,l)
a(i,l1) = a(i,l1) + t * v1
a(i,l) = a(i,l) + t * v2
end do
if ( matz ) then
do i = 1, n
t = z(i,l1) + u2 * z(i,l)
z(i,l1) = z(i,l1) + t * v1
z(i,l) = z(i,l) + t * v2
end do
end if
end if
end if
end do
end do
return
end
I would expand the allocation Process
integer :: status1, status2, status3, status4, status5
! check the allocation, returnvalue 0 means ok
ALLOCATE(ma(1:dimen,1:dimen), stat=status1)
ALLOCATE(tabm(1:dimen), stat=status2)
ALLOCATE(ga(1:dimen,1:dimen), stat=status3)
ALLOCATE(tabg(1:dimen), stat=status4)
ALLOCATE(zet(1:dimen,1:dimen), stat=status5)
And at the end of the Program deallocate all arrays, because, you maybe have no memoryleak now, but if you put this program into a subroutine and use it several time with big matricies during a programrun, the program could leak some serious memory.
....
DO i=1,dimen
tabg = ga(1:dimen,i)
WRITE (divg,*) tabg
END DO
CLOSE(divg)
DEALLOCATE(ma, stat=status1)
DEALLOCATE(tabm, stat=status2)
DEALLOCATE(ga, stat=status3)
DEALLOCATE(tabg, stat=status4)
DEALLOCATE(zet, stat=status5)
You can check again with the status integer, if the deallocation was ok, returnvalue again 0.
I have a fortran77 reservoir simulation project ,and want to use openacc directive to accelerate implementation,the compiler is PGI visual fortran ,a subroutine as follow:
SUBROUTINE jbild(a, b, impl,
[ ia, ja, neqa, kvst, ka, ibkmax, nja, ndima, nbmxc,
[ isymm)
USE parameter_data
USE connect_data
USE contrl
IMPLICIT REAL*8(A-H,O-Z)
include 'eleme.com'
COMMON/G9/NEXG(MNOGN)
COMMON/shiftf/SFTMIN(mxcom)
COMMON/gm_nm/gamman(njamax)
common/jocab2/uf(3,ibnd+maxlay),flw(3),fsav(3,ibnd+maxlay)
[ ,fsum(3),fsums(3), fdsum(3), fdp(3), fdiag(3)
COMMON/well_1/iwell(mnel)
COMMON/well_2/pwell(mnogn),vol_w(mnogn)
COMMON/source/qm_bc(mxcom)
integer ndima, nbmxc, ibkmax, nja, impl(ibkmax),
[ ia(ibkmax+1), ja(nja), neqa(ibkmax), kvst(ibkmax+1),
[ ka( nja+1), isymm(nja)
double precision a(ndima), b(nbmxc)
double precision fdsav(mxcom),eps
parameter (eps=1.0d-300)
COMMON/scndv2/densn(maxnn,mxphs+1),accn(maxnn,mxcom),acck(mxcom),acck_All
double precision Epsilon1(mxphs), Epsilon2(mxphs)
IDiagonal_dominace = 1 !--- =1: JACOBI
do 1 i=1, ka( nja+1 ) ! ndima
a(i) = 0.0d0
1 continue
do 3 i = 1, kvst( ibkmax + 1) ! nbmxc
b(i) = 0.0d0
3 continue
EpsilonMax1 = 0.0
EpsilonMax2 = 0.0
NEpsilonMax1 = 1
NEpsilonMax2 = 1
do 1000 i=1, ibkmax
inode=i
imat=matx(i)
do iphas=1, nph
fsum(iphas) = 0.0d0
fsums(iphas) = 0.0d0
fdsum( iphas ) = 0.0d0
fdsav(iphas) = 0.0d0
do index=1, ia(i+1)-1 - ( ia(i) )
fsav(iphas, index) = 0.0d0
enddo
enddo
if(iwell(inode).eq.0) then
do iphas=1,mnph
qm_bc(iphas)=0.0d0
enddo
elseif(iwell(inode).eq.1) then
call bc_ev(INODE)
elseif(iwell(inode).eq.2) then
call bc_well(inode,ishift,ia, ja,nja)
endif
call eqnsa(INODE,IMAT,ishift)
jconet=0
do 12 index = ia(i)+1, ia(i+1)-1
id = ja( index )
jconet=jconet+1
if(dabs(gamman(index)).le.eps) goto 12
call eqnsf(INODE,id,imat,ishift,index,jconet,impl(i))
do 14 iphas = 1, mxphs
if( impl(i) .eq. 0 )then
a( ka(isymm(index)) + iphas ) = fdp( iphas )
else
fsav(iphas, jconet) = flw(iphas)
endif
14 continue
if( (impl(i) .eq. 0) .AND. (IDiagonal_dominace .eq. 1) )then !---
a( ka(isymm(index)) + 1 ) = fdp( 3 )
a( ka(isymm(index)) + 3 ) = fdp( 1 )
endif
12 continue
do 15 iphas = 1, mxphs
b( kvst(i) + iphas ) = -fsum( iphas )
if(EPSN1.GT.0.0.AND.EPSN2.GT.0.0) then !-- -----------------
Epsilon1(iphas) = abs(b( kvst(i) + iphas )/(acck_All+1.0D-20)) !---
Epsilon2(iphas) = abs(b( kvst(i) + iphas )) !---
if(EpsilonMax1(iphas).LT.Epsilon1(iphas)) then
EpsilonMax1(iphas) = Epsilon1(iphas)
NEpsilonMax1(iphas) = i
endif
if(EpsilonMax2(iphas).LT.Epsilon2(iphas)) then
EpsilonMax2(iphas) = Epsilon2(iphas)
NEpsilonMax2(iphas) = i
endif
endif !--------------------------
if( impl(i) .eq. 0) then
fdsav( iphas ) = fdiag( iphas)
else
fsums(iphas) = fsum(iphas)
fdsav(iphas) = fdiag(iphas)
endif
15 continue
if(IDiagonal_dominace.EQ.1)then !---
b( kvst(i) + 1 ) = -fsum( 3 )
b( kvst(i) + 3 ) = -fsum( 1 )
endif
do 2000 icol=1, nph
isave=1
ishift=1
call save_v(INODE,ISAVE,ICOL)
call shif(INODE,ICOL,stemp)
if( impl(i) .eq. 0)then
kupdat = 0
else
kupdat = 1
endif
if(MOP(10).NE.0) kupdat=0 !--- add by Diyuan, 2014-6-6
call eosms(inode,kupdat,b,kvst)
if(iwell(inode).eq.0) then
!$acc loop
do iphas=1,mnph
qm_bc(iphas)=0.0d0
enddo
elseif(iwell(inode).eq.1) then
call bc_ev(INODE)
elseif(iwell(inode).eq.2) then
call bc_well(inode,ishift,ia, ja,nja)
endif
call eqnsa(inode,IMAT,ishift)
if( impl(i) .eq. 0 ) go to 100
if( impl(i) .eq. 0 .and. icol .gt. 1) go to 100
jconet=0
do 150 index =ia(i)+1, ia(i+1)-1
id = ja( index )
jconet=jconet+1
if(dabs(gamman(index)).le.eps) goto 150
call save_tauf_C(idcon(index),1,ICOL)
call EOSMS_Connection(idcon(index),kupdat) !-- add by Diyuan, 2012-6-22
call eqnsf(INODE,id,imat,ishift,index,jconet,impl(i))
call save_tauf_C(idcon(index),2,ICOL)
do 101 irow=1,mxphs
if( impl(i) .eq. 1)then
a(ka(isymm(index))+(irow-1)*mxphs+icol) = +(flw(irow)-fsav(irow,jconet))/stemp
else
a(ka(isymm(index))+irow) = (flw(irow)-fsav(irow,jconet))/stemp
endif
101 continue
if(IDiagonal_dominace.EQ.1)then !---
a_temp = a(ka(isymm(index))+(1-1)*mxphs+icol)
a(ka(isymm(index))+(1-1)*mxphs+icol) = a(ka(isymm(index))+(3-1)*mxphs+icol)
a(ka(isymm(index))+(3-1)*mxphs+icol) = a_temp
endif
150 continue
100 continue
do 120 irow=1, mxphs
itemp = ka( ia(i) ) + (irow-1)* mxphs
if( impl(i) .eq. 0 ) then
a(itemp + icol) = ( fdiag(irow) - fdsav(irow) ) / stemp
if( icol .eq. 1)then
a( itemp + icol ) = a( itemp + icol ) + fdsum(irow)
endif
else
a(itemp+icol) = + (fsum(irow) - fsums(irow ))/ stemp
endif
120 continue
if(IDiagonal_dominace.EQ.1)then !---
itemp1 = ka( ia(i) ) + (1-1)* mxphs
itemp3 = ka( ia(i) ) + (3-1)* mxphs
a_temp = a(itemp1 + icol)
a(itemp1 + icol) = a(itemp3 + icol)
a(itemp3 + icol) = a_temp
endif
isave=2
call save_v(INODE,ISAVE,ICOL)
2000 continue
1000 continue
ishift=0
RETURN
END
But when I add the openacc directive ,I can’t see the output information and data replication information ,in console there isn’t also outputing kernel execution time information. I have set up the environment variables and command-line parameters to ensure that the information output. :
!$acc parallel loop
do iphas=1, nph
fsum(iphas) = 0.0d0
fsums(iphas) = 0.0d0
fdsum( iphas ) = 0.0d0
fdsav(iphas) = 0.0d0
do index=1, ia(i+1)-1 - ( ia(i) )
fsav(iphas, index) = 0.0d0
enddo
enddo
!$acc end parallel
The array store in .com file . I don’t know why the openacc has no effort ,and what impact the goto-statement have , would I like to delete goto-statement the program to modify the program for using openacc
I am trying to run a stress autocorrelation function code to calculate the stress autocorrelation function,then from there I would like to calculate viscosity using Green -Kubo equation. Now the Fortran code I have does not read out my stress data in order to calculate stress auot-correlarion function. Anyone can please help me with this. I have attached my code and data I want to correlate. Hope to here from you soon.
Here is the error
./a.out
**** Program Stress_autocorrelation ****
Calculation of time Correlation Functions
Enter data file name
DFILE
Enter results file name
RFILE
0.00000000
0.00000000
0.00000000
0.00000000
0.00000000
0.00000000
0.00000000
0.00000000
At line 106 of file main.f95 (unit = 10, file = 'DFILE')
Fortran runtime error: Bad value during floating point read
Code and below is Input data:
! Program to claculate pressure autocorrelation function
program stress_autocorrelation
implicit none
common / block1 / STORA, STORB, STORC, STORD,STORE,STORF,STORG, STORH, STORI
common / block2 / PA, PB, PC, PD, PE, PF, PG, PH , PI
common / block3 / PACF, ANORM
! *******************************************************************
! ............ PRINCIPAL VARIABLES............
!
! ** integer N Number of atoms
! ** integer NSTEP Number of steps on the tape
! ** integer IOR Interval for time origins
! ** integer NT Correlation length, Including T=0
! ** integer NTIMOR Number of time origin
! ** integer NLABEL Label for step (1,2,3.....Nstep)
!
!
! ** real PACF(NT) The pressure correlation function
! ** NSTEP and NT should be multiples of IOR.
! ** PA,PB,PC = Pxx,Pxy,Pxz
! ** PD,PE,PF = Pyx,Pyy,Pyz
! ** PG,PH,PI = Pzx,Pzy,Pzz
!
!
! ...............ROUTINES REFERENCED..........................
!
! ....Subroutine Store (J1)..........
!Routine to store the data for correlation
! .....Subroutine Corr (J1,J2,IT).........
!Routine to correlate the stored time origin
!
!
! .....................USAGE..............................
!
! Data in file DFILE on fortrran UNIT DUNIT
! Results in File RFILE on fortran UNIT RUNIT
! *******************************************************************
integer N, NSTEP, IOR, NT, NDIM, DUNIT, RUNIT, NTIMOR
integer FULLUP
parameter ( N = 78, NSTEP = 10, IOR = 4, NT = 8 )
parameter ( DUNIT = 10, RUNIT = 11 )
parameter ( NDIM = NT / IOR + 1, NTIMOR = NSTEP / IOR )
parameter ( FULLUP = NDIM - 1 )
real PA(N), PB(N), PC(N), PD(N), PE(N), PF(N), PG(N), PH(N), PI(N)
real STORA(NDIM,N), STORB(NDIM,N), STORC(NDIM,N),STORD(NDIM,N), STORE(NDIM,N),STORF(NDIM,N),STORG(NDIM,N),STORH(NDIM,N)
real STORI(NDIM,N)
REAL PACF(NT), ANORM(NT)
integer S(NTIMOR), TM(NTIMOR)
integer TS, TSS, L, NINCOR, K, R, JA, IB, IN, IA, JO, I
integer NLABEL
character DUMMY * 5
character DFILE * 115
character RFILE * 115
! *******************************************************************
write(*,'('' **** Program Stress_autocorrelation **** '')')
write(*,'('' Calculation of time Correlation Functions '')')
!.....READ IN FILE NAMES.........
write(*,'('' Enter data file name'')')
read (*,'(A)') DFILE
write (*,'('' Enter results file name'')')
read (*,'(A)') RFILE
!......INITIALIZE COUNTERS.......
NINCOR = FULLUP
JA = 1
IA = 1
IB = 1
!........ZERO ARRAYS.............
do 5 I = 1, NT
PACF(I) = 0.0
ANORM(I) = 0.0
write(*,*) PACF(I)
5 continue
!..........OPEN DATA FILE AND RESULTS FILE...........
open ( UNIT = DUNIT, FILE = DFILE, STATUS = 'OLD', FORM = 'FORMATTED')
open ( UNIT = RUNIT, FILE = RFILE, STATUS = 'NEW' )
!.........CALCULATION BEGINS............
do 40 L = 1, NTIMOR
JA = JA + 1
S(L) = JA - 1
read ( DUNIT, '(A5,I4)') DUMMY, NLABEL
do 7 R = 1, N
read (DUNIT,'(F9.6,8(9X,F9.6))')PA(R),PB(R),PC(R),PD(R),PE(R),PF(R),PG(R),PH(R),PI(R)
7 continue
TM(L) = NLABEL
write(*,*) TM(L)
!.......STORE STEP AS A TIME ORIGIN......
call STOREE ( JA )
!........CORRELATE THE ORIGINS IN STORE......
do 10 IN = IA, L
TSS = TM(L) - TM(IN)
TS = TSS + 1
JO = S(IN) + 1
call CORR ( JO, JA, TS )
10 continue
!Read IN data between time origins. This can
!Be conveniently stored IN element 1 of the
!Array storx etc. and can then ben correlated
!With the time origins
do 30 K = 1, IOR - 1
read ( DUNIT, '(A5,I4)') DUMMY, NLABEL
do 15 R = 1, N
read ( DUNIT,'(F17.14,8(13X,F17.14))')PA(R),PB(R),PC(R),PD(R),PE(R),PF(R),PG(R),PH(R),PI(R)
15 continue
call STOREE ( 1 )
do 20 IN = IA, L
TSS = NLABEL - TM(IN)
TS = TSS + 1
JO = S(IN) + 1
call CORR ( JO, 1, TS )
20 continue
30 continue
if ( L .GE. FULLUP ) then
if ( L .EQ. NINCOR ) then
NINCOR = NINCOR + FULLUP
JA = 1
endif
IA = IA + 1
endif
40 continue
close ( DUNIT )
!.....NORMALISE CORRELATION FUNCTIONS.......
PACF(1) = PACF(1) / ANORM(1) / REAL ( N )
do 50 I = 2, NT
PACF(I) = PACF(I) / ANORM(I) / REAL ( N ) / PACF(1)
50 continue
write ( RUNIT, '('' Pressure ACF '')')
write ( RUNIT, '(I6,E15.6)') ( I, PACF(I), I = 1, NT )
close ( RUNIT )
stop
end
subroutine STOREE ( J1 )
common / BLOCK1 / STORA, STORB, STORC, STORD,STORE,STORF,STORG,STORH,STORI
common/ BLOCK2 / PA, PB, PC, PD, PE, PF, PG, PH, PI
! *******************************************************************
!.........SUBROUTINE TO STORE TIME ORIGINS..............
! *******************************************************************
integer J1
integer N, NT, IOR, NDIM
parameter ( N = 78, NT = 8, IOR =4 )
parameter ( NDIM = NT / IOR + 1 )
real STORA(NDIM,N), STORB(NDIM,N), STORC(NDIM,N),STORD(NDIM,N)
real STORE(NDIM,N),STORF(NDIM,N),STORG(NDIM,N),STORH(NDIM,N),STORI(NDIM,N)
real PA(N), PB(N), PC(N), PD(N), PE(N), PF(N),PG(N), PH(N), PI(N)
integer I
do 10 I = 1, N
STORA(J1,I) = PA(I)
STORB(J1,I) = PB(I)
STORC(J1,I) = PC(I)
STORD(J1,I) = PD(I)
STORE(J1,I) = PE(I)
STORF(J1,I) = PF(I)
STORG(J1,I) = PG(I)
STORH(J1,I) = PH(I)
STORI(J1,I) = PI(I)
10 continue
return
end
subroutine CORR ( J1, J2, IT )
common / block1 / STORA, STORB, STORC, STORD,STORE,STORF,STORG,STORH,STORI
common/ block3 / PACF, ANORM
! *******************************************************************
!......SUBROUTINE TO CORRELATE TIME ORIGINS....
! *******************************************************************
integer J1, J2, IT
integer N, NT, IOR, NDIM
parameter ( N = 78, NT = 8, IOR = 4 )
parameter ( NDIM = NT / IOR + 1 )
real STORA(NDIM,N), STORB(NDIM,N), STORC(NDIM,N),STORD(NDIM,N)
real STORE(NDIM,N),STORF(NDIM,N),STORG(NDIM,N),STORH(NDIM,N),STORI(NDIM,N)
real PACF(NT), ANORM(NT)
integer I
!********************************************************************
do 10 I = 1, N
PACF(IT) = PACF(IT) + STORA(J1,I) * STORA(J2,I) &
+ STORB(J1,I) * STORB(J2,I) &
+ STORC(J1,I) * STORC(J2,I) &
+ STORD(J1,I) * STORD(J2,I) &
+ STORE(J1,I) * STORE(J2,I) &
+ STORF(J1,I) * STORF(J2,I) &
+ STORG(J1,I) * STORG(J2,I) &
+ STORH(J1,I) * STORH(J2,I) &
+ STORI(J1,I) * STORI(J2,I)
10 continue
ANORM(IT) = ANORM(IT) + 1.0
return
end
Data: has 9 columns
-9.568336E+00 -1.615161E+00 1.042644E+00 -1.615161E+00 -1.131916E+01 -6.979813E-01 1.042644E+00 -6.979813E-01 -1.182917E+01
-4.765572E-01 9.005122E-01 -2.282920E+00 9.005122E-01 -3.827857E+00 -3.206736E+00 -2.282920E+00 -3.206736E+00 -6.252462E+00
-1.012710E+01 4.672368E-01 8.791873E-02 4.672368E-01 -4.680832E+00 -5.271814E-01 8.791873E-02 -5.271814E-01 -1.898345E-01
-7.699012E+00 -9.906154E-01 7.450304E-01 -9.906154E-01 -1.061230E+00 -3.546956E+00 7.450304E-01 -3.546956E+00 -6.843898E+00
-3.544260E+00 4.254020E+00 -1.963602E+00 4.254020E+00 3.740858E+00 -4.587760E+00 -1.963602E+00 -4.587760E+00 -6.776258E+00
1.755595E-01 -9.625855E-01 -2.395960E+00 -9.625855E-01 -1.701399E+00 -8.483695E-01 -2.395960E+00 -8.483695E-01 -4.165223E+00
-3.244186E+00 5.540608E+00 -4.951768E-01 5.540608E+00 3.068601E+00 -1.613010E-01 -4.951768E-01 -1.613010E-01 -5.641277E+00
-8.985849E+00 1.870244E+00 -2.295795E-01 1.870244E+00 -4.635924E+00 -4.787461E+00 -2.295795E-01 -4.787461E+00 -3.014272E+00
-1.651073E-01 -6.326584E-01 -3.028051E+00 -6.326584E-01 -2.621833E+00 -2.640439E+00 -3.028051E+00 -2.640439E+00 1.668877E+00
1.250349E+00 3.054784E+00 -2.898975E+00 3.054784E+00 8.419503E-01 9.620184E-01 -2.898975E+00 9.620184E-01 1.479256E+00
-7.796195E-01 1.942983E+00 -2.736569E+00 1.942983E+00 6.073043E+00 -2.520281E+00 -2.736569E+00 -2.520281E+00 -9.600832E-01
4.697066E-01 3.138124E+00 -1.092573E+00 3.138124E+00 -2.099285E+00 -1.581031E+00 -1.092573E+00 -1.581031E+00 -6.285002E-01
3.017532E-01 -9.701574E-02 1.611936E+00 -9.701574E-02 -1.762075E+00 -3.401961E+00 1.611936E+00 -3.401961E+00 -6.889746E-01
1.177410E-01 5.090611E-01 1.452691E-01 5.090611E-01 5.695570E+00 -3.573245E+00 1.452691E-01 -3.573245E+00 -1.099615E+00
-5.180126E+00 -1.876409E-01 -2.067182E+00 -1.876409E-01 1.611177E+00 5.458450E-01 -2.067182E+00 5.458450E-01 1.026071E+00
1.477567E+00 1.598949E+00 -1.577546E+00 1.598949E+00 3.933810E+00 -2.698132E+00 -1.577546E+00 -2.698132E+00 3.485029E+00
-2.533324E+00 1.753033E+00 1.425241E-01 1.753033E+00 2.406501E+00 -1.147217E+00 1.425241E-01 -1.147217E+00 3.065603E-01
-2.360274E+00 1.312721E+00 -3.711419E-01 1.312721E+00 2.556935E+00 3.152605E-01 -3.711419E-01 3.152605E-01 3.378170E+00
-1.698217E+00 1.105760E+00 3.780822E-01 1.105760E+00 2.736574E+00 7.920578E-01 3.780822E-01 7.920578E-01 -6.596856E-01
-5.099544E+00 1.647542E-01 -1.036544E+00 1.647542E-01 3.845429E+00 -1.034068E+00 -1.036544E+00 -1.034068E+00 -3.152053E+00
-2.686567E+00 1.335786E+00 -1.889911E-01 1.335786E+00 9.755267E-01 9.322043E-01 -1.889911E-01 9.322043E-01 3.229615E-01
1.542994E-01 3.104663E+00 -1.634353E-01 3.104663E+00 4.090105E+00 -1.128244E+00 -1.634353E-01 -1.128244E+00 -2.909383E-01
-4.235419E-01 1.554157E+00 3.475430E+00 1.554157E+00 4.701173E+00 -1.789414E+00 3.475430E+00 -1.789414E+00 1.517218E+00
-8.054924E-01 -1.167935E+00 -1.123460E+00 -1.167935E+00 1.169303E+00 -2.171076E+00 -1.123460E+00 -2.171076E+00 -5.636150E+00