      program brpchmax
C...............................................Dec. 2018
C
C Fix days of Pch peaks 2011-2018 at Bartels rotations
C
      dimension IM(12),ires(1:27),wps(632),iyrs(632,3)
	+,ibr(105,4) !Br start IYR,IMN,IDY,LDA
	character*50 infile,outfile
      character*2 AMN,ADY,AUT
	DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/
C
	infile='pchmax.txt'
	outfile='brpchmax.txt'	 ! Pch peaks
	OPEN(10,file=infile,action='READ')
	OPEN(11,file=outfile,access='APPEND')
   30 format(21X,I2,3(1X,I2),1X,F4.1)
   31 format(3X,I2,5X,I2,2(1X,I2),1X,F4.1)
   32 format(1X,F8.3,2(1X,I2),1X,F7.2,18X,I4)
C
      nn=0
      DO 49 i=1,632
c	read(10,*) txt
	read(10,32,end=50) xyear,imn,idy,pch
	+,ks
	iyear=int(xyear)
C--	if (iyear.lt.1997) goto 49
	ii=ii+1
	iyrs(ii,1)=iyear-iyear/100*100
	iyrs(ii,2)=imn
	iyrs(ii,3)=idy
	wps(ii)=pch
c	read(10,31,end=50) iyrs(ii,1),iyrs(ii,2),iyrs(ii,3),iyrs(ii,4),wps(ii)
   49	continue
   50 close(unit=10)
      iev=ii
C		  
C Start cycle on BR:
      iyr=11
	imn=02
	idy=23
	nnbr=2322 
	nm=0  ! number of Pch peak dates
	nmfix=0

CC
      DO 44 nn=1,iev
	nnbr=nnbr+1   ! number of BR
C
	lda=ndoy(iyr,imn,idy)
	ibr(nn,1)=iyr
	ibr(nn,2)=imn
	ibr(nn,3)=idy
	ibr(nn,4)=lda
C
	ryr=float(iyr)
		if(int(ryr/4.)*4.eq.iyr) THEN 
	ndnr=366
	im(2)=29
	                          ELSE
	ndnr=365
		im(2)=28
	ENDIF
      
	lda_nex=lda+27
	lda_nexc=lda_nex
      if (lda_nex.le.ndnr) then
	iyr_nex=iyr
	call submmdd(lda_nex,iyr_nex,imn_nex,idy_nex)
	else
	iyr_nex=iyr+1
	lda_nex=lda_nex-ndnr
	if (iyr.eq.99) iyr_nex=0   
	call submmdd(lda_nex,iyr_nex,imn_nex,idy_nex)
	endif
C
	lda_end=lda_nex-1
	if (lda_end.eq.0) lda_end=ndnr ! end of iyr
C
CC
      delyr=1./ndnr
	if (iyr.gt.50) then 
	ryear=1900.0
	else
	ryear=2000.0
	endif
C
C prepare output:
C
	ryear=ryear+ryr+(lda-1)*delyr
	call blet2(imn,AMN)
      call blet2(idy,ADY)
	do k=1,27
	ires(k)=-1
	enddo
c	nm=0
C	nmfix=0
C
C   43   nm=nm+1 ! Number of Vs peak
   43  CONTINUE
      if (nm.eq.nmfix) nm=nm+1
	if (nm.gt.632) GOTO 45                 !stop
C
      nyr=iyrs(nm,1)
	nmn=iyrs(nm,2)
	ndy=iyrs(nm,3)
	nlda=ndoy(nyr,nmn,ndy)
	nldac=nlda
	if (nyr.ne.iyr) nldac=nldac+ndnr
	if ((nyr.eq.iyr).or.(nyr.eq.iyr_nex)) then	   !+
C

C	if ((nyr.eq.iyr).and.((nldac.ge.lda).and.(nldac.lt.lda_nexc))) then  !  >>>
	if ((nldac.ge.lda).and.(nldac.lt.lda_nexc)) then  !  >>>
	kk=nldac-lda+1
	ires(kk)=kk
	nmfix=nm
	goto 43
	else									  !
	nm=nm-1
	goto 40
	endif		
                  
C
	               else						   !+
  	nm=nm-1
 	goto 40
	endif										!+
C

C    
   40 call blet2(idy,AUT)
	write(*,33) nnbr,ryear,AMN,ADY,ires
	write(11,33) nnbr,ryear,AMN,ADY,ires
C
	iyr=iyr_nex
	imn=imn_nex
	idy=idy_nex
	lda=lda_nex
   44 CONTINUE
   45  close(unit=11)
   33 format(1X,I4,1X,F8.3,2(1X,A2),27(1X,I2))
      pause ' '
	STOP
	END