subroutine CVAI (INSTR, NUM, LENFLD, ERRTN) c c Converts an ASCII string into an integer. c Input is the string INSTR, output is NUM, number of c characters to be converted is LENFLD, and optional c error return is ERRTN. c Specify starting position in the string in the calling routine c (i.e., call CVAI (STRING(3), NUM, ...) ). c If the string has trailing blanks, the number gets properly c right-justified. c If ERRTN is 0, printed error messages will be issued; if it is c non-zero, ERRRTN will be changed to a negative value dependent c on the error detected and the routine in which it occurs. c In both cases the routine returns. c c Converted to Fortran-77, 2-Mar-84. c New fix on right justification, 16-Oct-85. c Set ASCII characters > 9 to binary 0. c Allow minus signs on ASCII strings to produce negative number. c Fix for long strings where the number is <32767. c Added optional error return when it is inappropriate to c give a written error message. Changed error messages from c Fortran I/O to MSGPRT routine. Further cleanup. 9-Jan-87. c Added CVFA and CVAF. 14-Jan-87. c c Written by: c R. W. Barnard c BIO/COMP Applications c P. O. Box 5342 c Albuquerque, NM 87185 c Version 3.1, 13-Jan-87. c parameter (MC=10) !Maximum size of string. c real*4 RNUM, MAXNUM real*4 RN(MC), TEN integer*2 NUM, LENFLD, ERRTN integer*2 SIGN, RTNID byte INSTR(1), STRING(MC) c parameter (MAXNUM=32768., TEN=10.) parameter (RTNID= -10) !ID for CVAI. c if (LENFLD.le.0) then !No number of digits specified. if (ERRTN.eq.0) then call SAVCUR call MSGPRT (1, 'CVAI-E-Bad Specification of Digits$', 1 0, 0, 0, 1, '0 ', 1) call RESCUR else ERRTN= RTNID- 1 endif c else if (LENFLD.gt.MC) then !Too many digits specified. if (ERRTN.eq.0) then call SAVCUR call MSGPRT (1, 'CVAI-E-Too Many Digits: $', 1 0, LENFLD, 2, 1, '0 ', 1) call RESCUR else ERRTN= RTNID- 2 endif return !Get outta here. endif c RNUM= 0. !Intermediate answer. do 10 K= 1, LENFLD !Sanitize the output STRING(K)= ' ' !string. 10 continue c L= LENFLD do 20 K= LENFLD, 1, -1 !Right-justify the string. if (INSTR(K).ne.' ') then !Shift the non-blank characters STRING(L)= INSTR(K) !to the output string. L= L- 1 endif 20 continue c do 30 K= 1, LENFLD !See if we have a - sign. if (STRING(K).ne.' ') then !Find the first nonblank if (STRING(K).eq.'-') then !and check for "-". SIGN= -1 else SIGN= 1 endif go to 40 !Then move on. endif 30 continue c 40 continue do 50 K= 1, LENFLD RN(K)= STRING(K)- '0' !Convert ASCII to number. if (RN(K).lt.0. .or. RN(K).gt.9.) RN(K)= 0. !Make non-numbers L= LENFLD- K !Power of 10. RNUM= RNUM+ RN(K)* TEN**L !Build a number. 50 continue !zero. c if (ABS (RNUM).ge.MAXNUM) then !Make sure the number can if (ERRTN.eq.0) then !be an integer. call SAVCUR call MSGPRT (1, 'CVAI-E-Integer Overflow: $', 1 0, 0, 0, 0, '0 ', 0) call MSGPRT (0, INSTR, LENFLD, 0, 0, 1, '0 ', 1) call RESCUR else ERRTN= RTNID- 3 endif return endif c NUM= RNUM* SIGN !The final value. return c end subroutine CVIA (INUM, STRING, NDIGIT, ERRTN) c c This routine converts an integer into an ASCII string c (left-justified). c The number can be up to 32767 (10). c The position in the string where the digits are placed is c controlled by the call, (e.g., STRING(3)). c The number of digits in the string converted is returned in NDIGIT. c If the routine is entered with NDIGIT=0, leading zeros are not copied. c If NDIGIT >0, NDIGIT digits (including possibly leading zeros) are c copied over. If the number is bigger than the NDIGIT digits specified c in the subroutine call, all the digits in the number will be converted c (make sure your string is big enough)! c Allow negative numbers. Note - if you specify more digits to be c converted than the number has, you will get the following effect: c "-00xxx". This may or may not be aesthetically pleasing. c If ERRTN is 0, printed error messages will be issued; if it is c non-zero, ERRRTN will be changed to a negative value dependent c on the error detected. In both cases the routine returns. c parameter (NPWR=5) !Max number of digits. c integer*2 INUM, NUM, TEN integer*2 N(NPWR), SIGN, OFFSET, NSTART, ERRTN, RTNID byte STRING(1) c parameter (TEN= 10) parameter (RTNID= -20) !For CVIA. c NUM= ABS (INUM) !Save the original number. N1= 0 !Initialize. c do 10 K= 1, NPWR L= NPWR- K !Power of 10. N(K)= NUM/10**L !Split up the digits. c Find the number of digits after the leading zeros. if (N(K).ne.0 .and. N1.eq.0) N1= L+ 1 NUM= NUM- N(K)*10**L !Subtract off digit found. 10 continue c if (INUM.lt.0) then !See if we are dealing with a -ve #. STRING(1)= '-' !Take care of negative numbers. SIGN= 1 else SIGN= 0 endif c c Now figure out how many digits to copy, and where to place c them in the output string. (This depends on the number requested, c and whether there is a minus sign). if (NDIGIT.eq.0) then !Copy all the significant digits. NSTART= 1 OFFSET= SIGN NDIGIT= N1+ SIGN else if (NDIGIT.ge.N1+SIGN) then !We have less digits than NSTART= 1+ SIGN !were specified (including any sign). OFFSET= 0 !Don't take more digits than the N1= NDIGIT !program expects. else !Too many digits (including sign). if (ERRTN.eq.0) then call SAVCUR call MSGPRT (1, 'CVIA-E-String Overflow: $', 1 0, N1+SIGN, 2, 0, '0 ', 0) call MSGPRT (0, ' digits in a$', 0, NDIGIT, 2, 1 0, '0 ', 0) call MSGPRT (0, '-char string$', 0, 0, 0, 1, '0 ', 1) call RESCUR else ERRTN= RTNID- 1 endif do 20 K= 1, NDIGIT !Just set the number of digits STRING(K)= '0' !originally in the string to 0. 20 continue return endif c do 30 K= NSTART, N1 !Now copy over the digits. L= NPWR- N1+ K !Start at non-zero values in N(K) STRING(OFFSET+K)= N(L)+ '0' !Make ASCII 30 continue return c end subroutine CVAJ (INSTR, NUM, LENFLD, ERRTN) c c Converts an ASCII string into a double-precision integer. c (See the description of CVAI for details of the variables). c parameter (MC=16) !Maximum size of string. c real*8 RNUM, MAXNUM real*4 RN(MC), TEN integer*4 NUM integer*2 LENFLD, ERRTN integer*2 SIGN, RTNID byte INSTR(1), STRING(MC) c parameter (MAXNUM=2147385345., TEN=10.) parameter (RTNID= -30) !ID for CVAJ. c if (LENFLD.le.0) then !No number of digits specified. if (ERRTN.eq.0) then call SAVCUR call MSGPRT (1, 'CVAJ-E-Bad Specification of Digits$', 1 0, 0, 0, 1, '0 ', 1) call RESCUR else ERRTN= RTNID- 1 endif c else if (LENFLD.gt.MC) then !Too many digits specified. if (ERRTN.eq.0) then call SAVCUR call MSGPRT (1, 'CVAJ-E-Too Many Digits: $', 1 0, LENFLD, 2, 1, '0 ', 1) call RESCUR else ERRTN= RTNID- 2 endif return !Get outta here. endif c RNUM= 0. !Intermediate answer. do 10 K= 1, LENFLD !Sanitize the output STRING(K)= ' ' !string. 10 continue c L= LENFLD do 20 K= LENFLD, 1, -1 !Right-justify the string. if (INSTR(K).ne.' ') then !Shift the non-blank characters STRING(L)= INSTR(K) !to the output string. L= L- 1 endif 20 continue c do 30 K= 1, LENFLD !See if we have a - sign. if (STRING(K).ne.' ') then !Find the first nonblank if (STRING(K).eq.'-') then !and check for "-". SIGN= -1 else SIGN= 1 endif go to 40 !Then move on. endif 30 continue c 40 continue do 50 K= 1, LENFLD RN(K)= STRING(K)- '0' !Convert ASCII to number. if (RN(K).lt.0. .or. RN(K).gt.9.) RN(K)= 0. !Make non-numbers L= LENFLD- K !Power of 10. RNUM= RNUM+ RN(K)* TEN**L !Build a number. 50 continue !zero. c if (ABS (RNUM).ge.MAXNUM) then !Make sure the number can if (ERRTN.eq.0) then !be an integer. call SAVCUR call MSGPRT (1, 'CVAJ-E-Integer Overflow: $', 1 0, 0, 0, 0, '0 ', 0) call MSGPRT (0, INSTR, LENFLD, 0, 0, 1, '0 ', 1) call RESCUR else ERRTN= RTNID- 3 endif return endif c NUM= RNUM* SIGN !The final value. return c end subroutine CVJA (INUM, STRING, NDIGIT, ERRTN) c c This routine converts a double-precision integer into an c ASCII string (left-justified). c (See the description in CVIA for details). c parameter (NPWR= 10) !Max number of digits. c integer*4 INUM, NUM, TEN integer*2 N(NPWR), SIGN, OFFSET, NSTART, ERRTN, RTNID byte STRING(1) c parameter (TEN= 10) parameter (RTNID= -40) !For CVJA. c NUM= ABS (INUM) !Save the original number N1= 0 !Initialize c do 10 K= 1, NPWR L= NPWR- K !Power of 10 N(K)= NUM/TEN**L !Split up the digits c Find the number of digits after the leading zeros. if (N(K).ne.0 .and. N1.eq.0) N1= L+ 1 NUM= NUM- N(K)*TEN**L !Subtract off digit found 10 continue c if (INUM.lt.0) then STRING(1)= '-' !Take care of negative numbers. SIGN= 1 else SIGN= 0 endif c if (NDIGIT.eq.0) then !Copy all the significant digits. NSTART= 1 OFFSET= SIGN NDIGIT= N1+ SIGN else if (NDIGIT.ge.N1+SIGN) then !We have less digits than NSTART= 1+ SIGN !were specified (including any sign). OFFSET= 0 !Don't take more digits than the N1= NDIGIT !program expects. else !Too many digits (including sign). if (ERRTN.eq.0) then call SAVCUR call MSGPRT (1, 'CVJA-E-String Overflow: $', 1 0, N1+SIGN, 2, 0, '0 ', 0) call MSGPRT (0, ' digits in a$', 0, NDIGIT, 2, 1 0, '0 ', 0) call MSGPRT (0, '-char string$', 0, 0, 0, 1, '0 ', 1) call RESCUR else ERRTN= RTNID- 1 endif do 20 K= 1, NDIGIT !Just set the number of digits STRING(K)= '0' !originally in the string to 0. 20 continue return endif c do 30 K= NSTART, N1 !Now copy over the digits. L= NPWR- N1+ K !Start at non-zero values in N(K) STRING(OFFSET+K)= N(L)+ '0' !Make ASCII 30 continue return c end subroutine CVFA (INUM, CHRSTR, LENFLD, LENFRC, FIELD, ERRTN) c c This routine converts a single-precision floating point number c into an ASCII string (left-justified). The string in this routine c is a character variable, but it may be a byte string in the c calling routine. c The overall length of the string receiving the number is c LENFLD, with the fractional part being LENFRC. Field formats c of F (default), E or G can be specified by FIELD. c E-format numbers are always displayed with a 1P factor. c The number of digits in the string converted is returned in LENFLD. c If the routine is entered with LENFLD=0, the string will be the c same length as the number would be if displayed by Fortran. c Otherwise, LENFLD spaces will be used for CHRSTR. There c is no default for LENFRC. c The format used to convert the number is: c (P., X) c If ERRTN is 0, printed error messages will be issued; if it is c non-zero, ERRRTN will be changed to a negative value dependent c on the error detected and the routine in which it occurs. c In both cases the routine returns. c real*4 INUM integer*2 LENFLD, LENFRC, ERRTN integer*2 SIGN, FMTFAC, PFAC, SPACE, RTNID character*80 CHRSTR character*15 FMT character*5 EX byte FIELD c parameter (RTNID= -50) c if (INUM.lt.0.) then !Need to account for the sign. SIGN= 1 else if (INUM.eq.0.) then !If the number is 0, CHRSTR= '0.' !just load in an ASCII 0 and quit. if (LENFLD.eq.0) LENFLD= 2 return else SIGN= 0 endif c if (FIELD.eq.'E' .or. FIELD.eq.'G') then FMTFAC= 6 !Space for 1 digit, E+XX, and ".". SPACE= 0 !Only 1 digit to left of ".". PFAC= 1 !Always use 1PExx.x. else FIELD= 'F' !Default is floating. FMTFAC= 2 !Space for 1 digit and ".". SPACE= MAX1 (LOG10 (ABS (INUM)), 0.) !How much to add for > 1. PFAC= 0 !P-factor. endif c if (LENFLD.eq.0) then !Make the field just long enough. LENFLD= LENFRC+ SIGN+ FMTFAC+ SPACE NSPACE= 0 else !Use then actual length of number. NSPACE= LENFLD- (LENFRC+ SIGN+ FMTFAC+ SPACE) endif c if (NSPACE.gt.0) then !If filler is needed, build write (EX, 90) NSPACE !the format element. else EX= ' ' !Just use blanks. endif c write (FMT, 100) PFAC, FIELD, LENFLD-NSPACE, LENFRC, EX c if (NSPACE.lt.0) then !Bad selection of lengths. if (ERRTN.eq.0) then call SAVCUR call MSGPRT (1, 'CVFA-E-Format Error - Field length ($', 0, 1 LENFLD, 2, 0, '0 ', 0) call MSGPRT (0, ') incompatible with fraction length ($', 0, 1 LENFRC, 2, 0, '0 ', 0) call MSGPRT (0, ')$', 0, 0, 0, 0, '0 ', 1) call MSGPRT (1, 'Format is $', 0, 0, 0, 0, '0 ', 0) call MSGPRT (0, FMT, 15, 0, 0, 1, '0 ', 0) call RESCUR else ERRTN= RTNID- 1 !Just load in an ASCII 0 CHRSTR= '0.' !and quit. if (LENFLD.eq.0) LENFLD= 2 endif else !Write the number as a string write (CHRSTR, FMT) INUM !using the format just created. endif return c 90 format (', ' I2, 'X') 100 format ('(' I1, 'P' A1, I2.2, '.' I2.2, A ')') end subroutine CVAF (INSTR, NUM, LENFLD, ERRTN) c c Converts an ASCII string into an single-precision c floating point number. c Input is the string INSTR, output is NUM, number of c characters to be converted is LENFLD, and optional c error return is ERRTN. c If ERRTN is 0, printed error messages will be issued; if it is c non-zero, ERRRTN will be changed to a negative value dependent c on the error detected and the routine in which it occurs. c In both cases the routine returns. c parameter (MC= 20) c real*4 NUM character*20 CLOCAL character*7 FMT integer*2 LENFLD, ERRTN integer*2 RTNID byte INSTR(1) byte LOCAL(MC) c equivalence (LOCAL(1), CLOCAL) c external LEN c parameter (RTNID= -60) c do 10 K= 1, MC !Start fresh. LOCAL(K)= 0 10 continue c if (LENFLD.le.0) then !Check on parameters. if (ERRTN.eq.0) then call SAVCUR call MSGPRT (1, 'CVAF-E-Bad Specification of Digits$', 1 0, 0, 0, 1, '0 ', 1) call RESCUR else ERRTN= RTNID- 1 endif return endif if (LENFLD.gt.MC) then if (ERRTN.eq.0) then call SAVCUR call MSGPRT (1, 'CVAF-E-Too Many Digits: $', 1 0, LENFLD, 2, 1, '0 ', 1) call RESCUR else ERRTN= RTNID- 2 endif return !Get outta here. endif c call SCOPY (INSTR, LOCAL, LENFLD) !Move to local array call TRIM (LOCAL) !for further processing. IL= LEN (LOCAL) !Don't use any more if (IL.gt.0) then write (FMT, 100) IL !characters than necessary. read (CLOCAL, FMT) NUM !Convert the string. else NUM= 0. endif return c 100 format ('(E' I2.2, '.' '0)') end byte function UPCASE (CHAR) c c Converts a single character to upper case, if necessary. c It works on both BYTE and CHARACTER variables because the c character is passed as an argument to UPCASE. c Version 1.0, 14-Oct-85. c byte CHAR c if (CHAR.ge.'a' .and. CHAR.le.'z') then UPCASE= CHAR- 32 !Subtract a " " to make UC. else UPCASE= CHAR endif return c end