w3trnarg.f

Go to the documentation of this file.

C> @file
C                .      .    .                                       .  
C> SUBPROGRAM:    W3TRNARG    TRANSLATES ARG LINE FROM STANDARD INPUT 
C>   PRGMMR: KEYSER           ORG: NP22       DATE: 2002-02-11           
C>                                                                       
C> ABSTRACT: READS ARGUMENT LINES FROM STANDARD INPUT AND OBTAINS      ,
C>   SUBDIRECTORY, BUFR TANKNAME, CHARACTERS TO APPEND FOR ADDING
C>   AN ORBIT, AND OPTIONS FOR LIMITING THE TIME WINDOW.
C>                                                                       
C> PROGRAM HISTORY LOG:                                                  
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
C>                          TO "NOTIMLIM" RATHER THAN "TIMLIM" AND
C>                          GROSS TIME LIMITS WILL NOT BE CALCULATED
C>                          AND RETURNED IN "IYMDHB" AND "IYMDHE"
C>                                                                       
C> USAGE:    CALL W3TRNARG(SUBDIR,LSUBDR,TANKID,LTNKID,APPCHR,LAPCHR,
C>                         TLFLAG,IYMDHB,IYMDHE,IERR)
C>   OUTPUT ARGUMENT LIST:                                               
C>     SUBDIR   - NAME OF SUB-DIRECTORY INCLUDING BUFR DATA TYPE WHERE
C>                BUFR DATA TANK IS LOCATED.
C>     LSUBDR   - NUMBER OF CHARACTERS IN 'SUBDIR'.
C>     TANKID   - NAME OF FILE INCLUDING BUFR DATA SUB-TYPE CONTAINING
C>                BUFR DATA TANK.
C>     LTNKID   - NUMBER OF CHARACTERS IN 'TANKID'.
C>     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>     LAPCHR   - NUMBER OF CHARACTERS IN 'APPCHR'.
C>     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>     IYMDHB   - START OF TIME ACCEPTANCE WINDOW, IN FORM YYYYMMDDHH.
C>     IYMDHE   - END OF TIME ACCEPTANCE WINDOW, IN FORM YYYYMMDDHH.
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>   SUBPROGRAMS CALLED :
C>       W3LIB  - W3MOVDAT
C>
C> REMARKS:                                                              
C>                                                                       
C> ATTRIBUTES:                                                           
C>   LANGUAGE: FORTRAN 90                                                
C>   MACHINE:  IBM-SP
C>
      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