GIStemp STEP2_invnt

The program invnt.f

Here is the listing. The explanation will follow some months or weeks from now below, after the === bar.

   
 
C****   
C**** Input: 15  binary station data
C****
C**** extracts station information
      PARAMETER(ITRIM=1,IYRBEG=1880,IYREND=3001)
      PARAMETER(NRECPY=12, SCL=10., NDPRYR=NRECPY)
      PARAMETER(MONM=NDPRYR*(IYREND-IYRBEG+1),NTRL=14+ITRIM)
      CHARACTER*6 IDNOAA,IDNOW
      CHARACTER*80 TITLE,NAME*36,fname/' '/
      INTEGER INFO(8+ITRIM),ITRL(NTRL),ITR1(4),ID/0/
      DIMENSION PE(MONM),IDATA(MONM),ID1(MONM),PL(2,MONM)
      COMMON/DIFF/AVG(14),SD(0:12)
      EQUIVALENCE (ITRL(5),NAME),(ITRL(1),ITR1(1)),
     *  (ITRL(3),IDNOW)
C**** INITIALIZE
      CALL GETARG(1,fname)
      NDOT=INDEX(fname,' ')
      do 900 nfl=1,6
      write(fname(NDOT:NDOT+1),'(A1,I1)') '.',nfl
      NPRINT=0
      NCUR=1
      OPEN(15,STATUS='OLD',FILE=fname,FORM='UNFORMATTED')
      READ(15) INFO,TITLE
      N1=INFO(1)
      N2=INFO(4)
      IF(ITRIM.GT.0) N2=INFO(8+ITRIM)
      IF(INFO(6).LT.IYRBEG) STOP 'IYRBEG TOO HIGH'
      LENGTH=N2-N1+1
      IF(INFO(4).GT.MONM) STOP 'IYREND TOO LOW'
      MBAD=INFO(7)

      XBAD=MBAD
      IF(INFO(1).EQ.MBAD) go to 899 ! no data
  100 CALL INTT(IDATA,MONM,MBAD,PE,XBAD)
      CALL SPREAD(IDATA,ITRL,LENGTH,NTRL)
      IF(ID.GT.ITRL(3)) GO TO 800

      IYR0=(N1-1)/NDPRYR
      IYRL=(N2+NRECPY-1)/NDPRYR
      N1JAN=IYR0*NRECPY+1
C     WRITE(6,*) ITRL(3),INFO(6)+IYR0,INFO(6)+IYRL-1
      DO 210 N=N1JAN,MONM
      PE(N)=IDATA(N)
  210 ID1(N)=NINT(SCL*IDATA(N))
      MISS=NINT(SCL*XBAD)
      M=0
      WRITE(6,'(A,I9,1X,A30,1x,a,I5,I6,1x,a1,a1,a1,a4,a3)') 
     *  fname(1:NDOT+2),ITR1(3),name(1:30),
     *  'lat,lon (.1deg)',(ITR1(i),i=1,2),
     * name(32:32),name(31:31),name(33:33),' cc=',name(34:36)
      NPRINT=NPRINT+1
  800 N1=ITRL(14)
      IF(ITRIM.GT.0) N2=ITRL(14+ITRIM)
      LENGTH=N2-N1+1
      NCUR=NCUR+1
      IF (N1.NE.INFO(7)) GOTO 100
  899 CLOSE (15)
  900 continue
      STOP
      END

      SUBROUTINE SPREAD(IDATA,ITRL,LENGTH,NTRL)
      DIMENSION IDATA(LENGTH),ITRL(NTRL)
      READ(15) IDATA,ITRL
      RETURN
      END

      SUBROUTINE INTT(IDATA,MONM,MBAD,PE,XBAD)
      DIMENSION IDATA(MONM),PE(MONM)
      DO 333 I=1,MONM
        IDATA(I)=MBAD
      PE(I)=XBAD
 333  CONTINUE
      RETURN
      END


=========================================================

The analysis of this program will have to wait a fair while as I’m still finishing another step. It looks like it’s a well done library of utilities so I’ll likely leave it to the end.

Advertisements

About E.M.Smith

A technical managerial sort interested in things from Stonehenge to computer science. My present "hot buttons' are the mythology of Climate Change and ancient metrology; but things change...
This entry was posted in GISStemp Technical and Source Code and tagged , , , , , . Bookmark the permalink.