program calapodst97av6
C...........................................................Aug 2026
C Apo [-24 +48]  97 intense Dst <-100 nT APO profiles 
C Apo= 0, 15, 48, 80, 132, 207, 400, kp=0,3,5,6,7,8,9
C
C
	CHARACTER*20 INFHSS,INFILE,OUTFILE
	CHARACTER*6 YYMMDD
	DIMENSION iap(0:71),idst(0:71),res(0:6)
	+,redst(0:6),cnt(0:6)
	+,idtr(0:6)
	DATA idtr/0, 15, 48, 80, 132, 207, 400/
C
C 
C+       infhss='apoprof97.txt'	 ! 	97x72 list 
       infhss='calapo24mn.txt'	 ! 	monthly peak SYM-H
C
C	infile='apoprof97.txt'	 ! 	97x72 list 
C      infile='dstprof97.txt'	 ! Dst97 prof
       infile= 'caldst24mn.txt'	 ! 	monthly peak SYM-H

	outfile='calapodst97av6.txt' !%
C
C
	OPEN(10,file=outfile,access='APPEND')
C
C
C+   28 format(72(1X,I4))  ! Dst
C+   29 format(72(1X,I4)) ! Net Vol (%)
   28 format(1X,A6,1X,I3,24(1X,I4))  ! Dst
   29 format(1X,A6,1X,I3,24(1X,I4)) ! Apo
   30 format(3I2,24(1X,F4.2))     
C
C
	do k=0,6
	res(k)=0.0
	cnt(k)=0.0
	redst(k)=0.0
	enddo
C
	OPEN(12,file=infile,action='READ')
	OPEN(11,file=infhss,action='READ')
C	 
C+	    DO 78 iev=1,97	  !97 storm 90x72 
	    DO 78 iev=1,90	  !monthly SymHpeak before Jan. 
C
C+      read(11,28,end=127) (iap(k),k=0,71) ! Read Dst
C+          read(12,29,end=128) (idst(k),k=0,71) ! Read Apo
	      read(11,28,end=127) YYMMDD,lda1, (iap(k),k=0,23) ! Read Dst
          read(12,29,end=128) YYMMDD,lda2, (idst(k),k=0,23) ! Read Apo
C
C
C+        DO 77 k=0,71
        DO 77 k=0,23
C	  if ((iap(k).ge.idtr(0)).and.(iap(k).lt.idtr(1))) then
	  if ((idst(k).ge.0).and.(iap(k).lt.idtr(1))) then
	  cnt(0)=cnt(0)+1.0
	  redst(0)=redst(0)+float(idst(k))
	  res(0)=res(0)+float(iap(k))
	goto 77
	  endif 
	if ((iap(k).ge.idtr(1)).and.(iap(k).lt.idtr(2))
	&.and.(idst(k).lt.0)) then
	  cnt(1)=cnt(1)+1.0
	  redst(1)=redst(1)+float(idst(k))
	  res(1)=res(1)+float(iap(k))
	goto 77
	  endif 
	  if ((iap(k).ge.idtr(2)).and.(iap(k).lt.idtr(3))
	&.and.(idst(k).lt.0)) then
	  cnt(2)=cnt(2)+1.0
	  redst(2)=redst(2)+float(idst(k))
	  res(2)=res(2)+float(iap(k))
	goto 77
	  endif 
	  if ((iap(k).ge.idtr(3)).and.(iap(k).lt.idtr(4))
	&.and.(idst(k).lt.0)) then
	  cnt(3)=cnt(3)+1.0
	  redst(3)=redst(3)+float(idst(k))
	  res(3)=res(3)+float(iap(k))
	goto 77
	  endif 
	  if ((iap(k).ge.idtr(4)).and.(iap(k).lt.idtr(5))
	&.and.(idst(k).lt.0)) then
	  cnt(4)=cnt(4)+1.0
	  redst(4)=redst(4)+float(idst(k))
	  res(4)=res(4)+float(iap(k))
	goto 77
	  endif 
	  if ((iap(k).ge.idtr(5)).and.(iap(k).lt.idtr(6))
	&.and.(idst(k).lt.0)) then
	  cnt(5)=cnt(5)+1.0
	  redst(5)=redst(5)+float(idst(k))
	  res(5)=res(5)+float(iap(k))
	goto 77
	  endif 
	  if ((iap(k).ge.idtr(6)).and.(idst(k).lt.0)) then
	  cnt(6)=cnt(6)+1.0
	  redst(6)=redst(6)+float(idst(k))
	  res(6)=res(6)+float(iap(k))
	goto 77
	  endif 
  77	CONTINUE
  78				CONTINUE
C
  127 close(11)
  128 close(12)
        if (cnt(0).gt.0.) then
	avdst=redst(0)/cnt(0)
	redst(0)=avdst
	avrep=res(0)/cnt(0)
	res(0)=avrep
	endif
        if (cnt(1).gt.0.) then
	avdst=redst(1)/cnt(1)
	redst(1)=avdst
	avrep=res(1)/cnt(1)
	res(1)=avrep
	endif
        if (cnt(2).gt.0.) then
	avdst=redst(2)/cnt(2)
	redst(2)=avdst
	avrep=res(2)/cnt(2)
	res(2)=avrep
	endif
        if (cnt(3).gt.0.) then
	avdst=redst(3)/cnt(3)
	redst(3)=avdst
	avrep=res(3)/cnt(3)
	res(3)=avrep
	endif
        if (cnt(4).gt.0.) then
	avdst=redst(4)/cnt(4)
	redst(4)=avdst
	avrep=res(4)/cnt(4)
	res(4)=avrep
	endif
        if (cnt(5).gt.0.) then
	avdst=redst(5)/cnt(5)
	redst(5)=avdst
	avrep=res(5)/cnt(5)
	res(5)=avrep
	endif
        if (cnt(6).gt.0.) then
	avdst=redst(6)/cnt(6)
	redst(6)=avdst
	avrep=res(6)/cnt(6)
	res(6)=avrep
	endif
C
C+++++++++++++++++++++++++++++++++
          DO k=0,6
	write(*,32) idtr(k),res(k),redst(k),cnt(k)
	write(10,32) idtr(k),res(k),redst(k),cnt(k)
	   enddo
C	
  177	CONTINUE
      close(10)
  32	FORMAT(1X,I4,1X,F6.1,1X,F7.1,1X,F7.0)
       pause ' '
	STOP
	END