SUBROUTINE W3TRNARG(SUBDIR,LSUBDR,TANKID,LTNKID,APPCHR,LAPCHR,
1 TLFLAG,IYMDHB,IYMDHE,IERR)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
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
C$$$
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