00001 00002 c 00003 c Copyright (c) 1986,1987,1988,1989,1990,1991,1992,1993, 00004 c by Steve McMillan, Drexel University, Philadelphia, PA. 00005 c 00006 c All rights reserved. 00007 c 00008 c Redistribution and use in source and binary forms are permitted 00009 c provided that the above copyright notice and this paragraph are 00010 c duplicated in all such forms and that any documentation, 00011 c advertising materials, and other materials related to such 00012 c distribution and use acknowledge that the software was developed 00013 c by the author named above. 00014 c 00015 c THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR 00016 c IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED 00017 c WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. 00018 c 00019 00020 subroutine lscale(string,length,factor,ifirst) 00021 save 00022 c 00023 character*(*) string 00024 c 00025 i1 = 0 00026 i2 = 0 00027 do 100 i=1,length 00028 if (string(i:i).eq.'!') then 00029 if (i1.eq.0) then 00030 i1 = i 00031 else 00032 if (i.gt.i1+1) then 00033 i2 = i 00034 go to 200 00035 end if 00036 end if 00037 end if 00038 100 continue 00039 c 00040 200 factor = 1. 00041 ifirst = 1 00042 if (i1.eq.0.or.i2.eq.0.or.i2.le.i1+1) return 00043 c 00044 read(string(i1+1:i2-1),'(f6.3)',err=500,end=500)factor 00045 ifirst = i2 + 1 00046 c 00047 500 return 00048 end