subroutine aptbrev (idiga, ndiga, nerr) ccbeg. cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE APTBREV c c call aptbrev (idiga, ndiga, nerr) c c Version: aptbrev Updated 2006 May 12 13:40. c aptbrev Originated 2005 May 20 14:00. c c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123. c c c Purpose: To reverse the order of the integer array idiga, of length c ndiga, if ndiga is 2 or more. c c Flag nerr indicates any input error. c c See aptdtob, aptbadd, aptbsub, aptbmul, aptbdiv, aptbpow, c aptbrtn, aptbfac. c c Input: idiga. c c Output: idiga, nerr. c c Glossary: c c idiga In/Out An integer array of length ndiga, to be reversed. c c ndiga Input The length of integer array idiga. c c nerr Output Indicates an input error, if not zero. c 1 if ndiga is negative. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ccend. c.... Dimensioned arguments. integer idiga(1) c.... Local variables. integer idigx integer n integer nmid cbugc***DEBUG begins. cbug 9901 format (/ 'aptbrev reversing the integer array idiga,', cbug & ' of length ndiga =',i7,'.') cbug 9902 format (' a n =',i7,', idiga =',i7,'.') cbug write ( 3, 9901) ndiga cbug write ( 3, 9902) (n, idiga(n), n = 1, ndiga) cbugc***DEBUG ends. c.... Test for input errors. nerr = 0 if (ndiga .lt. 0) then nerr = 1 go to 210 elseif (ndiga .lt. 2) then go to 210 endif c.... Reverse the order of array idiga. nmid = ndiga / 2 do n = 1, nmid nrev = ndiga - n + 1 idigx = idiga(n) idiga(n) = idiga(nrev) idiga(nrev) = idigx enddo 210 continue if (nerr .ne. 0) then ndiga = 0 idiga(1) = -999999 endif cbugc***DEBUG begins. cbug 9911 format (/ 'aptbrev results: nerr=',i2,'.') cbug write ( 3, 9911) nerr cbug write ( 3, 9902) (n, idiga(n), n = 1, ndiga) cbugc***DEBUG ends. return c.... End of subroutine aptbrev. (+1 line.) end UCRL-WEB-209832