      program extrma4j
C................................................Mar. 2013
C Extract JPL TEC map for maglat=-85.-80,...,80,85  (35 lines)
C                         maglon=0, 5, 10, ..., 355, 360 (0:72 columns)
C Input: <glatgrid.txt> <glongrid.txt> =geogr.coords. for mlat,mlon grids
C 
C
C
C ...............................................Jan. 2013
C extract-interpolate from JPL-TEC or UPC-TEC map 
C
	CHARACTER*2 AYR,AMN,ADY,AUT
	CHARACTER*1 fm
	CHARACTER*65 outfile,infile
	+,inglats,inglons
	INTEGER*2 jyr,jmn,jdy1,jdy2,jdy,jut
	DIMENSION im(12),itec(0:72)
	+,glats(35,0:72),glons(35,0:72)
	DATA  IM/31,28,31,30,31,30,31,31,30,31,30,31/
C
  103	nn=1
  	fm='t'
C Read geogr. coords. for magn. grids
	inglats='glatgrid.txt'
	inglons='glongrid.txt'
  102	format(73(1X,I4))
  101	format(73(1X,F5.1))
	OPEN(10,file=inglats)
	OPEN(11,file=inglons)
C

	do i=1,35
	read(10,101) (glats(i,k),k=0,72)
	do k=0,72
	if (glats(i,k).gt.87.5) glats(i,k)=87.5
	if (glats(i,k).lt.-87.5) glats(i,k)=-87.5
	enddo
      read(11,101) (glons(i,k),k=0,72)
	enddo
	close(unit=10)
	close(unit=11)
C
	write(*,*) 'enter AYR='
	read(*,*) AYR
	write(*,*) 'enter AMN='
	read(*,*) amn
C
 	read(ayr,*) ryr
	jyr=int(ryr)
	read(amn,*) rmn
	jmn=int(rmn)
	if(int(ryr/4.)*4.eq.jyr) THEN 
 	im(2)=29
	                          ELSE
	IM(2)=28
	ENDIF

	jdy1=1
	jdy2=im(jmn)
C
	infile='d:\web\dts\YR\MN\tcMNDYUT.jYR'
	infile(12:13)=AYR
	infile(28:29)=AYR
	infile(15:16)=AMN
	infile(20:21)=AMN

C	outfile='d:\web\dtm\YR\MN\tmMNDYUT.jYR'
C 
C Start cycle on parameter
c-   31	nn=nn+1
c-	if (nn.gt.3) goto 23
C
C Day-to-day cycle
	do 120 jdy=jdy1,jdy2
	call blet2(jdy,ADY)
	infile(22:23)=ADY
C       
C Cycle on UT
	do 115 jut=0,23
	call blet2(jut,AUT)
	infile(24:25)=AUT

C	outfile='d:\web\dtm\YR\MN\tmMNDYUT.jYR'
		outfile=infile
	outfile(10:10)='m'		!  
	outfile(19:19)='m'		!  
	OPEN(13,file=outfile,access='APPEND')
C
C All Mlats for Local noon
  110	DO 100 ilat=1,35
      	DO ilon=0,72 
	glat=glats(ilat,ilon)
	glon=glons(ilat,ilon)
C
C
	call subinterp(fm,glat,glon,ayr,amn,ady,aut,res)
	itec(ilon)=nint(res)
	   ENDDO
	write(*,102) (itec(k),k=0,72)
	write(13,102) (itec(k),k=0,72)

C
  100	continue ! End cycle on ilat
	close(unit=13)

  115	CONTINUE        ! End cycle on UT

  120	CONTINUE        ! End day-to-day cycle
	write(*,121) ayr,amn
  121	format(1X,A2,1X,A2)
   23	pause ' '
	stop
	end