PROGRAM MAFCRD ! ! writes in the default directory a geographic coordinate file (.GEO) ! and a corrected geomagnetic coordinate file (.CGM) for each input ! DE-1 SAI image file. ! The list of SAI image files should be in a file named CDFname.FILES, ! where CDFname is the name that the final CDF will have. ! version 6 by Rae Dvorsky, University of Iowa, November 1991; ! set up for NSSDC CDAW use, June 1992 ! Modified to accept filelist, put I*2 words at end of commons (SEK) ! INCLUDE 'MAFREC.TXT' ! COMMON /IMAGE/ IMFILE,FCTDWN,FCTACR,NPHOT,CENTRMLC,PIXOFF COMMON /COORDS/ KHEAD,KSCAN,R8 ! CHARACTER*128 IMFILE,NFILE, CDFNM*10 INTEGER*2 NPHOT,CENTRMLC,PIXOFF,K,I1,I2,IND,L,N INTEGER*4 UTNC1,NSPIN,TSPIN,SOLMSEC1 REAL*4 FCTDWN,FCTACR LOGICAL*1 DSP BYTE KHEAD(200),KSCAN(628),R8(8) ! !---get MAF and set up for coordinate calculations !----identify image file (***Modified to accept file list, SEK 8/92) TYPE *, 'Enter CDFname (e.g. SAIyymmdd)' READ (5, '(A)') CDFNM OPEN(UNIT=10,FILE=CDFNM//'.FILES',STATUS='OLD',READONLY) 11 READ(10,'(A40)',END=95) IMFILE !----open file, read header record, get photometer ID (1, 2, or 3) CALL ERRSET(67,.TRUE.,.FALSE.,.TRUE.,.FALSE.,32000) OPEN(UNIT=2,FILE=IMFILE,FORM='UNFORMATTED',TYPE='OLD', & READONLY) READ(2) HEADER NPHOT = PHOTID CENTRMLC = 0 CLOSE(UNIT=2) !----coordinate calculation setup CALL IMAGEIN(IMFILE) CALL SETCRD ! !---open output files in default directory and MAF WRITE(6,*) IMFILE I1 = MAX(INDEX(IMFILE,']'),INDEX(IMFILE,':')) + 1 L = LEN(IMFILE) I2 = I1 IND = INDEX(IMFILE(I1+1:L),'.') DO WHILE (IND.GT.0) I2 = I2 + IND IND = INDEX(IMFILE(I2+1:L),'.') ENDDO I2 = I2 - 1 WRITE(NFILE,'(A)') IMFILE(I1:I2)//'.GEO' OPEN(UNIT=3,NAME=NFILE,FORM='UNFORMATTED',TYPE='NEW') WRITE(NFILE,'(A)') IMFILE(I1:I2)//'.CGM' OPEN(UNIT=4,NAME=NFILE,FORM='UNFORMATTED',TYPE='NEW') OPEN(UNIT=2,NAME=IMFILE,FORM='UNFORMATTED',TYPE='OLD',READONLY) READ(2) HEADER ! !---write header records CALL RCODE(R8) CALL INITHD ! !---write two coordinate records for each scan line DO 55 K=1,LINES 50 READ(2,END=55,ERR=53) SCAN 53 CALL CLINE 55 CONTINUE ! !---close files CLOSE(UNIT=3,DISP='SAVE') CLOSE(UNIT=4,DISP='SAVE') CLOSE(UNIT=2) ! GO TO 11 ! 95 CONTINUE END ! ! ! SUBROUTINE INITHD ! ! writes header records for .GEO and .CGM files on units 3 and 4; ! assumes .MAF is open on unit 2 ! INCLUDE 'MAFREC.TXT' ! COMMON /COORDS/KHEAD,KSCAN,R8 ! BYTE KHEAD(200),KSCAN(628),R8(8) INTEGER*2 KWORDS,KBLOCK,KBYTES,MAXBYT,MAFCRD,KDIRCT(3), & NUMBER,K INTEGER*4 KTYPE,KLINES,KMSOA,KALTTD REAL*4 SP,ALT CHARACTER*4 NAME ! EQUIVALENCE (KHEAD( 1),KWORDS), (KHEAD(37),KLINES ), & (KHEAD( 3),KBLOCK), (KHEAD(41), KMSOA ), & (KHEAD( 5),KBYTES), (KHEAD(125),KALTTD ), & (KHEAD( 7),MAXBYT), (KHEAD(193),MAFCRD ), & (KHEAD( 9), KTYPE), (KHEAD(195),KDIRCT(1)) ! ! !---get altitude for this filter CALL FILTERS(PHOTID,FWVOLT,NAME,NUMBER,SP,ALT) KALTTD = NINT(ALT)*1000 ! !---initialize header record KWORDS = 100 KBYTES = 200 MAXBYT = MAXPIXINLINE*4 + 28 DO K=13,28 KHEAD(K) = HEADER(K) ENDDO DO K=29,36 KHEAD(K) = HEADER(K+12) ENDDO KLINES = LINES KMSOA = OAMSEC DO K=45,84 KHEAD(K) = HEADER(K+72) ENDDO DO K=85,112 KHEAD(K) = HEADER(K+76) ENDDO DO K=113,124 KHEAD(K) = HEADER(K+80) ENDDO DO K=1,6 KHEAD(184+K) = ASCNAME(K) ENDDO KHEAD(191) = ' ' KHEAD(192) = ' ' MAFCRD = 6 KDIRCT(1) = XS3CHARS(2) KDIRCT(2) = XS3NAMES(3) KDIRCT(3) = XS3NAMES(4) DO K=1,8 KHEAD(176+K) = R8(K) ENDDO ! !---write header records KBLOCK = 10*256 + 1 KTYPE = 10 WRITE(3) KHEAD KBLOCK = 11*256 + 1 KTYPE = 11 WRITE(4) KHEAD ! RETURN END ! ! ! SUBROUTINE CLINE ! INCLUDE 'MAFREC.TXT' ! COMMON /IMCOORD/IMXMIN,IMXMAX,IMYMAX,STEP,PIXWD,PIXHT, & NSPIN,TSPIN,UTNC1,SOLMSEC1,SP,ALTF,MDIREC COMMON /COORDS/ KHEAD,KSCAN COMMON /IMAGE/ IMFILE,FCTDWN,FCTACR,NPHOT,CENTRMLC,PIXOFF ! BYTE KHEAD(200),KSCAN(628) INTEGER*2 KWRDS,KBYTS,KPIX,KMLC,KOFFST,KPAIRS(2,150), & MDIREC,ISINK,K INTEGER*4 NDUTMS,NDPGEI(3),KALTTD,UTPIX,NSPIN,TSPIN, & UTNC1,SOLMSEC1 REAL*4 XS,YS,P(4),ALT,GLAT,GLONG,GLT,GMLAT,GMLONG,GMLT, & IMXMIN,IMXMAX,IMYMAX,STEP,PIXWD,PIXHT,SP,ALTF REAL*8 DSTART,DSTOP LOGICAL*1 GOOD CHARACTER*128 IMFILE INTEGER*2 NPHOT,CENTRMLC,PIXOFF REAL*4 FCTDWN,FCTACR ! EQUIVALENCE (KHEAD(125),KALTTD) ! EQUIVALENCE (KSCAN(1),KWRDS), (KSCAN( 9), KOFFST), & (KSCAN(3),KBYTS), (KSCAN(13), NDUTMS), & (KSCAN(5), KPIX), (KSCAN(17), NDPGEI(1)), & (KSCAN(7), KMLC), (KSCAN(29),KPAIRS(1,1)) ! !---initialize record length fields and MLC KWRDS = (LBYTES-22)*2 + 14 KBYTS = KWRDS*2 KPIX = LBYTES - 22 KMLC = IZEXT(MLC) ! !---get pixel offset to nadir crossing KOFFST = INT((IMYMAX-(NADCOR(1)+NADCOR(2)+NADCOR(3))/8.)*10.) - & ISINK(IMSYNCVERS,UIPROCTIME,DCU)*10 ! !---get s/c position and UT for nadir crossing CALL LOCPX(IZEXT(MLC),KOFFST/10+1,XS,YS) NDUTMS = UTPIX(XS,YS) ! !---get s/c GEI position at nadir crossing DSTART = (OAMSEC-NDUTMS)/1.D3 DSTOP = -DSTART CALL DEORBIT(DSTART,DSTOP,0.D0,P) DO K=1,3 NDPGEI(K) = JIDNNT( DBLE(P(K))*1.D3 ) ENDDO ! !---get geographic coordinates for each pixel ALT = KALTTD/1.E3 DO K=1,KPIX CALL LOCPX(IZEXT(MLC),K,XS,YS) CALL VW2GEO(XS,YS,ALT,GLAT,GLONG,GLT,GOOD) IF (.NOT.GOOD) THEN GLAT = -300.0 GLONG = -300.0 ELSE IF (GLONG.GT.180.0) GLONG = GLONG - 360.0 ENDIF KPAIRS(1,K) = IIFIX(GLAT*100.) KPAIRS(2,K) = IIFIX(GLONG*100.) ENDDO WRITE(3) (KSCAN(K),K=1,KBYTS) ! !---get corrected geomagnetic coordinates for each pixel DO K=1,KPIX IF (KPAIRS(1,K).EQ.-30000) GO TO 56 GLAT = KPAIRS(1,K)/100. GLONG = KPAIRS(2,K)/100. IF (GLONG.LT.0.) GLONG = GLONG + 360. CALL GEO2MAG(YEAR,DAY,MSEC,GLAT,GLONG,GMLAT,GMLONG,GMLT,GOOD) IF (GOOD) THEN IF (GMLT.GT.180.) GMLT = GMLT - 360. ELSE 56 GMLAT = -300.0 GMLT = -300.0 ENDIF KPAIRS(1,K) = IIFIX(GMLAT*100.) KPAIRS(2,K) = IIFIX(GMLT*100.) ENDDO WRITE(4) (KSCAN(K),K=1,KBYTS) ! RETURN END ! ! ! SUBROUTINE RCODE(RESERVED8) ! INTEGER*4 MONTH,IDAY,IYEAR BYTE RESERVED8(8) ! RESERVED8(1) = 40 RESERVED8(2) = 53 RESERVED8(3) = 53 RESERVED8(4) = 23 RESERVED8(5) = 22 RESERVED8(6) = 0 CALL IDATE(MONTH,IDAY,IYEAR) RESERVED8(7) = IYEAR RESERVED8(8) = MONTH ! RETURN END