subroutine xerrwx (msg, nmes, nerr, iert, ni, i1, i2, nr, r1, r2) integer msg, nmes, nerr, iert, ni, i1, i2, nr, 1 i, lun, lunit, mesflg, ncpw, nch, nwds double precision r1, r2 dimension msg(nmes) c----------------------------------------------------------------------- c subroutines xerrwx, xsetf, and xsetun, as given here, constitute c a simplified version of the slatec error handling package. c written by a. c. hindmarsh at llnl. version of august 13, 1981. c this version is in double precision. c c all arguments are input arguments. c c msg = the message (hollerith litteral or integer array). c nmes = the length of msg (number of characters). c nerr = the error number (not used). c iert = the error type.. c 1 means recoverable (control returns to caller). c 2 means fatal (run is aborted--see note below). c ni = number of integers (0, 1, or 2) to be printed with message. c i1,i2 = integers to be printed, depending on ni. c nr = number of reals (0, 1, or 2) to be printed with message. c r1,r2 = reals to be printed, depending on nr. c c note.. this routine is machine-dependent and specialized for use c in limited context, in the following ways.. c 1. the number of hollerith characters stored per word, denoted c by ncpw below, is a data-loaded constant. c 2. the value of nmes is assumed to be at most 60. c (multi-line messages are generated by repeated calls.) c 3. if iert = 2, control passes to the statement stop c to abort the run. this statement may be machine-dependent. c 4. r1 and r2 are assumed to be in double precision and are printed c in d21.13 format. c 5. the common block /eh0001/ below is data-loaded (a machine- c dependent feature) with default values. c this block is needed for proper retention of parameters used by c this routine which the user can reset by calling xsetf or xsetun. c the variables in this block are as follows.. c mesflg = print control flag.. c 1 means print all messages (the default). c 0 means no printing. c lunit = logical unit number for messages. c the default is 6 (machine-dependent). c----------------------------------------------------------------------- c the following are instructions for installing this routine c in different machine environments. c c to change the default output unit, change the data statement c in the block data subprogram below. c c for a different number of characters per word, change the c data statement setting ncpw below, and format 10. alternatives for c various computers are shown in comment cards. c c for a different run-abort command, change the statement following c statement 100 at the end. c----------------------------------------------------------------------- common /eh0001/ mesflg, lunit c----------------------------------------------------------------------- c the following data-loaded value of ncpw is valid for the cdc-6600 c and cdc-7600 computers. c data ncpw/10/ c the following is valid for the cray-1 computer. c data ncpw/8/ c the following is valid for the burroughs 6700 and 7800 computers. c data ncpw/6/ c the following is valid for the pdp-10 computer. c data ncpw/5/ c the following is valid for the vax computer with 4 bytes per integer, c and for the ibm-360, ibm-370, ibm-303x, and ibm-43xx computers. data ncpw/4/ c the following is valid for the pdp-11, or vax with 2-byte integers. c data ncpw/2/ c----------------------------------------------------------------------- if (mesflg .eq. 0) go to 100 c get logical unit number. --------------------------------------------- lun = lunit c get number of words in message. -------------------------------------- nch = min0(nmes,60) nwds = nch/ncpw if (nch .ne. nwds*ncpw) nwds = nwds + 1 c write the message. --------------------------------------------------- write (lun, 10) (msg(i),i=1,nwds) c----------------------------------------------------------------------- c the following format statement is to have the form c 10 format(1x,mmann) c where nn = ncpw and mm is the smallest integer .ge. 60/ncpw. c the following is valid for ncpw = 10. c 10 format(1x,6a10) c the following is valid for ncpw = 8. c 10 format(1x,8a8) c the following is valid for ncpw = 6. c 10 format(1x,10a6) c the following is valid for ncpw = 5. c 10 format(1x,12a5) c the following is valid for ncpw = 4. 10 format(1x,15a4) c the following is valid for ncpw = 2. c 10 format(1x,30a2) c----------------------------------------------------------------------- if (ni .eq. 1) write (lun, 20) i1 20 format(6x,23hin above message, i1 =,i10) if (ni .eq. 2) write (lun, 30) i1,i2 30 format(6x,23hin above message, i1 =,i10,3x,4hi2 =,i10) if (nr .eq. 1) write (lun, 40) r1 40 format(6x,23hin above message, r1 =,d21.13) if (nr .eq. 2) write (lun, 50) r1,r2 50 format(6x,15hin above, r1 =,d21.13,3x,4hr2 =,d21.13) c abort the run if iert = 2. ------------------------------------------- 100 if (iert .ne. 2) return stop c----------------------- end of subroutine xerrwx ---------------------- end