program dststorm30
C.......................................................Dec. 2019
C Include -50 < Dst <=-30 (minor storms)
C.......................................................May. 2016
C correct output exclude doy, Dstaver
C
C Include Dst-min=<-50, Dst<=-30 -substorm onset, substorm end
C                                             April 2009
C DST-STORM SELECT STORM DAYS= DST-min=<-100 WITH 24-HRS Dst-indices
C DETECT STORM ONSET as soon as Dst=<-30 nT; Storm-end when Dstaver<50 nT
C This version to detect storm periods using ONLY input Dst-indices
C T.L. Gulyaeva                                                April, 2005
c DD1,IIT1,DDM,IIUTMIN,AAMIN,DD2
      DIMENSION IM(12),DA(366,0:24)
	DIMENSION XDEV(0:23)
	CHARACTER*22 INFILE
	CHARACTER*25 OUTFILE
	CHARACTER*10 YRINP,RE(366),D1,D2,DM,SYEAR,DD1,DD2,DDM
	+,DD1_pred,DDM_pred,DD2_pred
	REAL YEAR
	COMMON DA
      DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
	icnt=0
	icnt100=0
 100	WRITE(*,'(A\)') ' ENTER YEAR    :'
      READ (*,*) SYEAR
	READ (SYEAR,*) YEAR
	YEAR1=YEAR
	INFILE='D:\APKP\dst\dst'
	OUTFILE='dststorm30.txt'

	INFILE(16:)=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=''
	DD1_pred=DD1
	DD2=''
	DD2_pred=DD2
	DDM=''
	DDM_pred=DDM
      AAMIN_pred=0.
	IIT1=24
	IIT2=24
	IIDAY=0
	AAVER=0.
	AAMIN=0.
	IIUTMIN=24
	IIUTT=0
	AADST=0.
	IFL=0
C End of initials

	OPEN(111,FILE=INFILE)
	DO 15 J=1,IDNR

	READ (111,12,END=2,ERR=99) YRINP,XDEV
   12  FORMAT (A10,10X,24(F4.0))
	RE(J)=YRINP
C Calculation of daily mean:
	DAV=0.
	DO 14 K=0,23
	DA(J,K)=xdev(K)
	DAV=DAV+XDEV(K)
   14 CONTINUE
	DA(J,24)=DAV/24.
   15 CONTINUE

   2   CONTINUE
       CLOSE (UNIT=111)

		AAMIN_print=0.

c	OPEN(112,FILE=OUTFILE,ACCESS='APPEND',STATUS='NEW')	
		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
	IIUTMIN=IUTMIN
	IIUTT=IUTT
	AADST=ADST
	       ENDIF

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

C      IF (AMIN.LE.-50.) THEN 
      IF (AMIN.LE.-30.) THEN 
	  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 DETECT(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.LT.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
      if (iiutt.lt.3) goto 178
crem      WRITE(*,170) DD1,IIT1,DDM,IIUTMIN,IIDAY,AAVER,AAMIN,DD2
crem 	&,IIT2,IIUTT,AADST
crem 	WRITE(112,170) DD1,IIT1,DDM,IIUTMIN,IIDAY,AAVER,AAMIN,DD2
crem	&,IIT2,IIUTT,AADST
	       if (DD1.eq.DD1_pred) then              !<<<<<<<<<<<<<<<<<<<<<<
      	if ((AAMIN_pred.lt.AAMIN).and.(AAMIN_pred.lt.0.)) then !++++++++
	goto 178
	      else									  
	DD1_pred=DD1											!++++++++
	DD2_pred=DD2
	DDM_pred=DDM
	iit1_pred=iit1
	iit2_pred=iit2
	IIUTMIN_pred=IIUTMIN
	IIUTT_pred=IIUTT
	AAMIN_pred=AAMIN
	goto 178
	    endif                                                 !++++++++
                                 else					!<<<<<<<<<<<<<<<<<<<<<<
	    if (AAMIN_print.ne.AAMIN_pred) then				   !-----------
C	if (iiutt_pred.lt.3) goto 181
		icnt=icnt+1
C?	if (aamin.le.-100.) icnt100=icnt100+1
	if (aamin.le.-30.) icnt100=icnt100+1
	     AAMIN_print=AAMIN_pred
      WRITE(*,170) ICNT,DD1_pred,IIT1_pred,DDM_pred,IIUTMIN_pred
     +,AAMIN_pred,DD2_pred,IIT2_pred,IIUTT_pred
 	WRITE(112,170) ICNT,DD1_pred,IIT1_pred,DDM_pred,IIUTMIN_pred
	+,AAMIN_pred,DD2_pred,IIT2_pred,IIUTT_pred
  181 continue   
	     else												!-------------
	DD1_pred=DD1
	DD2_pred=DD2
	DDM_pred=DDM
	iit1_pred=iit1
	iit2_pred=iit2
	IIUTMIN_pred=IIUTMIN
	IIUTT_pred=IIUTT
	AAMIN_pred=AAMIN
	goto 177
	       endif											!-----------
	                                    
                                endif                       !<<<<<<<<<<<<<<<<<<<<<
  177	continue
      if (iiutt_pred.lt.3) goto 178
      icnt=icnt+1
C??      if (aamin.le.-100.) icnt100=icnt100+1
      if (aamin.le.-30.) icnt100=icnt100+1
	AAMIN_print=AAMIN_pred
      WRITE(*,170) ICNT,DD1_pred,IIT1_pred,DDM_pred,IIUTMIN_pred
     +,AAMIN_pred,DD2_pred,IIT2_pred,IIUTT_pred
 	WRITE(112,170) ICNT,DD1_pred,IIT1_pred,DDM_pred,IIUTMIN_pred
	+,AAMIN_pred,DD2_pred,IIT2_pred,IIUTT_pred
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,F6.0,2X,A10,I3,1X,I4)
  178	if (j.lt.idnr) goto 805
  800	CONTINUE
c	icnt=icnt+1
c	WRITE(*,170) ICNT,D1,IT1,DM,IUTMIN,AMIN,D2,IT2,IIUTT
c	WRITE(112,170) ICNT,D1,IT1,DM,IUTMIN,AMIN,D2,IT2,IIUTT
C	PAUSE ' '
  805	IIFL=IIFL+1
	
  810 CONTINUE
C
C
      CLOSE (UNIT=112)
      YEAR=YEAR+1
      IF (YEAR.LT.2020) GOTO 100
	write(*,*) icnt100
	pause ' '
   99	CONTINUE
C	CLOSE (UNIT=112)
      STOP
	END
C******************************************************************************
C      SUBROUTINE TO DETECT <STORM-START;STORM-END>
	SUBROUTINE DETECT(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).LE.-25.) 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).LE.-30.) 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*****************************************************
C -----------------------------------------------------------
      subroutine blet2(ilet,alet2)
c

	CHARACTER*1 IN(0:9)
c	integer*2 ilet
	DATA IN/'0','1','2','3','4','5','6','7','8','9'/
	CHARACTER*2 alet2
	alet2='00'
	j10=ilet/10
	j1=ilet-j10*10
    5	do i=0,9
	if (j10.eq.i) then
	alet2(1:1)=IN(i)
	endif
	enddo
   7	do i=0,9 
     	if (j1.eq.i) then
 	alet2(2:2)=IN(i)
	endif
	enddo 
	return
	end