From 98d6521bfa9a114692f2f6684ac38e89d9a537d2 Mon Sep 17 00:00:00 2001 From: FrankThomasTveter Date: Thu, 1 Jun 2017 09:33:20 +0000 Subject: [PATCH] eventStop bugfix. --- astro/src/astro/astroEvent.F | 54 ++++++++++++++++++------------------ astro/src/astro/event.F | 2 -- 2 files changed, 27 insertions(+), 29 deletions(-) diff --git a/astro/src/astro/astroEvent.F b/astro/src/astro/astroEvent.F index 2db4a11..abaad30 100644 --- a/astro/src/astro/astroEvent.F +++ b/astro/src/astro/astroEvent.F @@ -6021,7 +6021,7 @@ subroutine reportLLMax( lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=480 return end if C @@ -6182,7 +6182,7 @@ subroutine reportLLMin( lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=481 return end if if (nrep.eq.inrep) then ! no local minimum, check end points @@ -6506,7 +6506,7 @@ subroutine reportMax( lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=482 return end if if (nrep.gt.maxrep.and.maxrep.ne.0) then @@ -7059,7 +7059,7 @@ subroutine reportMercTransit( lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=483 return end if return @@ -7213,7 +7213,7 @@ subroutine reportMin( lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=484 return end if if (nrep.gt.maxrep.and.maxrep.ne.0) then @@ -8301,7 +8301,7 @@ subroutine reportMoonPos(loclat,loclon,lochgt, lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=485 return end if if (nrep.gt.maxrep.and.maxrep.ne.0) then @@ -9005,7 +9005,7 @@ subroutine reportSSPos(loclat,loclon,lochgt, lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=486 return end if if (nrep.gt.maxrep.and.maxrep.ne.0) then @@ -9369,7 +9369,7 @@ subroutine reportSunEclipse( lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=487 return end if C @@ -9989,7 +9989,7 @@ subroutine reportSunPos(loclat,loclon,lochgt, lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=488 return end if if (nrep.gt.maxrep.and.maxrep.ne.0) then @@ -10499,7 +10499,7 @@ subroutine reportUmbra( lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=489 return end if C @@ -10709,7 +10709,7 @@ subroutine reportVenusTransit( lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=490 return end if C @@ -10939,7 +10939,7 @@ real function searchLLMax( lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=491 return end if if (maxrep.ne.0.and.nrep.eq.inrep) then ! no local minimum, check end points @@ -11075,7 +11075,7 @@ real FUNCTION goldenLLMax(ax,bx,cx,f,tol,xmax, lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=492 return end if if(f1.lt.f2)then ! We are done. Output the best of the two current values. @@ -11252,7 +11252,7 @@ real function searchLLMin( lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=493 return end if if (maxrep.ne.0.and.nrep.eq.inrep) then ! no local minimum, check end points @@ -11388,7 +11388,7 @@ real FUNCTION goldenLLMin(ax,bx,cx,f,tol,xmin, lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=494 return end if if(f1.lt.f2)then ! We are done. Output the best of the two current values. @@ -11928,7 +11928,7 @@ real function XsearchLLTarget(tval, lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=495 return end if if (nrep.gt.maxrep.AND.MAXREP.NE.0) then @@ -12081,7 +12081,7 @@ real function dsearchLLTarget(tval, lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=496 return end if if (bdeb)write(*,*)myname,'Found:',bok,jd,tstart,tend,dstart,dend @@ -12592,7 +12592,7 @@ real function XsearchTarget(tval, lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=497 return end if if (nrep.gt.maxrep.AND.MAXREP.NE.0) then @@ -12737,7 +12737,7 @@ real function dsearchTarget(tval, lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=498 return end if if (bdeb)write(*,*)myname,'Found:',bok,jd,tstart,tend,dstart,dend @@ -13081,7 +13081,7 @@ real function searchMax( lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=499 return end if if (nrep.gt.maxrep.AND.MAXREP.NE.0) then @@ -13160,7 +13160,7 @@ real FUNCTION goldenMax(ax,bx,cx,f,tol,xmax,crc250,irc) lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=500 return end if if(f1.lt.f2)then ! We are done. Output the best of the two current values. @@ -13807,7 +13807,7 @@ real function searchMercTransit( lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=501 return end if C @@ -13995,7 +13995,7 @@ real function searchMin( lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=502 return end if if (nrep.gt.maxrep.AND.MAXREP.NE.0) then @@ -14075,7 +14075,7 @@ real FUNCTION goldenMin(ax,bx,cx,f,tol,xmin,crc250,irc) lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=503 return end if if(f1.lt.f2)then ! We are done. Output the best of the two current values. @@ -15631,7 +15631,7 @@ real function searchSunEclipse( lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=504 return end if C @@ -16431,7 +16431,7 @@ real function searchUmbra( lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=505 return end if C @@ -16665,7 +16665,7 @@ real function searchVenusTransit( lencrc=length(crc250,250,10) crc250=crc250(1:lencrc)//buff250 call chop0(crc250,250) - irc=457 + irc=506 return end if C diff --git a/astro/src/astro/event.F b/astro/src/astro/event.F index e7bc288..c9ede10 100644 --- a/astro/src/astro/event.F +++ b/astro/src/astro/event.F @@ -471,8 +471,6 @@ subroutine execute_event() dmi2=mi2 dsec2=sec2 dtstopJD=tstopJD - else - tstopJD=0.0D0 end if C if (debug) call cpu_time(cpuStart)