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