program extdst2
C.................................................................Dec  2019
C.................................................................Feb. 2014
C
C extract Dst storms excluding the same start day
C  input: dststorm.txt
C output dststorm.out
	CHARACTER*30 infile,outfile
	CHARACTER*77 txt
	CHARACTER*8 txt1,txt2,txt3,txt1i,txt2i,txt3i,txt1p,txt2p,txt3p
	integer nn,icnt,ihrs,ihrsp,ihrsi
	integer*2 idy1,iut1,idy2,iut2,idy3,iut3
	+,idy1p,iut1p,idy2p,iut2p,idy3p,iut3p
     +,idy1i,iut1i,idy2i,iut2i,idy3i,iut3i
C
C
	infile='dststorm.txt'
	outfile='dststorm.out'
	OPEN(11,FILE=INFILE,action='READ')
	OPEN(12,FILE=OUTFILE)
	do i=1,14
	read(11,20) txt	 ! title lines
	write(12,20) txt
	enddo

C
   20	format(A77)
   21	format(1X,I4,1X,A8,I2,1X,I2,2X,A8,I2,1X,I2,1X,F5.0
     +,2X,A8,I2,1X,I2,2X,I3)
C ==========================================================
	icnt=0
   1	continue               ! cycle on input line
	read(11,21,end=151) nn,txt1,idy1,iut1,txt2,idy2,iut2,dstmin
	+,txt3,idy3,iut3,ihrs
	write(*,21) nn,txt1,idy1,iut1,txt2,idy2,iut2,dstmin
	+,txt3,idy3,iut3,ihrs
	txt1p=txt1
	 idy1p=idy1
	iut1p=iut1
	txt2p=txt2
	idy2p=idy2
	iut2p=iut2
	dstminp=dstmin
	txt3p=txt3
	idy3p=idy3
	iut3p=iut3
	ihrsp=ihrs
	if (icnt.eq.0) goto 149
   2	read(11,21,end=151) nn,txt1,idy1,iut1,txt2,idy2,iut2,dstmin
	+,txt3,idy3,iut3,ihrs
	write(*,21) nn,txt1,idy1,iut1,txt2,idy2,iut2,dstmin
	+,txt3,idy3,iut3,ihrs
		if ((txt1.eq.txt1p).and.(idy1.eq.idy1p)) then
	icnt=icnt-1
	goto 148
	else
		goto 149
	endif
C equal yr,mn,dy1
148	if (dstminp.lt.dstmin) then
	txt1i=txt1p
 	idy1i=idy1p
	iut1i=iut1p
	txt2i=txt2p
	idy2i=idy2p
	iut2i=iut2p
	dstmini=dstminp
	goto 153
	else
	txt1i=txt1
 	idy1i=idy1
	iut1i=iut1
	txt2i=txt2
	idy2i=idy2
	iut2i=iut2
	dstmini=dstmin
	endif
C	write(*,*) 
  153	txt3i=txt3
 	idy3i=idy3
	iut3i=iut3
	ihrsi=ihrs
	goto 152
  149	txt1i=txt1
	idy1i=idy1
	iut1i=iut1
	txt2i=txt2
	idy2i=idy2
	iut2i=iut2
	dstmini=dstmin
	txt3i=txt3
	idy3i=idy3
	iut3i=iut3
	ihrsi=ihrs
  152 	icnt=icnt+1
      write(*,21) icnt,txt1i,idy1i,iut1i,txt2i,idy2i,iut2i,dstmini
 	+,txt3i,idy3i,iut3i,ihrsi
      write(12,21) icnt,txt1i,idy1i,iut1i,txt2i,idy2i,iut2i,dstmini
 	+,txt3i,idy3i,iut3i,ihrsi
	txt1p=txt1i
	 idy1p=idy1i
	iut1p=iut1i
	txt2p=txt2i
	idy2p=idy2i
	iut2p=iut2i
	dstminp=dstmini
	txt3p=txt3i
	idy3p=idy3i
	iut3p=iut3i
	ihrsp=ihrsi
  150	goto 2
  151 close(unit=11)
C
rem	pause ' '
	goto 22
    3	 write(*,*) 'INPUT FILE IS NOT IN YOUR DIRECTORY '
	write(*,*) infile
   22      CLOSE (unit=12)

	write(*,*) infile
	pause ' '
C
      STOP
	END
C ===============================================================
C ===============================================================
      integer function ndoy(iyr,imn,idy)
C To define day-of-year
C
	       DIMENSION IM(12)
	integer*2 iyr,imn,idy
	DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
	z1=iyr/4.0
      jz1=int(z1)*4
      IF(jz1.EQ.iyr) THEN
               IM(2)=29
        ELSE
                IM(2)=28
	       ENDIF
C Day-of-year LDA1
		mosum=0
      if(imn.gt.1) then
         do 1234 i=1,imn-1
1234    mosum=mosum+im(i)
         endif
      ndoy=mosum+idy	
	END FUNCTION
C ===============================================================
C Convert numeric parameter ilet to character alet
      subroutine blet4(ilet,alet4)
c     nn=1,2,3,4 

	CHARACTER*1 IN(0:9)
		DATA IN/'0','1','2','3','4','5','6','7','8','9'/
      CHARACTER*4 alet4
	alet4=' 000'
C
   1		j1000=ilet/1000
	      j100=(ilet-j1000*1000)/100
	j10=(ilet-j1000*1000-j100*100)/10
	j1=ilet-j1000*1000-j100*100-j10*10
	do i=0,9
		if (j1000.eq.i) then
	 alet4(1:1)=IN(i)
	endif
	enddo
	if(alet4(1:1).eq.'0') alet4(1:1)=' '
    3	do i=0,9
		if (j100.eq.i) then
	 alet4(2:2)=IN(i)
	endif
	enddo
c	if((alet4(1:1).eq.' ').and.(alet4(2:2).eq.'0')) alet4(2:2)=' '
    5	do i=0,9
	if (j10.eq.i) then
	alet4(3:3)=IN(i)
	endif
	enddo
   7	do i=0,9 
     	if (j1.eq.i) then
 	alet4(4:4)=IN(i)
	endif
	enddo 
	return
	end
C
      subroutine blet3(ilet,alet3)
c     nn=1,2,3,4 

	CHARACTER*1 IN(0:9)
	DATA IN/'0','1','2','3','4','5','6','7','8','9'/
	CHARACTER*3 alet3
	a3='000'
C
	j100=ilet/100
	      j10=(ilet-j100*100)/10
	j1=ilet-j100*100-j10*10
    3	do i=0,9
		if (j100.eq.i) then
	alet3(1:1)=IN(i)
	endif
	enddo
    5	do i=0,9
	if (j10.eq.i) then
	alet3(2:2)=IN(i)
	endif
	enddo
   7	do i=0,9 
     	if (j1.eq.i) then
 	alet3(3:3)=IN(i)
	endif
	enddo 
	return
	end
C
      subroutine blet2(ilet,alet2)
c     nn=1,2,3,4 

	CHARACTER*1 IN(0:9)
	DATA IN/'0','1','2','3','4','5','6','7','8','9'/
	CHARACTER*2 alet2
	a2='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
C
      subroutine blet1(ilet,alet1)
c     nn=1,2,3,4 

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