FTN4 SUBROUTINE SQUSH(BUFR,LENGTH) +,92069-16180 REV.2013 790316 C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED. C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18180 C RELOC: 92069-16180 C C C****************************************************************: C C C******************************************************************* C SQUSH DELETES ALL THE BLANKS FROM THE BUFR PASSED IN TO IT, C THEN PADS BUFR WITH BLANKS AT THE END. C RETURNS THE ANSWER IN BUFR. C C BUFGET = NEXT POSITION TO GET NEXT CHAR FROM. C BUFPUT = NEXT OPEN POSITION TO PUT THE NEXT CHAR IN. C C******************************************************************* INTEGER BUFR(1),LENGTH INTEGER BUFGET INTEGER BUFPUT INTEGER CHARS INTEGER TEMP C************************************************************* C INIT VARIABLES. C CHARS=2*LENGTH BUFPUT=1 C************************************************************* C GET RID OF ALL THE BLANKS C DO 15 BUFGET=1,CHARS CALL SGET(BUFR,BUFGET,TEMP) IF (TEMP .EQ. 40B) GO TO 15 CALL SPUT(BUFR,BUFPUT,TEMP) BUFPUT=BUFPUT+1 15 CONTINUE C************************************************************** C PAD BUFR AT END WITH BLANKS. C DO 25 J=BUFPUT,CHARS CALL SPUT(BUFR,J,40B) 25 CONTINUE RETURN END