program aestorm3
C........................................................................Feb. 2015
C
C Include all AEstart,end>=300 nT, AEmax>=1000 nT (AE storm and sub-storm)
C
C                    
      DIMENSION IM(12),DA(366,0:24)
	DIMENSION dat(0:23)
	CHARACTER*26 INFILE
	CHARACTER*25 OUTFILE
C	CHARACTER*128 txt
	CHARACTER*10 YRINP,RE(366),D1,D2,DM,SYEAR,DD1,DD2,DDM
	REAL YEAR
	COMMON DA
      DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
100	icnt=0
 	WRITE(*,'(A\)') ' ENTER YEAR    :'
      READ (*,*) SYEAR
	READ (SYEAR,*) YEAR
	YEAR1=YEAR
	INFILE='D:\Apkp\AE\WWWaeYEAR.dat'
	OUTFILE='AEsstorm3.txt'

	INFILE(17:20)=SYEAR
      IF ((YEAR/4.).EQ.IFIX(YEAR/4.)) THEN 
	IM(2)=29 
	IDNR=366
	ELSE 
	IM(2)=28
	IDNR=365
	ENDIF
C Put initials: D1,IT1,DM,IDAY,AVER,AMIN,IUTMIN,D2,IT2,IUTT,ADST
	DD1=''
	DD2=''
	DDM=''
	IIT1=24
	IIT2=24
	IIDAY=0
	AAVER=0.
	AAMIN=0.
	IIUTMIN=24
	IIUTT=0
	AADST=0.
	IFL=0
C End of initials
C1999-01-01 00:00:00.000 001        20.00     20.00      0.00     10.00
	OPEN(111,FILE=INFILE,action='READ')
	DO 15 J=1,IDNR

C	READ (111,12,END=2,ERR=99) YRINP,XDEV
C-	do kk=1,18
C	read(111,112,EOR=113,ADVANCE='NO',END=2,ERR=99) txt ! extra lines
C-1100	read(111,112,iostat=ix,END=1101,ERR=99) txt ! extra lines
C-1101	goto 1100
C-	enddo
C-  113	backspace(111)
C Calculation of daily mean:
	DAV=0.
	DO k=0,23
	READ (111,712,END=2,ERR=99) YRINP,DAT(k)
	ENDDO
   12  FORMAT (A10,10X,24(F4.0))
  112  FORMAT (A12)
  712  FORMAT (A10,22X,F8.2)
	RE(j)=YRINP
	DO 14 K=0,23
C	DA(J,K)=float(idat(K))
	DA(J,K)=dat(K)
C	DA(J,K)=xdev(K)
	DAV=DAV+DA(J,K)
   14 CONTINUE
	DA(J,24)=DAV/24.
   15 CONTINUE

   2   CONTINUE
       CLOSE (UNIT=111)

c
		OPEN(112,FILE=OUTFILE,ACCESS='APPEND')	
      DO 810 J=1,IDNR
C ++++++ Record results for preceding solution:
C	D1,IT1,DM,IDAY,AVER,AMIN,IUTMIN,D2,IT2,IUTT,ADST
	IIFL=IFL
	       IF ((J.GT.1).AND.(IFL.EQ.1)) THEN
	DD1=D1
	DD2=D2
	DDM=DM
	IIT1=IT1
	IIT2=IT2
	IIDAY=IDAY
	AAVER=AVER
	AAMIN=AMIN        !AEmax
	IIUTMIN=IUTMIN
	IIUTT=IUTT
	AADST=ADST
	       ENDIF

      AMIN=0.
	CNT=0
	
      DO K=0,23
      IF (DA(J,K).GT.AMIN) THEN 
	AMIN=DA(J,K) 
	IUTMIN=K
	ENDIF
	ENDDO

      IF (AMIN.GE.500.) THEN 		  ! AEpeak>=500.0 nT
	  IFL=1
	  GOTO 710
	ELSE
	  IFL=0
        IF (IIFL.EQ.1) THEN
	  GOTO 790
	            ELSE
	  GOTO 805
	           ENDIF
	ENDIF
	
C GO TO SUBROUTINE DETECTING <STORM-START;STORM-END> USING KPYR.D27
  710 CONTINUE
      D1='' 
      D2=''
	IT1=0
	IT2=0
	ADST=0.
	IDAY=J

	CALL DETECTAE(IDAY,RE,D1,IT1,D2,IT2,IUTT,ADST,IUTMIN)
	AVER=DA(J,24)
	DM=RE(J)
C

	IF ((D1.EQ.DD1).AND.(D2.EQ.DD2).AND.(IIUTT.EQ.IUTT)) THEN
	IF (J.EQ.IDNR) GOTO 800
	   IF (AMIN.GT.AAMIN) THEN

	       GOTO 805
	                      ELSE
	D1=DD1
	D2=DD2
	DM=DDM
	IT1=IIT1
	IT2=IIT2
	IDAY=IIDAY
	AVER=AAVER
	AMIN=AAMIN
	IUTMIN=IIUTMIN
	IUTT=IIUTT
	ADST=AADST
	IFL=IIFL
	      
	   ENDIF
	                                                ELSE
	if (iifl.eq.1) then
	goto 790
	 else
	      IF (J.EQ.IDNR) THEN 
		  GOTO 800
	                     ELSE
	      GOTO 805
	                     ENDIF
	endif
	                                                ENDIF
	GOTO 805
  790	CONTINUE
C++		if ((iutt.lt.3).or.(AAmin.lt.1000.)) goto 1800  ! Min 3 h, AE>=1000 nT
		if (iutt.lt.3) goto 1800  ! Min 3 h, AE>=500 nT
		if (AAmin.lt.500.) goto 1800  ! Min 3 h, AE>=500 nT
	icnt=icnt+1
 	WRITE(*,170) icnt,DD1,IIT1,DDM,IIUTMIN,AAMIN,DD2,IIT2,IIUTT
 	WRITE(112,170) icnt,DD1,IIT1,DDM,IIUTMIN,AAMIN,DD2,IIT2,IIUTT
crem 	WRITE(112,170) DD1,IIT1,DDM,IIUTMIN,IIDAY,AAVER,AAMIN,DD2
crem	&,IIT2,IIUTT,AADST
crem      WRITE(*,170) DD1,IIT1,DDM,IIUTMIN,IIDAY,AAVER,AAMIN,DD2
crem 	&,IIT2,IIUTT,AADST
crem  170	FORMAT(1X,A10,I3,2X,A10,I3,1X,I3,2F6.0,2X,A10,I3,1X,I4,F6.0)
  170	FORMAT(1X,I4,1X,A10,I3,2X,A10,I3,1X,F6.0,2X,A10,I3,1X,I4)
1800	if (j.lt.idnr) goto 805
  800	CONTINUE
crem	WRITE(112,170) D1,IT1,DM,IUTMIN,IDAY,AVER,AMIN,D2,IT2,IUTT,ADST
crem	WRITE(*,170) D1,IT1,DM,IUTMIN,IDAY,AVER,AMIN,D2,IT2,IUTT,ADST
C++	if ((iutt.lt.3).or.(AAmin.lt.1000.)) goto 805  ! Min 3 h
	if ((iutt.lt.3).or.(AAmin.lt.500.)) goto 805  ! Min 3 h
	icnt=icnt+1
	WRITE(*,170) icnt,D1,IT1,DM,IUTMIN,AMIN,D2,IT2,IUTT
	WRITE(112,170) icnt,D1,IT1,DM,IUTMIN,AMIN,D2,IT2,IUTT
C	PAUSE ' '
  805	IIFL=IIFL+1
	
  810 CONTINUE
C
C
      CLOSE (UNIT=112)
C      YEAR=YEAR+1
C      
   99	CONTINUE
      IF (YEAR.LT.2019.) GOTO 100
	pause ' '
      STOP
	END
C******************************************************************************
C      SUBROUTINE TO DETECT <STORM-START;STORM-END>
	SUBROUTINE DETECTAE(JDAY,RE,D1,IT1,D2,IT2,IUT,AADST,IMX)
	DIMENSION DA(366,0:24)
	CHARACTER*10 D1,D2,RE(366)
	INTEGER C1,C2
	COMMON DA
	
C START-OF-STORM DETECTING================
      J1=JDAY
	J2=JDAY
	 C2=-1
       K2=IMX
C  PRINT IMX,DEX 
  970    C1=-1  
	K1=23
      IF (J1.EQ.JDAY) K1=IMX
      K=K1
 1000 CONTINUE
C      WRITE(*,*) J1,K,DA(J1,K)
      IF (DA(J1,K).GE.300.) THEN 
	C1=K  
	GOTO 1030
	                     ELSE
      ISTR1=K+1 
	GOTO 1060
	ENDIF
 1030 K=K-1
      IF (K.GE.0) GOTO 1000
      IF (C1.GE.0) THEN 
	J1=J1-1 
	GOTO 970
	ENDIF

 1060  IF (ISTR1.LT.24) GOTO 1080
      J1=J1+1 
	 ISTR1=0
 1080  D1=RE(J1)
      IT1=ISTR1 
C      WRITE(*,*) D1,IT1 
C	PAUSE ' '
C DERIVE DURATION OF THE MAIN PHASE OF STORM:=========== 
 1290 IAV=IMX-ISTR1+1+(JDAY-J1)*24
	DSTAV=0.
1100	CONTINUE
	DO JA=J1,JDAY
	   IF (JA.EQ.J1) THEN
	     I0=ISTR1
	                 ELSE
	     I0=0
	   ENDIF 

	   IF (JA.LT.JDAY) THEN
	    IK=23
C	    JB=JA+1
	                   ELSE
	    IK=IMX
C	    JB=JDAY
	   ENDIF
		dstav=dstav+DSTAVER(JA,JA,I0,IK)
	ENDDO
C DETECTING OF END-OF-STORM =================
C Check of Dstaver<-30. nT:
 1300	CONTINUE
C UT-end of storm:
 1150 IT2=K2
	JEND=J2
      K2=K2+1
      IF (K2.GT.23) THEN
	J2=J2+1
	K2=0
	ENDIF
C+ 1160	IF (DA(J2,K2).LE.-25.) THEN
 1160	IF (DA(J2,K2).GE.300.) THEN
      DSTAV=DSTAV+DA(J2,K2)
	IAV=IAV+1
	GOTO 1150
                          	ELSE
		     AADST=DSTAV/IAV
C STORM DURATION=========== 
	     IUT=IAV
	                         ENDIF
 1240 D2=RE(JEND)
    
C PRINT D2,IT2
        RETURN
	END
C
C AVERAGE FOR SELECTED DAYs AND TIMEs
	REAL FUNCTION DSTAVER(N1,N2,M1,M2)
	DIMENSION DA(366,0:24)
	COMMON DA
	DO N=N1,N2
	DO M=M1,M2
	DSTAVER=DSTAVER+DA(N,M)
	ENDDO
	ENDDO
	RETURN
	END
C*****************************************************