C........................................................Mar.2019
C Extract fixed Vs-index from JPLi 15-min files (1 x 1 deg) for 12:00 UT
C longs=-179.5:1:179.5
C lats -89.5:1:89.5
C input Vs : D:\web\drs\YR\MN\vlMNDDUTMM.jYR index file
C calculate daily and monthly aver Vs+/map and Vs-/map (360x180 =648000 grids)
C output <extjpliv.txt>
C 
      PROGRAM extjpliv
C----------------------------------------------------------------
C
      integer ivs(360),IM(12)
C
	CHARACTER*2 AYR,AMN,ADY
      CHARACTER*128 INFILE,OUTFILE1,OUTFILE2
	CHARACTER(10) DD
      CHARACTER(10) TT
      CHARACTER(5) ZZ
	DATA IM/31,28,31,30,31,30,31,31,30,31,30,31/ 
C++
C
      ICALLS=0
	CALL DATE_AND_TIME(DATE=DD,TIME=TT,ZONE=ZZ)
      TT(5:)='      '
      WRITE(*,*) 'PC Date: Year,Month,Day = ',DD,'Time = ',TT
C
C 
	infile='D:\web\drs\YR\MN\vlMNDD1200.jYR'
C
 	outfile1='extjplivdy.txt'
	outfile2='extjplivmn.txt'
C
   30 FORMAT(1X,2A2,2(1X,I2),2(1X,F6.1))
   31 FORMAT(360(1X,I4))
   32 FORMAT(1X,3A2,2(1X,F6.2,1X,F8.0))
C
	OPEN(10,file=outfile1,access='APPEND')
	OPEN(11,file=outfile2,access='APPEND')
C
C Year-by-year cycle
C++	DO 200 iyr=0,17
	iyr=5
	call blet2(iyr,AYR)
		z1=iyr/4.0
      jz=int(z1)*4
	IF(jz.EQ.iyr) THEN
               IM(2)=29
	ndnr=366
        ELSE
                IM(2)=28
	  	ndnr=365
	       ENDIF
C
	infile(12:13)=AYR
	infile(30:31)=AYR
C
C Monthly cycle
C++      DO 201 imn=1,12
       imn=7
	call blet2(imn,AMN)
	infile(15:16)=AMN
	infile(20:21)=AMN
C
      cposmn=0.
	vposmn=0.
      cnegmn=0.
	vnegmn=0.

	idy1=1
	if ((iyr.eq.0).and.(imn.eq.1)) idy1=15
	idy2=im(imn)
C day-to-day cycle
       DO 40 idy=idy1,idy2
	CALL blet2(idy,ADY)
	infile(22:23)=ADY
C
      cposdy=0.
	vposdy=0.
      cnegdy=0.
	vnegdy=0.
C
	OPEN(12,file=infile,action='READ')
C
      xlat=-90.5
C lati cycle
	DO nlat=1,180
	xlat=xlat+1.0
	read(12,31,end=46) ivs
C
      xlon=-180.5
	DO 140 nlon=1,360
	xlon=xlon+1.0
	if (ivs(nlon).eq.0.) goto 140
	if (ivs(nlon).gt.0) then
	      cposdy=cposdy+1.
      vposdy=vposdy+ivs(nlon)
	                     else
	      cnegdy=cnegdy+1.
      vnegdy=vnegdy+ivs(nlon)
	endif					! +++
  140	CONTINUE
C
	ENDDO   ! lati cycle
	vposmn=vposmn+vposdy
	cposmn=cposmn+cposdy
	vnegmn=vnegmn+vnegdy
	cnegmn=cnegmn+cnegdy
C
	if (cposdy.gt.0.) vposdy=vposdy/cposdy
	if (cnegdy.gt.0.) vnegdy=vnegdy/cnegdy
	write(*,32) AYR,AMN,ADY,vnegdy,cnegdy,vposdy,cposdy
	write(10,32) AYR,AMN,ADY,vnegdy,cnegdy,vposdy,cposdy
   46		 close(unit=12)
   40 CONTINUE
	if (cposmn.gt.0.) vposmn=vposmn/cposmn
	if (cnegmn.gt.0.)vnegmn=vnegmn/cnegmn
	ADY='  '
	write(*,32) AYR,AMN,ADY,vnegmn,cnegmn,vposmn,cposmn
	write(11,32) AYR,AMN,ADY,vnegmn,cnegmn,vposmn,cposmn
  201 continue  ! mon
  200 continue ! year
	close(unit=10)
	close(unit=11)
C
   35      write(*,*) infile,outfile1
      pause ' ' 
      STOP
       END

C***********************************************************
