C++********************************************************************* C C GETLBNO.F C 3 DIGITS OK DEC 2005 ArDean Leith C C ********************************************************************** C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM. AUTHOR: J.FRANK * C=* Copyright (C) 1985-2005 Health Research Inc. * C=* * C=* HEALTH RESEARCH INCORPORATED (HRI), * C=* ONE UNIVERSITY PLACE, RENSSELAER, NY 12144-3455. * C=* * C=* Email: spider@wadsworth.org * C=* * C=* This program is free software; you can redistribute it and/or * C=* modify it under the terms of the GNU General Public License as * C=* published by the Free Software Foundation; either version 2 of the * C=* License, or (at your option) any later version. * C=* * C=* This program is distributed in the hope that it will be useful, * C=* but WITHOUT ANY WARRANTY; without even the implied warranty of * C=* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * C=* General Public License for more details. * C=* * C=* You should have received a copy of the GNU General Public License * C=* along with this program; if not, write to the * C=* Free Software Foundation, Inc., * C=* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * C=* * C ********************************************************************** C C GETLBNO(STRING,LBNO,IRTFLG) C C PURPOSE: GET LABEL NUMBER FROM STING C c PARAMETERS: STRING STRING CONTAINING LB NUMBER (ONLY) (SENT) C LBNO LABEL NUMBER (RETURNED) C C--******************************************************************* SUBROUTINE GETLBNO(STRING,LBNO,IRTFLG) CHARACTER(LEN=*) :: STRING CHARACTER(LEN=80) :: TEMP1 LOGICAL :: ISDIGI LBNO = -1 IRTFLG = 0 C FIND LAST NON-BLANK NCHAR1 = lnblnk(STRING) TEMP1 = STRING(1:NCHAR1) CALL SSUPCAS(TEMP1) IGO = INDEX(TEMP1,'LB') IF (IGO .LE. 0) RETURN NCHAR = 1 IF (ISDIGI(TEMP1(IGO+3:IGO+3))) NCHAR = 2 IF ((IGO+4) .LT. NCHAR1 .AND. ISDIGI(TEMP1(IGO+4:IGO+4))) THEN NCHAR = 3 ENDIF READ(TEMP1(IGO+2:IGO+2+NCHAR-1),8000) LBNO 8000 FORMAT(I6) RETURN END