Fortran: Program received signal SIGABRT: Process abort signal - fortran

I dont understand why I'm getting this runtime error:
Backtrace for this error:
#0 0xffffffffffffffff in ???
#1 0xffffffffffffffff in ???
#2 0xffffffffffffffff in ???
#3 0xffffffffffffffff in ???
#4 0xffffffffffffffff in ???
#5 0xffffffffffffffff in ???
#6 0xffffffffffffffff in ???
#7 0xffffffffffffffff in ???
#8 0xffffffffffffffff in ???
#9 0xffffffffffffffff in ???
0 [main] dertest2 248 cygwin_exception::open_stackdumpfile: Dumping stack trace to dertest2.exe.stackdump
this is the code that im running
integer JELEM, NumPatch, NNODE, NDOFEL, MCRD
integer p, nxi, q, neta
real*8 Weight(1,9)
real*8 PtGaus(2)
integer Jpqr(3)
real*8 COORDS(2,9)
real*8 Xi(6)
real*8 Eta(6)
real*8 DetJac
real*8 R(9)
real*8 dRdx(2,9)
JELEM=1
NNODE=9
MCDR=2
nxi=6
Jpqr(1)=nxi-1
p=2
neta=6
Jpqr(2)=neta-1
q=2
do ii=1,NNODE
Weight(1,ii)=1.d0
enddo
Xi(1)=0.d0
Xi(2)=0.d0
Xi(3)=0.d0
Xi(4)=1.d0
Xi(5)=1.d0
Xi(6)=1.d0
PtGaus(1)=0.211324865405187d0
Eta(1)=0.d0
Eta(2)=0.d0
Eta(3)=0.d0
Eta(4)=1.d0
Eta(5)=1.d0
Eta(6)=1.d0
PtGaus(2)=0.211324865405187d0
COORDS(1,1)=0.d0
COORDS(2,1)=100.d0
COORDS(1,2)=0.d0
COORDS(2,2)=50.d0
COORDS(1,3)=0.d0
COORDS(2,3)=0.d0
COORDS(1,4)=50.d0
COORDS(2,4)=100.d0
COORDS(1,5)=50.d0
COORDS(2,5)=50.d0
COORDS(1,6)=50.d0
COORDS(2,6)=0.d0
COORDS(1,7)=100.d0
COORDS(2,7)=100.d0
COORDS(1,8)=100.d0
COORDS(2,8)=50.d0
COORDS(1,9)=100.d0
COORDS(2,9)=0.d0
call shap2(COORDS,dRdx,NNODE,R,PtGaus,DetJac,NDOFEL,
1 MCRD,JELEM,NumPatch,Jpqr,Weight,Xi,p,nxi,Eta,q,neta)
write(*,*) DetJac
end
include "./derivative.f"
include "./shap2.f"
the code works fine up to
''' write(,) DetJac'''
where it doesn't print the value
when asking to write DetJac in subroutine shap2 it does work fine
this is the subroutine shap2
subroutine shap2(COORDS,dRdx,NNODE,R,PtGaus,DetJac,NDOFEL,
1 MCRD,JELEM,NumPatch,Jpqr,Weight,Xi,p,nxi,Eta,q,neta)
implicit none
integer ii,jj
integer JELEM, NumPatch, NNODE, NDOFEL, MCRD
integer n0, p, nxi, m0, q, neta
real*8 Weight(JELEM,NNODE)
real*8 PtGaus(MCRD)
integer Jpqr(3) !contains size nurb func.
real*8 COORDS(MCRD,NNODE) !Coordonnée Control Points (B)
real*8 Xi(nxi)
real*8 Eta(neta)
real*8 N(Jpqr(1),p+1) !Fonction d'inter direction xi
real*8 FN(Jpqr(1)) !Fonction d'inter direction xi at degree p
real*8 M(Jpqr(2),q+1) !Fonction d'inter direction eta
real*8 FM(Jpqr(2)) !Fonction d'inter direction eta at degree q
real*8 dNdxi(Jpqr(1)-p) !Dérivée fonc d'interp direction xi
real*8 dMdEta(Jpqr(2)-q) !Dérivée fonc d'interp direction eta
real*8 J(MCRD,MCRD) !jacobien ds le repère param
real*8 Jinv(MCRD,MCRD) !Inv Jac ds le repère parame
real*8 DetJac
real*8 R(NNODE) !Array of triviate nurbs basis fonction
real*8 dRdxi(Jpqr(1)-p,Jpqr(1)-p)
real*8 dRdeta(Jpqr(2)-q,Jpqr(2)-q)
real*8 dRdx(MCRD,NNODE)
do ii=1,Jpqr(1)
do jj=1,3
N(ii,jj)=0.d0
enddo
enddo
do ii=1,Jpqr(2)
do jj=1,3
M(ii,jj)=0.d0
enddo
enddo
call derivative(p,Xi,nxi,N,dNdxi,Jpqr(1),PtGaus(1))
call derivative(q,Eta,neta,M,dMdeta,Jpqr(2),PtGaus(2))
do ii=1,Jpqr(1)
FN(ii)=N(ii,p+1)
enddo
do ii=1,Jpqr(2)
FM(ii)=M(ii,p+1)
enddo
call NURBS2(p,Xi,nxi,FN,dNdxi,Jpqr(1),q,Eta,neta,FM,dMdeta,
# Jpqr(2), Weight(JELEM,1:),R,dRdxi,dRdeta,COORDS,J,dRdx,DetJac,
# NNODE)
return
end SUBROUTINE shap2
I ran the code check and got only warning for unused defined variables
gfortran -g -fbacktrace -Wall -fcheck=all
and this is what i get:
f951: Warning: Nonconforming tab character in column 1 of line 75 [-Wtabs]
f951: Warning: Nonconforming tab character in column 1 of line 2 [-Wtabs]
f951: Warning: Nonconforming tab character in column 1 of line 6 [-Wtabs]
f951: Warning: Nonconforming tab character in column 1 of line 78 [-Wtabs]
f951: Warning: Nonconforming tab character in column 1 of line 143 [-Wtabs]
f951: Warning: Nonconforming tab character in column 1 of line 161 [-Wtabs]
f951: Warning: Nonconforming tab character in column 1 of line 162 [-Wtabs]
f951: Warning: Nonconforming tab character in column 1 of line 175 [-Wtabs]
f951: Warning: Nonconforming tab character in column 1 of line 176 [-Wtabs]
f951: Warning: Nonconforming tab character in column 1 of line 3 [-Wtabs]
f951: Warning: Nonconforming tab character in column 1 of line 14 [-Wtabs]
f951: Warning: Nonconforming tab character in column 1 of line 53 [-Wtabs]
f951: Warning: Nonconforming tab character in column 1 of line 138 [-Wtabs]
f951: Warning: Nonconforming tab character in column 1 of line 139 [-Wtabs]
f951: Warning: Nonconforming tab character in column 1 of line 140 [-Wtabs]
./shap2.f:34:28:
34 | real*8 Jinv(MCRD,MCRD) !Inv Jac ds le repère parame
| 1
Warning: Unused variable 'jinv' declared at (1) [-Wunused-variable]
./shap2.f:9:28:
9 | integer n0, p, nxi, m0, q, neta
| 1
Warning: Unused variable 'm0' declared at (1) [-Wunused-variable]
./shap2.f:9:16:
9 | integer n0, p, nxi, m0, q, neta
| 1
Warning: Unused variable 'n0' declared at (1) [-Wunused-variable]
./shap2.f:1:63:
1 | subroutine shap2(COORDS,dRdx,NNODE,R,PtGaus,DetJac,NDOFEL,
| 1
Warning: Unused dummy argument 'ndofel' at (1) [-Wunused-dummy-argument]
./shap2.f:2:27:
2 | 1 MCRD,JELEM,NumPatch,Jpqr,Weight,Xi,p,nxi,Eta,q,neta)
| 1
Warning: Unused dummy argument 'numpatch' at (1) [-Wunused-dummy-argument]
./derivative.f:74:20:
74 | # M(m0-q), eps, temp1, temp2, temp3, temp4, gpt, w(NNODE),
| 1
Warning: Unused variable 'eps' declared at (1) [-Wunused-variable]
./derivative.f:69:49:
69 | subroutine NURBS2(p,Xi,nxi,N,dNdxi,n0,q,Eta,neta,M,dMdeta,m0, !ccccccc
| 1
Warning: Unused dummy argument 'eta' at (1) [-Wunused-dummy-argument]
./derivative.f:74:53:
74 | # M(m0-q), eps, temp1, temp2, temp3, temp4, gpt, w(NNODE),
| 1
Warning: Unused variable 'gpt' declared at (1) [-Wunused-variable]
./derivative.f:72:49:
72 | integer p, nxi, n0, q, neta, m0, ii, jj, kk, NNODE
| 1
Warning: Unused variable 'kk' declared at (1) [-Wunused-variable]
./derivative.f:74:41:
74 | # M(m0-q), eps, temp1, temp2, temp3, temp4, gpt, w(NNODE),
| 1
Warning: Unused variable 'temp3' declared at (1) [-Wunused-variable]
./derivative.f:74:48:
74 | # M(m0-q), eps, temp1, temp2, temp3, temp4, gpt, w(NNODE),
| 1
Warning: Unused variable 'temp4' declared at (1) [-Wunused-variable]
./derivative.f:69:28:
69 | subroutine NURBS2(p,Xi,nxi,N,dNdxi,n0,q,Eta,neta,M,dMdeta,m0, !ccccccc
| 1
Warning: Unused dummy argument 'xi' at (1) [-Wunused-dummy-argument]
./derivative.f:174:28:
174 | double precision DetBB
| 1
Warning: Unused variable 'detbb' declared at (1) [-Wunused-variable]
./derivative.f:5:26:
5 | # temp1, temp2, temp3, temp4, gpt
| 1
Warning: Unused variable 'temp3' declared at (1) [-Wunused-variable]
./derivative.f:5:33:
5 | # temp1, temp2, temp3, temp4, gpt
| 1
Warning: Unused variable 'temp4' declared at (1) [-Wunused-variable]
./derivative.f:147:29:
147 | # r,Zeta,nzeta,L,dLdzeta,l0,gpt)
| 1
Warning: Unused dummy argument 'dldzeta' at (1) [-Wunused-dummy-argument]
./derivative.f:146:63:
146 | subroutine NURBS3(p,Xi,nxi,N,dNdxi,n0,q,Eta,neta,M,dMdeta,m0, !ccccccccccc
| 1
Warning: Unused dummy argument 'dmdeta' at (1) [-Wunused-dummy-argument]
./derivative.f:146:40:
146 | subroutine NURBS3(p,Xi,nxi,N,dNdxi,n0,q,Eta,neta,M,dMdeta,m0, !ccccccccccc
| 1
Warning: Unused dummy argument 'dndxi' at (1) [-Wunused-dummy-argument]
./derivative.f:151:57:
151 | # M(m0-q), Zeta(nzeta), dLdzeta(l0-r), L(l0-r), eps, temp1,
| 1
Warning: Unused variable 'eps' declared at (1) [-Wunused-variable]
./derivative.f:146:49:
146 | subroutine NURBS3(p,Xi,nxi,N,dNdxi,n0,q,Eta,neta,M,dMdeta,m0, !ccccccccccc
| 1
Warning: Unused dummy argument 'eta' at (1) [-Wunused-dummy-argument]
./derivative.f:147:36:
147 | # r,Zeta,nzeta,L,dLdzeta,l0,gpt)
| 1
Warning: Unused dummy argument 'gpt' at (1) [-Wunused-dummy-argument]
./derivative.f:149:55:
149 | integer p, nxi, n0, q, neta, m0, r, nzeta, l0, ii, jj, kk
| 1
Warning: Unused variable 'ii' declared at (1) [-Wunused-variable]
./derivative.f:149:59:
149 | integer p, nxi, n0, q, neta, m0, r, nzeta, l0, ii, jj, kk
| 1
Warning: Unused variable 'jj' declared at (1) [-Wunused-variable]
./derivative.f:149:63:
149 | integer p, nxi, n0, q, neta, m0, r, nzeta, l0, ii, jj, kk
| 1
Warning: Unused variable 'kk' declared at (1) [-Wunused-variable]
./derivative.f:147:21:
147 | # r,Zeta,nzeta,L,dLdzeta,l0,gpt)
| 1
Warning: Unused dummy argument 'l' at (1) [-Wunused-dummy-argument]
./derivative.f:146:56:
146 | subroutine NURBS3(p,Xi,nxi,N,dNdxi,n0,q,Eta,neta,M,dMdeta,m0, !ccccccccccc
| 1
Warning: Unused dummy argument 'm' at (1) [-Wunused-dummy-argument]
./derivative.f:146:34:
146 | subroutine NURBS3(p,Xi,nxi,N,dNdxi,n0,q,Eta,neta,M,dMdeta,m0, !ccccccccccc
| 1
Warning: Unused dummy argument 'n' at (1) [-Wunused-dummy-argument]
./derivative.f:151:64:
151 | # M(m0-q), Zeta(nzeta), dLdzeta(l0-r), L(l0-r), eps, temp1,
| 1
Warning: Unused variable 'temp1' declared at (1) [-Wunused-variable]
./derivative.f:152:13:
152 | # temp2, temp3, temp4, gpt
| 1
Warning: Unused variable 'temp2' declared at (1) [-Wunused-variable]
./derivative.f:152:20:
152 | # temp2, temp3, temp4, gpt
| 1
Warning: Unused variable 'temp3' declared at (1) [-Wunused-variable]
./derivative.f:152:27:
152 | # temp2, temp3, temp4, gpt
| 1
Warning: Unused variable 'temp4' declared at (1) [-Wunused-variable]
./derivative.f:146:28:
146 | subroutine NURBS3(p,Xi,nxi,N,dNdxi,n0,q,Eta,neta,M,dMdeta,m0, !ccccccccccc
| 1
Warning: Unused dummy argument 'xi' at (1) [-Wunused-dummy-argument]
./derivative.f:147:13:
Any help would be greatly appreciated

Related

Fortran 77 compilation for IRI 2016 model

I've been trying to compile the IRI model lately, somewhat unsuccessfully. I've downloaded the IRI 2016 + common files + indices files, and using the test file to, well, test. I'm using gfortran (though the code is in fortran 77) with the -std=legacy flag (to remove unnecessary warnings, but I think the code is compiled as fortran 2003 or something). The linking/compilation command I'm using is:
gfortran -std=legacy -o iri iritest.for irisub.for irifun.for iritec.for iridreg.for igrf.for cira.for iriflip.for
This gives me the iri.exe executable, and yields a few warnings of the form:
Warning: Array reference at (1) out of bounds in loop beginning at (2)
(at compile time).
When I run the executable and enter the inputs through the console, I'm getting the following flags:
Note: The following floating-point exceptions are signalling: IEEE_UNDERFLOW_FLAG IEEE_DENORMAL
and the code apparently does what it's supposed to (outputs a nonempty file named fort.7 with the results). I've read that the IEEE flags I'm getting are rather common, and that I can disregard them, but the out of range warnings are a bit more concerning to me.
I'm also getting the following warnings:
igrf.for:298:10:
296 | DO 3 N=3,3333
| 2
297 | C*****CORRECTOR (FIELD LINE TRACING)
298 | P(1,N)=P(1,N-1)+STEP12*(5.*P(4,N)+8.*P(4,N-1)-P(4,N-2))
| 1
Warning: Array reference at (1) out of bounds (3333 > 100) in loop beginning at (2)
igrf.for:298:17:
296 | DO 3 N=3,3333
| 2
297 | C*****CORRECTOR (FIELD LINE TRACING)
298 | P(1,N)=P(1,N-1)+STEP12*(5.*P(4,N)+8.*P(4,N-1)-P(4,N-2))
| 1
Warning: Array reference at (1) out of bounds (3332 > 100) in loop beginning at (2)
igrf.for:298:37:
296 | DO 3 N=3,3333
| 2
297 | C*****CORRECTOR (FIELD LINE TRACING)
298 | P(1,N)=P(1,N-1)+STEP12*(5.*P(4,N)+8.*P(4,N-1)-P(4,N-2))
| 1
Warning: Array reference at (1) out of bounds (3333 > 100) in loop beginning at (2)
igrf.for:298:47:
296 | DO 3 N=3,3333
| 2
297 | C*****CORRECTOR (FIELD LINE TRACING)
298 | P(1,N)=P(1,N-1)+STEP12*(5.*P(4,N)+8.*P(4,N-1)-P(4,N-2))
| 1
Warning: Array reference at (1) out of bounds (3332 > 100) in loop beginning at (2)
igrf.for:298:56:
296 | DO 3 N=3,3333
| 2
297 | C*****CORRECTOR (FIELD LINE TRACING)
298 | P(1,N)=P(1,N-1)+STEP12*(5.*P(4,N)+8.*P(4,N-1)-P(4,N-2))
| 1
Warning: Array reference at (1) out of bounds (3331 > 100) in loop beginning at (2)
igrf.for:299:10:
296 | DO 3 N=3,3333
| 2
......
299 | P(2,N)=P(2,N-1)+STEP12*(5.*P(5,N)+8.*P(5,N-1)-P(5,N-2))
| 1
Warning: Array reference at (1) out of bounds (3333 > 100) in loop beginning at (2)
igrf.for:299:17:
296 | DO 3 N=3,3333
| 2
......
299 | P(2,N)=P(2,N-1)+STEP12*(5.*P(5,N)+8.*P(5,N-1)-P(5,N-2))
| 1
Warning: Array reference at (1) out of bounds (3332 > 100) in loop beginning at (2)
igrf.for:299:37:
296 | DO 3 N=3,3333
| 2
......
299 | P(2,N)=P(2,N-1)+STEP12*(5.*P(5,N)+8.*P(5,N-1)-P(5,N-2))
| 1
Warning: Array reference at (1) out of bounds (3333 > 100) in loop beginning at (2)
igrf.for:299:47:
296 | DO 3 N=3,3333
| 2
......
299 | P(2,N)=P(2,N-1)+STEP12*(5.*P(5,N)+8.*P(5,N-1)-P(5,N-2))
| 1
Warning: Array reference at (1) out of bounds (3332 > 100) in loop beginning at (2)
igrf.for:299:56:
296 | DO 3 N=3,3333
| 2
......
299 | P(2,N)=P(2,N-1)+STEP12*(5.*P(5,N)+8.*P(5,N-1)-P(5,N-2))
| 1
Warning: Array reference at (1) out of bounds (3331 > 100) in loop beginning at (2)
igrf.for:302:10:
296 | DO 3 N=3,3333
| 2
......
302 | P(8,N)=STEP2*(P(1,N)*P(4,N)+P(2,N)*P(5,N))
| 1
Warning: Array reference at (1) out of bounds (3333 > 100) in loop beginning at (2)
igrf.for:302:24:
296 | DO 3 N=3,3333
| 2
......
302 | P(8,N)=STEP2*(P(1,N)*P(4,N)+P(2,N)*P(5,N))
| 1
Warning: Array reference at (1) out of bounds (3333 > 100) in loop beginning at (2)
igrf.for:302:31:
296 | DO 3 N=3,3333
| 2
......
302 | P(8,N)=STEP2*(P(1,N)*P(4,N)+P(2,N)*P(5,N))
| 1
Warning: Array reference at (1) out of bounds (3333 > 100) in loop beginning at (2)
igrf.for:302:38:
296 | DO 3 N=3,3333
| 2
......
302 | P(8,N)=STEP2*(P(1,N)*P(4,N)+P(2,N)*P(5,N))
| 1
Warning: Array reference at (1) out of bounds (3333 > 100) in loop beginning at (2)
igrf.for:302:45:
296 | DO 3 N=3,3333
| 2
......
302 | P(8,N)=STEP2*(P(1,N)*P(4,N)+P(2,N)*P(5,N))
| 1
Warning: Array reference at (1) out of bounds (3333 > 100) in loop beginning at (2)
igrf.for:303:13:
296 | DO 3 N=3,3333
| 2
......
303 | C0=P(1,N-1)**2+P(2,N-1)**2
| 1
Warning: Array reference at (1) out of bounds (3332 > 100) in loop beginning at (2)
igrf.for:303:25:
296 | DO 3 N=3,3333
| 2
......
303 | C0=P(1,N-1)**2+P(2,N-1)**2
| 1
Warning: Array reference at (1) out of bounds (3332 > 100) in loop beginning at (2)
igrf.for:304:13:
296 | DO 3 N=3,3333
| 2
......
304 | C1=P(8,N-1)
| 1
Warning: Array reference at (1) out of bounds (3332 > 100) in loop beginning at (2)
igrf.for:305:14:
296 | DO 3 N=3,3333
| 2
......
305 | C2=(P(8,N)-P(8,N-2))*0.25
| 1
Warning: Array reference at (1) out of bounds (3333 > 100) in loop beginning at (2)
igrf.for:305:21:
296 | DO 3 N=3,3333
| 2
......
305 | C2=(P(8,N)-P(8,N-2))*0.25
| 1
Warning: Array reference at (1) out of bounds (3331 > 100) in loop beginning at (2)
igrf.for:306:14:
296 | DO 3 N=3,3333
| 2
......
306 | C3=(P(8,N)+P(8,N-2)-C1-C1)/6.0
| 1
Warning: Array reference at (1) out of bounds (3333 > 100) in loop beginning at (2)
igrf.for:306:21:
296 | DO 3 N=3,3333
| 2
......
306 | C3=(P(8,N)+P(8,N-2)-C1-C1)/6.0
| 1
Warning: Array reference at (1) out of bounds (3331 > 100) in loop beginning at (2)
igrf.for:307:13:
296 | DO 3 N=3,3333
| 2
......
307 | D0=P(6,N-1)
| 1
Warning: Array reference at (1) out of bounds (3332 > 100) in loop beginning at (2)
igrf.for:308:14:
296 | DO 3 N=3,3333
| 2
......
308 | D1=(P(6,N)-P(6,N-2))*0.5
| 1
Warning: Array reference at (1) out of bounds (3333 > 100) in loop beginning at (2)
igrf.for:308:21:
296 | DO 3 N=3,3333
| 2
......
308 | D1=(P(6,N)-P(6,N-2))*0.5
| 1
Warning: Array reference at (1) out of bounds (3331 > 100) in loop beginning at (2)
igrf.for:309:14:
296 | DO 3 N=3,3333
| 2
......
309 | D2=(P(6,N)+P(6,N-2)-D0-D0)*0.5
| 1
Warning: Array reference at (1) out of bounds (3333 > 100) in loop beginning at (2)
igrf.for:309:21:
296 | DO 3 N=3,3333
| 2
......
309 | D2=(P(6,N)+P(6,N-2)-D0-D0)*0.5
| 1
Warning: Array reference at (1) out of bounds (3331 > 100) in loop beginning at (2)
igrf.for:310:13:
296 | DO 3 N=3,3333
| 2
......
310 | E0=P(7,N-1)
| 1
Warning: Array reference at (1) out of bounds (3332 > 100) in loop beginning at (2)
igrf.for:311:14:
296 | DO 3 N=3,3333
| 2
......
311 | E1=(P(7,N)-P(7,N-2))*0.5
| 1
Warning: Array reference at (1) out of bounds (3333 > 100) in loop beginning at (2)
igrf.for:311:21:
296 | DO 3 N=3,3333
| 2
......
311 | E1=(P(7,N)-P(7,N-2))*0.5
| 1
Warning: Array reference at (1) out of bounds (3331 > 100) in loop beginning at (2)
igrf.for:312:14:
296 | DO 3 N=3,3333
| 2
......
312 | E2=(P(7,N)+P(7,N-2)-E0-E0)*0.5
| 1
Warning: Array reference at (1) out of bounds (3333 > 100) in loop beginning at (2)
igrf.for:312:21:
296 | DO 3 N=3,3333
| 2
......
312 | E2=(P(7,N)+P(7,N-2)-E0-E0)*0.5
| 1
Warning: Array reference at (1) out of bounds (3331 > 100) in loop beginning at (2)
igrf.for:314:15:
296 | DO 3 N=3,3333
| 2
......
314 | 4 T=(Z-P(3,N-1))/STEP
| 1
Warning: Array reference at (1) out of bounds (3332 > 100) in loop beginning at (2)
This is what I'm getting with gfortran compiler. I don't get any when using the Intel Fortran compiler.
Now, when I'm trying to compile the same model with a custom script instead of the test script in iritest.for, I get the same out of range warnings at compile time and a few errors at runtime, as well as a fort.7 file containing only -1s (which is the value for "no value/result"). The errors/flags at runtime are:
Note: The following floating-point exceptions are signalling: IEEE_INVALID_FLAG
and
201301** OUT OF RANGE **
The file IG_RZ.DAT which contains the indices Rz12 and IG12
currently only covers the time period (yymm) : 0- 0
In that custom script I'm only calling the subroutine IRI_SUB present in the irisub.for file, with inputs declared within the script+read from a text file. I've made sure to include the lines that are mandatory to include (see iritest.for). The inputs from the text file are indeed read (verified with a few WRITE). I know the custom script worked at some point in time because it's from a thesis made in the laboratory I'm currently working for. I've run out of ideas as of what I can try to debug this. I've tried the same with IRI 2012 and I'm getting the exact same flags/warnings/errors. Has anyone any idea of what I can try next?
EDIT: I've been able to get the custom script to yield results, but I'm not sure they are the right ones, since I've used the Intel Fortran compiler (and this one does not give me any warning anymore).

PL/SQL regex match commas not inside quotes

I have a comma-separated string and I need to match all the commas in this string except for the commas inside the double-quotes. I'm using regex for this.
,,,,"8000000,B767-200","B767-200","Boeing 767-200","ACFT",,,,,,,,,,,,,,,,,,,,,,,,,,
I tried the following regex patterns but none of them are working in PL/SQL but working in online regex testers.
,(?=(?:[^\"]*\"[^\"]*\")*(?![^\"]*\"))
(?!\B"[^"]*),(?![^"]*"\B)
I'm using REGEXP_INSTR function inside a procedure in PL/SQL to identify the index of the commas. Can someone suggest me a working regex pattern in PL/SQL for this purpose or help me to write one.
Thank you.

Oracle does not support look-ahead and non-capturing groups so you will need to match the quotes.
Assuming you can either have a non-quoted string or a quoted string (which could contain escaped quotes) then you can the regular expression:
([^",]*|"(\\"|[^"])*"),
Which you could use like this:
WITH matches ( id, csv, start_pos, comma_pos, idx, num_matches ) AS (
SELECT id,
csv,
1,
REGEXP_INSTR( csv, '([^",]*|"(\\"|[^"])*"),', 1, 1, 1, NULL ) - 1,
1,
REGEXP_COUNT( csv, '([^",]*|"(\\"|[^"])*"),' )
FROM test_data
UNION ALL
SELECT id,
csv,
REGEXP_INSTR( csv, '([^",]*|"(\\"|[^"])*"),', 1, idx + 1, 0, NULL ),
REGEXP_INSTR( csv, '([^",]*|"(\\"|[^"])*"),', 1, idx + 1, 1, NULL ) - 1,
idx + 1,
num_matches
FROM matches
WHERE idx < num_matches
)
SELECT id,
idx,
start_pos,
comma_pos,
SUBSTR( csv, start_pos, comma_pos - start_pos ) AS value
FROM matches
so for your test data:
CREATE TABLE test_data ( id, csv ) AS
SELECT 1, ',,,,"8000000,B767-200","B767-200","Boeing 767-200","ACFT",,,,,,,,,,,,,,,,,,,,,,,,,,' FROM DUAL
which outputs:
ID | IDX | START_POS | COMMA_POS | VALUE
-: | --: | --------: | --------: | :-----------------
1 | 1 | 1 | 1 | null
1 | 2 | 2 | 2 | null
1 | 3 | 3 | 3 | null
1 | 4 | 4 | 4 | null
1 | 5 | 5 | 23 | "8000000,B767-200"
1 | 6 | 24 | 34 | "B767-200"
1 | 7 | 35 | 51 | "Boeing 767-200"
1 | 8 | 52 | 58 | "ACFT"
1 | 9 | 59 | 59 | null
1 | 10 | 60 | 60 | null
1 | 11 | 61 | 61 | null
1 | 12 | 62 | 62 | null
1 | 13 | 63 | 63 | null
1 | 14 | 64 | 64 | null
1 | 15 | 65 | 65 | null
1 | 16 | 66 | 66 | null
1 | 17 | 67 | 67 | null
1 | 18 | 68 | 68 | null
1 | 19 | 69 | 69 | null
1 | 20 | 70 | 70 | null
1 | 21 | 71 | 71 | null
1 | 22 | 72 | 72 | null
1 | 23 | 73 | 73 | null
1 | 24 | 74 | 74 | null
1 | 25 | 75 | 75 | null
1 | 26 | 76 | 76 | null
1 | 27 | 77 | 77 | null
1 | 28 | 78 | 78 | null
1 | 29 | 79 | 79 | null
1 | 30 | 80 | 80 | null
1 | 31 | 81 | 81 | null
1 | 32 | 82 | 82 | null
1 | 33 | 83 | 83 | null
db<>fiddle here
(Note: you wanted to match the commas and this regular expression does exactly what you ask; it does not match any final value in the comma-delimited list as there is no terminating comma. If you wanted to do that then use the regular expression ([^",]*|"(\\"|[^"])*")(,|$) db<>fiddle.)
If you want it in a procedure then:
CREATE PROCEDURE extract_csv_value(
i_csv IN VARCHAR2,
i_index IN INTEGER,
o_value OUT VARCHAR2
)
IS
BEGIN
o_value := REGEXP_SUBSTR( i_csv, '([^",]*|"(\\"|[^"])*")(,|$)', 1, i_index, NULL, 1 );
IF SUBSTR( o_value, 1, 1 ) = '"' THEN
o_value := REPLACE( SUBSTR( o_value, 2, LENGTH( o_value ) - 2 ), '\"', '"' );
END IF;
END;
/
then:
DECLARE
csv VARCHAR2(4000) := ',,,,"8000000,B767-200","B767-200","Boeing 767-200","ACFT",,,,,,,,,,,,,,,,,,,,,,,,,,';
value VARCHAR2(100);
BEGIN
FOR i IN 1 .. 10 LOOP
extract_csv_value( csv, i, value );
DBMS_OUTPUT.PUT_LINE( LPAD( i, 2, ' ' ) || ' ' || value );
END LOOP;
END;
/
outputs:
1
2
3
4
5 8000000,B767-200
6 B767-200
7 Boeing 767-200
8 ACFT
9
10
db<>fiddle here

I tried to solve it without using a REGEX so check the following PROCEDURE if works as expected.
CREATE OR REPLACE PROCEDURE p_extract(p_string IN VARCHAR) AS
TYPE table_result IS TABLE OF VARCHAR2(255) INDEX BY PLS_INTEGER;
t_retval table_result;
opening BOOLEAN := FALSE;
cnt INTEGER := 1;
I INTEGER := 1;
j INTEGER := 1;
BEGIN
WHILE cnt <= LENGTH(p_string) AND cnt <> 0 LOOP
IF substr(p_string, cnt, 1) = '"'THEN
opening := NOT opening;
END IF;
IF opening THEN
I := instr(p_string, '"', cnt + 1, 1);
t_retval(t_retval.COUNT + 1) := substr(p_string, cnt, I - cnt + 1);
END IF;
cnt := instr(p_string, '"', cnt + 1, 1);
END LOOP;
FOR K IN t_retval.FIRST..t_retval.LAST LOOP
dbms_output.put_line(t_retval(K));
END LOOP;
END;
Test it.
BEGIN
p_extract(',,,,"8000000,B767-200","B767-200","Boeing 767-200","ACFT",,,,,,,,,,,,,,,,,,,,,,,,,,');
END;
--OUTPUT
/*
"8000000,B767-200"
"B767-200"
"Boeing 767-200"
"ACFT"
*/
However this won't work if you miss the last or first "

Fortran MPI allgatherv with derived type for 2d array

Need help with this Fortran MPI problem. Trying to gather data from different columns of 2D array. The problem is that all data from each row is not used and columns assigned per process my not be equal. All processes start with a equivalent global view of data, each process should perform work on specific columns, and finally exchange information so that all process share the common view again. Problems is similar to MPI partition and gather 2D array in Fortran and Sending 2D arrays in Fortran with MPI_Gather
Drawn example: data(8,4) using 3 MPI process
---------------------
| a1 | b1 | c1 | d1 |
| a2 | b2 | c2 | d2 |
| a3 | b3 | c3 | d3 |
| a4 | b4 | c4 | d4 |
| a5 | b5 | c5 | d5 |
| a6 | b6 | c6 | d6 |
| a7 | b7 | c7 | d7 |
| a8 | b8 | c8 | d8 |
---------------------
Process 1 will get 2 column to work, process 2 gets 1 column, process 3 gets 1 column.
----------- ------ ------
| a1 | b1 | | c1 | | d1 |
| a2 | b2 | | c2 | | d2 |
| a3 | b3 | | c3 | | d3 |
| a4 | b4 | | c4 | | d4 |
| a5 | b5 | | c5 | | d5 |
| a6 | b6 | | c6 | | d6 |
| a7 | b7 | | c7 | | d7 |
| a8 | b8 | | c8 | | d8 |
----------- ------ ------
In real problem, the actual size is data(200000,59). This is a preallocated chunk of memory where I am only used part of each column (always starting at index 1). For instance, I only need the first 3 values in each column.
----------- ------ ------
| a1 | b1 | | c1 | | d1 |
| a2 | b2 | | c2 | | d2 |
| a3 | b3 | | c3 | | d3 |
| == | == | | == | | == |
| a4 | b4 | | c4 | | d4 |
| a5 | b5 | | c5 | | d5 |
| a6 | b6 | | c6 | | d6 |
| a7 | b7 | | c7 | | d7 |
| a8 | b8 | | c8 | | d8 |
----------- ------ ------
I am trying to create a send and receive data type that can be used to accomplish this. My best guess so far has been to use MPI_TYPE_VECTOR.
MPI_TYPE_VECTOR(COUNT, BLOCKLENGTH, STRIDE, OLDTYPE, NEWTYPE, IERROR)
For this would use MPI_TYPE_VECTOR(1, 3, 8, MPI_DOUBLE, newtype, ierr). This should allow each process to send minimal amount of information. With this, I thought I should be able to send information with ALLGATHERV.
MPI_ALLGATHERV(SENDBUF, SENDCOUNT, SENDTYPE, RECVBUF, RECVCOUNT, DISPLS, RECVTYPE, COMM, IERROR)
Where I use MPI_ALLGATHERV(data(1,my_first_col), num_cols_to_be_sent, newtype, data, RECVCOUNT[], DISPLS[], newtype, COMM, IERROR)
From what I can tell, this is the information that should be sent being sent for each process.
Process 1: [a1,a2,a3,b1,b2,b3]
Process 2: [c1,c2,c3]
Process 3: [d1,d2,d3]
The examples I have seen all use either the entire column of data or the displacement is naturally a multiple of the subarray needed. I cannot get it to unpack into the correct columns. Shouldn't it be able to do this since the receive end has an understanding of the type's size/extent. Granted i am very confused on the whole extent thing. Any help would be appreciated. The real code is at work, but here is a quick recreation for viewing and comments (may not compile,just made quickly).
MODULE PARALLEL
INTEGER iproc, nproc, rank, ierr
INTEGER mylow, myhigh, mysize, ichunk, irem
INTEGER, ALLOCATABLE :: isize(:), idisp(:), ilow(:), ihigh(:)
DOUBLE PRECISION, ALLOCATABLE :: glob_val(:,:)
INTEGER newtype
END MODULE
PROGRAM MAIN
USE PARALLEL
IMPLICIT NONE
INCLUDE 'mpif.f'
c **temp variables
integer i, j
integer num_rows,num_cols
integer used_rows
c ----setup MPI----
call MPI_INIT(ierr)
call MPI_COMM_RANK(MPI_COMM_WORLD,rank,ierr)
call MPI_COMM_SIZE(MPI_COMM_WORLD,nproc,ierr)
iproc = rank+1 !rank is base 0, rest of fortran base 1
c ----setup initial data
integer num_rows=20 !contiguous in memory over rows (ie single column)
integer num_cols=11 !noncontiguous memory between different columns
integer
ALLOCATE (isize(nproc))
ALLOCATE (idisp(nproc))
ALLOCATE (ilow(nproc))
ALLOCATE (ishigh(nproc))
ALLOCATE (glob_val(num_rows,num_cols))
glob_val = 1.0*iproc !sent all glob values to process id
do i=1,num_cols
do j=1,used_rows
glob_val(j,i) = iproc+.01*j !add refernce index to used data
end do
end do
c ---setup exchange information
ichunk = num_cols/nproc
irem = num_cols -(ichunk*nproc)
mysize=ichunk
if(iproc.le.irem) mysize=mysize+1
mylow=0
myhigh=0
do i=1,nproc !establish global understanding of processes
mylow=myhigh+1
myhigh=mylow+ichunk
if(i.le.irem) myhigh=myhigh+1
isize(i)=myhigh-mylow+1
idisp(i)=(mylow-1) !based on receiving type size/extent
ilow(i)=mylow
ihigh(i)=myhigh
end do
mylow=ilow(iproc)
myhigh=ihigh(iproc)
call MPI_TYPE_VECTOR(1,used_rows,num_rows,MPI_DOUBLE,
& newtype,ierr)
call MPI_TYPE_COMMIT(newtype,ierr)
c --- perform exchange based on 'newtype'
!MPI_ALLGATHERV(SENDBUF, SENDCOUNT, SENDTYPE,
! RECVBUF, RECVCOUNT, DISPLS, RECVTYPE,
! COMM, IERROR)
call MPI_ALLGATHERV(glob_val(1,mylow),mysize,newtype
& glob_val,isize,iproc,newtype,
& MPI_COMM_WORLD,ierr)
c ---print out global results of process 2
if(iproc.eq.2) then
do i=1,num_rows
write(*,*) (glob_val(i,j),j=1,num_cols)
end do
end if
END program

OK, I got this working in the following way:
1) myhigh=mylow + ichunk - 1 not myhigh = mylow + ichunk
2) used_rows has to be set before the assignment loop
3) Define the actual buffers more explicitly, try
call MPI_ALLGATHERV(glob_val(:,mylow:myhigh), mysize, newtype, &
glob_val(1:used_rows,:), isize, idisp, newtype, &
MPI_COMM_WORLD, ierr)
full code using gfortran and openmpi:
MODULE PARALLEL
INTEGER iproc, nproc, rank, ierr
INTEGER mylow, myhigh, mysize, ichunk, irem
INTEGER, ALLOCATABLE :: isize(:), idisp(:), ilow(:), ihigh(:)
DOUBLE PRECISION, ALLOCATABLE :: glob_val(:,:)
INTEGER newtype
END MODULE
PROGRAM MAIN
USE PARALLEL
use mpi
IMPLICIT NONE
! INCLUDE 'mpif.f'
! **temp variables
integer i, j
integer num_rows,num_cols
integer used_rows
! ----setup MPI----
call MPI_INIT(ierr)
call MPI_COMM_RANK(MPI_COMM_WORLD,rank,ierr)
call MPI_COMM_SIZE(MPI_COMM_WORLD,nproc,ierr)
iproc = rank+1 !rank is base 0, rest of fortran base 1
! ----setup initial data
num_rows=8 !contiguous in memory over rows (ie single column)
num_cols=4 !noncontiguous memory between different columns
used_rows = 3
ALLOCATE (isize(nproc))
ALLOCATE (idisp(nproc))
ALLOCATE (ilow(nproc))
ALLOCATE (ihigh(nproc))
ALLOCATE (glob_val(num_rows,num_cols))
! glob_val = 1.0*iproc !sent all glob values to process id
glob_val = -1.0 * iproc
do i=1,num_cols
do j=1,used_rows
glob_val(j,i) = (1.0*iproc)+(.01*j) !add refernce index to used data
end do
end do
! ---setup exchange information
ichunk = num_cols/nproc
irem = num_cols -(ichunk*nproc)
mysize=ichunk
if(iproc.le.irem) mysize=mysize+1
mylow=0
myhigh=0
do i=1,nproc !establish global understanding of processes
mylow=myhigh+1
myhigh=mylow+ichunk-1
if(i.le.irem) myhigh=myhigh+1
isize(i)=myhigh-mylow+1
idisp(i)=(mylow-1) !based on receiving type size/extent
ilow(i)=mylow
ihigh(i)=myhigh
end do
mylow=ilow(iproc)
myhigh=ihigh(iproc)
call MPI_TYPE_VECTOR(1,used_rows,num_rows,MPI_DOUBLE, &
newtype,ierr)
call MPI_TYPE_COMMIT(newtype,ierr)
write(*,*) rank, idisp
write(*,*) rank, isize
! --- perform exchange based on 'newtype'
!MPI_ALLGATHERV(SENDBUF, SENDCOUNT, SENDTYPE,
! RECVBUF, RECVCOUNT, DISPLS, RECVTYPE,
! COMM, IERROR)
call MPI_ALLGATHERV(glob_val(:,mylow:myhigh),mysize,newtype, &
glob_val(1:used_rows,:),isize,idisp,newtype, &
MPI_COMM_WORLD,ierr)
! ---print out global results of process 2
if(iproc.eq.2) then
do i=1,num_rows
write(*,*) (glob_val(i,j),j=1,num_cols)
end do
end if
call MPI_Finalize(ierr)
END program

Rolling sum with unbalanced panel with non-even times in Stata

I have an unbalanced daily panel where entries occur at uneven times. I would like to generate the rolling sum of some variable x over the past 365 days. I can think of two ways to do this, but the first is memory hungry and the second is processor hungry. Is there a third alternative that avoids these problems?
Here are my two solutions. Is there a third solution without memory or speed problems?
clear
set obs 200
set seed 2001
/* panel variables */
generate id = 1 + int(2*runiform())
generate time = mdy(1, 1, 2000) + int(10*365*runiform())
format time %td
duplicates drop
xtset id time
/* data */
generate x = runiform()
/* first approach is to fill the panel with `tsfill` */
/* then remove "seasonality" with `s.` */
tsfill
generate sx = sum(x)
generate ssx = s365.sx
/* second approach without `tsfill` */
/* but nested loop is fairly slow */
drop if missing(x)
generate double ssx_alt = 0
forvalues i = 1/`= _N' {
local j = `i'
local delta = time[`i'] - time[`j']
while ((`j' > 0) & (`delta' < 365) & (id[`i'] == id[`j'])) {
local x = cond(missing(x[`j']), 0, x[`j'])
replace ssx_alt = ssx_alt + `x' in `i'
local j = `j' - 1
local delta = time[`i'] - time[`j']
}
}

The sum over the last # days is the difference between two cumulative sums, the cumulative sum to now and the cumulative sum to # days ago. The extension to panel data is easy, but not shown here. I don't think gaps disturb this principle once you have applied tsfill.
. set obs 20
obs was 0, now 20
. gen t = _n
. gen y = 100 + _n
. gen sumy = sum(y)
. tsset t
time variable: t, 1 to 20
delta: 1 unit
. gen diff = sumy - L10.sumy
(10 missing values generated)
. l
+------------------------+
| t y sumy diff |
|------------------------|
1. | 1 101 101 . |
2. | 2 102 203 . |
3. | 3 103 306 . |
4. | 4 104 410 . |
5. | 5 105 515 . |
|------------------------|
6. | 6 106 621 . |
7. | 7 107 728 . |
8. | 8 108 836 . |
9. | 9 109 945 . |
10. | 10 110 1055 . |
|------------------------|
11. | 11 111 1166 1065 |
12. | 12 112 1278 1075 |
13. | 13 113 1391 1085 |
14. | 14 114 1505 1095 |
15. | 15 115 1620 1105 |
|------------------------|
16. | 16 116 1736 1115 |
17. | 17 117 1853 1125 |
18. | 18 118 1971 1135 |
19. | 19 119 2090 1145 |
20. | 20 120 2210 1155 |
+------------------------+

How to transform an SNP matrix in Tab-delimited format into numbers using python?

I am attempting to transform the bases in the tab-delimited file into integers. The input file must be duplicated and the new copy must have a '1' for the reference base and a '2' for the most common alternate allele after that, and a '3' for for the next and so on. I'm new to python so any help is welcome, i've been attempting to use pandas because the file is so large. Here is a sample of the data:
dfmolecule refpos syn? refbase 0.1288 1304 09BKT076207
NC_011353 68 NA A A A A
NC_011353 255 NSYN A A A A
NC_011353 493 NSYN T T T C
NC_011353 514 NSYN C C C C
NC_011353 1790 SYN G G G G
NC_011353 1798 NSYN A A A T
NC_011353 2015 SYN C C C C
NC_011353 2345 SYN T T T T
NC_011353 2655 NSYN C C C C
NC_011353 2906 NSYN C C C C
Output should theoretically look like this:
dfmolecule refpos syn? refbase 0.1288 1304 09BKT076207
NC_011353 68 NA 1 1 1 1
NC_011353 255 NSYN 1 1 1 1
NC_011353 493 NSYN 1 1 1 2
NC_011353 514 NSYN 1 1 1 1
NC_011353 1790 SYN 1 1 1 1
NC_011353 1798 NSYN 1 1 1 2
NC_011353 2015 SYN 1 1 1 1
NC_011353 2345 SYN 1 1 1 1
NC_011353 2655 NSYN 1 1 1 1
NC_011353 2906 NSYN 1 1 1 1
This will help me visualize the SNPs better and allow me to rank the most common allele change per row. I don't know where to begin thats why I'm posting. The code I do have just converts the bases to numbers. The 'refbase' needs to always be '1' and when python reads a base that is different from the ref base across the row it substitutes the base with a '2' for the 2nd most common allele in that row. I hope thats a little more clear.
my code new code, Now just need to figure out how to rank the allele changes by frequency?:
import csv
import pdb
import os
import sys
if len(sys.argv) != 2:
exit("Need arg <snp file>")
snp_file = sys.argv[1]
wtf = csv.writer(open('/users/new_snp.txt' , 'w'), delimiter='\t')
newf = list(csv.reader(open(snp_file,'rU'), delimiter='\t'))
#--------------------------------------------------------------
# Returns an array of tuples with ('A', 8)
# where the letter is the nucleotide and the number
# is the amount of times a letter is present in a row
#--------------------------------------------------------------
def refbase_count(r):
# This is a blank hash to keep count of occurances
# of the alleles
rep = {'A':0, 'T':0, 'G':0,'C': 0}
for i in r:
rep[i] += 1
# sort before returning
import operator
sorted_rep = sorted(rep.iteritems(), key=operator.itemgetter(1))
# Want them with the most frequent first
sorted_rep.reverse()
return sorted_rep
#--------------------------------------------------------------
# print the top row outside of the loop
print newf[0]
wtf.writerow(newf[0])
for row in newf[1:]:
#rep = refbase_count(row[4:])
for index, val in enumerate( row[4:] ):
# If the refbase (in index 3) is equal to the
# value at a given spot, then we give it a new value of 1
# otherwise, it's a 2
if row[3] == val:
row[index+4] = 1
else:
row[index+4] = 2
print row
wtf.writerow(row)

You should post what you've tried and what you think the output should look like. Maybe spend some time clarifying your question too.
If I understand correctly, you want to rank by the column refbase? To do that use
In [38]: rnk = df.groupby('refbase').apply(lambda x: np.size(x)).rank(ascending=False)
In [39]: rnk
Out[39]:
refbase
A 2
C 1
G 4
T 3
dtype: float64
Then you can create a new column with the ranks based off that:
In [40]: df['refpos_rank'] = df.refbase.replace(rnk.to_dict())
In [41]: df
Out[41]:
dfmolecule refpos syn? refbase 0.1288 1304 09BKT076207 refpos_rank
0 NC_011353 68 NaN A A A A 2
1 NC_011353 255 NSYN A A A A 2
2 NC_011353 493 NSYN T T T C 3
3 NC_011353 514 NSYN C C C C 1
4 NC_011353 1790 SYN G G G G 4
5 NC_011353 1798 NSYN A A A T 2
6 NC_011353 2015 SYN C C C C 1
7 NC_011353 2345 SYN T T T T 3
8 NC_011353 2655 NSYN C C C C 1
9 NC_011353 2906 NSYN C C C C 1
This can be written to a tab delimited file with df.to_csv(path, sep='\t')