      program calterm2
C...........................................................Jan 2022
C  Calculate TECsr /TECss    along terminator from map 1x1
C
      DIMENSION tlat(360),slat(360),slon(360),ivat(360)
	CHARACTER*2 AMN,ADY,AUT,AMM,CMN,CDY,CUT,CMM
		CHARACTER*64 infile,outfiless,outfilesr
C	    
       outfiless='Term2ssav1.txt'
	OPEN(11,file=outfiless,access='APPEND')
	outfilesr='Term2srav1.txt'
	OPEN(12,file=outfilesr,access='APPEND')
      infile='c:\MSDEV\Projects\Maps\Output\Term2022MNDD.dat'
	AMN='02'
	infile(39:40)=AMN
	write(*,*) ' Enter ADY:'
	read(*,*) ADY
C	ADY='01'
      infile(41:42)=ADY
   30 format(2X,2A2,2X,2A2)
   31 format(2(1X,F6.1),2X,F6.1,1X,I4)
C
       OPEN(10,file=infile,action='READ')
C
	DO 51 iut=0,23
	call blet2(iut,AUT)
C
	DO 50 imm=0,45,15
	call blet2(imm,AMM)
C
	read(10,30) CMN,CDY,CUT,CMM
	if ((CMN.eq.AMN).and.(CDY.eq.ADY).and.(CMM.eq.AMM)) then
       do kk=1,360
	read(10,31,end=55) slon(kk),slat(kk),tlat(kk),ivat(kk)
	 enddo
	else
	write (*,*) ' Check input file'
	close(10)
	pause ' '
	STOP
	endif
C
C Select SR / SS ranges
C
C Peak max/min slat
C
          tlatmax1=0.
	          tlatmin1=90.
	sumsr=0.
	cntsr=0.
	sumss=0.
	cntss=0.
	iflag=0
	DO kk=1,180
	if (slat(kk).gt.tlatmax1) then 
	tlatmax1=slat(kk)
	ktlatmax1=kk
	endif
	ENDDO
	if (ktlatmax1.gt.1) then
	iflag=1
	kstart=1
	kend=ktlatmax1
	else
	iflag=2
	kstart=ktlatmax1
	kend=ktlatmax1+200
	endif
C
	DO kk=kstart,kend
      if (slat(kk).lt.tlatmin1) then
	tlatmin1=slat(kk)
	ktlatmin1=kk
	endif
	ENDDO
C
          tlatmax2=0.
	          tlatmin2=90.
	          tlatmin3=90.
	if (iflag.eq.1) then             !+++
        DO kk=ktlatmin1,360
	if (slat(kk).gt.tlatmax2) then 
	tlatmax2=slat(kk)
	ktlatmax2=kk
	endif
        ENDDO
C
          DO kk=ktlatmax2,360
      if (slat(kk).lt.tlatmin2) then
	tlatmin2=slat(kk)
	ktlatmin2=kk
	endif
	    ENDDO
C?	DO kk=ktlatmax2,360
C?      if (slat(kk).lt.tlatmax2) then
C?	tlatmin3=slat(kk)
C?	ktlatmin3=kk
C?	    ENDDO
	                                 else	!+++
        DO kk=ktlatmin1,360
	if (slat(kk).gt.tlatmax2) then 
	tlatmax2=slat(kk)
	ktlatmax2=kk
	endif
	ENDDO
          DO kk=ktlatmax2,360
      if (slat(kk).lt.tlatmin2) then
	tlatmin2=slat(kk)
	ktlatmin2=kk
	endif
	    ENDDO
C
	ENDIF                                         !+++

C--	if ((tlatmax1.lt.90.).and.(ktlatmax1.gt.1)) tlatmax1=slat(1)+0.1 
	tlatmax=tlatmax1
      tlatmin=tlatmin1
	ktlatmax=ktlatmax1
      ktlatmin=ktlatmin1
	IF (slat(1).eq.tlatmin1) THEN
	 klonss2=1
	cntss1=1000.
	GOTO 121
	ENDIF
C
      alatsr1=90.0
	alatss1=90.
	blatsr1=90.
	blatss1=90
	xlat_pre=90.0
C
C Start SS1:
	DO kk=1,360
	if ((slat(kk).lt.xlat_pre).and.(slat(kk).lt.tlatmax)) then
C  SS starts
	alatss1=slat(kk)
	klonss1=kk
	alonss1=slon(kk)
	xlat_pre=slat(kk)
	exit
	endif
	xlat_pre=slat(kk)
      enddo
C
C  End SS1:
C Start SS2
	DO kk=klonss1,ktlatmin
	if ((slat(kk).lt.xlat_pre).and.(slat(kk).eq.tlatmin)) then
	alatss2=slat(kk)
	klonss2=kk
      alonss2=slon(kk)
	xlat_pre=slat(kk)
	exit
	endif
	xlat_pre=slat(kk)
      enddo
C End SS2
C SumTEC
       DO kk=klonss1,klonss2
	sumss=sumss+tlat(kk)
	cntss=cntss+1.0
	 enddo
	tecss=sumss/cntss
      write(*,33) ady,aut,amm,alonss1,alatss1,alonss2,alatss2
	+,tecss,cntss
	 cntss1=cntss
C?      write(11,33) ady,aut,amm,alonss1,alatss1,alonss2,alatss2
C?	+,tecss,cntss
C
C Start SR1
C
  121	DO kk=klonss2,ktlatmax2
C
	if ((slat(kk).gt.xlat_pre).and.(slat(kk).gt.tlatmin)) then
C  SR starts
	alatsr1=slat(kk)
	klonsr1=kk
	alonsr1=slon(kk)
	xlat_pre=slat(kk)
	exit
	endif
	xlat_pre=slat(kk)
      enddo
C
C  End SR1:
	tlatmax=tlatmax2
      tlatmin=tlatmin2
	ktlatmax=ktlatmax2
      ktlatmin=ktlatmin2
C End	SR2:           
	alatsr2=tlatmax
	klonsr2=ktlatmax
	alonsr2=slon(ktlatmax)
	xlat_pre=alatsr2
C
C SumTEC
       DO kk=klonsr1,klonsr2
	sumsr=sumsr+tlat(kk)
	cntsr=cntsr+1.0
	 enddo
	tecsr=sumsr/cntsr
      write(*,33) ady,aut,amm,alonsr1,alatsr1,alonsr2,alatsr2
	+,tecsr,cntsr
C      write(12,33) ady,aut,amm,alonsr1,alatsr1,alonsr2,alatsr2
C 	+,tecsr,cntsr
	 IF (slat(360).eq.tlatmax2) then
	klonsr1c=360
	 GOTO 150
	ENDIF
C	                        
C Start SS1c (cont.)
	DO kk=klonsr2,ktlatmin
	if ((slat(kk).lt.xlat_pre).and.(slat(kk).lt.tlatmax)) then
	alatss1c=slat(kk)
	klonss1c=kk
	alonss1c=slon(kk)
	xlat_pre=slat(kk)
	exit
	endif
	xlat_pre=slat(kk)
      enddo
C
C 
C Start SS2c
C	DO kk=klonss1c,360
	DO kk=klonss1c,360
		if ((slat(kk).lt.xlat_pre).and.(slat(kk).eq.tlatmin)
	+.or.(kk.eq.360)) then
	alatss2c=slat(kk)
		klonss2c=kk
      alonss2c=slon(kk)
		xlat_pre=slat(kk)
	exit
	endif
	xlat_pre=slat(kk)
      enddo
C+?	                     ENDIF
C End SS2c

C else find tmin2 & find End SS2c
C	                   
C End SS1c
C SumTEC
       DO kk=klonss1c,klonss2c
	sumss=sumss+tlat(kk)
	cntss=cntss+1.0
	 enddo
	tecss=sumss/cntss
C
  123     write(*,33) ady,aut,amm,alonss1c,alatss1c,alonss2c,alatss2c
     +,tecss,cntss
C	GOTO 50 !++++++++++++++++++++++++++++++++++++++++++++++++++>>>>>>>>>>>>>>>>
	klonsr1c=360
	IF ((klonss2.eq.1).and.(slat(360).gt.tlatmin2)) THEN  !1
C Start SR1c
C        write (*,*) ' NEED SS1c'
       DO kk=ktlatmin2,360
	if (((slat(kk).gt.xlat_pre).and.(slat(kk).gt.tlatmin2))  !2
	+.or.(kk.eq.360)) then
	alatsr1c=slat(kk)
		klonsr1c=kk
      alonsr1c=slon(kk)
		xlat_pre=slat(kk)
	exit
	endif													 !2
	xlat_pre=slat(kk)
      enddo
C	pause ' '
C	   End SR1c
C       if (klonsr1c.lt.360) then
C      alatsr2c=tlatmin2
C	alonsr2c=slon(ktlatmin2)
C	       else
	alatsr2c=slat(360)
	alonsr2c=179.5
C	endif
C SumTEC
       DO kk=klonsr1c,360
	sumsr=sumsr+tlat(kk)
	cntsr=cntsr+1.0
	 enddo
	tecsr=sumsr/cntsr
C
	write(*,33) ady,aut,amm,alonsr1c,alatsr1c,alonsr2c,alatsr2c
	+,tecsr,cntsr
	ENDIF
C
  33	format(1X,3(1X,A2),6(1X,F6.1))
C
  150	if (klonsr1c.eq.360) then
      write(12,33) ady,aut,amm,alonsr1,alatsr1,alonsr2,alatsr2
 	+,tecsr,cntsr
	                     else
	  write(12,33) ady,aut,amm,alonsr1c,alatsr1c,alonsr2c,alatsr2c
	+,tecsr,cntsr
                    endif
		 if (cntss1.lt.cntss) then
       write(11,33) ady,aut,amm,alonss1c,alatss1c,alonss2c,alatss2c
	+,tecss,cntss 	
                        else
        write(11,33) ady,aut,amm,alonss1,alatss1,alonss2,alatss2
	+,tecss,cntss
	 endif

   50 continue
   51 continue
   55 close(10)
       close(11)
	close(12)
	pause ' '
	STOP
	END
         