c c------------------------------------------------------------------ c Begin file /home/sting/foster/empsrc/disptp.f c------------------------------------------------------------------ c SUBROUTINE DISPTP(VNAME,DNAME,IDISP,IUNIT) SAVE C **** C **** WRITE FILE, DNAME, TO MASS STORE VOLUME, C **** /VNAME(1)/VNAME(2)/VNAME(3) C **** IDISP = DISPOSAL FLAG C **** IDISP = 1 FOR DISPOSAL C **** IDISP = 0 FOR NO DISPOSAL (DEBUGGING) C **** INTEGER VNAME(3),DNAME,TNAME CHARACTER FMT*20, CMND*30 DATA INAME/0/ REWIND IUNIT C **** C **** GENERATE TEMPORARY FILE NAME C **** INAME = MOD(INAME,9)+1 ENCODE(7,103,TNAME)INAME 103 FORMAT(*SCRHST*,I1) C **** C **** SET UP COMMAND TO COPY DNAME TO TNAME C **** CALL COUNT(DNAME,IDCH) FMT = ' ' WRITE(FMT,104)IDCH 104 FORMAT('(*cp *,A',I1,',* *,A7)') C WRITE(6,105)FMT C 105 FORMAT(A) CMND = ' ' WRITE(CMND,FMT)DNAME,TNAME C WRITE(6,106)CMND C 106 FORMAT(A) ISTAT = ISHELL(CMND) IF(ISTAT.NE.0)THEN C **** C **** COPY FAILED C **** WRITE(6,107)DNAME,TNAME 107 FORMAT(* DISPTP -- COPY OF *,A8,* TO*,A7,* FAILED*) STOP ENDIF C **** C **** SAVE FILE IN /usr/tmp/TIGCM C **** IDEL = 1-IDISP CALL SAVE(VNAME,TNAME,IDEL) C **** C **** DISPOSE HISTORY FILE TO MS STORE IF IDISP=1 C **** IF(IDISP.EQ.1)CALL DISPOSE(VNAME,TNAME) C **** C **** MESSAGE SHOWING WRITE COMPLETED C **** WRITE(6,101)(VNAME(N),N=1,3) 101 FORMAT(* HISTORY VOLUME, *,3(*/*,A8),* DISPOSED TO MASS STORE*) C ***** C ***** REPOSITION FILE BEFORE EOF C ***** C DO 1 N = 1,500 C BUFFER IN(IUNIT,1)(DUM,DUM) C ERR = UNIT(IUNIT) C IF(ERR.EQ.0.)THEN C WRITE(6,102)N C 102 FORMAT(* DISPTP --- END OF FILE AT RECORD NUMBER,*,I3) C BACKSPACE IUNIT C GO TO 2 C ENDIF C 1 CONTINUE C 2 CONTINUE RETURN END C C SUBROUTINE DISPOSE(VNAME,DNAME) C **** C **** DISPOSE FILE, DNAME, TO MASS STORE AS C **** /VNAME(1)/VNAME(2)/VNAME(3) C **** INTEGER ICH(3),VNAME(3),DNAME CHARACTER FMT*120 CHARACTER CMDLW*120,PATHNM*50,CMND*400,SAVE*150,CMDRM*120 C **** C **** DETERMINE NO OF CHARACTERS IN EACH ELEMENT OF VNAME C **** DO 1 N = 1,3 CALL COUNT(VNAME(N),ICH(N)) 1 CONTINUE CALL COUNT(DNAME,IDCH) C **** C **** ASSEMBLE LWRITE COMMAND C **** C **** CREATE FORMAT STATEMENT C **** FMT = ' ' WRITE(FMT,100)IDCH,(ICH(N),N=1,3) 100 FORMAT('(*lwrite local=*,A',I1, 1 ',* format=tr passwd=,ECRIDLEY retpd=367 remote=/*,A',I1, 2 ',*/*,A',I1,',*/*,A',I1,',* options=retry*)') CMDLW = ' ' WRITE(CMDLW,FMT)DNAME,(VNAME(N),N=1,3) C WRITE(6,101)CMDLW 101 FORMAT(A) C **** C **** SET UP PATHNAM C **** C **** CREATE FORMAT C **** FMT = ' ' WRITE(FMT,106)(ICH(N),N=2,3) 106 FORMAT('(*$HOME/rje/*,A',I1,'*.*,A',I1,')') PATHNM = ' ' WRITE(PATHNM,FMT)(VNAME(N),N=2,3) C **** C **** SET COMMAND TO REMOVE TEMPORARY FILE DNAME C **** C **** FORMAT C **** FMT = ' ' WRITE(FMT,104)IDCH 104 FORMAT('(*rm *,A',I1,')') CMDRM = ' ' WRITE(CMDRM,FMT)DNAME C **** C **** ASSEMBLE COMPLETE BACK GROUND COMMAND C **** CMND = ' ' CMND = CMDLW(1:LSTR(CMDLW)) C CMND = "("//CMDLW(1:LSTR(CMDLW))//";"// C 1 CMDRM(1:LSTR(CMDRM))// C 2 ";dir=`pwd`;cd ..;test `ls $dir|wc -w` -eq 0 && rm -r $dir)"// C 3 " >> "//PATHNM(1:LSTR(PATHNM))//" 2>&1 &" ISTAT =ISHELL(CMND) IF(ISTAT.NE.0)THEN WRITE(6,105)ISTAT 105 FORMAT(* DISPOSE -- UNABLE TO DISPOSE FILE DNAME, ISTAT=*,I5) ENDIF RETURN END C SUBROUTINE COUNT(NAME,ICH) SAVE C **** C **** RETURNS NUMBER OF CHARACTERS IN NAME (.LE.8) C **** DIMENSION MASK(0:8) MASK(0) = 0200401002004010020040B MASK(1) = 1774401002004010020040B MASK(2) = 1777771002004010020040B MASK(3) = 1777777762004010020040B MASK(4) = 1777777777744010020040B MASK(5) = 1777777777777710020040B MASK(6) = 1777777777777777620040B MASK(7) = 1777777777777777777440B MASK(8) = 1777777777777777777777B DO 1 N = 0,8 C WRITE(6,100)NAME,MASK(N) 100 FORMAT(O22) IF(NAME.EQ.AND(NAME,MASK(N)))THEN ICH = N GO TO 2 ENDIF 1 CONTINUE 2 CONTINUE C WRITE(6,101)NAME,ICH 101 FORMAT(A8,I5) RETURN END C INTEGER FUNCTION LSTR (CMD) CHARACTER CMD*(*) DO 10 I=LEN(CMD),1,-1 IF (CMD(I:I).NE. ' ') THEN LSTR=I GO TO 20 ENDIF 10 CONTINUE LSTR=0 20 CONTINUE RETURN END C SUBROUTINE SAVE(VNAME,DNAME,IDEL) SAVE C **** C **** SAVE FILE , DNAME, IN DIRECTORY, TIGCM, UNDER C **** NAME, VNAME(2).VNAME(3) C **** IF IDEL=1, DELETE DNAME. C **** INTEGER ICH(3),VNAME(3),DNAME CHARACTER FMT*120,KEEP*150,CMDRM*120 C **** C **** DETERMINE NO OF CHARACTERS IN EACH ELEMENT OF VNAME C **** AND DNAME C **** DO 1 N = 1,3 CALL COUNT(VNAME(N),ICH(N)) 1 CONTINUE CALL COUNT(DNAME,IDCH) C **** C **** CONSTRUCT KEEP SEQUENCE C **** C **** FORMAT C **** FMT = ' ' WRITE(FMT,102)(ICH(N),N=2,3),(ICH(N),N=2,3),IDCH,(ICH(N),N=2,3) 102 FORMAT('(*test -f /usr/tmp/TIGCM/*,A',I1,',*.*,A',I1, 1 ',* && rm /usr/tmp/TIGCM/*,A',I1,',*.*,A',I1, 2 ',*;ln *,A',I1,',* /usr/tmp/TIGCM/*,A',I1,',*.*,A',I1,')') KEEP = ' ' WRITE(KEEP,FMT)(VNAME(N),N=2,3),(VNAME(N),N=2,3),DNAME, 1 (VNAME(N),N=2,3) ISTAT = ISHELL(KEEP) IF(ISTAT.NE.0)THEN WRITE(6,105)ISTAT 105 FORMAT(* SAVE -- UNABLE TO SAVE FILE DNAME, ISTAT=*,I5) ENDIF C **** C **** IF IDEL=1, DELETE DNAME. C **** C **** FORMAT C **** IF(IDEL.EQ.1)THEN FMT = ' ' WRITE(FMT,104)IDCH 104 FORMAT('(*rm *,A',I1,')') CMDRM = ' ' WRITE(CMDRM,FMT)DNAME ISTAT = ISHELL(CMDRM) IF(ISTAT.NE.0)THEN WRITE(6,106)ISTAT 106 FORMAT(* SAVE -- UNABLE TO DELETE FILE DNAME, ISTAT=*,I5) ENDIF ENDIF RETURN END