Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Removed shared labels in do loops #43

Open
wants to merge 13 commits into
base: master
Choose a base branch
from
Open

Removed shared labels in do loops #43

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
13 commits
Select commit Hold shift + click to select a range
8508e65
Removed shared labels in do loops
bendudson Jul 19, 2023
8229a39
Remove DO termination statement warning from daux1
holm10 Oct 18, 2023
f7d0ad1
Fixes Shared DO termination label warnings in fmombal
holm10 Oct 18, 2023
eef5ee6
Remove DO termination statement warning from vodpk
holm10 Oct 18, 2023
e0997b9
Fixes Shared DO termination label warnings in inelrates
holm10 Oct 18, 2023
2259a12
Removes DO termination statement warning from inelrates
holm10 Oct 18, 2023
3de8a33
Remove DO termination statement warning from svrut3
holm10 Oct 18, 2023
ac7fcb7
Removes DO termination statement warning from nksol
holm10 Oct 18, 2023
0a4b4ab
Removes DO termination statement warning from daspk.m
holm10 Oct 18, 2023
bc8bf0d
Removes missed DO termination statement warning from daspk.m
holm10 Oct 18, 2023
5db73ee
Fixes Shared DO termination label warnings in flxcomp.m
holm10 Oct 18, 2023
30adb4a
Fixes DO-loop errors for comutil.m
holm10 Oct 19, 2023
8b9e3dd
Remove obsolete definition of condition in exmain.c
holm10 Oct 19, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
128 changes: 68 additions & 60 deletions api/fmombal.m
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -402,7 +402,7 @@ c AND U(1,1,alpha) MUST BE EXPRESSED IN TERMS OF AI, UBAR
amat(1+j,1+j) = one !totmass*anorm * fanorm
amat(2+j,2+j) = one !NOT USED FOR ANYTHING PHYSICAL
amat(3+j,3+j) = one !NOT USED FOR ANYTHING PHYSICAL
do 10 misa = 1,miso
do misa = 1,miso
nz = natom(misa)
dnur1 = (fanorm*denmass(misa,z1))*nurec(misa,z1)
c
Expand All @@ -424,14 +424,14 @@ c AND U(1,1,alpha) MUST BE EXPRESSED IN TERMS OF AI, UBAR
> rhomass*uresp(mflow,nzsum,misa,iacci)
enddo
i = KXA*(misa-1)
do 10 m = 1,KXA
do m = 1,KXA
if( (misa.ne.mise) .or. (m.ne.mflow) )then
sbar(m,misa) =
> sdot(nz,zi(misa,1),miso,uresp(m,z1,misa,iforc),KXA)
amat(m+i,1+j) =
> -sdot(nz,zi(misa,1),miso,uresp(m,z1,misa,iacci),KXA)
endif
do 10 mpmisb = 1,KXA*miso
do mpmisb = 1,KXA*miso
do nzb = 1,nz
usum(nzb) = uresp(m,nzb,misa,ilam1)*elab(ilam1,misa,mpmisb)
> + uresp(m,nzb,misa,ilam2)*elab(ilam2,misa,mpmisb)
Expand All @@ -450,7 +450,9 @@ c PERFORM SUMS OVER MISA (ISOTOPE MASS A)
> + (denmass(misa,nzsum)/totmass)*usum(nzsum)
enddo
endif
10 continue
end do
end do
end do
c
c ADD DIAGONAL ELEMENTS
c
Expand Down Expand Up @@ -694,43 +696,45 @@ real nuion(miso,0:nzch), nurec(miso,nzch),
acci = acci0*anorm
sumflow = 0.
sumaflow= 0.
do 55 misa = 1,miso
do misa = 1,miso
vtherm=sqrt(2.0*tempa(misa)/amu(misa)/promas)
do 55 m = 1,2 !Only look at flow, heat flow
if( m.eq.1 )then
write(*,500)m,amu(misa),sbar(m,misa),
> 1000.*tempa(misa)/xj7kv,vtherm,caplam(m,misa)
write(*,510)
if( misa.ne.1 )
> write(*,520)0,uneut(misa),den(misa,0),nuion(misa,0)
else if(m.eq.2)then
write(*,505)m,amu(misa),sbar(m,misa)
write(*,530)
endif
nzmax = natom(misa)
do 55 nz = 1,nzmax
force = fmom(m,nz,misa)
friction = zi(misa,nz) * ( ela(m,1,misa)*usol(1,nz,misa)
> + ela(m,2,misa)*usol(2,nz,misa)
> + ela(m,3,misa)*usol(3,nz,misa) + caplam(m,misa) )
friction = friction - denmass(misa,nz)*usol(m,nz,misa)*
> (nuion(misa,nz) + nurec(misa,nz))*al32(m)
if( nz.gt.1 )friction = friction + usol(m,nz-1,misa)
> *denmass(misa,nz-1) * nuion(misa,nz-1) * al32(m)
if( nz.lt.nzmax )friction = friction + usol(m,nz+1,misa)
> *denmass(misa,nz+1) * nurec(misa,nz+1) * al32(m)
if( m.eq.1 )then
force = force + denmass(misa,nz)*acci
sumflow = sumflow + denmass(misa,nz)*usol(1,nz,misa)
sumaflow= sumaflow+ denmass(misa,nz)*abs(usol(1,nz,misa))
write(*,550)nz,usol(m,nz,misa),force,friction,
> den(misa,nz),zi(misa,nz),nuion(misa,nz),nurec(misa,nz)
else if( m.eq.2 )then
pres = den(misa,nz)*tempa(misa)
write(*,550)nz,-2.5*usol(m,nz,misa)*pres,
> force,friction,gradp(misa,nz),den(misa,nz)*gradt(misa,nz)
endif
55 continue
do m = 1,2 !Only look at flow, heat flow
if( m.eq.1 )then
write(*,500)m,amu(misa),sbar(m,misa),
> 1000.*tempa(misa)/xj7kv,vtherm,caplam(m,misa)
write(*,510)
if( misa.ne.1 )
> write(*,520)0,uneut(misa),den(misa,0),nuion(misa,0)
else if(m.eq.2)then
write(*,505)m,amu(misa),sbar(m,misa)
write(*,530)
endif
nzmax = natom(misa)
do nz = 1,nzmax
force = fmom(m,nz,misa)
friction = zi(misa,nz) * ( ela(m,1,misa)*usol(1,nz,misa)
> + ela(m,2,misa)*usol(2,nz,misa)
> + ela(m,3,misa)*usol(3,nz,misa) + caplam(m,misa) )
friction = friction - denmass(misa,nz)*usol(m,nz,misa)*
> (nuion(misa,nz) + nurec(misa,nz))*al32(m)
if( nz.gt.1 )friction = friction + usol(m,nz-1,misa)
> *denmass(misa,nz-1) * nuion(misa,nz-1) * al32(m)
if( nz.lt.nzmax )friction = friction + usol(m,nz+1,misa)
> *denmass(misa,nz+1) * nurec(misa,nz+1) * al32(m)
if( m.eq.1 )then
force = force + denmass(misa,nz)*acci
sumflow = sumflow + denmass(misa,nz)*usol(1,nz,misa)
sumaflow= sumaflow+ denmass(misa,nz)*abs(usol(1,nz,misa))
write(*,550)nz,usol(m,nz,misa),force,friction,
> den(misa,nz),zi(misa,nz),nuion(misa,nz),nurec(misa,nz)
else if( m.eq.2 )then
pres = den(misa,nz)*tempa(misa)
write(*,550)nz,-2.5*usol(m,nz,misa)*pres,
> force,friction,gradp(misa,nz),den(misa,nz)*gradt(misa,nz)
endif
end do
end do
end do
sumaflow = max(sumaflow,totmass*abs(umass))
500 format(/' UBAR (m=',i1,', mass=',1pe9.2,') = ',1pe10.3,
> ' (m/sec) TEMP = ',1pe10.3,' (eV) VTHERM = ',1pe10.3,
Expand Down Expand Up @@ -940,7 +944,7 @@ call scopy(k2,a(napk+1),1,a(na+1),1)
kblock = km1
krow = k
endif
do 90 j=1,kblock
do j=1,kblock
c***** Determine element of maximum modulus in next column.
c***** Only allow permutations within blocks of k rows.
if( iflag.ne.0 )goto 1010
Expand Down Expand Up @@ -992,7 +996,7 @@ call saxpy(krow-jp1+1,-sca,a(ms+jp1),1,
c***** Subtract pivot row right side from other right-hand side(s)
if(sca.ne.0.0)call saxpy(nbrt,-sca,b(msb,1),nk,b(ls,1),nk)
enddo
90 continue
end do
c***** Move block 2 to 1, block 3 to 2, 0 out block 3 of rows used in
c***** this stage that will also be used in next.
if( iblock.ne.n .and. iflag.eq.0 )then
Expand All @@ -1013,7 +1017,7 @@ call scopy(k2,a(nrow(l)+k+1),1,a(nrow(l)+1),1)
iflag=1
return
endif
do 100 lb = 1,nbrt
do lb = 1,nbrt
nkb = nrow(nk)/k3 + 1
x(nk,lb)=b(nkb,lb)/a(nrow(nk)+k)
neq=nk-1
Expand All @@ -1039,7 +1043,8 @@ call scopy(k2,a(nrow(l)+k+1),1,a(nrow(l)+1),1)
neq=neq-1
enddo
if(neq.gt.0) goto 180
100 continue
100 continue
end do
iflag=0
return
end
Expand Down Expand Up @@ -1111,7 +1116,7 @@ c SAME (SEE SUBROUTINE ZSOURCE FOR DETAILS)
c
kx3 = 3*KXA
kxsq3 = kx3 * KXA
do 100 misa = 1,miso
do misa = 1,miso
nz = natom(misa)
nkz = nz * KXA
nresp = NBA*nkz !Number of response array elements per isotope
Expand Down Expand Up @@ -1146,11 +1151,11 @@ call zsource(asource,zi,den,fmom(1,1,misa),denmass,misa,nz)
amat(i)=zero
enddo

do 10 m = 1,KXA
do 10 mp= 1,KXA
do m = 1,KXA
do mp= 1,KXA
i1 = mp + kx3*(m-1)
i2 = m + nforc
do 10 jz= 1,nz
do jz= 1,nz
index = i1 + (jz-1)*kxsq3 !consecutive block-by-block index
is = i2 + (jz-1)*KXA
c
Expand Down Expand Up @@ -1187,7 +1192,9 @@ c UPPER DIAGONAL ELEMENTS (RECOMBINATION FROM HIGHER CHARGE STATE)
> asource(is) = asource(is) - amat(index)*usave(mp,jp,misa)
endif
endif
10 continue
end do
end do
end do
c
c SOLVE TRIDIAGONAL SYSTEM WITH NBA RIGHT SIDES STORED IN SOURCE
c STORE FOR FAST (INCREMENTAL) RECALCULATION (LDIR = 0,1)
Expand Down Expand Up @@ -1222,7 +1229,7 @@ c URESP(KXA=1,2,3,NATOM,n=1,..,NBA).
noff = 1 + nkz*(ntype-1)
call scopy(nkz,xsol(noff),1,uresp(1,1,misa,ntype),1)
enddo
100 continue
end do
return
end
c---- End of subroutine zrespond ---------------------------------------
Expand All @@ -1232,16 +1239,17 @@ implicit real (a-h,o-z), integer (i-n)
Use(Reduced_ion_constants)
real zi(miso,*), den(miso,0:nz), source(KXA,nz,NBA), fmom(KXA,*)
real denmass(miso,0:nz)
do 20 jz= 1,nz
do 20 m = 1,KXA
if( m.eq.1 )then
source(m,jz,ilam1) = one
source(m,jz,iacci) = denmass(misa,jz) * anorm / zi(misa,jz)
else if( (m.eq.ilam2) .or. (m.eq.ilam3) )then
source(m,jz,m) = one
endif
source(m,jz,iforc) = fmom(m,jz)/zi(misa,jz)
20 continue
do jz= 1,nz
do m = 1,KXA
if( m.eq.1 )then
source(m,jz,ilam1) = one
source(m,jz,iacci) = denmass(misa,jz) * anorm / zi(misa,jz)
else if( (m.eq.ilam2) .or. (m.eq.ilam3) )then
source(m,jz,m) = one
endif
source(m,jz,iforc) = fmom(m,jz)/zi(misa,jz)
end do
end do
return
end
c---- End of subroutine zsource ----------------------------------------
Expand Down
49 changes: 27 additions & 22 deletions api/inelrates.m
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -51,23 +51,25 @@ call xerrab("")
read(us,inrad)
close (us)
c
do 102 i = 1,ncaset
do i = 1,ncaset
terad(i)=terad(i)*1.602e-19/ctemp
102 continue
end do
c
do 103 i = 1,ncasent
rntau(i)=rntau(i)*crni*rl/cs
103 continue
do i = 1,ncasent
rntau(i)=rntau(i)*crni*rl/cs
end do
c
c
do 111 i = 1,ncaset
do 111 j = 1,ncaseno
do 111 k = 1,ncasent
do i = 1,ncaset
do j = 1,ncaseno
do k = 1,ncasent
c
radrate(i,j,k)=radrate(i,j,k)*crni*rl*1.602e-19
radrate(i,j,k)=radrate(i,j,k)*crni*rl*1.602e-19
. /cs/ctemp/1.5
c
111 continue
end do
end do
end do
c
c----------------------------------------------------------------------c
elseif (impflag .eq. 2) then
Expand Down Expand Up @@ -105,19 +107,21 @@ call xerrab("")
c
c ionization rate
c
do 200 i = 1,ntev
do i = 1,ntev
read(us,1000) tevb(i),(rsi(i,k),k=0,nz-1)
do 201 k = 0,nz-1
201 rsi(i,k) = rsi(i,k)*crni*rl/cs
200 continue
do k = 0,nz-1
rsi(i,k) = rsi(i,k)*crni*rl/cs
end do
end do
c
c recombination rate
c
do 210 i = 1,ntev
do i = 1,ntev
read(us,1000) tevb(i),(rre(i,k),k=1,nz)
do 211 k = 1,nz
211 rre(i,k) = rre(i,k)*crni*rl/cs
210 continue
do k = 1,nz
rre(i,k) = rre(i,k)*crni*rl/cs
end do
end do
c
c radiative power rate
c
Expand All @@ -132,11 +136,12 @@ c write(*,*) i,(rpwr(i,k),k=0,nz)
c
c CX recomb. rate
c
do 230 i = 1,ntev
do i = 1,ntev
read(us,1000) tevb(i),(rrcx(i,k),k=1,nz)
do 231 k = 1,nz
231 rrcx(i,k) = rrcx(i,k)*crni*rl/cs
230 continue
do k = 1,nz
rrcx(i,k) = rrcx(i,k)*crni*rl/cs
end do
end do
c
c ... Scale temperature scale for multi-charge rates to code units.
do i = 1, ntev
Expand Down
2 changes: 0 additions & 2 deletions bbb/exmain.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -37,8 +37,6 @@ void int_handler() {
printf("or a single line to be evaluated by Python.\n");
#pragma omp master
{
int condition;
condition=1;
while(1){
#ifdef HAS_READLINE
ret = readline("Debug>>> ");
Expand Down
Loading
Loading