C  MICROSOFT FORTRAN SOURCE CODE FOR PROGRAM DIRACC  (DMAAC/GGCB, 11 MAY 94)
C                                          ------  
C***********************************************************************
C* 
C*                     DIRACC  
C*   LGLEN   =  NUMBER OF LONGTITUDE BANDS IN THE DIRECT ACCESS FILE
C*   IRECL   =  NUMBER OF WORDS PER RECORD 
C*   NREC    =  NUMBER OF RECORDS IN DIRECT ACCESS FILE
C*   XINC    =  SPACING IN MINUTES OF DIRECT ACCESS FILE
C* 
C*                     INPUT
C*   NWR     =  NUMBER OF WORDS PER RECORD 
C*   NRB     =  NUMBER OF RECORDS PER BLOCK
C***********************************************************************
      IMPLICIT REAL*4 (A-H,O-Z)
C     NAMELIST /DIRACC/ LGLEN,IRECL,NREC,XINC  
C     NAMELIST /INPUT/ NWR,NRB,TOPLAT,WL
      DIMENSION WRD(500),W(3)  
      DATA WRD/500*0.0/, PAD/-5401.0/  
      DATA W/3*-9999.0/

      OPEN(15,STATUS='UNKNOWN',FILE='DIRACC.DAT')                   
      OPEN(12,STATUS='UNKNOWN',FILE='WWGRID.TXT')
C  
      READ(15,*) LGLEN,IRECL,NREC,XINC
      OPEN(13,ACCESS='DIRECT',RECL=IRECL*4,FILE='DIRACC.OUT')
      READ(15,*) NWR,NRB,TOPLAT,WL
      WRITE(6,50) LGLEN,IRECL,NREC,XINC 
      WRITE(6,51) NWR,NRB,TOPLAT,WL
   50 FORMAT (' LGLEN = ',I4,2X,'IRECL = ',I2,2X,'NREC = ',I8,  
     >2X,'XINC = ',F6.1//)
   51 FORMAT (' NWR = ',I2,2X,'NRB = ',I3,2X,'TOPLAT = ',F6.0,
     >2X,'WL = ',F6.0//)
C************************************************************************  
C*   OPEN DIRECT ACCESS FILE AND FILL RECTANGULAR AREA CONTAINING  
C*   AREA OF INTEREST WITH A PAD OF -9999.0
C************************************************************************  
  
      DO 1 L = 1,NREC
          WRITE(13,REC=L) W(1), W(2), W(3)  
  1   CONTINUE
  
C************************************************************************  
C*   NPTS  -  NUMBER OF POINTS 
C*   NWB   -  NUMBER OF WORDS PER BLOCK
C*   NWR   -  NUMBER OF WORDS PER RECORD
C*   NRB   -  NUMBER OF RECORDS PER BLOCK  
C************************************************************************* 
  
      NPTS = 0 
      NWB = NWR * NRB  
   10 READ(12,*,END=30) W(1),W(2),W(3)
              IF ( W(1) .LE. PAD) GOTO 30 
              NPTS = NPTS + 1  
              W(1) = W(1) * 60.  
              W(2) = W(2) * 60.
C              IF ( W(2) .EQ. 21600.0 ) W(2) = 0.0
              CALL RECORD(W(1),W(2),TOPLAT,WL,LGLEN,XINC,IREC) 
              WRITE(UNIT=13,REC=IREC) (W(J), J = 1, 3)  
  20      CONTINUE 
      GOTO 10  
  30  CONTINUE 
      WRITE(6,*)W(1),W(2)  
      PRINT*, '    NUMBER OF VALUES WRITTEN TO FILE ',NPTS 
      STOP 
      END  
      
      SUBROUTINE RECORD( LAT,LONG,TOPLAT,WL,LGLEN,XINC,IREC)
      IMPLICIT REAL*4 (A-H,O-Z)
      REAL*4 LAT, LONG 
      IPOSLT = NINT((TOPLAT - LAT)/XINC)
      IPOSLG = NINT((LONG - WL)/XINC) + 1  
      IREC = IPOSLT * LGLEN + IPOSLG
      RETURN
      END