*-- Author : S.Burke / J.V. Morris SUBROUTINE FKSAVE(IFLAG,JFIRST,JLAST) ********************************************************************** * * * Save/restore smoothed vector (+ residuals) from JFIRST to * * JLAST (inclusive) * * * * Save if IFLAG is >= 0; restore otherwise * * * * Note that there is NO error checking. * * * * Also note that this does not save the entire status (i.e. * * projected and filtered vectors). * * * ********************************************************************** IMPLICIT DOUBLE PRECISION (A-H,O-Z) *KEEP,FKNPL. CHARACTER*5 CKDBG PARAMETER (CKDBG='FKDBG') PARAMETER (NPL=72) LOGICAL LTRUE,LFIRST,LTRPL,LTRPLD DOUBLE PRECISION TRUE,RTRUE,CHITRU,SPRO,CPRO,SFIL,CFIL &, SSMT,CSMT,SSMTR,CSMTR,DPRO,CBPRO,QPRO,QGAIN &, RPRO,CRPRO,RFIL,CRFIL,RSMT,CRSMT,CHIFIL,CHISMT * * Per-track values can go in H1WORK; note that LTRUE and LFIRST must * be set at least per event. * * This is about 36k words long; the remaining common blocks are * about 3.6k in total. Some of this could be in /H1WORK/, but the * blocks would have to be reorganised. * COMMON /H1WORK/ * /FKPROJ/ & SPRO(5,NPL),CPRO(5,5,NPL) * /FKFILT/ &, SFIL(5,NPL),CFIL(5,5,NPL) * /FKSMTH/ &, SSMT(5,NPL),CSMT(5,5,NPL) &, SSMTR(5,NPL),CSMTR(5,5,NPL) * /FKINT/ &, DPRO(5,5,NPL),CBPRO(5,5,NPL),QPRO(5,5,NPL) &, QGAIN(5,5,NPL),IAPROX,LFIRST * /FKRSID/ &, RPRO(2,NPL),CRPRO(2,2,NPL),RFIL(2,NPL) &, CRFIL(2,2,NPL),RSMT(2,NPL),CRSMT(2,2,NPL) &, CHIFIL(NPL),CHISMT(NPL) * /FKTRUE/ &, TRUE(5,NPL),RTRUE(5,NPL),CHITRU(NPL),LTRUE * /FKDBG/ &, LTRPL(NPL),LTRPLD(NPL) *KEEP,FKFLAG. LOGICAL LPRO,LFIL,LSMT,LMES,LRAD,LRPRO,LRFIL,LRSMT,LPOINT,LBLOCK COMMON /FKFLAG/ LPRO(NPL),LFIL(NPL),LSMT(NPL),LMES(NPL) &, LRAD(NPL),LRPRO,LRFIL,LRSMT,LPOINT,LBLOCK *KEEP,FKSMTH. *KEEP,FKRSID. *KEEP,FKTRUE. *KEND. ********************************************************************** DIMENSION SSAVE(5,NPL),CSAVE(5,5,NPL) &, SRSAVE(2,NPL),CRSAVE(2,2,NPL),CHSAVE(NPL) &, RTSAVE(5,NPL),CTSAVE(NPL) SAVE SSAVE,CSAVE,SRSAVE,CRSAVE,CHSAVE,RTSAVE,CTSAVE ********************************************************************** JMIN = MIN(JFIRST,JLAST) JDIFF = ABS(JLAST-JFIRST) + 1 IF (IFLAG.GE.0) THEN CALL UCOPY(SSMT(1,JMIN),SSAVE,10*JDIFF) CALL UCOPY(CSMT(1,1,JMIN),CSAVE,50*JDIFF) IF (LRSMT) THEN CALL UCOPY(RSMT(1,JMIN),SRSAVE,4*JDIFF) CALL UCOPY(CRSMT(1,1,JMIN),CRSAVE,8*JDIFF) CALL UCOPY(CHISMT(JMIN),CHSAVE,2*JDIFF) ENDIF IF (LTRUE) THEN CALL UCOPY(RTRUE(1,JMIN),RTSAVE,10*JDIFF) CALL UCOPY(CHITRU(JMIN),CTSAVE,2*JDIFF) ENDIF RETURN ENDIF CALL UCOPY(SSAVE,SSMT(1,JMIN),10*JDIFF) CALL UCOPY(CSAVE,CSMT(1,1,JMIN),50*JDIFF) IF (LRSMT) THEN CALL UCOPY(SRSAVE,RSMT(1,JMIN),4*JDIFF) CALL UCOPY(CRSAVE,CRSMT(1,1,JMIN),8*JDIFF) CALL UCOPY(CHSAVE,CHISMT(JMIN),2*JDIFF) ENDIF IF (LTRUE) THEN CALL UCOPY(RTSAVE,RTRUE(1,JMIN),10*JDIFF) CALL UCOPY(CTSAVE,CHITRU(JMIN),2*JDIFF) ENDIF RETURN END *