w3trnarg.f

Go to the documentation of this file.

C> @file
C> @brief Translates arg line from standard input
C> @author Dennis Keyser @date 2002-02-11
 
C> Reads argument lines from standard input and obtains subdirectory, bufr
C> tankname, characters to append for adding an orbit, and options for limiting
C> the time window.
C>
C> ### Program History Log:
C> Date | Programmer | Comment
C> -----|------------|--------
C> 1996-09-03 | B. KATZ   | Original author
C> 1998-11-27 | B. KATZ   | Changes for y2k and fortran 90 compliance
C> 2002-02-11 | D. KEYSER | If "tlflag" is not specified, it defaults to
C> "notimlim" rather than "timlim" and gross time limits will not be
C> calculated and returned in "iymdhb" and "iymdhe"
C>
C> @param[in] SUBDIR Name of sub-directory including bufr data type where
C> bufr data tank is located.
C> @param[in] LSUBDR Number of characters in 'subdir'.
C> @param[in] TANKID Name of file including bufr data sub-type containing
C> bufr data tank.
C> @param[in] LTNKID Number of characters in 'tankid'.
C> @param[in] APPCHR Characters to be appended to 'tankid' giving a
C> uniquely named file to contain the original tank
C> with one orbit appended to it.
C> @param[in] LAPCHR Number of characters in 'appchr'.
C> @param[in] TLFLAG 8 character flag indicating whether time acceptance
C> checks atre to be performed.
C> = 'timlim  ' : perform time acceptance checks.
C> = 'notimlim' : do not perform time acceptance checks.
C>                jdate and kdate are disregarded.
C> @param[in] IYMDHB Start of time acceptance window, in form yyyymmddhh.
C> @param[in] IYMDHE End of time acceptance window, in form yyyymmddhh.
C> @param IERR
C>
C> Input files :
C> unit 05  - standard input for passing in arguments. arguments
C> (for list-directed i/o) are as follows :
C> record 1 - (1) subdirectory. contains bufr data type
C>            (2) tankfile. contains bufr data sub-type
C>            (3) append characters. appended to tankfile
C>                to give unique output file name.
C>            (4) date in yyyymmddhh format.
C> next three records are optional :
C> record 2 - (1) time limit flag. may be either
C>                'timlim  ' or 'notimlim'.  see
C>                description of 'tlflag' above.
C>                (default is 'notimlim')
C> record 3 - (1) hours before current time.
C> record 4 - (1) hours after current time.
C> if 'timlim  ' is specified in record 2, the
C> quantities in records 3 and 4 are used to
C> compute the limits of the time acceptance window.
C> if records 3 and 4 are omitted, the values
C> default to -48 (48 hours before current time)
C> and +12 (12 hours after current time).
C> if 'notimlim  ' is specified in record 2, then
C> these quantities are not used regardless of whether
C> or not they were specified.
C>
C> @author Dennis Keyser @date 2002-02-11
      SUBROUTINE w3trnarg(SUBDIR,LSUBDR,TANKID,LTNKID,APPCHR,LAPCHR,
     1                    TLFLAG,IYMDHB,IYMDHE,IERR)
      CHARACTER*(*) SUBDIR,TANKID,APPCHR,TLFLAG
      INTEGER IDATIN(8),IDTOUT(8)
      REAL TIMINC(5)
      READ(5,*,END=9999) SUBDIR,TANKID,APPCHR,iymdh
      msubdr = len(subdir)
      DO lsubdr=0,msubdr-1
        IF(subdir(lsubdr+1:lsubdr+1).EQ.' ') GO TO 10
      ENDDO
      lsubdr = msubdr
   10 CONTINUE
      IF(lsubdr.LT.4) THEN
        WRITE(6,'(1X,I2,'' CHARACTERS IN SUBDIRECTORY ARGUMENT'',
     1            '' AT LEAST 4 CHARACTERS ARE REQUIRED'')') lsubdr
        ierr = 2
        RETURN
      ENDIF
      mtnkid = len(tankid)
      DO ltnkid=0,mtnkid-1
        IF(tankid(ltnkid+1:ltnkid+1).EQ.' ') GO TO 20
      ENDDO
      ltnkid = mtnkid
   20 CONTINUE
      IF(ltnkid.LT.4) THEN
        WRITE(6,'(1X,I2,'' CHARACTERS IN TANKFILE ARGUMENT'',
     1            '' AT LEAST 4 CHARACTERS ARE REQUIRED'')') ltnkid
        ierr = 2
        RETURN
      ENDIF
      mapchr = len(appchr)
      DO lapchr=0,mapchr-1
        IF(appchr(lapchr+1:lapchr+1).EQ.' ') GO TO 30
      ENDDO
      lapchr = mapchr
   30 CONTINUE
      tlflag = 'NOTIMLIM'  ! The default is to NOT perform time checks
      READ(5,*,END=40) tlflag
   40 CONTINUE
      IF(tlflag(1:6).NE.'TIMLIM') THEN
        tlflag = 'NOTIMLIM'
        print 123, iymdh,subdir(1:lsubdr),tankid(1:ltnkid)
  123   FORMAT(/'RUN ON ',i10/'WRITE TO ',a,'/',a/'GROSS TIME LIMIT ',
     1   'CHECKS ARE NOT PERFORMED HERE - SUBSEQUENT PROGRAM ',
     1   'BUFR_TRANJB WILL TAKE CARE OF THIS'/)
        iymdhb = 0000000000
        iymdhe = 2100000000
        ierr = 0
        RETURN
      ENDIF
      tlflag(7:8) = '  '
      READ(5,*,END=60) ihrbef
      GO TO 70
   60 CONTINUE
      ihrbef = -48
      ihraft = 12
      GO TO 100
   70 CONTINUE
      READ(5,*,END=80) ihraft
      GO TO 90
   80 CONTINUE
      ihraft = 12
      GO TO 100
   90 CONTINUE
      IF(ihrbef.GT.0 .AND. ihraft.LT.0) THEN
        itemp = ihrbef
        ihrbef = ihraft
        ihraft = itemp
      ELSE IF(ihrbef.GT.0) THEN
        ihrbef = -1 * ihrbef
      ENDIF
  100 CONTINUE
      idatin(1) = iymdh / 1000000
      idatin(2) = mod(iymdh,1000000) / 10000
      idatin(3) = mod(iymdh,10000) / 100
      idatin(4) = 0
      idatin(5) = mod(iymdh,100)
      idatin(6:8) = 0
      timinc(1) = 0.0
      timinc(2) = float(ihrbef)
      timinc(3:5) = 0.0
      CALL w3movdat(timinc,idatin,idtout)
      iymdhb = ((idtout(1) * 100 + idtout(2)) * 100 + idtout(3)) *
     1           100 + idtout(5)
      timinc(2) = float(ihraft)
      CALL w3movdat(timinc,idatin,idtout)
      iymdhe = ((idtout(1) * 100 + idtout(2)) * 100 + idtout(3)) *
     1           100 + idtout(5)
      print 124, iymdh,subdir(1:lsubdr),tankid(1:ltnkid),iymdhb,iymdhe
  124 FORMAT(/'RUN ON ',i10/'WRITE TO ',a,'/',a/'ACCEPT BETWEEN ',i10,
     1 ' AND ',i10/)
      ierr = 0
      RETURN
 9999 CONTINUE
      WRITE(6,'('' INSUFFICIENT NO. OF ARGUMENTS TO BUFR '',
     1          ''TRANSLATION PROCEDURE - AT LEAST 4 ARE NEEDED'')')
      ierr = 1
      RETURN
      END