      program calterm2a
C...........................................................Jan 2022
C  Calculate TECsr /TECss    along terminator from map 1x1
C for case starting from -89.5 (South Hemisphere winter)
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='Term8ssav1.txt'
	OPEN(12,file=outfiless,access='APPEND')
	outfilesr='Term8srav1.txt'
	OPEN(11,file=outfilesr,access='APPEND')
      infile='c:\MSDEV\Projects\Maps\Output\Term2022MNDD.dat'
	AMN='08'
	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.0
	ktlatmax1=0
C	          tlatmin1=-89.5
	          tlatmin1=slat(1)
	ktlatmin1=1
	sumsr=0.
	cntsr=0.
	sumss=0.
	cntss=0.
	iflag=0
	IF (slat(1).eq.-89.5) THEN              !++++++++++++
C
      	IF (slat(2).le.slat(1)) THEN
	DO kk=1,180
	if (slat(kk).gt.tlatmin1) then 
	tlatmin1=slat(kk)
	ktlatmin1=kk
	iflag=2	                      !SS
	kstart=ktlatmin1
	kend=ktlatmin1+200
	tlatmax1=tlatmin1
	exit
	endif
	ENDDO
	                       ELSE
	DO kk=1,180
	if (slat(kk).gt.tlatmax1) then 
	tlatmax1=slat(kk)
	ktlatmax1=kk
	iflag=1						 !SR
	kstart=ktlatmax1
	kend=ktlatmax1+200
	tlatmin1=tlatmax1
	exit
	endif
	ENDDO
	                         ENDIF
	                                      ELSE   !++++++++++
      	IF (slat(2).gt.slat(1)) THEN
	tlatmin1=slat(1)
	ktlatmin1=1
	tlatmax1=slat(2)
	ktlatmax1=2
	DO kk=1,180
	if (slat(kk).gt.tlatmax1) then 
	tlatmax1=slat(kk)
	ktlatmax1=kk
	iflag=2	                      !SS
	kstart=ktlatmax1
	kend=ktlatmax1+200
	tlatmin2=tlatmax1
C	exit
	endif
	ENDDO
	                       ELSE
	tlatmax1=slat(1)
	ktlatmax1=1
	tlatmin1=slat(2)
	ktlatmin1=2
	DO kk=1,180
	if (slat(kk).lt.tlatmin1) then 
	tlatmin1=slat(kk)
	ktlatmin1=kk
	iflag=1						 !SR
	kstart=ktlatmin1
	kend=ktlatmin1+200
	tlatmax2=tlatmin1
C	exit
	endif
	ENDDO
	                         ENDIF
	                                      ENDIF  !++++++++++++++++
C
C       
	DO kk=kstart,kend
	IF (iflag.eq.2) THEN				  !+
        if (slat(kk).gt.tlatmax1) then	 !++2SS
	  tlatmax1=slat(kk)
	  ktlatmax1=kk
	kstart=ktlatmax1
	tlatmax2=tlatmax1
	  endif								 !++
	                ELSE				   !+
        if (slat(kk).lt.tlatmin1) then	 !++1SR
	  tlatmin1=slat(kk)
	  ktlatmin1=kk
	kstart=ktlatmin1
	tlatmin2=tlatmin1
	  endif								 !++
                      ENDIF				  !+
	ENDDO
C
      DO kk=kstart,360
	IF (iflag.eq.2) THEN             !+ 2SS1
	if (slat(kk).lt.tlatmax2) then 	   !++2
	tlatmax2=slat(kk)
	ktlatmax2=kk
	kstart=ktlatmax2
	tlatmin2=tlatmax2
	exit
	endif							 !++
	                  ELSE			  !+
	if (slat(kk).gt.tlatmin2) then 	   !++SR1
	tlatmin2=slat(kk)
	ktlatmin2=kk
	kstart=ktlatmin2
	tlatmax2=tlatmin2
	exit
	endif							!++
                          ENDIF		  !+
        ENDDO
C
          DO kk=kstart,360
	if (iflag.eq.2) THEN             !+ 2SS2
      if (slat(kk).lt.tlatmin2) then
	tlatmin2=slat(kk)
	ktlatmin2=kk
	kstart=ktlatmin2
	tlatmax3=tlatmin2
	endif
	                                 else	!+
	if (slat(kk).gt.tlatmax2) then 		 !1SR2
	tlatmax2=slat(kk)
	ktlatmax2=kk
	kstart=ktlatmax2
	tlatmin3=tlatmax2
	endif
	                       endif             !+
	ENDDO
C
C Check added part at the end of terminator:
       ktlatmax3=0
	ktlatmin3=0
C
      IF (slat(360).gt.-89.5) THEN         !+++++++++++++++++++++++++  1
C
                DO kk=kstart,360
	if (iflag.eq.2) THEN             !+ 2SS2	   >>>>>>>>>>>>>>>>	2
      if (slat(kk).gt.tlatmax3) then					  !		3
	tlatmax3=slat(kk)
	ktlatmax3=kk
	kstart=ktlatmax3
	tlatmin4=tlatmax3
	endif                                             !     3
	                                 else	!+		 >>>>>>>>>>>>>>>>2
	if (slat(kk).lt.tlatmin3) then 		 !1SR2		   ! 4
	tlatmin3=slat(kk)
	ktlatmin3=kk
	kstart=ktlatmin3
	tlatmax4=tlatmin3								  !
	endif											  !      4
	                                endif            !>>>>>>>>>>>>>>>>>2
	ENDDO
                                  ENDIF   !++++++++++++++++++++++++++++
CC
CC Produce TECav for 2SS1 
CC 
        IF (iflag.eq.2) THEN   !=================
	alatss1=tlatmin1
	alatss2=tlatmax1
	alonss1=slon(ktlatmin1)
	alonss2=slon(ktlatmax1)
C       DO kk=klonss1,klonss2
       DO kk=ktlatmin1,ktlatmax1
	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(12,33) ady,aut,amm,alonss1,alatss1,alonss2,alatss2
C	+,tecss,cntss
C
C Then TECav for SR2
C
	alatsr1=tlatmax2
	alatsr2=tlatmin2
	alonsr1=slon(ktlatmax2)
	alonsr2=slon(ktlatmin2)
       DO kk=ktlatmax2,ktlatmin2
	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(11,33) ady,aut,amm,alonsr1,alatsr1,alonsr2,alatsr2
C 	+,tecsr,cntsr
C
                              ELSE			!================
C
C
C TECav	  SR1
C
	alatsr1=tlatmax1
	alatsr2=tlatmin1
	alonsr1=slon(ktlatmax1)
	alonsr2=slon(ktlatmin1)

	DO kk=ktlatmax1,ktlatmin1
	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(11,33) ady,aut,amm,alonsr1,alatsr1,alonsr2,alatsr2
C 	+,tecsr,cntsr
C Then TECav for SS1
	alatss1=tlatmin2
	alatss2=tlatmax2
	alonss1=slon(ktlatmin2)
	alonss2=slon(ktlatmax2)

	DO kk=ktlatmin3,360
	if (slat(kk).gt.-89.5) then
	sumss=sumss+tlat(kk)
	cntss=cntss+1.0
	endif
	 enddo
	tecss=sumss/cntss
      write(*,33) ady,aut,amm,alonss1,alatss1,alonss2,alatss2
 	+,tecss,cntss
C      write(12,33) ady,aut,amm,alonss1,alatss1,alonss2,alatss2
C 	+,tecss,cntss
                          
                             ENDIF		  !++++++++++++++++++++++++++
C
	klonsr1c=360
	cntss1=1000
CC
CC Produce TECav for 2SS1 
CC
       IF ((ktlatmax3.gt.0).or.(ktlatmin3.gt.0)) THEN		!================
C
C TECav for extra 3rd range
        IF (iflag.eq.2) THEN								!+++++++++
	alatss1=tlatmin3
	alonss1=slon(ktlatmin3)
       DO kk=ktlatmin3,360
	if (slat(kk).gt.-89.5) then						   !----
	sumss=sumss+tlat(kk)
	cntss=cntss+1.0
	klatmax=kk
	endif											   !----
	 enddo
	tecss=sumss/cntss
	alatss2=slat(klatmax)
	alonss2=slon(klatmax)
      write(*,33) ady,aut,amm,alonss1,alatss1,alonss2,alatss2
	+,tecss,cntss
C?	 cntss1=cntss
C      write(12,33) ady,aut,amm,alonss1,alatss1,alonss2,alatss2
C	+,tecss,cntss
                       ELSE							   !+++++++++++++++
	alatsr1=tlatmax3
	alonsr1=slon(ktlatmax3)
       DO kk=ktlatmax3,360
	if (slat(kk).gt.-89.5) then
	sumsr=sumsr+tlat(kk)
	cntsr=cntsr+1.0
	klatmin=kk
	endif
	 enddo
	tecsr=sumsr/cntsr
	alatsr2=slat(klatmin)
	alonsr2=slon(klatmin)
      write(*,33) ady,aut,amm,alonsr1,alatsr1,alonsr2,alatsr2
	+,tecsr,cntsr
C?	 cntss1=cntss
C      write(12,33) ady,aut,amm,alonss1,alatss1,alonss2,alatss2
C	+,tecss,cntss

	                                      ENDIF			 !++++++++++
C                                               
                                                    ENDIF !===================
C	klonsr1c=360

C	cntss1=1000
C	GOTO 150

C
  33	format(1X,3(1X,A2),6(1X,F6.1))
C
C  150	if (klonsr1c.eq.360) then
 150     write(12,33) ady,aut,amm,alonsr1,alatsr1,alonsr2,alatsr2
 	+,tecsr,cntsr
C	                     else
C	  write(12,33) ady,aut,amm,alonsr1c,alatsr1c,alonsr2c,alatsr2c
C	+,tecsr,cntsr
C                   endif
C		 if (cntss1.lt.cntss) then
C       write(11,33) ady,aut,amm,alonss1c,alatss1c,alonss2c,alatss2c
C	+,tecss,cntss 	
C                        else
        write(11,33) ady,aut,amm,alonss1,alatss1,alonss2,alatss2
	+,tecss,cntss
C	 endif

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