C Copyright(c) 1997, Space Science and Engineering Center, UW-Madison C Refer to "McIDAS Software Acquisition and Distribution Policies" C in the file mcidas/data/license.txt C *** $Id: mcgetscantime.f,v 1.15 2024/01/24 23:03:43 rickk Tst $ *** *$ Name: *$ mcgetscantime - get the scan time of a given line *$ *$ Interface: *$ integer function *$ mcgetscantime(integer header(*), integer pfxlen, integer prefix(*), *$ integer file_handle, integer img_line_1, integer img_elem_1, *$ integer inav(*), integer scantime) *$ *$ Input: *$ header -- area header *$ pfxlen -- length of prefix *$ prefix -- line prefix *$ file_handle -- used to access proper data stream from server *$ img_line_1 -- 1st image line in area *$ img_elem_1 -- 1st image elem in area *$ inav -- nav block *$ *$ Input and Output: *$ none *$ *$ Output: *$ scantime -- time that line was scanned *$ *$ Return values: *$ 0 - all is okay *$ -3 - mcapfx failed to read prefix *$ *$ Remarks: *$ Compute the exact (or nearly so) time a line is scanned *$ *$ This is done differently for different satellites *$ *$ Categories: *$ grid *$ met/science integer function mcgetscantime(file_dir,pfxlen,prefix, & file_handle,img_line_1,img_elem_1,inav,scantime) implicit none include 'areaparm.inc' integer LIN_SIZ ! size of data array (in bytes) parameter (LIN_SIZ = MAXDFELEMENTS) character*12 cfi integer getaaalinetime integer getl1blinetime integer getgmslinetime integer getgvarlinetime integer getpoeslinetime integer getcoms1linetime integer getwarilinetime integer lit integer mcapfx integer mcinctime integer mcisimagebandpresent integer mcdaytimetosec integer mcsectodaytime integer file_dir(*) integer pfxlen integer prefix(LIN_SIZ) ! prefix integer file_handle integer img_line_1 integer img_elem_1 integer inav(1000) integer scantime integer check_dnb_band integer day integer time integer hold integer hr integer inc_seconds integer iret integer min integer msglines integer newday integer nlines integer scanline integer sec integer seconds integer sec_hms integer start_seconds integer stat integer total_seconds scantime = -9999 mcgetscantime = 0 day = file_dir(4) time = file_dir(5) if (pfxlen .gt. 0) then stat = mcapfx(file_handle,prefix) if (stat .lt. 0) then call edest('Unable to read line prefix ',0) call mccodeset(2) mcgetscantime = -3 return endif if ( ( file_dir(52) .eq. lit('MSU ') ) .or. & ( file_dir(52) .eq. lit('AVHR') ) .or. & ( file_dir(52) .eq. lit('TIRO') ) .or. & ( file_dir(57) .eq. lit('MSU ') ) .or. & ( file_dir(57) .eq. lit('AVHR') ) .or. & ( file_dir(57) .eq. lit('TIRO') ) ) then iret = getpoeslinetime(prefix,pfxlen,file_dir,scantime) elseif (file_dir(52) .eq. lit('GVAR') .or. & file_dir(57) .eq. lit('GVAR') .or. & ( file_dir(3) .ge. 70 .and. file_dir(3) .le. 79) .or. & ( file_dir(3) .ge. 180 .and. & file_dir(3) .le. 185)) then iret = getgvarlinetime(prefix,pfxlen,file_dir,scantime) elseif (file_dir(52) .eq. lit('AAA ') .or. & file_dir(57) .eq. lit('AAA ') .or. & ( file_dir(3) .eq. 32 .or. file_dir(3) .eq. 33)) then iret = getaaalinetime(prefix,pfxlen,file_dir,scantime) elseif (file_dir(52) .eq. lit('GMS ') .or. & file_dir(57) .eq. lit('GMS ') .or. & file_dir(52) .eq. lit('FY2 ') .or. & file_dir(57) .eq. lit('FY2 ') .or. & ( file_dir(3) .ge. 34 .and. file_dir(3) .le. 40)) then iret = getgmslinetime(inav,1000,img_line_1, & file_dir,scantime) elseif (file_dir(52) .eq. lit('AVH3')) then iret = getl1blinetime(file_dir,img_line_1,scantime) elseif (file_dir(52) .eq. lit('COMS')) then iret = getcoms1linetime(file_dir,img_line_1,scantime) else scantime = -9999 endif else ! GMS may not have a prefix, but info is in ! nav block if (file_dir(52) .eq. lit('GMS ') .or. & file_dir(57) .eq. lit('GMS ') .or. & file_dir(52) .eq. lit('FY2 ') .or. & file_dir(57) .eq. lit('FY2 ') .or. & (file_dir(3) .ge. 34 .and. file_dir(3) .le. 40)) then iret = getgmslinetime(inav,1000,img_line_1, & file_dir,scantime) endif endif C -- if there is no prefix or no time computed, don't despair! Some C times must be computed using the scan speed per line if (scantime .eq. -9999) then if (file_dir(52) .eq. lit('HIRS') .or. & file_dir(57) .eq. lit('HIRS') .or. & file_dir(52) .eq. lit('HIR3') .or. & file_dir(57) .eq. lit('HIR3') ) then C --- HIRS data scans at 6.4 seconds per line nlines = img_line_1 seconds = (nlines - 1)*6.4 hr = seconds/3600 min = (seconds-hr*3600)/60 sec = seconds - hr*3600 - min*60 sec_hms = hr*10000 + min*100 + sec iret = mcinctime( day,time,sec_hms,newday,scantime) elseif (file_dir(52) .eq. lit('VIIR') .or. & file_dir(57) .eq. lit('VIIR')) then C --- VIIRS (SNPP, N20 ..) data scans at 1.779 revolutions per second C and there are 32 lines scanned at a time C DNB is a special case as it is a product. Can only use an estimate C For a lack of a better way need to check for band of 22. C The value for band in file_dir(19) is 2**(band-1) check_dnb_band = file_dir(19) if (check_dnb_band .eq. 2097152) then scanline = img_line_1-1 inc_seconds = nint(scanline*84.0/768.0) iret = mcdaytimetosec(day, time, start_seconds) total_seconds = start_seconds + inc_seconds iret = mcsectodaytime(total_seconds, & newday, scantime) else scanline = int((img_line_1-1)/32) inc_seconds = nint(scanline * 1.779) iret = mcdaytimetosec(day, time, start_seconds) total_seconds = start_seconds + inc_seconds iret = mcsectodaytime(total_seconds, & newday, scantime) endif elseif (file_dir(52) .eq. lit('MODS') .or. & file_dir(57) .eq. lit('MODS') .or. & (file_dir(3) .ge.101 .and.file_dir(3) .le.104)) then C --- MODIS (TERRA or AQUA) data scans at 20.3 revolutions per minute. C ..and there are 8 lines scanned at a time seconds = 60* ( (img_line_1 - 1)/80 )/20.3 hr = seconds/3600 min = (seconds-hr*3600)/60 sec = seconds - hr*3600 - min*60 sec_hms = hr*10000 + min*100 + sec iret = mcinctime(day,time,sec_hms,newday,scantime) elseif (file_dir(52) .eq. lit('FY1 ') .or. & file_dir(52) .eq. lit('FY1C') .or. & file_dir(57) .eq. lit('FY1 ') .or. & file_dir(57) .eq. lit('FY1C') .or. & (file_dir(3).ge.95 .and. file_dir(3).le.97)) then C --- FY1 scans at 6 lines/second per JMB C --- FY1 called FY1C in early ingestors nlines = img_line_1 seconds = (nlines - 1)/6. hr = seconds/3600 min = (seconds-hr*3600)/60 sec = seconds - hr*3600 - min*60 sec_hms = hr*10000 + min*100 + sec iret = mcinctime( day,time,sec_hms,newday,scantime) elseif (file_dir(52) .eq. lit('MTST') .or. & file_dir(57) .eq. lit('MTST') .or. & file_dir(3) .ge. 84 .and. file_dir(3) .le. 85) then C --- MTSAT scans at 440 lines per minute C C C -- if file_dir(48) is non-zero, check to see if it's equal to the C first line in the header. If so, that's the first scanline C MTSAT/SH images have the first line stored in file_dir(8) nlines = img_line_1 hold = img_line_1 if (file_dir(48) .ne. 0) then hold = (img_line_1 - file_dir(48)) endif if (file_dir(8) .ne. 0) then hold = (img_line_1 - file_dir(8)) endif seconds = (hold - 1)/(440./60.) hr = seconds/3600 min = (seconds-hr*3600)/60 sec = seconds - hr*3600 - min*60 sec_hms = hr*10000 + min*100 + sec iret = mcinctime( day,time,sec_hms,newday,scantime) C C -- MSG scans at 100 rpm, with the first line (line 11136) at the South Pole. C -- If the image time is 00/15/30/45, then the image has started at the South C -- If the image time is 12/27/42/57, or thereabouts, then the image time is C -- the end of the image. 9 (full-res) lines are scanned at once -- thus it C -- takes 12+ minutes to do a full disk. elseif (file_dir(52) .eq. lit('MSG ') .or. & file_dir(52) .eq. lit('MSG') .or. & file_dir(57) .eq. lit('MSG ') .or. & file_dir(57) .eq. lit('MSG') .or. & file_dir(3) .ge. 51 .and. file_dir(3) .le. 53) then C --- MSG scans from south to north msglines = 11136 - img_line_1 seconds = msglines/(900./60.) hr = seconds/3600 min = (seconds-hr*3600)/60 sec = seconds - hr*3600 - min*60 sec_hms = hr*10000 + min*100 + sec iret = mcinctime(day,time,sec_hms,newday,scantime) C C -- MET also scans at 100 rpm, with the first line (line 5000) at the South Pole. C -- If the image time is 00/15/30/45, then the image has started at the South C -- 2 (full-res) lines are scanned at once -- thus it C -- takes 25 minutes to do a full disk. elseif (file_dir(52) .eq. lit('MET ') .or. & file_dir(52) .eq. lit('MET') .or. & file_dir(57) .eq. lit('MET ') .or. & file_dir(57) .eq. lit('MET') .or. & file_dir(3) .ge. 54 .and. file_dir(3) .le. 58) then C --- MSG scans from south to north msglines = 5000 - img_line_1 seconds = msglines/(200./60.) hr = seconds/3600 min = (seconds-hr*3600)/60 sec = seconds - hr*3600 - min*60 sec_hms = (hr*10000 + min*100 + sec) iret = mcinctime(day,time,sec_hms,newday,scantime) elseif (file_dir(52) .eq. lit('COMS')) then iret = getcoms1linetime(file_dir,img_line_1,scantime) elseif ( & file_dir(52) .eq. lit('ABIN') .or. & file_dir(52) .eq. lit('FCIN') .or. & file_dir(52) .eq. lit('WARI') .or. & file_dir(52) .eq. lit('WARC') .or. & file_dir(57) .eq. lit('ABIN') .or. & file_dir(57) .eq. lit('FCIN') .or. & file_dir(57) .eq. lit('WARI') .or. & file_dir(57) .eq. lit('WARC') & ) then iret = getwarilinetime(file_dir,img_line_1,img_elem_1, & scantime) else scantime = -9999 endif endif return end ** Name: ** getpoeslinetime - get time of POES line from prefix ** ** Interface: ** integer function ** getpoeslinetime ( integer prefix(*), integer prefixlen, ** integer dir(*), integer time) ** ** Input: ** prefix - line prefix ** prefixlen - length of prefix in bytes ( >0 ) ** dir - area header ** ** Input and Output: ** none ** ** Output: ** time - hhmmss time of POES line ** ** Return values: ** -1 - prefix length too small, must be > 4 ** 0 - success ** ** Remarks: ** Routine depends on the POS_COM common block being defined prior ** to call. ** ** Categories: ** image integer function getpoeslinetime(prefix,pfxlen,dir,Ltime) implicit none integer prefix(*) ! line prefix integer pfxlen ! prefix length integer dir(*) ! area directory integer jbuf(1000) ! buffer integer Ltime,ntime integer i,k integer sig integer shift(6),mask(6) character*12 cff,cfi,cfz integer m0itime,ioff,j real*8 dtime real*8 persec(4) DATA SHIFT/23,15,13,5,3,-5/,MASK/15,224,127,224,127,224/ C PERSEC - NUMBER OF SCANLINES PER SECOND DATA (PERSEC(I),I=01,04)/6.0,2.0,6.0,.15625/,SIG/1/ C -- I grabbed this function from tirchk, supplied to me by Dave Santek! Ltime = -9999 ntime = dir(47) if (dir(49) .eq. 0) then ! no prefix containing time getpoeslinetime = -1 return endif if (pfxlen .lt. 4) then getpoeslinetime = -1 return endif C -- swbyt the prefix if needed call swbyt2(prefix(1),pfxlen/2) call ddest('crack the prefix',0) CALL CRACK(pfxlen,prefix,JBUF) K=0 ioff = 10 if(dir(36) .eq. 0) ioff = 6 DO 100 I=1,6 call ddest(cfi(i)//cfz(jbuf(i+ioff)),0) J=ISHFT(IAND(JBUF(I+ioff),MASK(I)),SHIFT(I)) K=IOR(K,J) 100 CONTINUE DTIME=(K-NTIME)/1000.D0 CALL DDEST('Directory Time Scan Time',0) CALL DDEST(CFI(NTIME)//CFI(K),0) ntime= ntime/1000 k = k/1000 CALL DDEST(CFI(m0itime(NTIME/3600.))// * CFI(m0itime(K/3600.)),0) Ltime = m0itime(K/3600.) CALL DDEST('DIFF '//CFF(DTIME,3),0) DTIME = DTIME * PERSEC(SIG) CALL DDEST('IMGLIN'//CFI(IDNINT(DTIME)+1),0) getpoeslinetime = 0 RETURN END ** Name: ** getgvarlinetime - get time of GVAR line from prefix ** ** Interface: ** integer function ** getgvarlinetime ( integer prefix(*), integer prefixlen, ** integer filehead(*), integer time) ** ** Input: ** prefix - line prefix ** prefixlen - length of prefix in bytes ( >0 ) ** filehead - area directory ** ** Input and Output: ** none ** ** Output: ** time - hhmmss time of POES line ** ** Return values: ** -2 - Not GVAR data ** -1 - prefix length too small, must be > 4 ** 0 - success ** ** Remarks: ** Get the actual scan time out of the GVAR prefix ** ** Categories: ** image integer function getgvarlinetime(prefix,pfxlen,dir,Ltime) implicit none integer prefix(*) ! line prefix integer pfxlen ! prefix length integer dir(*) ! area directory integer ltime ! scantime C -- this code has been copied from the mcrd code gvarinfo, which C Geary Callan wrote integer itimes(16) integer loc1,loc2,loc4 integer hour,min,sec,msec integer year,dayofyr Ltime = -9999 C -- test for GVAR if ((dir(3) .lt. 70) .or. & (dir(3) .gt. 79 .and. dir(3) .lt. 180) .or. & (dir(3) .gt. 185)) then getgvarlinetime = -2 return endif if (dir(36) .ne. 0) then loc1 = 4 loc2 = 2 loc4 = 1 else loc1 = 0 loc2 = 0 loc4 = 0 endif if (dir(49) .eq. 0) then getgvarlinetime = -1 return endif 100 format(1x,10(i10,1x)) if (mod(dir(3),2) .eq. 0) then ! IMAGER data, ss even call unpktime(prefix,itimes,6+LOC1) else ! SOUNDER data, ss odd call unpktime(prefix,itimes,9+LOC1) endif 200 format(16(i4,1x)) year = itimes(1)*1000 + itimes(2)*100 + itimes(3)*10 + itimes(4) dayofyr = itimes(5)*100 + itimes(6)*10 + itimes(7) hour = itimes(8)*10 +itimes(9) min = itimes(10)*10 +itimes(11) sec = itimes(12)*10 +itimes(13) msec = itimes(14)*100 + itimes(15)*10 + itimes(16) ltime = hour*10000 + min*100 + sec getgvarlinetime = 0 RETURN END SUBROUTINE UNPKTIME (LDOC,ITIMES,LOC) C LOC is 13 for sounder, 11 for imager integer ITIMES(16) integer cracked_doc(32) INTEGER MASK1, MASK2, MASK3 integer lword integer ldoc(256) equivalence (lword,iword) C DATA declarations DATA mask1 /15/ ! z0000000F DATA mask2 /240/ ! z000000F0 DATA mask3 /255/ ! z000000FF C C crack out the doc 1 byte at a time to avoid byte-flipping probs C call crack(32,ldoc,cracked_doc) K = 0 DO 200 I=1,8 LWORD = cracked_doc(LOC+i) C call movc(1, ldoc, LOC+i-1, lword, 3) iword = iand(iword,mask3) K = K + 1 ITIMES(k) = iand(iword,mask2) ITIMES(k) = ISHFT(ITIMES(k),-4) K = K + 1 ITIMES(k) = iand(iword,mask1) 200 CONTINUE RETURN END ** Name: ** getaaalinetime - get time of GOES line from prefix ** ** Interface: ** integer function ** getaaalinetime ( integer prefix(*), integer prefixlen, ** integer time) ** ** Input: ** prefix - line prefix ** prefixlen - length of prefix in bytes ( >0 ) ** ** Input and Output: ** none ** ** Output: ** time - hhmmss time of POES line ** ** Return values: ** -1 - prefix length too small, must be > 4 ** 0 - success ** ** Remarks: ** Routine depends on the POS_COM common block being defined prior ** to call. ** ** Categories: ** image integer function getaaalinetime(prefix,pfxlen,dir,Ltime) implicit none integer prefix(*) ! line prefix integer pfxlen ! prefix length integer dir(*) ! area directory integer Ltime C -- The scan time of the individual line is held in the CAL part of C the prefix. According to the doc, the line prefix contains C a 4-byte validity code, 512 bytes of IR common documentation, C and then 116 bytes of VAS cal information, bytes 5-8 of which C are the time of the scan. So check to make sure the prefix C is long enough before reading the time out of it. Ltime = -9999 if (dir(49) .eq. 0) then ! no prefix containing time getaaalinetime = -1 return endif if (pfxlen .lt. 131*4) then getaaalinetime = -1 return endif Ltime = prefix(131) call swbyt4(Ltime,1) call swbyt2(Ltime,2) getaaalinetime = 0 RETURN END ** Name: ** getgmslinetime - get time of GMS line from nav block ** ** Interface: ** integer function ** getgmslinetime ( integer inav(*), integer navlength, ** integer img_line_1,integer idir(*), integer time) ** ** Input: ** inav - nav documentation ** navlength - length of nav block ** img_line_1- line number in image ** idir - 64-word image directory ** ** Input and Output: ** none ** ** Output: ** time - hhmmss time of POES line ** ** Return values: ** -1 - nav block length too small ** 0 - success ** ** Remarks: ** See GMS Nav documentation for clarifying comments. ** ** Categories: ** image integer function getgmslinetime(inav,navlength,img_line,dir,Ltime) implicit none integer inav(*) ! navigation block integer navlength ! length of nav block integer img_line ! line number integer dir(*) ! area directory integer Ltime integer kchar character*12 cfz, ctext character*6 cspin integer ispin(2) integer lit ! integer mcinctime integer idata1 integer day,time ! nominal day/time of image, from directory integer nlines ! number of lines integer newday ! day of scanline integer hr,min,sec,seconds! time variables integer sec_hms ! seconds in hms format integer iret,scantime integer linenumber,vissensor,irsensor double precision spinrate, r8dat C -- Get the spin rate out of the nav block, use that and the line C number to compute the time (add the seconds to the nominal time C in the area directory) C -- some of the variables are not flipped for little-endian C machines, and need to be day = dir(4) time = dir(5) linenumber = img_line vissensor = 4 irsensor = 1 Ltime = -9999 if (inav(1) .eq. lit('GOES')) then spinrate = 100 ! 100 lines per minute elseif (inav(1) .eq. lit('GMSX')) then C grab mean spin rate from 4+(241->246) , that is, 245-250. The doc C has this info in words 241-246, but the first 4 words are lit 'GMSX' C so shift everything to the right by 4 words (the GMSX words are not in C the doc) call movc(6,inav(2),240,ispin,0) call movwc(ispin, cspin) ctext = cfz(ispin(1)) ctext = cfz(ispin(2)) IDATA1 = kchar( cspin(1:1) )/128 R8DAT = DFLOAT( MOD(kchar(cspin(1:1)),128))*2.D0**(8*5)+ * DFLOAT( kchar(cspin(2:2)) )*2.D0**(8*4)+ * DFLOAT( kchar(cspin(3:3)) )*2.D0**(8*3)+ * DFLOAT( kchar(cspin(4:4)) )*2.D0**(8*2)+ * DFLOAT( kchar(cspin(5:5)) )*2.D0**(8*1)+ * DFLOAT( kchar(cspin(6:6)) ) R8DAT = R8DAT/(10.D0**8) IF(IDATA1.EQ.1) R8DAT =-R8DAT spinrate = r8dat call ddest('Spin rate ', idnint(spinrate)) call movc(4,inav(2),38,vissensor,0) call movc(4,inav(2),42,irsensor,0) call swbyt4(vissensor,1) call swbyt4(irsensor,1) else c c --- probably have remapped data c getgmslinetime = -1 return endif C --- GMS spinrate stored as lines per minute -- make it per second spinrate = spinrate/60. nlines = irsensor*linenumber/vissensor seconds = (nlines - 1)/spinrate hr = seconds/3600 min = (seconds-hr*3600)/60 sec = seconds - hr*3600 - min*60 sec_hms = hr*10000 + min*100 + sec iret = mcinctime( day,time,sec_hms,newday,scantime) if (iret .ge. 0) then Ltime = scantime getgmslinetime = 0 else getgmslinetime = -1 endif RETURN END ** ** Name: ** getl1blinetime - compute time of l1b line ** ** Interface: ** integer function ** getl1blinetime ( integer idir(*), integer img_line, ** integer time) ** ** Input: ** idir - 64-word image directory ** img_line - line number in image ** ** Input and Output: ** none ** ** Output: ** time - hhmmss time of l1b line ** ** Return values: ** 0 - success ** ** Remarks: ** Computes the time given the line number and the scan rate ** ** Categories: ** image integer function getl1blinetime(dir,img_line,Ltime) implicit none integer img_line ! line number integer dir(*) ! area directory integer Ltime integer mcinctime double precision scanrate ! scan rate of level 1b image integer day,time ! nominal day/time of image, from directory integer newday ! day of scanline integer hr,min,sec,seconds! time variables integer sec_hms ! seconds in hms format integer iret,scantime C -- level 1b data are at 166.66666666666 msec per scan line. C GAC/LAC is different from HRPT, however, because of the C reduced resolution of the former. Query the area directory C to see what kind of area beast we are dealing with scanrate = 166.666666667 day = dir(4) time = dir(5) seconds = img_line*scanrate/1000. hr = seconds/3600 min = (seconds-hr*3600)/60 sec = seconds - hr*3600 - min*60 sec_hms = hr*10000 + min*100 + sec iret = mcinctime( day,time,sec_hms,newday,scantime) if (iret .ge. 0) then Ltime = scantime getl1blinetime = 0 else getl1blinetime = -1 endif RETURN END ** ** Name: ** getcoms1linetime - compute time of coms-1 line ** ** Interface: ** integer function ** getcoms1linetime ( integer idir(*), integer img_line, ** integer time) ** ** Input: ** idir - 64-word image directory ** img_line - line number in image ** ** Input and Output: ** none ** ** Output: ** time - hhmmss time of l1b line ** ** Return values: ** 0 - success ** ** Remarks: ** Computes the time given the line number. coms1 scans a FD ** 11000 lines in about 27 minutes, per this reference: ** ** https://directory.eoportal.org/web/eoportal/satellite-missions/c-missions/coms-1 ** ** Categories: ** image integer function getcoms1linetime(dir,img_line,Ltime) implicit none integer img_line ! line number integer dir(*) ! area directory integer Ltime integer mcinctime character*12 cfr double precision scanrate ! scan rate of level 1b image integer day,time ! nominal day/time of image, from directory integer newday ! day of scanline integer hr,min,sec,seconds! time variables integer sec_hms ! seconds in hms format integer iret,scantime C -- A FD image in COMS1 -- 11,000 lines -- is scanned in 30 minutes C 11,000 / 1620 seconds is 6.790 lines each second, or 0.1472727273 C seconds for one line scanrate = 147.2727272727 day = dir(4) time = dir(5) seconds = img_line*scanrate/1000. hr = seconds/3600 min = (seconds-hr*3600)/60 sec = seconds - hr*3600 - min*60 sec_hms = hr*10000 + min*100 + sec iret = mcinctime( day,time,sec_hms,newday,scantime) if (iret .ge. 0) then Ltime = scantime getcoms1linetime = 0 else getcoms1linetime = -1 endif RETURN END INTEGER FUNCTION KCHAR(C) C Return integer value of character CHARACTER*1 C INTEGER J J = 0 CALL MOVC( 1, C, 0, J, 3 ) ! Assume big endian CALL SWBYT4( J, 1 ) ! Swap bytes on little endian hosts kchar = J RETURN END ** ** Name: ** gethwarilinetime - compute time of Himawari line ** ** Interface: ** integer function ** getwarilinetime ( integer idir(*), integer img_line, ** integer time) ** ** Input: ** idir - 64-word image directory ** img_line - line number in image ** ** Input and Output: ** none ** ** Output: ** time - hhmmss time of l1b line ** ** Return values: ** 0 - success ** ** Remarks: ** Computes the time given the line number. ** ** ** Categories: ** image integer function getwarilinetime(dir,img_line,img_elem,Ltime) implicit none integer HCASTSS parameter (HCASTSS = 286) integer img_line ! line number integer img_elem ! line number integer dir(*) ! area directory integer Ltime integer mcinctime character*4 clit character*12 cfr double precision scanrate ! scan rate of level 1b image integer day,time ! nominal day/time of image, from directory integer newday ! day of scanline integer hr,min,sec,seconds! time variables integer sec_hms ! seconds in hms format integer iret,scantime integer ScanSector integer Target ! 0 if not a Target Sector real MAXLINE integer SCANSTEP real*4 scansec_start(22) real*4 scansec_end(22) C -- A Full-disk image has 22 scans (with 250 C lines scanned simultaneously) for a total of 5500 lines. C The values below are from a time-time chart C The Full Disk is done in 10 minutes (600 Seconds). C Scan 1 -- 1st 250 lines -- is 6.5-13.5 seconds C Scan 2 -- lines 251-500 -- is 30-36 seconds C Scan 3 -- lines 501-750 -- is 37-48 seconds C Scan 4 -- lines 751-1000 -- is 61.5-74 seconds C Scan 5 -- lines 1001-1250 -- is 90-101 seconds C Scan 6 -- lines 1251-1500 -- is 120-129 seconds C Scan 7 -- lines 1501-1750 -- is 150-159 seconds C Scan 8 -- lines 1751-2000 -- is 180-190 seconds C Scan 9 -- lines 2001-2250 -- is 210-219.5 seconds C Scan 10 -- lines 2251-2500 -- is 240-249 seconds C Scan 11 -- lines 2501-2750 -- is 270-279 seconds C Scan 12 -- lines 2751-3000 -- is 300-312 seconds C Scan 13 -- lines 3001-3250 -- is 330-342 seconds C Scan 14 -- lines 3251-3500 -- is 360-371 seconds C Scan 15 -- lines 3501-3750 -- is 390-401 seconds C Scan 16 -- lines 3751-4000 -- is 420-430 seconds C Scan 17 -- lines 4001-4250 -- is 450-461 seconds C Scan 18 -- lines 4251-4500 -- is 480-490 seconds C Scan 19 -- lines 4501-4750 -- is 510-517 seconds C Scan 20 -- lines 4751-5000 -- is 544-555 seconds C Scan 21 -- lines 5001-5250 -- is 570-578.5 seconds C Scan 22 -- lines 5251-5500 -- is 578.8-585.5 seconds C data scansec_start/6.5,30.,37.,61.5,90.,120.,150.,180.,210.,240., $ 270.,300.,330.,360.,390.,420.,450.,480.,510.,544.,570.,578.8/ data scansec_end /13.5,36.,48.,74.,101.,129.,159.,190.,219.5, $ 249.,279.,312.,342.,371.,401.,430.,461.,490.,517.,555., $ 578.5,585.5/ C The Target space is scanned in 6.4 seconds... C 3.1 per half with a .2 second break in between C C In the area directory, (21) is the mode: For Himawari, this should be 1 C (22) contains 'FLDK' (Full Disk) or C (22) contains 'R301', 'R302', 'R303' or 'R304' (Target Sector) Target = 0 if (clit(dir(22)) .eq. 'R301') then Target = 1 elseif (clit(dir(22)) .eq. 'R302') then Target = 2 elseif (clit(dir(22)) .eq. 'R303') then Target = 3 elseif (clit(dir(22)) .eq. 'R304') then Target = 4 endif day = dir(4) time = dir(5) if (Target .eq. 0) then C C -- Assumption: This is a full disk image (or part of one) C c --- RCD 02/03/2016: changes for HCAST c -----> OLD CODE was this c ScanSector = nint((499+img_line)/1000.) c seconds = scansec_start(ScanSector) + c & (img_elem/22000.)*(scansec_end(ScanSector) - c & scansec_start(ScanSector)) c -----> REVISED CODE if( dir(3).eq.HCASTSS ) then c call sdest('NEW HIMAWARICAST',0) MAXLINE = 11000.0 SCANSTEP = 500 else c call sdest('NEW HIMAWARI',0) MAXLINE = 22000.0 SCANSTEP = 1000 endif ScanSector = (img_line-1)/SCANSTEP + 1 seconds = scansec_start(ScanSector) + & (img_elem/MAXLINE)*(scansec_end(ScanSector) - & scansec_start(ScanSector)) c --- RCD 02/03/2016 else if (img_line .lt. 1000) then seconds = ((img_elem)/2000.)*(3.1) else seconds = 3.2 + ((img_elem)/2000.)*(3.1) endif endif hr = seconds/3600 min = (seconds-hr*3600)/60 sec = seconds - hr*3600 - min*60 sec_hms = hr*10000 + min*100 + sec iret = mcinctime( day,time,sec_hms,newday,scantime) if (iret .ge. 0) then Ltime = scantime getwarilinetime = 0 else getwarilinetime = -1 endif RETURN END