      program calterm2c
C...........................................................Feb 2023
C  Calculate TECsr /TECss    along terminator from map 1x1
C for case starting from -89.5 (South Hemisphere winter)
C add subroutines: subsr, subss
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,outfiletot
	common /BL/slat
	common /BL2/tlat
C	    
        outfiletot='Term2c.out'
	OPEN(13,file=outfiletot)
       outfiless='Term8ssav1.txt'
	OPEN(11,file=outfiless,access='APPEND')
	outfilesr='Term8srav1.txt'
	OPEN(12,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
  123	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///         if (iut.lt.17) GOTO 50 !TESTTTTTTTTTTTTTTTTTTT
C Select SR / SS ranges
C
C Peak max/min slat
C
C?          tlatmax1=0.0
C?	ktlatmax1=0
C	          tlatmin1=-89.5
	sumsr=0.
	cntsr=0.
	sumss=0.
	cntss=0.
	iflag=0
C
CC
       IF ((slat(2).ge.slat(1)).and.(slat(1).ge.slat(2)).and.
	+(slat(1).ne.-89.5)) GOTO 111
CC
	IF ((slat(1).eq.-89.5).or.(slat(2).gt.slat(1))) THEN              !++++++++++++
	          tlatmin1=slat(1)
	ktlatstart=1
	do k=2,270
	if ((slat(k+1).lt.slat(k)).and.(slat(k+2).lt.slat(k+1))) then
	ktlatend=k
	exit
	endif
	enddo
C
	call subsr(ktlatstart,ktlatend,klonsr1,klonsr2,alatsr1,alatsr2)
	alonsr1=slon(klonsr1)
      alonsr2=slon(klonsr2)
	call subtecsrss(klonsr1,klonsr2,tecsr1,cntsr1)
C	sum=tecsr*cntsr+tecsr1*cntsr1
      sum=sumsr*cntsr+tecsr1*cntsr1
	cntsr=cntsr+cntsr1
      sumsr=sum/cntsr
	tecsr=sumsr
C
      write(*,33) ady,aut,amm,alonsr1,alatsr1,alonsr2,alatsr2
	+,tecsr,cntsr
      write(13,33) ady,aut,amm,alonsr1,alatsr1,alonsr2,alatsr2
 	+,tecsr1,cntsr1
C++
C SS after SR
       ktlatstart=klonsr2
	kdelta=180
	DO k=360,ktlatstart,-1
	if (slat(k).eq.-89.5) then
	ktlatend=k
	exit
	endif
	ENDDO
	call subss(ktlatstart,ktlatend,klonss1,klonss2,alatss1,alatss2)
	alonss1=slon(klonss1)
      alonss2=slon(klonss2)
      call subtecsrss(klonss1,klonss2,tecss1,cntss1)
	sum=sumss*cntss+tecss1*cntss1
	cntss=cntss+cntss1
	sumss=sum/cntss
	tecss=sumss
      write(*,33) ady,aut,amm,alonss1,alatss1,alonss2,alatss2
	+,tecss,cntss
      write(13,33) ady,aut,amm,alonss1,alatss1,alonss2,alatss2
 	+,tecss1,cntss1
C++
	IF (slat(360).eq.-89.5) THEN
	GOTO 150
	                  ELSE
       ktlatstart=klonss2
	ktlatend=360
	call subsr(ktlatstart,ktlatend,klonsr3,klonsr4,alatsr3,alatsr4)
	alonsr3=slon(klonsr3)
      alonsr4=slon(klonsr4)
	call subtecsrss(klonsr3,klonsr4,tecsr2,cntsr2)
	sum=sumsr*cntsr+tecsr2*cntsr2
	cntsr=cntsr+cntsr2
	sumsr=sum/cntsr
	tecsr=sumsr
C
      write(*,33) ady,aut,amm,alonsr3,alatsr3,alonsr4,alatsr4
	+,tecsr,cntsr
      write(13,33) ady,aut,amm,alonsr3,alatsr3,alonsr4,alatsr4
 	+,tecsr2,cntsr2
C++
C++ 2nd ss
CC
	IF ((klonsr3.lt.360).and.(slat(360).lt.alatsr4)) THEN         !==================
       ktlatstart=klonsr4
	ktlatend=360
	call subss(ktlatstart,ktlatend,klonss3,klonss4,alatss3,alatss4)
	alonss3=slon(klonss3)
      alonss4=slon(klonss4)
	call subtecsrss(klonss3,klonss4,tecss2,cntss2)
	sum=sumss*cntss+tecss2*cntss2
	cntss=cntss+cntss2
	sumss=sum/cntss
	tecss=sumss
C
      write(*,33) ady,aut,amm,alonss3,alatss3,alonss4,alatss4
	+,tecss,cntss
      write(13,33) ady,aut,amm,alonss3,alatss3,alonss4,alatss4
 	+,tecss2,cntss2
	 alatss2=alatsr4 !Summary TEC
	alonss2=alonss4	 !Summary TEC
       GOTO 150
	                            ELSE
	 alatsr2=alatsr4 !Summary TEC
	alonsr2=alonsr4	 !Summary TEC
       GOTO 150
	ENDIF
	                                  ENDIF
	ENDIF
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  111    	IF (slat(2).le.slat(1)) THEN
	          tlatmax1=slat(1)
	ktlatstart=1
	do k=2,270
	if (slat(k).eq.-89.5) then
	ktlatend=k
	exit
	endif
	enddo
C SS first
C
	call subss(ktlatstart,ktlatend,klonss1,klonss2,alatss1,alatss2)
	alonss1=slon(klonss1)
      alonss2=slon(klonss2)
      call subtecsrss(klonss1,klonss2,tecss1,cntss1)
	sum=sumss*cntss+tecss1*cntss1
	cntss=cntss+cntss1
	sumss=sum/cntss
	tecss=sumss
      write(*,33) ady,aut,amm,alonss1,alatss1,alonss2,alatss2
	+,tecss,cntss
      write(13,33) ady,aut,amm,alonss1,alatss1,alonss2,alatss2
 	+,tecss1,cntss1
C SR after SS
      ktlatstart=klonss2+1
	ktlatend=360
	call subsr(ktlatstart,ktlatend,klonsr1,klonsr2,alatsr1,alatsr2)
	alonsr1=slon(klonsr1)
      alonsr2=slon(klonsr2)
	call subtecsrss(klonsr1,klonsr2,tecsr1,cntsr1)
C	sum=tecsr*cntsr+tecsr1*cntsr1
      sum=sumsr*cntsr+tecsr1*cntsr1
	cntsr=cntsr+cntsr1
      sumsr=sum/cntsr
	tecsr=sumsr
C
      write(*,33) ady,aut,amm,alonsr1,alatsr1,alonsr2,alatsr2
	+,tecsr,cntsr
      write(13,33) ady,aut,amm,alonsr1,alatsr1,alonsr2,alatsr2
 	+,tecsr1,cntsr1
C++
C 2nd SS
	IF ((klonsr2.lt.360).and.(slat(360).lt.alatsr2)) THEN         !==================
       ktlatstart=klonsr2
	ktlatend=360
	call subss(ktlatstart,ktlatend,klonss3,klonss4,alatss3,alatss4)
	alonss3=slon(klonss3)
      alonss4=slon(klonss4)
	call subtecsrss(klonss3,klonss4,tecss2,cntss2)
	sum=sumss*cntss+tecss2*cntss2
	cntss=cntss+cntss2
	sumss=sum/cntss
	tecss=sumss
C
      write(*,33) ady,aut,amm,alonss3,alatss3,alonss4,alatss4
	+,tecss,cntss
      write(13,33) ady,aut,amm,alonss3,alatss3,alonss4,alatss4
 	+,tecss2,cntss2
	 alatss2=alatsr4 !Summary TEC
	alonss2=alonss4	 !Summary TEC
       GOTO 150
	                     ELSE
	GOTO 150
	ENDIF
	ENDIF
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 33	format(1X,3(1X,A2),6(1X,F6.1))
C
C  150	if (klonsr1c.eq.360) then
 150     write(11,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(12,33) ady,aut,amm,alonss1,alatss1,alonss2,alatss2
	+,tecss,cntss
C	 endif

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