SUBROUTINE AMBODB(AMBDAT,AMBANC,BODREC,AMBCNT,BODF1ST,BLAST, 1 LIMREC,GETLIMOB,OBSAMB,ERSTAT) IMPLICIT NONE C C********************************************************************** C C NAME- AMBODB C C LANGUAGE- VS FORTRAN TYPE- SUBROUTINE COMPUTER- IBM SP C C VERSION- 2.0 DATE- 01/22/04 PROGRAMMER- FRANK TILLEY (RAYTHEON) C VERSION- 2.1 DATE- 09/22/04 PROGRAMMER- A. ALLEGRINO (RAYTHEON) C C C FUNCTION-** THIS SUBROUTINE WRITES OUT A FRAME OF AMSU-B DATA TO THE C AMSU-B ORBITAL DATA FILE (BODF) A CYCLE (SPOT) AT A TIME. C C VERSION- 2.1 corrected an indexing problem in the array limobsb. C the computation of the index was (K+7+(18*(I-1))). C the correct version is (K+7+(8*(I-1))). (WR#261) C C FILES- C DSN OR DESCRIPTIVE TITLE I/O UNIT FUNCTIONAL DESCRIPTION C ------------------------ --- ---- ---------------------- C .../BODF O BIDFU BODF FILE. C .../KIDS O KUNIT KIDS MESSAGE FILE. C .../*AMBX*.LIMOBS O BLMUNT TEMPERATURE DATA FOR LIMB C CORRECTION COEFFICIENT C GENERATION. C C CALLING SEQUENCE PARAMETERS- C VARIABLE TYPE I/O FUNCTION C -------- ---- --- -------- C AMBDAT REAL I/O ARRAY OF DIMENSION (BNSPOT X BTOTLN C X BDATEL) WHICH HOLDS ONE DATA FRAME C OF 256 SECONDS OF AMSU-B SPOTS. C AMBANC REAL I/O ARRAY OF DIMENSION (BNSPOT X BTOTLN C X BNANC) WHICH HOLDS THE ANCILLARY C AMSU-B INFORMATION. C BODREC INT I BODF RECORD NUMBER. C AMBCNT INT O NUMBER OF RECS WRITTEN TO BODF. C BODF1ST INT O FIRST AMSU-B LINE WRITTEN TO BODF. C BLAST INT O LARST AMSU-B LINE WRITTEN TO BODF. C LIMREC INT I/O COUNTS NUMBER OF RECS WRITTEN TO BLMUNT. C GETLIMOB INT I =1 MEANS COLLECT SUB-1B* DATA. C OBSAMB REAL I UNLIMB CORRECTED AMSU-B DATA ARRAY. C ERSTAT INT O NORMALLY SET TO 0 BUT IF AN ERROR C OCCURS AN ERROR STATUS CODE IS SET. C C COMMON AREA PARAMETERS- FRMINF,INSPARM,INPARM,SPVAL,SPGUNT C INCLUDE 'INSPARM' INCLUDE 'FRMINF' INCLUDE 'INPARM' INCLUDE 'SPVAL' INCLUDE 'SPGUNT' INCLUDE 'ERPARM' INCLUDE 'ERINFO' INCLUDE 'AMASTAT' INCLUDE 'MONSTA' C C LOCAL PARAMETERS- C VARIABLE TYPE DESCRIPTION C -------- ---- ------------------------------------- C DUMMY INT VECTOR OF DIMENSION 2 HOLDING THE PLACE C OF THE RECORD AND BYTE POINTERS. C I,J,K INT LOOP CONTROL INDICES. C MISSNG LOGICAL SET TRUE WHEN ALL BRIGHTNESS TEMPERATURES C IN RDATCY ARE MISSING. C M INT SCAN LINE NUMBER USED IN COMPUTING C SPOTNR. C N INT AMOUNT OF OVERFLOW SCAN LINES IN AMBDAT. C RDATCY REAL VECTOR OF DIMENSION INPARM:BNCHAN WITH C BRIGHTNESS TEMPERATURES OF AMSU-B DATA. C STAT INT ERROR STATUS RETURNED BY FMU'S. C SPOTNR INT SPOT NUMBER WITHIN THE DATA FRAME. C SPTCON INT INTEGER TO HOLD THE SPOT CONFIDENCE C VALUE. C TERTYP INT INTEGER TO HOLD THE TERRAIN TYPE C VALUE OF THE REAL AMBANC BUFFER C EQUIVALENCED TO CERTYP. C C6TEMP CH*6 TEMPORARY FOR WRITING TO KIDS. C KMSG CH*100 KIDS MESSAGE BUFFER. C BODFBUF INT 8-BYTE BODF RECORD BUFFER. C C2BODF CH*1 CHARACTER BODF RECORD BUFFER. C DUMOBS INT DUMMY FOR WRITING TO BODF. C LIMOBSB INT ARRAY TO HOLD OBSERVATIONS FOR C AMSU-B LIMB CORRECTION. C YEAR INT SCAN YEAR C MONTH INT SCAN MONTH C DAY INT SCAN DAY OF THE MONTH C HOUR INT SCAN HOUR OF THE DAY C MIN INT SCAN MINUTES C SEC INT SCAN SECONDS C SCNTIM INT ARRAY HOLDING THE SCAN DATE AND TIME C TOTELMB INT TOTAL NUMBER OF ELEMENTS IN THE AMSU-B C LIMB OBSERVATIONS ARRAY (NUMBER OF SPOTS C X (NUMBER OF CHANNELS + LAT + LONG + C ORBIT NODE)) + 4 TIME ELEMENTS. C DYOFMN INT BEGINNING JULIAN DAY OF EACH MONTH - 1 C JDAY INT JULIAN DAY C I4LIMOBS CH*1 I*4 VERSION OF THE LIMOBSB ARRAY. C C SUBPROGRAMS CALLED- KIDS C C EXIT STATES- C ERSTAT = 0; INDICATING NO ERROR FOUND C ERSTAT = 99; INDICATING A FATAL ERROR WAS DETECTED C C******************************************************************** C INTEGER ERSTAT, BODREC, IOERR, AMBCNT,BODF1ST,BLAST,GETLIMOB INTEGER LIMRECB REAL AMBDAT(BNSPOT,BTOTLN,BDATEL),OBSAMB(BNSPOT,BTOTLN,BDATEL) REAL AMBANC(BNSPOT,BTOTLN,BNANC) C INTEGER BODFLN, BBFLEN, TOTELMB PARAMETER (BODFLN=100, BBFLEN=BODFLN/2) PARAMETER (TOTELMB=BNSPOT*(BNCHAN+3)+4) CHARACTER*1 C2BODF(BODFLN),I4LIMOBS(TOTELMB*4) CHARACTER*4 C4TEMP CHARACTER*6 C6TEMP CHARACTER*100 KMSG INTEGER SPOTNR,STAT, DUMOBS INTEGER I,J,K,M,N,SPTCON,TERTYP,ILERR INTEGER DUMMY(2),LIMREC,DYOFMN(12) INTEGER FORDGTYR INTEGER SCNTIME(3),YEAR,MONTH,DAY,HOUR,MIN,SEC,JDAY INTEGER*4 LIMOBSB(TOTELMB) INTEGER*2 BODFBUF(BBFLEN) EQUIVALENCE (BODFBUF, C2BODF) EQUIVALENCE (LIMOBSB, I4LIMOBS) REAL RDATCY(BNCHAN) LOGICAL MISSNG, PACK,B1ST LOGICAL ISR4SPV ccft PARAMETER (N=BTOTBF/2) PARAMETER (N=BTOTBF) DATA DYOFMN/0,31,59,90,120,151,181,212,243,273,304,334/ C C C********************************************************************** C C INITIALIZE N TO REPRESENT THE OVERFLOW LINES AT THE BEGINNING OF C THE BUFFER, WHICH IS HALF THE TOTAL OVERFLOW SCAN LINES. C AMBCNT = 0 SPOTNR = 0 M=N+1 IOERR=0 B1ST = .TRUE. PACK = .TRUE. DO K=1,BBFLEN BODFBUF(K) = I2SPV END DO C C THE AMSU-B BUFFERS, PASSED IN THE CALL, CONTAIN A DATA FRAME C CONSISTING OF 12 SCAN LINES OVERLAP AT THE BEGINNING AND THE END OF C THE BUFFER. C C BEGIN LOOP OF ACTIVE SCAN LINES. IF THE GETLIMOB FLAG IS SET TO 1, C THEN EXTRACT THE DATA NECESSARY FOR THE LIMB CORRECTION COEFFICIENT C GENERATION. C ccft DO 60 J = 1+N,BTOTLN-N DO 60 J = 1+N,BTOTLN C C INITIALIZE THE AMSU-B LIMB DATA ARRAY C IF(GETLIMOB.EQ.1) THEN DO M=1,TOTELMB LIMOBSB(M)=0 ENDDO C C IF THE SCAN TIME IS NEGATIVE (A MISSING VALUE), SKIP THE SPOT C IF (BSCTIM(1,J).LT.0) GO TO 60 C C C LOAD ORBIT NUMBER INTO LIMB DATA ARRAY & GET SCAN TIME IN YEAR/MONTH C , DAY/HOUR AND MIN/SEC AND THEN CONVERT TIME TO JULIAN DAY AND TENTHS C SECONDS. C LIMOBSB(1)=SORB(2) CALL ODBTIM(BSCTIM(1,J),BSCTIM(2,J),SCNTIME) YEAR = SCNTIME(1)/100 MONTH = SCNTIME(1) - ((SCNTIME(1)/100)*100) DAY = SCNTIME(2)/100 HOUR = SCNTIME(2) - ((SCNTIME(2)/100)*100) MIN = SCNTIME(3)/100 SEC = SCNTIME(3) - ((SCNTIME(3)/100)*100) C C CHECK TO SEE IF YEAR IS 2000 OR ABOVE. C FORDGTYR = YEAR IF(YEAR .LT. 98) FORDGTYR=2000 + YEAR C C CALCULATE THE JULIAN DAY C JDAY = DYOFMN(MONTH) + DAY IF(MOD(YEAR,4).EQ.0 .OR. MOD(FORDGTYR,400).EQ.0) THEN IF(MONTH.GT.2) JDAY = JDAY + 1 ENDIF LIMOBSB(2) = YEAR LIMOBSB(3) = JDAY C C CALCULATE THE YEARTIME IN DECISECONDS C LIMOBSB(4)= SEC* 10 + MIN*600 + HOUR*36000 + > (JDAY-1)*864000 ENDIF C C LOAD THE AMSU-B BRIGHTNESS TEMPERATURES FOR CHANNELS 1-5 PER SPOT. C DO 50 I = 1,BNSPOT DO K=1,BBFLEN BODFBUF(K) = I2SPV END DO C C START FILLING BODF RECORD BUFFER. C BODFBUF(1) = 2 DUMOBS = 2 C C FIRST, DETERMINE IF RDATCY HAS ANY MISSING VALUES. IF IT IS ALL C MISSING, DO NOT WRITE THIS RECORD BUT GO TO 30 SO SPOTNR IS C SET CORRECTLY. THE VALUES IN RDATCY ARE THE OBSERVED, NOT THE C LIMB CORRECTED, BRIGHTNESS TEMPERATURES. C MISSNG = .TRUE. DO 20 K = 1,BNCHAN RDATCY(K)=AMBDAT(I,J,K+5) IF(.NOT. ISR4SPV(RDATCY(K))) MISSNG = .FALSE. 20 CONTINUE IF(MISSNG) GO TO 30 C C SINCE ALL RDATCY ARE NOT MISSING, FILL THE BODF BUFFER AND THE C LIMB COLLECTION BUFFER, IF SPECIFIED. C PLACE THE LIMB CORRECTED AMSU-B DATA INTO THE BODF BUFFER AT POSITIONS C 2-6. C DO 25 K=1,BNCHAN IF (.NOT. ISR4SPV(AMBDAT(I,J,K))) THEN BODFBUF(DUMOBS) = NINT(AMBDAT(I,J,K) * 64.0) ENDIF IF (.NOT. ISR4SPV(OBSAMB(I,J,K))) THEN BODFBUF(DUMOBS+5) = NINT(OBSAMB(I,J,K) * 64.0) ENDIF DUMOBS = DUMOBS + 1 25 CONTINUE C C CAPTURING DATA FOR LIMB CORRECTION C IF(GETLIMOB.EQ.1) THEN DO 27 K=1,BNCHAN IF (ISR4SPV(RDATCY(K))) THEN LIMOBSB(K+7+(8*(I-1)))=0 ELSE LIMOBSB(K+7+(8*(I-1)))=NINT(RDATCY(K)*100.0) ENDIF 27 CONTINUE ENDIF C C LOAD THE SOLAR ZENITH ANGLE OF THE AMSU-B SPOT. C IF (.NOT. ISR4SPV(AMBANC(I,J,3))) THEN BODFBUF(12) = NINT(AMBANC(I,J,3) * 128.0) END IF C C LOAD THE SATELLITE ZENITH ANGLE OF THE AMSU-A SPOT. C IF (.NOT. ISR4SPV(AMBANC(I,J,4))) THEN BODFBUF(13) = NINT(AMBANC(I,J,4) * 128.0) END IF C C LOAD THE SPOT NUMBER IN REFERENCE TO THE DATA FRAME. C 30 CONTINUE IF(J .GT. M) THEN SPOTNR = (J - (N + 1))*BNSPOT M = J ENDIF SPOTNR = SPOTNR + 1 IF(MISSNG) GOTO 50 BODFBUF(14) = SPOTNR C C LOAD THE LATITUDE OF THE SPOT. C IF (AMBANC(I,J,1).GE.(-90.0)) THEN IF (AMBANC(I,J,1).LE.90.0) THEN BODFBUF(15) = NINT(AMBANC(I,J,1)*128.0) END IF END IF C C LOAD THE LONGITUDE OF THE SPOT. C IF (AMBANC(I,J,2).GE.(-180.0)) THEN IF (AMBANC(I,J,2).LE.180.0) THEN BODFBUF(16) = NINT(AMBANC(I,J,2)*128.0) END IF END IF C C LOAD THE SPOT CONFIDENCE VALUE. C SPTCON = NINT(AMBANC(I,J,5)) IF (.NOT. ISR4SPV(AMBANC(I,J,5))) THEN BODFBUF(17) = SPTCON END IF C C LOAD THE CHANNEL AVAILABILITY. C BODFBUF(18) = NINT(AMBANC(I,J,6)) C C LOAD THE TERRAIN HEIGHT OF THE SPOT. C BODFBUF(19) = NINT(AMBANC(I,J,7)) C C LOAD THE TERRAIN TYPE OF THE SPOT. C TERTYP = NINT(AMBANC(I,J,8)) IF (.NOT. ISR4SPV(AMBANC(I,J,8))) THEN BODFBUF(20) = TERTYP END IF C C LEAVE BUFFER SLOTS 21-30 AS SPARES C C LOAD THE NODE OF THE SPOT. C BODFBUF(31) = NINT(AMBANC(I,J,11)) C C PLACE THE LATITUDE, LONGITUDE, AND NODE INTO THE OBSERVATION RECORD C FOR THE LIMB CORRECTION COEFFICIENT CREATION. C IF(GETLIMOB.EQ.1) THEN LIMOBSB(5+(8*(I-1)))=NINT(AMBANC(I,J,1)*100.0) LIMOBSB(6+(8*(I-1)))=NINT(AMBANC(I,J,2)*100.0) LIMOBSB(7+(8*(I-1)))=BODFBUF(31) ENDIF C CCFT C ADD THE BUFFER LINE AND SPOT C BODFBUF(32) = J BODFBUF(33) = I C C INCREMENT THE RECORD COUNTER & WRITE THE SPOT TO THE BODF. C BODREC = BODREC + 1 WRITE(UNIT=BIDFU,REC=BODREC,IOSTAT=IOERR,ERR=900) C2BODF IF(IOERR.NE.0) GO TO 900 C C UPDATE INFORMATION FOR BODF FRAME HEADER C AMBCNT = AMBCNT + 1 IF(B1ST) THEN BODF1ST = J B1ST = .FALSE. ENDIF BLAST = J 50 CONTINUE TOTBLN = TOTBLN + 1 C C UPDATE LIMBOBS FILES C IF(GETLIMOB.EQ.1) THEN LIMREC = LIMREC + 1 WRITE(UNIT=BLMUNT,REC=LIMREC,IOSTAT=IOERR,ERR=901) 1 I4LIMOBS IF(IOERR.NE.0) GO TO 901 ENDIF C C CHECK NEXT LINE. C 60 CONTINUE GO TO 1000 C 900 KMSG = '* FATAL ERROR * WRITING RECORD OF BODF FILE' WRITE(C6TEMP,'(I6)') BODREC KMSG(32:37) = C6TEMP IF(IOERR.NE.0) THEN KMSG(39:100) = 'WITH IOSTAT = ' WRITE(C4TEMP,'(I4)') IOERR KMSG(53:56) = C4TEMP ENDIF SUBNAM='SPGDVR' CALL KIDS(KUNIT,SUBNAM,0,KMSG,0) C C SINCE SOMETHING WAS WRONG WITH THIS RECORD, DECREMENT THE RECORD C NUMBER COUNTER FOR THIS FILE C BODREC = BODREC - 1 ERSTAT = 99 GO TO 1000 C 901 KMSG(1:50)='* FATAL ERROR * WRITING RECORD OF LIMB AMSU' KMSG(51:100)='-B OBSERVATIONS FILE.' WRITE(C6TEMP,'(I6)') LIMREC KMSG(32:37) = C6TEMP IF(ILERR.NE.0) THEN KMSG(71:100) = ' WITH IOSTAT = ' WRITE(C4TEMP,'(I4)') IOERR KMSG(86:89) = C4TEMP ENDIF SUBNAM='SPGDVR' CALL KIDS(KUNIT,SUBNAM,0,KMSG,0) C C SINCE SOMETHING WAS WRONG WITH THIS RECORD, DECREMENT THE RECORD C NUMBER COUNTER FOR THIS FILE C LIMREC = LIMREC - 1 ERSTAT = 99 GO TO 1000 C C 1000 RETURN END