      PROGRAM msghaget

      IMPLICIT NONE

      ! symbolic constants and shared data

      CHARACTER*8   servername
      PARAMETER (servername = 'MSGHAGET')

      CHARACTER*4096 comment
      CHARACTER*4096 reqst
      CHARACTER*3000 a
      CHARACTER*512  cal_array
      CHARACTER*500  ctype
      CHARACTER*500  info
      CHARACTER*500  mask
      CHARACTER*256  argdum
      CHARACTER*200  filnam
      CHARACTER*120  b
      CHARACTER*100  filnam1
      CHARACTER*80   ctemp
      CHARACTER*128   path
      CHARACTER*50   group
      CHARACTER*50   descriptor
      CHARACTER*12   ckey
      CHARACTER*12   ckind,cfi
      CHARACTER*12   clat,clon
      CHARACTER*12   clit
      CHARACTER*8    f1
      CHARACTER*3    compress
      CHARACTER*4    units

      CHARACTER*1 ff(180000)
      CHARACTER*1 mm(500)

      INTEGER area_dir(64)
      INTEGER area_nav(128)
      INTEGER bband
      INTEGER bday
      INTEGER bday1
      INTEGER btim
      INTEGER btim1
      INTEGER center_ele
      INTEGER center_line
      INTEGER etim
      INTEGER etim1
      INTEGER fpos
      INTEGER i
      INTEGER ical(128)
      INTEGER iele
      INTEGER iele1
      INTEGER iele2
      INTEGER ierr
      INTEGER ilin
      INTEGER iemax
      INTEGER ilmax
      INTEGER imgele
      INTEGER imglin
      INTEGER*2 image_data(11136)
      INTEGER image_first_ele
      INTEGER image_first_line
      INTEGER image_req_ele
      INTEGER image_req_line
      INTEGER iopt(2)
      INTEGER ir,ilr,ier
      INTEGER iret
      INTEGER irow,icol
      INTEGER istat
      INTEGER istep
      INTEGER itim
      INTEGER jday          
      INTEGER jj
      INTEGER jk
      INTEGER jl
      INTEGER jmonth
      INTEGER j(64)
      INTEGER jpos(2976)
      INTEGER jyear
      INTEGER j1
      INTEGER k
      INTEGER kb1cal,kb2cal,kb3cal
      INTEGER kb1ini,kb2ini,kb3ini
      INTEGER kb1opt,kb2opt,kb3opt
      INTEGER kreq(125)
      INTEGER lbi
      INTEGER lencmd
      INTEGER line1
      INTEGER line2
      INTEGER lit
      INTEGER lwfile
      INTEGER m0cmdparse
      INTEGER m0sxdatasetinfo
      INTEGER m0sxdone
      INTEGER m0sxsettraceon
      INTEGER mcargihr
      INTEGER mcargint
      INTEGER mcargiyd
      INTEGER mcargstr
      INTEGER mcdmytocyd
      INTEGER mfd
      INTEGER name_begin(2976)
      INTEGER name_length(2976)
      INTEGER nbytes
      INTEGER nlen
      INTEGER num
      INTEGER numele
      INTEGER numele_file
      INTEGER numfile
      INTEGER numlin
      INTEGER numsv
      INTEGER offset_ele
      INTEGER offset_line
      INTEGER pfix
      INTEGER pos
      INTEGER pos1
      INTEGER pos2
      INTEGER*2 rc
      INTEGER req_num_ele
      INTEGER req_num_line
      INTEGER req_day
      INTEGER req_hour
      INTEGER req_minute
      INTEGER req_time
      INTEGER satnum
      INTEGER serve_data(11136)
      INTEGER spac
      INTEGER*2 true_data(11136)
      INTEGER xday(2976)
      INTEGER xnum
      INTEGER xsatnum(2976)
      INTEGER xtim(2976)

      REAL cal_data(6)
      REAL gain
      REAL offset
      REAL xhelp

      EQUIVALENCE (mm(1),mask)
      EQUIVALENCE (kreq(7),a)
      EQUIVALENCE (cal_array,ical(1))
      DOUBLE PRECISION dtokll

      DATA mm / 500*" "/
      DATA fpos / 24 /

C----- fpos is the position of the start of the date string
C----- within the file name

      CALL initblok (rc)
      DO i=1,64
        j(i) = 0
      ENDDO
      DO i=1,11136
        image_data(i) = 0
        serve_data(i) = 0
        true_data(i)  = 0
      ENDDO

C----- uncomment the following line to enable tracing

      iret = m0sxsettraceon()
      call m0sxtrce (' MSGHAGET')

C------ Read request header

      DO i=1,6
        CALL getarg(i,ctemp)
      ENDDO
      CALL getarg(7,a)

C------ Parse command line

      CALL m0cmdput(m0cmdparse(a,lencmd))
      call  m0sxtrce ('a '//a)

C------ find requested band, if any

      bband = 12

C------ find position number, if any

      istat = mcargint (0, ' ', 2, -1, 0 ,2976, pos, argdum)

C------ day

      istat = mcargiyd(0, 'DAY', 1, -1,   0, -1, bday, argdum)

C------ time

      istat = mcargihr(0, 'TIM.E', 1,  -1, 0, -1,btim, argdum)
      istat = mcargihr(0, 'TIM.E', 2,btim, 0, -1,etim, argdum)
      IF (etim.LT.0) etim=btim

C------ read ADDE request

      istat = mcargstr (0, ' ', 0, ' ', group)
      istat = mcargstr (0, ' ', 1, ' ', descriptor)

      reqst = group//' '//descriptor
      istat = m0sxdatasetinfo (reqst,group,descriptor,ctype,ckind,
     &                         mask,info,comment,jj,jk,jl)
      IF (istat.NE.0) GO TO 1011

C------ construct path and find files

      DO nlen=500,1,-1
        IF (mm(nlen).NE." ") GO TO 1700
      ENDDO
      GO TO 1011

 1700 path = mask(1:nlen)//'/'//CHAR(0)

      numfile = 0
   
      call m0sxtrce('path:'//path(1:nlen))

      CALL readfilelist (ff,path,numfile,name_length)
      WRITE(b,'(I10)') numfile
      call m0sxtrce ('numfile '//b)

      name_begin(1) = 1
      DO i=2,numfile
        name_begin(i) = name_begin(i-1) + name_length(i-1) + 1
      ENDDO

      DO i=1,numfile
        k = name_begin(i) + name_length(i) - 3
        compress = ff(k)//ff(k+1)//ff(k+2)
        IF (compress.EQ.'.gz'.OR.compress.EQ.'bz2')
     &     name_begin(i) = 1
      ENDDO

      num = 0
      IF (pos.GT.0) THEN
        pos1 = pos
        pos2 = pos
        xnum = 1
        istep = 1
      ENDIF
      IF (pos.LE.0) THEN
        xnum = -pos + 1
        pos1 = numfile
        pos2 = 1
        istep = -1
      ENDIF

      DO i=pos1,pos2,istep
        j1 = name_begin(i)
        IF (j1.LE.0) GO TO 1900
        READ(ff(j1+3),'(I1)') satnum
        satnum = satnum + 7
        f1 = ff(j1+fpos)//ff(j1+fpos+1)//ff(j1+fpos+2)//
     &       ff(j1+fpos+3)//ff(j1+fpos+4)//ff(j1+fpos+5)//
     &       ff(j1+fpos+6)//ff(j1+fpos+7)
        READ(f1,'(I4,2I2)') jyear,jmonth,jday
        istat = mcdmytocyd (jday,jmonth,jyear,req_day)
        f1 = ff(j1+fpos+8)//ff(j1+fpos+9)//ff(j1+fpos+10)//
     &       ff(j1+fpos+11)
        READ(f1,'(2I2)') req_hour,req_minute
        req_minute = (req_minute/15) * 15
        req_time = req_hour*100 + req_minute
        req_time = req_time * 100

        btim1 = btim
        etim1 = etim
        bday1 = bday

        IF (btim1.LT.0) btim1 = req_time
        IF (etim1.LT.0) etim1 = req_time
        IF (bday1.LE.0) bday1 = req_day
        

        IF (req_day.EQ.bday1.AND.
     &      req_time.GE.btim1.AND.req_time.LE.etim1) THEN
          num = num+1
          jpos(num) = i
          xday(num) = req_day
          xtim(num) = req_time
          xsatnum(num) = satnum
          IF (num.GE.xnum) GO TO 3450
        ENDIF
 1900 ENDDO
      
 3450 IF (num.LT.xnum) GO TO 1012
      IF (num.EQ.0) GO TO 1012

C------ serve simply the last image (index num)

      j1 = name_begin(jpos(num))
      WRITE(filnam1,'(100A1)') (ff(i),i=j1,j1+name_length(i)-1)
      filnam = path(1:nlen+1)//filnam1
      call m0sxtrce ('filnam '//filnam)
      istat = LWFILE(filnam)
      IF (istat.NE.1) GO TO 1013

C------ requested resolution

      istat = mcargint (0, ' ', 6, 1, 0 ,-1, ir, argdum)
      WRITE(b,'(I10)') ir
      call m0sxtrce ('ir '//b)
      istat = mcargint (0, 'LMA.G ', 1, ir, 0, -1, ilr, argdum)
      istat = mcargint (0, 'EMA.G ', 1, ir, 0, -1, ier, argdum)
      IF (ier.EQ.0) ier = ilr
      ilr = IABS(ilr)
      ier = IABS(ier)

C------ Units

      istat = mcargstr (0,'UNI.TS',1,'RAW ',units)
      call m0sxtrce ('units '//units)

C------ Byte resolution

      istat = mcargint (0,'SPA.C',1,2,1,4,spac,argdum)
      IF (spac.EQ.0.AND.units.EQ.'RAW ') spac=2
      IF (spac.EQ.0.AND.units.EQ.'BRIT') spac=1
      IF (spac.NE.4.AND.units.EQ.'RAD ') spac=4
      IF (spac.NE.4.and.units.EQ.'REFL') spac=4

C------ Size of image window

      istat = mcargint (0, ' ', 7, 480, 0, -1, req_num_line, argdum)
      istat = mcargint (0, ' ', 8, 640, 0, -1, req_num_ele, argdum)

C------ make AREA directory

      DO i=1,64
        area_dir(i) = 0
      ENDDO
      area_dir(1)  = jpos(num)
      area_dir(2)  = 4
      area_dir(3)  = 43 + xsatnum(num)
      IF (xsatnum(num).GE.11) area_dir(3) = 343 + xsatnum(num)
      area_dir(4)  = xday(num)-1900000
      area_dir(5)  = xtim(num)
      area_dir(6)  = 1
      area_dir(7)  = 1
      area_dir(8)  = 1
      area_dir(9)  = 11136
      area_dir(10) = 11136
      area_dir(11) = spac
      area_dir(12) = 1
      area_dir(13) = 1
      area_dir(14) = 1
      area_dir(15) = 0
      area_dir(17) = area_dir(4)
      area_dir(18) = area_dir(5)
      area_dir(19) = 2**(bband-1)
      area_dir(34) = 1280
      area_dir(35) = 256
      area_dir(52) = LIT('MSG ')
      area_dir(53) = LIT(units)
      area_dir(59) = 1
      area_dir(63) = 768

C----- get coordinates

      istat = mcargstr (0, ' ', 3, ' ', ckey)

C----- earth coordinates:

      IF (ckey(1:1).EQ.'E') THEN

        istat = mcargstr (0, ' ', 4, ' ', clat)
        istat = mcargstr (0, ' ', 5, ' ', clon)
        image_req_line = mfd(dtokll(clat))
        image_req_ele  = mfd(dtokll(clon))
        CALL earth (image_req_line,image_req_ele,ierr)
        IF (ierr.NE.0) GO TO 1003

      ELSEIF (ckey(1:1).EQ.'A') THEN

        istat = mcargint (0, ' ', 4, 0, 0, -1, imglin, argdum)
        istat = mcargint (0, ' ', 5, 0, 0, -1, imgele, argdum)
        image_req_line = imglin + 1
        image_req_ele  = imgele + 1
        IF (image_req_line.LE.0.OR.image_req_line.GT.11135) GO TO 1003
        IF (image_req_ele .LE.0.OR.image_req_ele .GT.11135) GO TO 1003

      ELSE

        istat = mcargint (0, ' ', 4, area_dir(6), 0, -1, imglin, argdum)
        istat = mcargint (0, ' ', 5, area_dir(7), 0, -1, imgele, argdum)
        image_req_line = imglin
        image_req_ele  = imgele
        IF (image_req_line.LT.0.OR.image_req_line.GT.11136) GO TO 1003
        IF (image_req_ele .LT.0.OR.image_req_ele .GT.11136) GO TO 1003

      ENDIF

C------ Calculate starting upper-left corner

      offset_line = 0
      offset_ele  = 0

      IF (ckey(2:2).EQ.'C') THEN
        center_line = NINT(req_num_line/2.)
        center_ele  = NINT(req_num_ele/2.)
        offset_line = center_line - 1
        offset_ele  = center_ele  - 1
      ENDIF

C-----   make navigation codicil

      DO i=1,128
        area_nav(i) = 0
      ENDDO
      area_nav(1) = LIT('MSG ')
      area_nav(2) = 0

C-----   make calibration codicil

      DO i=1,6
        cal_data(i) = 0.
      ENDDO
      CALL read_data_hrv (filnam,bband,gain,offset,image_data,
     &                  1,iret)
      IF (iret.NE.0)  GO TO 1013
      cal_data(5) = gain
      cal_data(6) = offset

      WRITE(cal_array,'(6E17.10)') (cal_data(i),i=1,6)
      call m0sxtrce ('cal_array '//cal_array)
      CALL kbprep (1,area_dir(52))
      CALL kbprep (2,area_dir(52))

C-----  adjust area directory for request specs
C-----  find upper left corner

      image_first_line = image_req_line - ilr*offset_line*area_dir(12)
      image_first_ele  = image_req_ele  - ier*offset_ele *area_dir(13)

      area_dir(6) = image_first_line
      area_dir(7) = image_first_ele

C----- number of lines and elements to serve

      IF (req_num_ele.LT.4) req_num_ele = 4

      area_dir(9)  = MIN(req_num_line,area_dir(9))
      area_dir(10) = MIN(req_num_ele,area_dir(10))
      area_dir(10) = ((area_dir(10)+3)/4) * 4

C---- determine requested lines in file coordinates (1-based)

      line1 = NINT(FLOAT(area_dir(6))/FLOAT(area_dir(12)))
      line2 = line1 + (area_dir(9)-1) * ilr
      numlin = (line2-line1)/ilr + 1

C---- determine requested elements in file coordinates (1-based)

      iele1 = NINT(FLOAT(area_dir(7))/FLOAT(area_dir(13)))
      iele2 = iele1 + (area_dir(10)-1) * ier
      numele = area_dir(10)

C----- final resolution

      area_dir(12) = area_dir(12) * ilr
      area_dir(13) = area_dir(13) * ier

C----- adjust directory for requested unit

      IF (units.EQ.'RAD ') THEN
        area_dir(58) = LIT('mWm2')
        area_dir(59) = 100
      ENDIF
      IF (units.EQ.'BRIT') THEN
        area_dir(58) = LIT('    ')
        area_dir(59) = 1
      ENDIF  

      IF (units.EQ.'REFL') THEN
        area_dir(58) = LIT('%   ')
        area_dir(59) = 100
      ENDIF  

C----- serve directory

      nbytes = 64*4 + 128*4 + 128*4 + numlin * area_dir(10) * spac
      CALL swbyt4 (nbytes,1)
      CALL m0sxsend (4,nbytes)
      CALL swbyt4 (nbytes,1)
      CALL swbyt4 (area_dir(1),64)
      CALL swbyt4 (area_dir(52),2)
      CALL swbyt4 (area_dir(58),1)
      CALL m0sxsend (256,area_dir)
      CALL swbyt4 (area_dir(1),64)
      CALL swbyt4 (area_dir(52),2)
      CALL swbyt4 (area_dir(58),1)
      CALL swbyt4 (area_nav(2),1)
      CALL m0sxsend (512,area_nav(1))
      CALL swbyt4 (area_nav(2),1)
      CALL m0sxsend (512,ical)

C---  read and serve data line by line

      DO ilin=line1,line2,ilr

        i = 0
        IF (ilin.LT.1.OR.ilin.GE.3712*3) GO TO 4000
        CALL read_data_hrv (filnam,bband,gain,offset,image_data,
     &                  ilin,iret)
        IF (iret.NE.0) GO TO 1013
 4000   DO iele=iele1,iele2,ier
          i = i+1
          IF (iele.GE.1.AND.iele.LE.3712*3.AND.
     &        ilin.GE.1.AND.ilin.LE.3712*3) THEN
            true_data(i) = image_data(iele)
          ELSE
            true_data(i) = -999
          ENDIF
        ENDDO

C----- at this point, true_data(1:numele) are one line of data to be served,
C----- their values are either -999 (off disk) or some value taken from the image file

C----- now we have to deal with the various units / spac options
C----- before we actually serve the data

        IF (units.EQ.'BRIT') THEN
          DO iele=1,numele
            serve_data(iele) = true_data(iele)
          ENDDO
          CALL mpixel (numele,4,2,serve_data)

          iopt(1) = 2
          iopt(2) = 2
          istat = kb2ini ('RAW ','BRIT',iopt)
          istat = kb2opt ('CALB',cal_array)
          pfix = 0
          istat = kb2cal (pfix,area_dir(1),numele,bband,serve_data(1))
          CALL mpixel (numele,2,4,serve_data)
          DO iele=1,numele
            IF (true_data(iele).LT.0) serve_data(iele) = 0
          ENDDO  
          CALL mpixel (numele,4,spac,serve_data)
          IF (spac.EQ.2) CALL swbyt2 (serve_data(1),numele)
          IF (spac.EQ.4) CALL swbyt4 (serve_data(1),numele)
          CALL m0sxsend (numele*spac,serve_data(1))
        ENDIF

        IF (units.EQ.'RAW') THEN
          DO iele=1,numele
            serve_data(iele) = true_data(iele)
            IF (true_data(iele).LT.0) serve_data(iele) = 0
          ENDDO
          CALL mpixel (numele,4,spac,serve_data)
          IF (spac.EQ.2) CALL swbyt2 (serve_data(1),numele)
          IF (spac.EQ.4) CALL swbyt4 (serve_data(1),numele)
          CALL m0sxsend (numele*spac,serve_data(1))
        ENDIF

        IF (units.EQ.'RAD ') THEN
          DO iele=1,numele
            serve_data(iele) = true_data(iele)
          ENDDO
          WRITE(b,'(I10)') area_dir(59)
          call m0sxtrce ('areadir for rad '//b)

          iopt(1) = 4
          iopt(2) = spac
          istat = kb1ini ('RAW ','RAD ',iopt)
          istat = kb1opt ('CALB', cal_array)
          pfix = 0
          numsv = numele*spac/2
          WRITE(b,'(4I10)') (serve_data(i),i=1,4)
          call m0sxtrce ('served data before cal '//b)
          istat = kb1cal(pfix,area_dir(1),numsv,bband,serve_data(1))
          WRITE(b,'(4I10)') (serve_data(i),i=1,4)
          call m0sxtrce ('served data after cal '//b)
          CALL swbyt4 (serve_data(1),numele)
          WRITE(b,'(4I10)') (serve_data(i),i=1,4)
          call m0sxtrce ('served data after cal '//b)
          CALL m0sxsend (numele*spac,serve_data(1))
        ENDIF

        IF (units.EQ.'REFL') THEN
          iopt(1) = 4
          iopt(2) = spac
          istat = kb1ini ('RAW ','REFL',iopt)
          istat = kb1opt ('CALB',cal_array)
          pfix = 0
          DO iele=1,numele
            serve_data(iele) = true_data(iele)
          ENDDO
          numsv = numele*spac/2
          istat = kb1cal (pfix,area_dir(1),numsv,bband,serve_data(1))
          CALL swbyt4 (serve_data(1),numele)
          CALL m0sxsend (numele*spac,serve_data(1))
         ENDIF

      ENDDO

      GO TO 2000

 1003 b = 'Unable to initialize navigation for this image'
      IF (ierr.EQ.-2)
     &b = 'The requested Earth location is not contained in the image'
      j(43) = -1000
      CALL movcw (b,j(44))
      istat = m0sxdone (j)
      GO TO 9999
 1011 b = 'Wrong server request'
      j(43) = -1000
      CALL movcw (b,j(44))
      istat = m0sxdone (j)
      GO TO 9999
 1012 b = 'No image found for your request'
      j(43) = -1000
      CALL movcw (b,j(44))
      istat = m0sxdone (j)
      GO TO 9999
 1013 b = 'Could not open an image file'
      j(43) = -1000
      CALL movcw (b,j(44))
      istat = m0sxdone (j)
      GO TO 9999
 1015 b = 'The requested portion of this image does not exist'
      j(43) = -1000
      CALL movcw (b,j(44))
      istat = m0sxdone (j)
      GO TO 9999
 1020 b = 'Valid bands are 1-11'
      j(43) = -1000
      CALL movcw (b,j(44))
      istat = m0sxdone (j)
      GO TO 9999
 2000 b = 'Done'
      j(43) = 0
      CALL movcw (b,j(44))
      istat = m0sxdone (j)

9999  CONTINUE
      END

      SUBROUTINE earth (iy,ix,ierr)
      IMPLICIT INTEGER (A-Z)
      REAL flalo,xlat,xlon,zdum
      INTEGER area_nav(2),lit
      
      area_nav(1) = lit('MSG ')
      area_nav(2) = 0

      IF (nvprep (1,area_nav(1)).NE.0) THEN
        ierr = -1
       RETURN
      ENDIF

      istat = nv1ini (1,area_nav(1))
      istat = nv1ini (2,'LL  ')

      xlat = FLALO(iy)
      xlon = FLALO(ix)
      IF (nv1eas(xlat,xlon,0.,xlin,xele,zdum).NE.0) THEN
        ierr = -2
       RETURN
      ENDIF

      iy = IROUND(xlin)
      ix = IROUND(xele)
      ierr = 0

      RETURN
      END


