PROGRAM msghadir C ADDE Server for the image directory (only HRV for MSH) IMPLICIT NONE ! symbolic constants and shared data CHARACTER*8 servername PARAMETER (servername = 'MSGHADIR') CHARACTER*4096 comment CHARACTER*4096 reqst CHARACTER*3000 a CHARACTER*500 info CHARACTER*500 ctype CHARACTER*500 mask CHARACTER*256 argdum CHARACTER*80 ctemp CHARACTER*50 b CHARACTER*50 descriptor CHARACTER*50 group CHARACTER*128 path CHARACTER*12 cfg CHARACTER*12 cfi CHARACTER*12 cfu CHARACTER*4 clit CHARACTER*12 ckind CHARACTER*12 getaux CHARACTER*32 keyexp CHARACTER*8 f1 CHARACTER*3 compress CHARACTER*1 ff(180000) CHARACTER*1 mm(500) INTEGER all INTEGER area_dir(64) INTEGER bband INTEGER bday INTEGER bday1 INTEGER btim INTEGER btim1 INTEGER cards(4000) INTEGER center_ele INTEGER center_line INTEGER eband INTEGER eday INTEGER eday1 INTEGER etim INTEGER etim1 INTEGER fpos INTEGER file_ok INTEGER hit INTEGER i INTEGER ibuf(64) INTEGER iday INTEGER ientry INTEGER ires INTEGER iret INTEGER istat INTEGER istep INTEGER itim INTEGER j(64) INTEGER jday INTEGER jj INTEGER jk INTEGER jl INTEGER jmonth INTEGER jpos (2976) INTEGER jyear INTEGER j1 INTEGER k INTEGER kbprep INTEGER kb1opt INTEGER keys(20) INTEGER kreq(125) INTEGER lbi INTEGER lencmd INTEGER lit INTEGER lltora INTEGER mcargihr INTEGER mcargint INTEGER mcargiyd INTEGER mcargstr INTEGER mcdmytocyd INTEGER m0cmdparse INTEGER m0sxdatasetinfo INTEGER m0sxsettraceon INTEGER m0sxtrce INTEGER name_begin(2976) INTEGER name_length(2976) INTEGER navparms(2) INTEGER nbytes INTEGER ncard INTEGER num INTEGER numfile INTEGER nvprep INTEGER nv1ini INTEGER nv1sae INTEGER pos1 INTEGER pos2 INTEGER*2 rc INTEGER req_day INTEGER req_hour INTEGER req_minute INTEGER req_time INTEGER satnum INTEGER value(4) INTEGER xday(2976) INTEGER xnum INTEGER xsatnum(2976) INTEGER xtim(2976) REAL xdum REAL xele REAL xlat REAL xlat2 REAL xlin REAL xlon REAL xlon2 REAL xlnres REAL xltres DOUBLE PRECISION range1,range2,azimuth EQUIVALENCE (mm(1),mask) EQUIVALENCE (kreq(7),a) DATA mm / 500*" "/ DATA fpos / 24 / C------ fpos is the position of the start of the date string C------ within the file name DO i=1,64 j(i) = 0 ENDDO C------ uncomment the following line to enable tracing iret = m0sxsettraceon() istat=m0sxtrce (' MSGHADIR') CALL initblok (rc) C------ Read request header DO i = 1, 6 CALL getarg(i,ctemp) READ( ctemp, '(I10)' ) kreq(i) ENDDO CALL getarg(7,a) C------ parse command line CALL m0cmdput(m0cmdparse(a,lencmd)) C------ requested ADDE dataset 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) C------ day istat = mcargiyd (0, 'DAY', 1, -1, 0, -1, bday, argdum) istat = mcargiyd (0, 'DAY', 2, bday, 0, -1, eday, argdum) IF (eday.LE.0) eday=bday WRITE(b,'(2I10)') bday,eday istat = m0sxtrce ('bday eday '//b) 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 WRITE(b,'(2I10)') btim,etim istat = m0sxtrce ('btim etim '//b) C------ band bband = 12 eband = 12 C------ position numbers istat = mcargint (0, ' ', 2, 0, 1, -1, pos1,argdum) istat = mcargint (0, ' ', 3, 0, 1, -1, pos2,argdum) C------ construct path and find files DO i=500,1,-1 IF (mm(i).NE." ") GO TO 1700 ENDDO GO TO 1010 1700 path = mask(1:i)//'/'//char(0) numfile = 0 CALL readfilelist (ff,path,numfile,name_length) 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 all = LIT('ALL ') CALL swbyt4 (all,1) istep = 1 xnum = pos2 - pos1 + 1 IF (pos1.EQ.all) THEN pos1 = 1 pos2 = numfile xnum = numfile ENDIF IF (pos2.LE.0) pos2 = pos1 IF (pos1.LE.0) THEN xnum = -pos1 + 1 pos1 = numfile pos2 = 1 istep = -1 ENDIF WRITE(b,'(2I10)') pos1,pos2 istat=m0sxtrce ('new positions '//b) C----- search files between pos1 and pos2 for given specs C----- relevant are DAY and TIME and SS (band 12 is always available) num = 0 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 eday1 = eday IF (btim.LT.0) btim1 = req_time IF (etim.LT.0) etim1 = req_time IF (bday.LE.0) bday1 = req_day IF (eday.LE.0) eday1 = req_day IF (req_day.GE.bday1.AND.req_day.LE.eday1.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 C------ make AREA directory 3450 IF (num.EQ.0) GO TO 1011 hit = 0 DO ientry=1,num IF (istep.GT.0) THEN IF (jpos(ientry).LT.pos1.OR.jpos(ientry).GT.pos2) GO TO 1800 ELSE IF (jpos(ientry).GT.pos1.OR.jpos(ientry).LT.pos2) GO TO 1800 ENDIF hit = 1 DO i=1,64 area_dir(i) = 0 ENDDO area_dir(1) = jpos(ientry) area_dir(2) = 4 area_dir(3) = 43 + xsatnum(ientry) IF (xsatnum(ientry).GE.11) area_dir(3) = 343 + xsatnum(ientry) area_dir(4) = xday(ientry)-1900000 area_dir(5) = xtim(ientry) area_dir(6) = 1 area_dir(7) = 1 area_dir(8) = 1 area_dir(9) = 11136 area_dir(10) = 11136 area_dir(11) = 2 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**(12-1) area_dir(34) = 792 area_dir(35) = 256 area_dir(52) = LIT('MSG ') area_dir(53) = LIT('RAW ') area_dir(63) = 768 C----- get comment cards ncard = 0 C----- center lat and lon istat = mcargstr (0, 'AUX', 1, 'N', getaux) IF (getaux(1:1).EQ.'Y') THEN center_line = NINT((1. + area_dir(12)*area_dir(9))/2.) center_ele = NINT ((1.+ area_dir(13)*area_dir(10))/2.) xlin = FLOAT(center_line) xele = FLOAT(center_ele) navparms(1) = LIT('MSG ') C C--- navparms(2) should be set to the satellite subpoint C--- scaled by 10000 C navparms(2) = 0 istat = nvprep (1,navparms) istat = nv1ini (2,LIT('LL ')) istat = nv1sae (xlin,xele,xdum,xlat,xlon,xdum) ctemp = 'Center latitude = ' // cfg(xlat) CALL movcw (ctemp,cards(1+20*ncard)) ncard = ncard+1 ctemp = 'Center longitude = ' // cfg(xlon) CALL movcw (ctemp,cards(1+20*ncard)) ncard = ncard+1 ENDIF C----- resolution xlin = center_line + area_dir(12) xele = center_ele istat = nv1sae (xlin,xele,xdum,xlat2,xlon2,xdum) istat = LLTORA (xlat,xlon,xlat2,xlon2,range1,azimuth) xlat = xlat2 xlon = xlon2 xele = center_ele + area_dir(13) istat = nv1sae (xlin,xele,xdum,xlat2,xlon2,xdum) istat = LLTORA (xlat,xlon,xlat2,xlon2,range2,azimuth) xltres = REAL((range1+range2)/2.0) xlnres = xltres ctemp = 'Computed Latitude resolution (km) = '// & cfg(REAL(range1)) CALL bsquez (ctemp) CALL movcw (ctemp, cards(1+20*ncard)) ncard = ncard+1 ires = NINT(xltres) ctemp = 'Latitude resolution (km) ' // cfi(ires) CALL bsquez (ctemp) CALL movcw (ctemp, cards(1+20*ncard)) ncard = ncard+1 ctemp = 'Computed Longitude resolution (km) = '// & cfg(REAL(range2)) CALL bsquez (ctemp) CALL movcw (ctemp, cards(1+20*ncard)) ncard = ncard+1 ires = NINT(xlnres) ctemp = 'Longitude resolution (km) ' // cfi(ires) CALL bsquez (ctemp) CALL movcw (ctemp, cards(1+20*ncard)) ncard = ncard+1 C----- valid calibration types file_ok = 1 istat = kbprep(1,area_dir(52)) ibuf(1) = area_dir(3) ibuf(2) = area_dir(4) ibuf(3) = area_dir(5) ibuf(4) = 12 ibuf(37) = area_dir(52) istat = kb1opt ('KEYS',ibuf,keys) DO i=2,keys(1)+1 if( keys(i) .eq. lit('RAW ')) keyexp=' "RAW"' if( keys(i) .eq. lit('BRIT')) keyexp=' "BRIGHTNESS"' if( keys(i) .eq. lit('RAD ')) keyexp=' "RADIANCE"' if( keys(i) .eq. lit('REFL')) keyexp=' "REFLECTANCE"' if( keys(i) .eq. lit('TEMP')) keyexp=' "TEMPERATURE"' ctemp = 'Valid calibration unit for band ' & //cfu(12)//' = ' //CLIT(keys(i))//keyexp CALL bsquez (ctemp) CALL movcw (ctemp,cards(1+20*ncard)) ncard = ncard+1 ENDDO area_dir(64) = ncard C----- send number of bytes nbytes = 260 + 80*ncard CALL swbyt4 (nbytes,1) CALL swbyt4 (file_ok,1) CALL m0sxsend (4,nbytes) CALL m0sxsend (4,file_ok) CALL swbyt4(area_dir,64) CALL swbyt4(area_dir(52),2) CALL m0sxsend (256,area_dir) CALL m0sxsend (ncard*80,cards) 1800 ENDDO IF (hit.EQ.0) THEN b = 'No entry found for your DAY/TIME range' j(43) = -1000 CALL movcw (b,j(44)) CALL m0sxdone (j) GO TO 9999 ENDIF GO TO 2000 1010 b = 'No directory specified' j(43) = -1000 CALL movcw (b,j(44)) CALL m0sxdone (j) GO TO 9999 1011 b = 'No files found' j(43) = -1000 CALL movcw (b,j(44)) CALL m0sxdone (j) GO TO 9999 2000 b = 'Done' j(43) = 0 CALL movcw (b,j(44)) CALL m0sxdone (j) 9999 CONTINUE END