C C LISTING FIXSVH.FOR C C SETUP SAVE AREA ZERO FOR HEART SMOOTH AND CHANGE TITLE IN ZERO C C C C PC AND PCB EQUIVALENCED IN MAIN C ADMN AND ADMNB EQUIVALENCE IN MAIN !! C SUBROUTINE FIXSVH(ICH1,ICH2,FILE,TITLE,PC 1,ADMN,ADMNB,IBUFSZ) INTEGER*2 FILE(4),PC(4096),ADMN(256) LOGICAL*1 ADMNB(512),TITLE(12) ITP = 0 CALL READW(256,ADMN,ITP,ICH1) N1=ADMN(75) SUM=0.0 MAX=0 MIN=32000 MM = 1 CALL READW(IBUFSZ,PC,N1,ICH2) CALL WRITW(IBUFSZ,PC,MM,ICH1) DO 1 I = 1,IBUFSZ IF(PC(I).GT.MAX) MAX=PC(I) IF(PC(I).LT.MIN) MIN=PC(I) A=PC(I) 1 SUM=SUM+A C C INSERT CORRECT TITLE (12 CHARATERS) C ICT = 0 DO 2 I = 17,100 IF (ADMNB(I).EQ.','.AND.ADMNB(I+1).EQ.' ') ICT = ICT + 1 IF (ICT.EQ.2) GOTO 3 2 CONTINUE 3 IC = 1 DO 4 II = I+2,I+13 ADMNB(II) = TITLE(IC) 4 IC = IC + 1 ADMN(1)=FILE(1) ADMN(2)=FILE(2) ADMN(3)=FILE(3) ADMN(4)=FILE(4) ADMN(84) = IBUFSZ ADMN(87)=MAX ADMN(88)=MIN ADMN(91)=SUM/4096.0 ADMN(120) = IBUFSZ ITP = 0 C C SVAR00 ADRESSES STUDY CONTAINED IF FILE C CALL WRITW(256,ADMN,ITP,ICH1) RETURN END