      program upd                                                           upd.2   
c     ******************************************************************    upd.3   
c                                                                           upd.4   
c     A Simple Update Program                            vers: 1.4        jul97.3   
c     for Maintaining FORTRAN Codes                      date: 14 jul 97  jul97.4   
c     -------------------------------                                       upd.7   
c                                                                           upd.8   
c     This program is loosely based on the UPDATE program that runs on      upd.9   
c     CDC and Cray machines.  It allows you to keep a record of             upd.10  
c     consecutive changes to a FORTRAN program that is useful for           upd.11  
c     history and quality assurance purposes.  The changes are              upd.12  
c     specified with simple commands that are easy to exchange              upd.13  
c     between various users of a code being maintained with upd.            upd.14  
c     This is a stripped-down adaptation with only basic capabilities,      upd.15  
c     but because of that, it is easy to install on any computer system.    upd.16  
c                                                                           upd.17  
c     The original FORTRAN source code is stored in the file "src".         upd.18  
c     It is divided up into separate named parts by "*deck name" lines.     upd.19  
c     In each named part, the first line after the "*deck" line             upd.20  
c     is numbered "name.2", the next card is referred to using "name.3",    upd.21  
c     etc.  The "src" files can also contain "*if", "*elseif", "*else",     upd.22  
c     and "*endif" lines as described below.  These lines are numbered      upd.23  
c     just like any other lines in the "src" file.                          upd.24  
c                                                                           upd.25  
c     Changes to the FORTRAN code are given in an input file called         upd.26  
c     "upn".  This file is divided into separate named parts by             upd.27  
c     "*ident name".  Each "ident" can contain a mixture of upd direc-      upd.28  
c     tives and new FORTRAN statements. The directives are as follows:      upd.29  
c                                                                           upd.30  
c      *i ref                                                               upd.31  
c          insert the lines between the "*i" directive and the              upd.32  
c          next upd directive after the location "ref".                     upd.33  
c                                                                           upd.34  
c      *b ref                                                               upd.35  
c          insert the lines between the "*b" directive and the              upd.36  
c          next upd directive before the location "ref".                    upd.37  
c                                                                           upd.38  
c      *d ref1,ref2                                                         upd.39  
c          delete the lines between "ref1" and "ref2, and                   upd.40  
c          insert the lines between the "*d" directive and the              upd.41  
c          next upd directive (if any).                                     upd.42  
c                                                                           upd.43  
c     The line references can have the following forms:                     upd.44  
c                                                                           upd.45  
c          name.5                                                           upd.46  
c          name.5,7                                                         upd.47  
c          name1.5,name2.6                                                  upd.48  
c                                                                           upd.49  
c     Updates can be made on top of previous updates as long as             upd.50  
c     each line referenced is currently active.  Updates are                upd.51  
c     numbered so that the first line after the "*ident name" line          upd.52  
c     is labeled "name.2".                                                  upd.53  
c                                                                           upd.54  
c     Update decks can also contain comments of the form                    upd.55  
c                                                                           upd.56  
c          */ text                                                          upd.57  
c                                                                           upd.58  
c     Comments are numbered just like other lines in the ident.             upd.59  
c     They are not written to the output files.  It is recommended          upd.60  
c     that "*/" comments be used to explain the purpose of each ident       upd.61  
c     and to give the date of the modification.                             upd.62  
c                                                                           upd.63  
c     Both decks and update "idents" can contain conditional                upd.64  
c     statements.  Only the following very basic form is supported:         upd.65  
c                                                                           upd.66  
c          *if condition                                                    upd.67  
c          ...                                                              upd.68  
c          *elseif condition                                                upd.69  
c          ...                                                              upd.70  
c          *else                                                            upd.71  
c          ...                                                              upd.72  
c          *endif                                                           upd.73  
c                                                                           upd.74  
c     The condition consists of a single word that has been "set"           upd.75  
c     true with a "*set word" command at the beginning of the upd           upd.76  
c     input deck.  All words not set are assumed to be false.  These        upd.77  
c     "if" statements can be nested.                                      apr93.9   
c                                                                         apr93.10  
c     New decks can be added by including a *deck command followed        apr93.11  
c     by the FORTRAN coding in the UPN file.  Deck names must be unique   apr93.12  
c     and must not be the same as any ident name.                         apr93.13  
c                                                                         apr93.14  
c     Comdecks may appear in either the UPN or SRC files.  They are       apr93.15  
c     preceded by a *comdeck command. A *call comdeckname will place      apr93.16  
c     a copy of the comdeck in this location.  Comdecks may be updated    apr93.17  
c     with the normal *i, *b, and *d commands.                            apr93.18  
c                                                                           upd.79  
c     There are several upd commands that can appear at the                 upd.80  
c     beginning of the upd input deck "upn".  They are as follows:          upd.81  
c                                                                           upd.82  
c       *cpl name1,name2,name3,.....                                        upd.83  
c          request that the named deck(s) be included in a partial          upd.84  
c          "cpl" file.  More than one "*cpl" command can be included.       upd.85  
c          Each line on the "cpl" file will have a label of the             upd.86  
c          form "name.number" starting in column 73.  The name will         upd.87  
c          be either a deck name or an ident name.  If no deck names        upd.88  
c          are given, all decks are written to the "cpl" file.              upd.89  
c                                                                           upd.90  
c       *noid                                                               upd.91  
c          request that the card identifiers in colums 73-84 be             upd.92  
c          omitted from all lines of the cpl file.  This is required        upd.93  
c          for some compilers that cannot handle more than 80 chars         upd.94  
c          per line.  Use the lst file to determine card labels.            upd.95  
c                                                                           upd.96  
c       *npl                                                                upd.97  
c          request that a new "src" file called "npl" be created            upd.98  
c          with all the corrections applied.  The "*deck" lines and         upd.99  
c          the "*if" constructs are included in the file.  No line          upd.100 
c          number identifiers are given.                                    upd.101 
c                                                                           upd.102 
c       *lst name1,name2,name3,.....                                        upd.103 
c          request that a special "lst" file be prepared containing         upd.104 
c          a listing of the modified file.  This listing has the line       upd.105 
c          identifier labels on the left and program, subroutine, or        upd.106 
c          function names on the right.  If there are no names              upd.107 
c          all decks are written to the "lst" file.  Otherwise only name    upd.108 
c          decks are written.  All branches of "*if" constructs are         upd.109 
c          listed.                                                          upd.110 
c                                                                           upd.111 
c       *set word1,word2,.....                                              upd.112 
c          set a word or words for a "*if" construction to the "true"       upd.113 
c          state.                                                           upd.114 
c                                                                           upd.115 
c     Running upd with the files "src" and "upn" present can generate       upd.116 
c     a file "cpl" containing the updated FORTRAN code ,an "npl" file       upd.117 
c     suitable for use as a new "src" file , "lst" file, or any combin-     upd.118 
c     ation of these three files depending on which directives appear in    upd.119 
c     "upn".  Note that "npl" is not a binary file as in CDC of CRAY        upd.120 
c     UPDATE and that no binary "OLDPL" is used in UPD.                     upd.121 
c                                                                           upd.122 
c     history...                                                            upd.123 
c                                                                           upd.124 
c     1.1     Increased number of active lines allowed to 5000.             upd.125 
c             Minor cleanup work.                                           upd.126 
c     1.2     Fixed a problem in deleting a range that started              upd.127 
c               inside one block and ended inside another.                  upd.128 
c             Added the noid option.                                        upd.129 
c     1.3     Add comdeck, nested ifs and deck in upn file                apr93.20  
c     1.4     Increased number of active lines to 9999                    jul97.5
c                                                                           upd.130 
c     ******************************************************************    upd.131 
      common /upd1/ nid,nact,ndecks                                         upd.132 
      common /upd2/ iseq,iseq1                                              upd.133 
      common /upd3/ iupn,iout,jupn,kold                                   apr93.22  
      common /upd4/ iact(3,9999)                                          jul97.6 
      character*10 id                                                       upd.136 
      common /upd5/ id(1000)                                                upd.137 
      common /upd6/ lid(1000)                                               upd.138 
      common /upd7/ lcds(500),lcde(500),lcdn(500),ncmdk,jc,jcd,           apr93.24  
     x iseqs(500),iptcd(100),ncdid,jdx1,jdx2,noid,nlns                    apr93.25  
      common /upd8/ nupn,ncdu                                             apr93.26  
      character*10 cdnames(500),cdid(100),idid                            apr93.27  
      logical cmdk,dk                                                     apr93.28  
      character*72 iline,lline                                              upd.139 
      character*10 opr,opn                                                  upd.140 
      character*10 id1,id2                                                  upd.141 
      character*13 label                                                    upd.142 
      character*6 vers                                                      upd.143 
      character*10 cnames(100),swords(100),gettok,lnames(100)               upd.144 
      external gettok                                                       upd.145 
      character*7 sname                                                     upd.146 
      logical new,list,compl,noid,nlns                                    apr93.30  
      logical cdeck                                                         upd.148 
      logical on(20),skip(20)                                             apr93.32  
c                                                                           upd.150 
c     ***initialize                                                         upd.151 
      iout=6                                                                upd.152 
c     open(iout,status='unknown',file='tty')                              apr93.34  
      vers='1.4'                                                          jul97.7   
      llen=72                                                               upd.155 
      write(iout,'('' upd: vers: '',a)') vers                               upd.156 
      ncmdk=0                                                             apr93.36  
      jc=0                                                                apr93.37  
      cmdk=.false.                                                        apr93.38  
      dk=.false.                                                          apr93.39  
c                                                                           upd.157 
c     ***read in the src file                                               upd.158 
      nsrc=1                                                                upd.159 
      open(nsrc,file='src',status='old')                                    upd.160 
      ntmp=11                                                             apr93.41  
      open(ntmp,status='scratch')                                         apr93.42  
      ncdid=0                                                             apr93.43  
      nid=0                                                                 upd.161 
      nact=0                                                                upd.162 
      iseq=0                                                                upd.163 
      isrc=0                                                                upd.164 
      jsrc=0                                                              apr93.45  
  110 isrc=isrc+1                                                           upd.165 
      read(nsrc,'(a)',end=120) iline                                        upd.166 
      jsrc=jsrc+1                                                         apr93.47  
 112  if(iline(1:8).ne.'*comdeck') write(ntmp,'(a)') iline                apr93.48  
      if (iline(1:5).eq.'*deck'.and.(dk.or.nid.eq.0)) then                apr93.49  
         if (nid.gt.0) then                                                 upd.168 
            iact(3,nact)=iseq                                               upd.169 
            iseq=0                                                          upd.170 
         endif                                                              upd.171 
         if(ncmdk.gt.0.and.cmdk) then                                     apr93.51  
           lcde(ncmdk)=jc                                                 apr93.52  
           cmdk=.false.                                                   apr93.53  
         endif                                                            apr93.54  
         dk=.true.                                                        apr93.55  
         nid=nid+1                                                          upd.172 
         if (nid.gt.1000)                                                   upd.173 
     1      call error('too many identifiers (1000 max)')                   upd.174 
         id(nid)=iline(7:16)                                                upd.175 
         lid(nid)=isrc                                                      upd.176 
         nact=nact+1                                                        upd.177 
         if (nact.gt.9999)                                                jul97.8 
     1      call error('too many active line entries (9999 max)')         jul97.9 
         iact(1,nact)=nid                                                   upd.180 
         iact(2,nact)=1                                                     upd.181 
      endif                                                                 upd.182 
      if(iline(1:8).eq.'*comdeck') then                                   apr93.57  
         if(nid.gt.0.and.dk) then                                         apr93.58  
            iact(3,nact)=iseq                                             apr93.59  
            dk=.false.                                                    apr93.60  
            iseq=0                                                        apr93.61  
         endif                                                            apr93.62  
         if(ncmdk.gt.0.and.cmdk) then                                     apr93.63  
            lcde(ncmdk)=jc                                                apr93.64  
         endif                                                            apr93.65  
         jcd=1                                                            apr93.66  
         cmdk=.true.                                                      apr93.67  
         if(ncmdk.eq.0) then                                              apr93.68  
            ncdu=12                                                       apr93.69  
            open(ncdu,status='unknown',access='direct',recl=84)           apr93.70  
         endif                                                            apr93.71  
         ncmdk=ncmdk+1                                                    apr93.72  
         cdnames(ncmdk)=iline(10:19)                                      apr93.73  
         ncdid=ncdid+1                                                    apr93.74  
         cdid(ncdid)=cdnames(ncmdk)                                       apr93.75  
         iptcd(ncdid)=ncmdk                                               apr93.76  
         if(ncmdk.gt.500) call error('too many comdecks (500 max)')       apr93.77  
         lcds(ncmdk)=jc+1                                                 apr93.78  
         lcdn(ncmdk)=0                                                    apr93.79  
         iseqs(ncmdk)=2                                                   apr93.80  
 115     read(nsrc,'(a)',end=117) iline                                   apr93.81  
         jsrc=jsrc+1                                                      apr93.82  
         if(iline(1:1).eq.'*') go to 112                                  apr93.83  
         jcd=jcd+1                                                        apr93.84  
         jc=jc+1                                                          apr93.85  
         if(noid) then                                                    apr93.86  
            label=' '                                                     apr93.87  
         else                                                             apr93.88  
            call packl(cdnames(ncmdk),jcd,label)                          apr93.89  
         endif                                                            apr93.90  
         write(ncdu,rec=jc) iline,label                                   apr93.91  
         go to 115                                                        apr93.92  
 117     lcde(ncmdk)=jc                                                   apr93.93  
         go to 121                                                        apr93.94  
      endif                                                               apr93.95  
      iseq=iseq+1                                                           upd.183 
      go to 110                                                             upd.184 
  120 iact(3,nact)=iseq                                                     upd.185 
  121 ndecks=nid                                                          apr93.97  
      isrc=isrc-1                                                         apr93.98  
      write(iout,'('' upd: src:'',i6,'' cards '',i4,'' decks'')')           upd.188 
     1   jsrc,ndecks                                                        upd.189 
c                                                                           upd.190 
c     ***read the upd input "upn" file,                                     upd.191 
c     ***copy the lines to a direct access file,                            upd.192 
c     ***and make a table of active lines                                   upd.193 
      nupn=2                                                                upd.194 
      open(nupn,file='upn',status='old')                                    upd.195 
      ndir=3                                                                upd.196 
      open(ndir,status='scratch',access='direct',recl=llen)                 upd.197 
      nnames=0                                                              upd.198 
      nlistn=0                                                              upd.199 
      nwords=0                                                              upd.200 
      new=.false.                                                           upd.201 
      list=.false.                                                          upd.202 
      noid=.false.                                                          upd.203 
      iupn=0                                                                upd.204 
      jupn=0                                                              apr93.100 
      knew=1                                                              apr93.101 
      opr=' '                                                               upd.205 
      lupn=0                                                                upd.206 
  140 iupn=iupn+1                                                           upd.207 
      read(nupn,'(a)',end=150) iline                                        upd.208 
      jupn=jupn+1                                                         apr93.103 
      jcd=jcd+1                                                           apr93.104 
 145  if(iline(1:8).ne.'*comdeck') write(ndir,rec=iupn) iline             apr93.105 
      go to 160                                                             upd.210 
  150 iline='*end'                                                          upd.211 
c                                                                           upd.212 
c     ***is this an operation?                                              upd.213 
  160 if (iline(1:1).ne.'*') go to 175                                      upd.214 
      kold=knew                                                           apr93.107 
      knew=jupn                                                           apr93.108 
      if (iline(1:2).eq.'*/') go to 175                                     upd.215 
      if(iline(1:5).eq.'*call') go to 175                                 apr93.110 
      j=1                                                                   upd.216 
      call getopr(j,iline,opn)                                              upd.217 
      if (opn.eq.'*ident') idid=iline(8:18)                               apr93.112 
      if (opn.eq.'*ident') jcd=1                                          apr93.113 
      if (opn.ne.'*ident'.and.opn.ne.'*b'.and.opn.ne.'*d'                 apr93.114 
     x   .and.opn.ne.'*i'.and.opn.ne.'*end'.and.opn.ne.'*deck'            apr93.115 
     x    .and.opn.ne.'*comdeck') go to 170                               apr93.116 
c                                                                           upd.220 
c     ***perform the pending operation                                      upd.221 
      if (opr.eq.'*ident') then                                             upd.222 
         nid=nid+1                                                          upd.223 
         if (nid.gt.1000)                                                   upd.224 
     1      call error('too many identifiers (1000 max)')                   upd.225 
         id(nid)=lline(8:n)                                                 upd.226 
         lid(nid)=-lupn                                                   apr93.118 
         iseq=iupn-lupn+1                                                   upd.228 
         iseq1=iseq                                                         upd.229 
      else if (opr.eq.'*b') then                                            upd.230 
         call getadr(i,lline,id1,n1,id2,n2)                                 upd.231 
         call before(id1,n1)                                                upd.232 
      else if (opr.eq.'*d') then                                            upd.233 
         call getadr(i,lline,id1,n1,id2,n2)                                 upd.234 
         call delete(id1,n1,id2,n2)                                         upd.235 
      else if (opr.eq.'*i') then                                            upd.236 
         call getadr(i,lline,id1,n1,id2,n2)                                 upd.237 
         call insert(id1,n1)                                                upd.238 
      endif                                                                 upd.239 
c                                                                         apr93.120 
c      *** look for comdeck operations                                    apr93.121 
      if(opn.eq.'*b'.or.opn.eq.'*d'.or.opn.eq.'*i') then                  apr93.122 
         i=1                                                              apr93.123 
         call getadr(i,iline,id1,n1,id2,n2)                               apr93.124 
         call getcd(cdnames,cdid,idid,id1,n1,id2,n2)                      apr93.125 
         if(jdx1.ne.0) then                                               apr93.126 
            call fixcd(cdnames,cdid,idid,opn,id1,n1,id2,n2,iline)         apr93.127 
            opr=' '                                                       apr93.128 
            iseq=iseq+2                                                   apr93.129 
            iupn=iupn+1                                                   apr93.130 
            iseq1=iseq                                                    apr93.131 
            lupn=iupn                                                     apr93.132 
            go to 145                                                     apr93.133 
         endif                                                            apr93.134 
      endif                                                               apr93.135 
c                                                                         apr93.136 
c      *** if operation is deck add these cards to the end of the         apr93.137 
c          copied source file and update active table                     apr93.138 
      if(opn.eq.'*deck') then                                             apr93.139 
         isrc=isrc+1                                                      apr93.140 
         ndecks=ndecks+1                                                  apr93.141 
         iseql=0                                                          apr93.142 
         nid=nid+1                                                        apr93.143 
         if(nid.gt.1000) call                                             apr93.144 
     x      error('too many identifiers (1000 max)')                      apr93.145 
         id(nid)=iline(7:16)                                              apr93.146 
         lid(nid)=isrc                                                    apr93.147 
         nact=nact+1                                                      apr93.148 
         iact(1,nact)=nid                                                 apr93.149 
         iact(2,nact)=1                                                   apr93.150 
         write(ntmp,'(a)') iline                                          apr93.151 
 162     read(nupn,'(a)',end=161) iline                                   apr93.152 
         jupn=jupn+1                                                      apr93.153 
         iseql=iseql+1                                                    apr93.154 
         if(iline(1:1).eq.'*') then                                       apr93.155 
            opr=' '                                                       apr93.156 
            iact(3,nact)=iseql                                            apr93.157 
            iseql=0                                                       apr93.158 
            go to 145                                                     apr93.159 
         else                                                             apr93.160 
            write(ntmp,'(a)') iline                                       apr93.161 
            go to 162                                                     apr93.162 
         endif                                                            apr93.163 
 161     opr=' '                                                          apr93.164 
         iact(3,nact)=iseql+1                                             apr93.165 
         iseql=0                                                          apr93.166 
         go to 150                                                        apr93.167 
      endif                                                               apr93.168 
c                                                                         apr93.169 
c      ***if operation is comdeck move cards to direct access             apr93.170 
c         comdeck file                                                    apr93.171 
      if(opn.eq.'*comdeck') then                                          apr93.172 
         nln=1                                                            apr93.173 
         if(ncmdk.eq.0) then                                              apr93.174 
            ncdu=12                                                       apr93.175 
            open(ncdu,status='unknown',access='direct',recl=84)           apr93.176 
         endif                                                            apr93.177 
         ncmdk=ncmdk+1                                                    apr93.178 
         if(ncmdk.gt.500) call error('too many comdecks (500 max)')       apr93.179 
         cdnames(ncmdk)=iline(10:19)                                      apr93.180 
         ncdid=ncdid+1                                                    apr93.181 
         cdid(ncdid)=cdnames(ncmdk)                                       apr93.182 
         iptcd(ncdid)=ncmdk                                               apr93.183 
         lcds(ncmdk)=jc+1                                                 apr93.184 
         lcdn(ncmdk)=0                                                    apr93.185 
         iseqs(ncmdk)=2                                                   apr93.186 
 166     read(nupn,'(a)',end=169) iline                                   apr93.187 
         jupn=jupn+1                                                      apr93.188 
         if(iline(1:1).eq.'*') go to 168                                  apr93.189 
         nln=nln+1                                                        apr93.190 
         jc=jc+1                                                          apr93.191 
         if(noid) then                                                    apr93.192 
            label=' '                                                     apr93.193 
         else                                                             apr93.194 
            call packl(cdnames(ncmdk),nln,label)                          apr93.195 
         endif                                                            apr93.196 
         write(ncdu,rec=jc) iline,label                                   apr93.197 
         go to 166                                                        apr93.198 
 168     lcde(ncmdk)=jc                                                   apr93.199 
         opr=' '                                                          apr93.200 
         go to 160                                                        apr93.201 
 169     lcde(ncmdk)=jc                                                   apr93.202 
         opr=' '                                                          apr93.203 
         go to 150                                                        apr93.204 
      endif                                                               apr93.205 
c                                                                           upd.240 
c     ***get the new operation                                              upd.241 
      i=j                                                                   upd.242 
      opr=opn                                                               upd.243 
      n=len(iline)                                                          upd.244 
      if (opr.eq.'*end') go to 180                                          upd.245 
      lline=iline                                                           upd.246 
      lupn=iupn                                                             upd.247 
      iseq=iseq+1                                                           upd.248 
      iseq1=iseq                                                            upd.249 
      go to 140                                                             upd.250 
c                                                                           upd.251 
c     ***is this a upd command?                                             upd.252 
  170 iseq=iseq+1                                                           upd.253 
      nn=len(iline)                                                         upd.254 
      if (opn.eq.'*npl') then                                               upd.255 
         new=.true.                                                         upd.256 
         opr=opn                                                            upd.257 
         go to 140                                                          upd.258 
      else if (opn.eq.'*lst') then                                          upd.259 
         list=.true.                                                        upd.260 
         idx=6                                                              upd.261 
 172     lnames(nlistn+1)=gettok(iline,idx,nn)                              upd.262 
         if(lnames(nlistn+1).ne.' ') then                                   upd.263 
           nlistn=nlistn+1                                                  upd.264 
           if(idx.lt.nn) go to 172                                          upd.265 
         endif                                                              upd.266 
         opr=opn                                                            upd.267 
         go to 140                                                          upd.268 
      else if (opn.eq.'*cpl') then                                          upd.269 
         compl=.true.                                                       upd.270 
         idx=6                                                              upd.271 
 173     cnames(nnames+1)=gettok(iline,idx,nn)                              upd.272 
         if(cnames(nnames+1).ne.' ') then                                   upd.273 
           nnames=nnames+1                                                  upd.274 
           if(idx.lt.nn) go to 173                                          upd.275 
         endif                                                              upd.276 
         opr=opn                                                            upd.277 
         go to 140                                                          upd.278 
      else if (opn.eq.'*noid') then                                         upd.279 
         noid=.true.                                                        upd.280 
         opr=opn                                                            upd.281 
         go to 140                                                          upd.282 
      else if (opn.eq.'*set') then                                          upd.283 
         idx=6                                                              upd.284 
 174     swords(nwords+1)=gettok(iline,idx,nn)                              upd.285 
         if(swords(nwords+1).ne.' ') then                                   upd.286 
           nwords=nwords+1                                                  upd.287 
           if(idx.lt.nn) go to 174                                          upd.288 
         endif                                                              upd.289 
         opr=opn                                                            upd.290 
         go to 140                                                          upd.291 
      else                                                                  upd.292 
         go to 140                                                          upd.293 
      endif                                                                 upd.294 
c                                                                           upd.295 
c     ***data line                                                          upd.296 
  175 iseq=iseq+1                                                           upd.297 
      go to 140                                                             upd.298 
c                                                                           upd.299 
c     ***finished up the "upn" file                                         upd.300 
 180  write(iout,'('' upd: upn:'',i6,'' cards '',i4,'' idents'')')        apr93.207 
     1   jupn,nid-ndecks                                                  apr93.208 
      if(.not.compl) go to 300                                              upd.303 
c                                                                           upd.304 
c     ***write the "cpl" file                                               upd.305 
      ncpl=4                                                                upd.306 
      icpl=0                                                                upd.307 
      rewind ntmp                                                         apr93.210 
      isrc=0                                                                upd.309 
      open(ncpl,file='cpl',status='unknown')                                upd.310 
      cdeck=.true.                                                          upd.311 
      do 181 i=1,20                                                       apr93.212 
 181  on(i)=.true.                                                        apr93.213 
      do 290 i=1,nact                                                       upd.313 
c                                                                           upd.314 
c     ***get the parameters for this table entry                            upd.315 
      k1=iact(1,i)                                                          upd.316 
      id1=id(k1)                                                            upd.317 
      i1=iact(2,i)                                                          upd.318 
      i2=iact(3,i)                                                          upd.319 
      do 190 j=1,nid                                                        upd.320 
      k=j                                                                   upd.321 
      if (id1.eq.id(j)) go to 200                                           upd.322 
  190 continue                                                              upd.323 
  200 l=iabs(lid(k))                                                      apr93.215 
      dk=.false.                                                          apr93.216 
      if(lid(k).gt.0) dk=.true.                                           apr93.217 
      if (i1.gt.1) go to 205                                                upd.325 
      if (nnames.eq.0) go to 205                                            upd.326 
      cdeck=.false.                                                         upd.327 
      do 204 j=1,nnames                                                     upd.328 
      if (cnames(j).eq.id1) cdeck=.true.                                    upd.329 
  204 continue                                                              upd.330 
  205 if(.not.dk) go to 240                                               apr93.219 
c                                                                           upd.332 
c     ***take lines from "src" decks                                        upd.333 
      nskip=l+i1-isrc-2                                                     upd.334 
      if (nskip.le.0) go to 220                                             upd.335 
      do 210 ii=1,nskip                                                     upd.336 
      isrc=isrc+1                                                           upd.337 
      read (ntmp,'(a)') iline                                             apr93.221 
  210 continue                                                              upd.339 
  220 nkeep=i2-i1+1                                                         upd.340 
      do 230 ii=1,nkeep                                                     upd.341 
      isrc=isrc+1                                                           upd.342 
      read (ntmp,'(a)') iline                                             apr93.223 
c                                                                           upd.344 
c     ***check whether this line is to be written                           upd.345 
      if (.not.cdeck) go to 230                                             upd.346 
      if (iline(1:5).eq.'*deck') go to 230                                  upd.347 
      if (iline(1:3).eq.'*if') then                                         upd.348 
         lc=lc+1                                                          apr93.225 
         skip(lc)=.false.                                                 apr93.226 
         on(lc)=.false.                                                   apr93.227 
         if (nwords.eq.0) go to 230                                         upd.351 
         do 225 j=1,nwords                                                  upd.352 
         if (swords(j).eq.iline(5:n)) on(lc)=.true.                       apr93.229 
  225    continue                                                           upd.354 
         if (on(lc)) skip(lc)=.true.                                      apr93.231 
         go to 230                                                          upd.356 
      elseif (iline(1:7).eq.'*elseif') then                                 upd.357 
         if(lc.eq.0) call error('illegal use of *if statements')          apr93.233 
         if (skip(lc)) then                                               apr93.234 
            on(lc)=.false.                                                apr93.235 
            go to 230                                                       upd.360 
         endif                                                              upd.361 
         on(lc)=.false.                                                   apr93.237 
         if (nwords.eq.0) go to 230                                         upd.363 
         do 226 j=1,nwords                                                  upd.364 
         if (swords(j).eq.iline(9:n)) on(lc)=.true.                       apr93.239 
  226    continue                                                           upd.366 
         if (on(lc)) skip(lc)=.true.                                      apr93.241 
         go to 230                                                          upd.368 
      elseif (iline(1:5).eq.'*else') then                                   upd.369 
         if(lc.eq.0) call error('illegal use of *if statements')          apr93.243 
         on(lc)=.not.skip(lc)                                             apr93.244 
         go to 230                                                          upd.371 
      elseif (iline(1:6).eq.'*endif') then                                  upd.372 
         lc=lc-1                                                          apr93.246 
         if(lc.lt.0) call error('illegal use of *if statements')          apr93.247 
         go to 230                                                          upd.374 
      endif                                                                 upd.375 
      if(lc.gt.0) then                                                    apr93.249 
         do 221 ll=1,lc                                                   apr93.250 
         if(.not.on(ll)) go to 230                                        apr93.251 
 221     continue                                                         apr93.252 
      endif                                                               apr93.253 
c                                                                         apr93.254 
c     ***expand *call with appropriate comdeck                            apr93.255 
      if(iline(1:5).eq.'*call') then                                      apr93.256 
        do 228 i1=1,ncdid                                                 apr93.257 
        if(cdid(i1).eq.iline(7:16)) then                                  apr93.258 
           j=iptcd(i1)                                                    apr93.259 
           k=lcds(j)                                                      apr93.260 
  227      read(ncdu,rec=k) iline,label                                   apr93.261 
           icpl=icpl+1                                                    apr93.262 
           if (noid) then                                                 apr93.263 
              write(ncpl,'(a)') iline                                     apr93.264 
           else                                                           apr93.265 
              write(ncpl,'(a72,a13)') iline,label                         apr93.266 
           endif                                                          apr93.267 
           k=k+1                                                          apr93.268 
           if(k.le.lcde(j)) go to 227                                     apr93.269 
           m=lcdn(j)                                                      apr93.270 
           if(m.gt.0) then                                                apr93.271 
              k=lcds(m)                                                   apr93.272 
              j=m                                                         apr93.273 
              go to 227                                                   apr93.274 
           endif                                                          apr93.275 
           go to 229                                                      apr93.276 
        endif                                                             apr93.277 
 228    continue                                                          apr93.278 
        call error('cant find comdeck')                                   apr93.279 
 229    continue                                                          apr93.280 
        go to 230                                                         apr93.281 
      endif                                                               apr93.282 
c                                                                           upd.377 
c     ***write the line with or without label                               upd.378 
      if (noid) then                                                        upd.379 
         write(ncpl,'(a)') iline                                            upd.380 
      else                                                                  upd.381 
         call packl(id1,isrc-l+1,label)                                     upd.382 
         write (ncpl,'(a72,a13)') iline,label                               upd.383 
      endif                                                                 upd.384 
      icpl=icpl+1                                                           upd.385 
  230 continue                                                              upd.386 
      go to 290                                                             upd.387 
                                                                            upd.388 
c     ***take lines from "upn" input                                        upd.389 
  240 nkeep=i2-i1+1                                                         upd.390 
      do 250 ii=1,nkeep                                                     upd.391 
      read (ndir,rec=l+i1+ii-2) iline                                       upd.392 
c                                                                           upd.393 
c     ***check whether this line is to be written                           upd.394 
      if (.not.cdeck) go to 250                                             upd.395 
c                                                                         apr93.284 
c     ***expand *call with appropriate comdeck                            apr93.285 
      if(iline(1:5).eq.'*call') then                                      apr93.286 
        do 243 i1=1,ncdid                                                 apr93.287 
        if(cdid(i1).eq.iline(7:16)) then                                  apr93.288 
           j=iptcd(i1)                                                    apr93.289 
           k=lcds(j)                                                      apr93.290 
  241      read(ncdu,rec=k) iline,label                                   apr93.291 
           icpl=icpl+1                                                    apr93.292 
           if (noid) then                                                 apr93.293 
              write(ncpl,'(a)') iline                                     apr93.294 
           else                                                           apr93.295 
              write(ncpl,'(a72,a13)') iline,label                         apr93.296 
           endif                                                          apr93.297 
           k=k+1                                                          apr93.298 
           if(k.le.lcde(j)) go to 241                                     apr93.299 
           m=lcdn(j)                                                      apr93.300 
           if(m.gt.0) then                                                apr93.301 
              k=lcds(m)                                                   apr93.302 
              j=m                                                         apr93.303 
              go to 241                                                   apr93.304 
           endif                                                          apr93.305 
           go to 244                                                      apr93.306 
        endif                                                             apr93.307 
 243    continue                                                          apr93.308 
        call error('cant find comdeck')                                   apr93.309 
 244    continue                                                          apr93.310 
        go to 250                                                         apr93.311 
      endif                                                               apr93.312 
      if (iline(1:3).eq.'*if') then                                         upd.396 
         lc=lc+1                                                          apr93.314 
         skip(lc)=.false.                                                 apr93.315 
         on(lc)=.false.                                                   apr93.316 
         if (nwords.eq.0) go to 250                                         upd.399 
         do 245 j=1,nwords                                                  upd.400 
         if (swords(j).eq.iline(5:n)) on(lc)=.true.                       apr93.318 
  245    continue                                                           upd.402 
         if (on(lc)) skip(lc)=.true.                                      apr93.320 
         go to 250                                                          upd.404 
      elseif (iline(1:7).eq.'*elseif') then                                 upd.405 
         if(lc.eq.0) call error('illegal use of *if statements')          apr93.322 
         if (skip(lc)) then                                               apr93.323 
            on(lc)=.false.                                                apr93.324 
            go to 250                                                       upd.408 
         endif                                                              upd.409 
         on(lc)=.false.                                                   apr93.326 
         if (nwords.eq.0) go to 250                                         upd.411 
         do 246 j=1,nwords                                                  upd.412 
         if (swords(j).eq.iline(9:n)) on(lc)=.true.                       apr93.328 
  246    continue                                                           upd.414 
         if (on(lc)) skip(lc)=.true.                                      apr93.330 
         go to 250                                                          upd.416 
      elseif (iline(1:5).eq.'*else') then                                   upd.417 
         if(lc.eq.0) call error('illegal use of *if statements')          apr93.332 
         on(lc)=.not.skip(lc)                                             apr93.333 
         go to 250                                                          upd.419 
      elseif (iline(1:6).eq.'*endif') then                                  upd.420 
         lc=lc-1                                                          apr93.335 
         if(lc.lt.0) call error('illegal use of *if statements')          apr93.336 
         go to 250                                                          upd.422 
      endif                                                                 upd.423 
      if(lc.gt.0) then                                                    apr93.338 
         do 247 ll=1,lc                                                   apr93.339 
         if(.not.on(ll)) go to 250                                        apr93.340 
 247     continue                                                         apr93.341 
      endif                                                               apr93.342 
      if (iline(1:2).eq.'*/') go to 250                                     upd.425 
c                                                                           upd.426 
c     ***write the line with or without label                               upd.427 
      if (noid) then                                                        upd.428 
         write(ncpl,'(a)') iline                                            upd.429 
      else                                                                  upd.430 
         call packl(id1,i1+ii-1,label)                                      upd.431 
         write (ncpl,'(a72,a13)') iline,label                               upd.432 
      endif                                                                 upd.433 
      icpl=icpl+1                                                           upd.434 
  250 continue                                                              upd.435 
c                                                                           upd.436 
c     ***continue loop over entries in table of active lines                upd.437 
  290 continue                                                              upd.438 
      write(iout,'('' upd: cpl:'',i6,'' lines written'')') icpl             upd.439 
      if(lc.ne.0) call error('illegal use of *if statement')              apr93.344 
      close (ncpl)                                                          upd.440 
c                                                                           upd.441 
c     ***write the "npl" file                                               upd.442 
 300  if(.not.new) go to 400                                                upd.443 
      nnpl=4                                                                upd.444 
      inpl=0                                                                upd.445 
      rewind ntmp                                                         apr93.346 
      isrc=0                                                                upd.447 
      open(nnpl,file='npl',status='unknown')                                upd.448 
      do 390 i=1,nact                                                       upd.449 
c                                                                           upd.450 
c     ***get the parameters for this table entry                            upd.451 
      k1=iact(1,i)                                                          upd.452 
      id1=id(k1)                                                            upd.453 
      i1=iact(2,i)                                                          upd.454 
      i2=iact(3,i)                                                          upd.455 
      do 310 j=1,nid                                                        upd.456 
      k=j                                                                   upd.457 
      if (id1.eq.id(j)) go to 320                                           upd.458 
  310 continue                                                              upd.459 
  320 l=iabs(lid(k))                                                      apr93.348 
      dk=.false.                                                          apr93.349 
      if(lid(k).gt.0) dk=.true.                                           apr93.350 
      if (.not.dk) go to 360                                              apr93.351 
c                                                                           upd.462 
c     ***take lines from "src" decks                                        upd.463 
      nskip=l+i1-isrc-2                                                     upd.464 
      if (nskip.le.0) go to 340                                             upd.465 
      do 330 ii=1,nskip                                                     upd.466 
      isrc=isrc+1                                                           upd.467 
      read (ntmp,'(a)') iline                                             apr93.353 
  330 continue                                                              upd.469 
  340 nkeep=i2-i1+1                                                         upd.470 
      do 350 ii=1,nkeep                                                     upd.471 
      isrc=isrc+1                                                           upd.472 
      read (ntmp,'(a)') iline                                             apr93.355 
      if (iline(1:2).eq.'*/') go to 350                                     upd.474 
      inpl=inpl+1                                                           upd.475 
      write (nnpl,'(a72)') iline                                            upd.476 
  350 continue                                                              upd.477 
      go to 390                                                             upd.478 
                                                                            upd.479 
c     ***take lines from "upn" input                                        upd.480 
  360 nkeep=i2-i1+1                                                         upd.481 
      do 370 ii=1,nkeep                                                     upd.482 
      read (ndir,rec=l+i1+ii-2) iline                                       upd.483 
      if (iline(1:2).eq.'*/') go to 370                                     upd.484 
      inpl=inpl+1                                                           upd.485 
      write (nnpl,'(a72)') iline                                            upd.486 
  370 continue                                                              upd.487 
c                                                                           upd.488 
c     ***continue loop over entries in table of active lines                upd.489 
  390 continue                                                              upd.490 
c                                                                         apr93.357 
c     ***list comdecks                                                    apr93.358 
      if(ncdid.ne.0) then                                                 apr93.359 
         do 399 i=1,ncdid                                                 apr93.360 
         j=iptcd(i)                                                       apr93.361 
         write(nnpl,391) cdnames(j)                                       apr93.362 
         inpl=inpl+1                                                      apr93.363 
 391     format('*comdeck ',a10)                                          apr93.364 
         k=lcds(j)                                                        apr93.365 
 392     read(ncdu,rec=k) iline                                           apr93.366 
         write(nnpl,'(a)') iline                                          apr93.367 
         inpl=inpl+1                                                      apr93.368 
         k=k+1                                                            apr93.369 
         if(k.le.lcde(j)) go to 392                                       apr93.370 
         m=lcdn(j)                                                        apr93.371 
         j=m                                                              apr93.372 
         if(m.eq.0) go to 399                                             apr93.373 
         k=lcds(m)                                                        apr93.374 
         go to 392                                                        apr93.375 
 399     continue                                                         apr93.376 
      endif                                                               apr93.377 
      write(iout,'('' upd: npl:'',i6,'' lines written'')') inpl             upd.491 
      close (nnpl)                                                          upd.492 
c                                                                           upd.493 
c     ***write the "lst" file                                               upd.494 
 400  if(.not.list) go to 500                                               upd.495 
      nlst=4                                                                upd.496 
      ilst=0                                                                upd.497 
      rewind ntmp                                                         apr93.379 
      isrc=0                                                                upd.499 
      open(nlst,file='lst',status='unknown')                                upd.500 
      do 490 i=1,nact                                                       upd.501 
c                                                                           upd.502 
c     ***get the parameters for this table entry                            upd.503 
      k1=iact(1,i)                                                          upd.504 
      id1=id(k1)                                                            upd.505 
      i1=iact(2,i)                                                          upd.506 
      i2=iact(3,i)                                                          upd.507 
      do 410 j=1,nid                                                        upd.508 
      k=j                                                                   upd.509 
      if (id1.eq.id(j)) go to 420                                           upd.510 
  410 continue                                                              upd.511 
  420 l=iabs(lid(k))                                                      apr93.381 
      dk=.false.                                                          apr93.382 
      if(lid(k).gt.0) dk=.true.                                           apr93.383 
      if (i1.gt.1) go to 425                                                upd.513 
      cdeck=.true.                                                          upd.514 
      if(nlistn.ne.0) then                                                  upd.515 
        cdeck=.false.                                                       upd.516 
        do 424 j=1,nlistn                                                   upd.517 
        if (lnames(j).eq.id1) cdeck=.true.                                  upd.518 
  424   continue                                                            upd.519 
      endif                                                                 upd.520 
  425 if(.not.dk) go to 460                                               apr93.385 
c                                                                           upd.522 
c     ***take lines from "src" decks                                        upd.523 
      nskip=l+i1-isrc-2                                                     upd.524 
      if (nskip.le.0) go to 440                                             upd.525 
      do 430 ii=1,nskip                                                     upd.526 
      isrc=isrc+1                                                           upd.527 
      read (ntmp,'(a)') iline                                             apr93.387 
  430 continue                                                              upd.529 
  440 nkeep=i2-i1+1                                                         upd.530 
      do 450 ii=1,nkeep                                                     upd.531 
      isrc=isrc+1                                                           upd.532 
      read (ntmp,'(a)') iline                                             apr93.389 
      j=0                                                                   upd.534 
      if(iline(1:1).ne.'c') then                                            upd.535 
         jj=7                                                               upd.536 
         call skipb(iline,jj)                                               upd.537 
         if (iline(jj:jj+6).eq.'program') then                              upd.538 
            j=jj+8                                                          upd.539 
         elseif (iline(jj:jj+9).eq.'subroutine') then                       upd.540 
            j=jj+11                                                         upd.541 
         elseif (iline(jj:jj+7).eq.'function') then                         upd.542 
            j=jj+9                                                          upd.543 
         else                                                               upd.544 
            do 441 jk=jj,nn                                                 upd.545 
            if(iline(jk:jk).eq.' ') go to 442                               upd.546 
  441       continue                                                        upd.547 
            go to 443                                                       upd.548 
  442       call skipb(iline,jk)                                            upd.549 
            if (iline(jk:jk+6).eq.'program') j=jk+8                         upd.550 
            if (iline(jk:jk+9).eq.'subroutine') j=jk+11                     upd.551 
            if (iline(jk:jk+7).eq.'function') j=jk+9                        upd.552 
         endif                                                              upd.553 
      endif                                                                 upd.554 
  443 if (j.eq.0) go to 447                                                 upd.555 
      call skipb(iline,j)                                                   upd.556 
      nn=len(iline)                                                         upd.557 
      do 445 jj=j,nn                                                        upd.558 
      k=jj                                                                  upd.559 
      if (iline(jj:jj).eq.'(') go to 446                                    upd.560 
  445 continue                                                              upd.561 
  446 k=k-1                                                                 upd.562 
      sname=iline(j:k)                                                      upd.563 
  447 if (.not.cdeck) go to 450                                             upd.564 
      if (iline(1:5).eq.'*deck') go to 450                                  upd.565 
      if (iline(1:2).eq.'*/') go to 450                                     upd.566 
      call packl(id1,isrc-l+1,label)                                        upd.567 
      ilst=ilst+1                                                           upd.568 
      write (nlst,'(a13,'' --- '',a72,'' '',a7)') label,iline,sname         upd.569 
  450 continue                                                              upd.570 
      go to 490                                                             upd.571 
                                                                            upd.572 
c     ***take lines from "upn" input                                        upd.573 
  460 nkeep=i2-i1+1                                                         upd.574 
      do 470 ii=1,nkeep                                                     upd.575 
      read (ndir,rec=l+i1+ii-2) iline                                       upd.576 
      j=0                                                                   upd.577 
      if(iline(1:1).ne.'c') then                                            upd.578 
         jj=7                                                               upd.579 
         call skipb(iline,jj)                                               upd.580 
         if (iline(jj:jj+6).eq.'program') then                              upd.581 
            j=jj+8                                                          upd.582 
         elseif (iline(jj:jj+9).eq.'subroutine') then                       upd.583 
            j=jj+11                                                         upd.584 
         elseif (iline(jj:jj+7).eq.'function') then                         upd.585 
            j=jj+9                                                          upd.586 
         else                                                               upd.587 
            do 461 jk=jj,nn                                                 upd.588 
            if(iline(jk:jk).eq.' ') go to 462                               upd.589 
  461       continue                                                        upd.590 
            go to 463                                                       upd.591 
  462       call skipb(iline,jk)                                            upd.592 
            if (iline(jk:jk+6).eq.'program') j=jk+8                         upd.593 
            if (iline(jk:jk+9).eq.'subroutine') j=jk+11                     upd.594 
            if (iline(jk:jk+7).eq.'function') j=jk+9                        upd.595 
         endif                                                              upd.596 
      endif                                                                 upd.597 
  463 if (j.eq.0) go to 467                                                 upd.598 
      call skipb(iline,j)                                                   upd.599 
      do 465 jj=j,nn                                                        upd.600 
      k=jj                                                                  upd.601 
      if (iline(jj:jj).eq.'(') go to 466                                    upd.602 
  465 continue                                                              upd.603 
  466 k=k-1                                                                 upd.604 
      sname=iline(j:k)                                                      upd.605 
  467 if (.not.cdeck) go to 470                                             upd.606 
      if (iline(1:2).eq.'*/') go to 470                                     upd.607 
      call packl(id1,i1+ii-1,label)                                         upd.608 
      ilst=ilst+1                                                           upd.609 
      write (nlst,'(a13,'' --- '',a72,'' '',a7)') label,iline,sname         upd.610 
  470 continue                                                              upd.611 
c                                                                           upd.612 
c     ***continue loop over entries in table of active lines                upd.613 
  490 continue                                                              upd.614 
c                                                                         apr93.391 
c     ***list comdecks                                                    apr93.392 
      if(ncdid.ne.0) then                                                 apr93.393 
         do 479 i=1,ncdid                                                 apr93.394 
         cdeck=.true.                                                     apr93.395 
         if(nlistn.ne.0) then                                             apr93.396 
            cdeck=.false.                                                 apr93.397 
            do 471 k=1,nlistn                                             apr93.398 
            if(lnames(k).eq.cdid(i)) cdeck=.true.                         apr93.399 
 471        continue                                                      apr93.400 
         endif                                                            apr93.401 
         if(.not.cdeck) go to 479                                         apr93.402 
         j=iptcd(i)                                                       apr93.403 
         k=lcds(j)                                                        apr93.404 
 472     read(ncdu,rec=k) iline,label                                     apr93.405 
      write (nlst,'(a13,'' --- '',a72,'' '',a7)') label,iline,sname       apr93.406 
         ilst=ilst+1                                                      apr93.407 
         k=k+1                                                            apr93.408 
         if(k.le.lcde(j)) go to 472                                       apr93.409 
         m=lcdn(j)                                                        apr93.410 
         j=m                                                              apr93.411 
         if(m.eq.0) go to 479                                             apr93.412 
         k=lcds(m)                                                        apr93.413 
         go to 472                                                        apr93.414 
 479     continue                                                         apr93.415 
      endif                                                               apr93.416 
      write(iout,'('' upd: lst:'',i6,'' lines written'')') ilst             upd.615 
      close (nlst)                                                          upd.616 
c                                                                           upd.617 
  500 write(iout,'('' upd: complete'')')                                    upd.618 
      end                                                                   upd.619 
c                                                                           upd.620 
      subroutine getopr(i,iline,opr)                                        upd.621 
c     ******************************************************************    upd.622 
c     parse the upd command line for the operation                          upd.623 
c     ******************************************************************    upd.624 
      character*(*) iline,opr                                               upd.625 
c                                                                           upd.626 
      n=len(iline)                                                          upd.627 
  110 if (i.gt.n) go to 120                                                 upd.628 
      if (iline(i:i).eq.' ') go to 120                                      upd.629 
      i=i+1                                                                 upd.630 
      go to 110                                                             upd.631 
  120 opr=iline(1:i-1)                                                      upd.632 
      return                                                                upd.633 
      end                                                                   upd.634 
c                                                                           upd.635 
      subroutine getadr(i,iline,id1,n1,id2,n2)                              upd.636 
c     ******************************************************************    upd.637 
c     parse the upd command line for addresses                              upd.638 
c     ******************************************************************    upd.639 
      common /upd1/ nid,nact,ndecks                                         upd.640 
      character*(*) iline,id1,id2                                           upd.641 
      integer n1,n2                                                         upd.642 
c                                                                           upd.643 
      if(nid-ndecks.eq.0) call error('ident directive missing')             upd.644 
      n=len(iline)                                                          upd.645 
      k=0                                                                   upd.646 
      do 100 j=1,n                                                          upd.647 
      if (iline(j:j).ne.' ') k=j                                            upd.648 
  100 continue                                                              upd.649 
      n=k                                                                   upd.650 
      j=i                                                                   upd.651 
      if (j.gt.n) go to 180                                                 upd.652 
  110 if (iline(j:j).eq.'.') go to 120                                      upd.653 
      if (iline(j:j).eq.' ') i=j+1                                        apr93.418 
      j=j+1                                                                 upd.655 
      go to 110                                                             upd.656 
  120 id1=iline(i:j-1)                                                      upd.657 
      j=j+1                                                                 upd.658 
      i=j                                                                   upd.659 
      n1=0                                                                  upd.660 
  130 if (j.gt.n) go to 190                                                 upd.661 
      m=ichar(iline(j:j))-ichar('0')                                        upd.662 
      if (m.lt.0.or.m.gt.9) go to 140                                       upd.663 
      n1=10*n1+m                                                            upd.664 
      j=j+1                                                                 upd.665 
      go to 130                                                             upd.666 
  140 j=j+1                                                                 upd.667 
      i=j                                                                   upd.668 
      m=ichar(iline(j:j))-ichar('0')                                        upd.669 
      if (m.lt.0.or.m.gt.9) go to 150                                       upd.670 
      id2=id1                                                               upd.671 
      n2=0                                                                  upd.672 
      go to 170                                                             upd.673 
  150 if (iline(j:j).eq.'.') go to 160                                      upd.674 
      if (iline(j:j).eq.' ') i=i+1                                          upd.675 
      j=j+1                                                                 upd.676 
      go to 150                                                             upd.677 
  160 id2=iline(i:j-1)                                                      upd.678 
      j=j+1                                                                 upd.679 
      i=j                                                                   upd.680 
      n2=0                                                                  upd.681 
  170 m=ichar(iline(j:j))-ichar('0')                                        upd.682 
      if (m.lt.0.or.m.gt.9) go to 200                                       upd.683 
      n2=10*n2+m                                                            upd.684 
      j=j+1                                                                 upd.685 
      go to 170                                                             upd.686 
  180 id1=' '                                                               upd.687 
      n1=0                                                                  upd.688 
  190 id2=id1                                                               upd.689 
      n2=n1                                                                 upd.690 
  200 return                                                                upd.691 
      end                                                                   upd.692 
c                                                                           upd.693 
      subroutine before(id1,n1)                                             upd.694 
c     ******************************************************************    upd.695 
c     insert lines before the specified line                                upd.696 
c     ******************************************************************    upd.697 
      character*(*) id1                                                     upd.698 
      integer n1                                                            upd.699 
      common /upd1/ nid,nact,ndecks                                         upd.700 
      common /upd2/ iseq,iseq1                                              upd.701 
      common /upd4/ iact(3,9999)                                          jul97.10 
      character*10 id                                                       upd.703 
      common /upd5/ id(1000)                                                upd.704 
      common /upd6/ lid(1000)                                               upd.705 
c                                                                           upd.706 
c     ***check the insert id string                                         upd.707 
      i1=0                                                                  upd.708 
      do 110 i=1,nid                                                        upd.709 
      if (id1.eq.id(i)) i1=i                                                upd.710 
  110 continue                                                              upd.711 
      if (i1.eq.0) call error('unknown identifier for before')              upd.712 
c                                                                           upd.713 
c     ***check the insert line number                                       upd.714 
      k1=1                                                                  upd.715 
  120 if (i1.eq.iact(1,k1)                                                  upd.716 
     1  .and.n1.ge.iact(2,k1).and.n1.le.iact(3,k1)) go to 130               upd.717 
      k1=k1+1                                                               upd.718 
      if (k1.le.nact) go to 120                                             upd.719 
      call error('line is not active for before')                           upd.720 
c                                                                           upd.721 
c     ***special case for before the first line in a block                  upd.722 
  130 if (n1.gt.iact(2,k1)) go to 160                                       upd.723 
      n=nact-k1+1                                                           upd.724 
      do 150 j=1,n                                                          upd.725 
      k=nact-j+1                                                            upd.726 
      do 140 l=1,3                                                          upd.727 
      iact(l,k+1)=iact(l,k)                                                 upd.728 
  140 continue                                                              upd.729 
  150 continue                                                              upd.730 
      nact=nact+1                                                           upd.731 
      if (nact.gt.9999)                                                   jul97.11 
     1   call error('too many active line entries (9999 max)')            jul97.12 
      iact(1,k1)=nid                                                        upd.734 
      iact(2,k1)=iseq1                                                      upd.735 
      iact(3,k1)=iseq-1                                                     upd.736 
      go to 190                                                             upd.737 
c                                                                           upd.738 
c     ***open up space in the active lines table                            upd.739 
c     ***and fix up the active line data                                    upd.740 
  160 n=nact-k1                                                             upd.741 
      do 180 j=1,n                                                          upd.742 
      k=nact-j+1                                                            upd.743 
      do 170 l=1,3                                                          upd.744 
      iact(l,k+2)=iact(l,k)                                                 upd.745 
  170 continue                                                              upd.746 
  180 continue                                                              upd.747 
      nact=nact+2                                                           upd.748 
      if (nact.gt.9999)                                                   jul97.13 
     1   call error('too many active line entries (9999 max)')            jul97.14 
      iact(1,k1+2)=iact(1,k1)                                               upd.751 
      iact(2,k1+2)=n1                                                       upd.752 
      iact(3,k1+2)=iact(3,k1)                                               upd.753 
      iact(1,k1+1)=nid                                                      upd.754 
      iact(2,k1+1)=iseq1                                                    upd.755 
      iact(3,k1+1)=iseq-1                                                   upd.756 
      iact(3,k1)=n1-1                                                       upd.757 
  190 continue                                                              upd.758 
      return                                                                upd.759 
      end                                                                   upd.760 
c                                                                           upd.761 
      subroutine delete(id1,n1,id2,n2)                                      upd.762 
c     ******************************************************************    upd.763 
c     delete lines, and insert following text (if any)                      upd.764 
c     ******************************************************************    upd.765 
      character*(*) id1,id2                                                 upd.766 
      integer n1,n2                                                         upd.767 
      common /upd1/ nid,nact,ndecks                                         upd.768 
      common /upd2/ iseq,iseq1                                              upd.769 
      common /upd4/ iact(3,9999)                                          jul97.15 
      character*10 id                                                       upd.771 
      common /upd5/ id(1000)                                                upd.772 
      common /upd6/ lid(1000)                                               upd.773 
      character*10 id3                                                      upd.774 
      integer n3                                                            upd.775 
      logical after                                                         upd.776 
c                                                                           upd.777 
c     ***check the two id strings                                           upd.778 
      i1=0                                                                  upd.779 
      i2=0                                                                  upd.780 
      do 110 i=1,nid                                                        upd.781 
      if (id1.eq.id(i)) i1=i                                                upd.782 
      if (id2.eq.id(i)) i2=i                                                upd.783 
  110 continue                                                              upd.784 
      if (i1.eq.0) call error('unknown identifier for delete')              upd.785 
      if (i2.eq.0) call error('unknown identifier for delete')              upd.786 
c                                                                           upd.787 
c     ***check the two line numbers                                         upd.788 
      k1=1                                                                  upd.789 
  120 if (i1.eq.iact(1,k1)                                                  upd.790 
     1   .and.n1.ge.iact(2,k1).and.n1.le.iact(3,k1)) go to 130              upd.791 
      k1=k1+1                                                               upd.792 
      if (k1.le.nact) go to 120                                             upd.793 
      call error('first line for delete is not active')                     upd.794 
  130 k2=k1                                                                 upd.795 
  140 if (i2.eq.iact(1,k2)                                                  upd.796 
     1   .and.n2.ge.iact(2,k2).and.n2.le.iact(3,k2)) go to 150              upd.797 
      k2=k2+1                                                               upd.798 
      if (k2.le.nact) go to 140                                             upd.799 
      call error('second line for delete is not active')                    upd.800 
c                                                                           upd.801 
c     ***do all the special cases                                           upd.802 
  150 if (n1.gt.iact(2,k1)) go to 220                                       upd.803 
      if (n2.lt.iact(3,k2)) go to 180                                       upd.804 
c                                                                           upd.805 
c     ***delete entire blocks                                               upd.806 
      m=k2-k1+1                                                             upd.807 
      n=nact-k1                                                             upd.808 
      if (n.le.0) go to 175                                                 upd.809 
      do 170 i=1,n                                                          upd.810 
      k=k1+i-1                                                              upd.811 
      do 160 j=1,3                                                          upd.812 
      iact(j,k)=iact(j,k+m)                                                 upd.813 
  160 continue                                                              upd.814 
  170 continue                                                              upd.815 
  175 nact=nact-m                                                           upd.816 
      if (k1.le.nact) then                                                  upd.817 
         after=.false.                                                      upd.818 
      else                                                                  upd.819 
         after=.true.                                                       upd.820 
         k1=k1-1                                                            upd.821 
      endif                                                                 upd.822 
      go to 350                                                             upd.823 
c                                                                           upd.824 
c     ***break occurs in second block only                                  upd.825 
  180 m=k2-k1                                                               upd.826 
      n=nact-k1                                                             upd.827 
      if (m.eq.0.or.n.eq.0) go to 210                                       upd.828 
      do 200 i=1,n                                                          upd.829 
      k=k1+i-1                                                              upd.830 
      do 190 j=1,3                                                          upd.831 
      iact(j,k)=iact(j,k+m)                                                 upd.832 
  190 continue                                                              upd.833 
  200 continue                                                              upd.834 
  210 nact=nact-m                                                           upd.835 
      iact(2,k1)=n2+1                                                       upd.836 
      after=.false.                                                         upd.837 
      go to 350                                                             upd.838 
c                                                                           upd.839 
c     ***break occurs in first block only                                   upd.840 
  220 if (k1.ne.k2.or.n2.ne.iact(3,k1)) go to 270                           upd.841 
      m=k2-k1                                                               upd.842 
      n=nact-k1-1                                                           upd.843 
      if (m.eq.0.or.n.eq.0) go to 250                                       upd.844 
      do 240 i=1,n                                                          upd.845 
      k=k1+i                                                                upd.846 
      do 230 j=1,3                                                          upd.847 
      iact(j,k)=iact(j,k+m)                                                 upd.848 
  230 continue                                                              upd.849 
  240 continue                                                              upd.850 
  250 nact=nact-m                                                           upd.851 
      iact(3,k1)=n1-1                                                       upd.852 
      after=.true.                                                          upd.853 
      go to 350                                                             upd.854 
c                                                                           upd.855 
c     ***breaks occcur in the middle of different blocks                    upd.856 
  270 if (k2.eq.k1) go to 310                                               upd.857 
      m=k2-k1-1                                                             upd.858 
      if (m.eq.0) go to 300                                                 upd.859 
      n=nact-k1-m                                                           upd.860 
      do 290 i=1,n                                                          upd.861 
      k=k1+1+(i-1)                                                          upd.862 
      do 280 j=1,3                                                          upd.863 
  280 iact(j,k)=iact(j,k+m)                                                 upd.864 
  290 continue                                                              upd.865 
  300 nact=nact-m                                                           upd.866 
      iact(3,k1)=n1-1                                                       upd.867 
      iact(2,k1+1)=n2+1                                                     upd.868 
      after=.true.                                                          upd.869 
      go to 350                                                             upd.870 
c                                                                           upd.871 
c     ***break occurs in the middle of a single block                       upd.872 
  310 n=nact-k1                                                             upd.873 
      if (n.eq.0) go to 340                                                 upd.874 
      do 330 i=1,n                                                          upd.875 
      k=nact-i+1                                                            upd.876 
      do 320 j=1,3                                                          upd.877 
      iact(j,k+1)=iact(j,k)                                                 upd.878 
  320 continue                                                              upd.879 
  330 continue                                                              upd.880 
  340 nact=nact+1                                                           upd.881 
      if (nact.gt.9999)                                                   jul97.16 
     1   call error('too many active line entries (9999 max)')            jul97.17 
      iact(1,k1+1)=iact(1,k1)                                               upd.884 
      iact(2,k1+1)=n2+1                                                     upd.885 
      iact(3,k1+1)=iact(3,k1)                                               upd.886 
      iact(3,k1)=n1-1                                                       upd.887 
      after=.true.                                                          upd.888 
  350 continue                                                              upd.889 
c                                                                           upd.890 
c     ***insert the additional lines (if any)                               upd.891 
      if (iseq.eq.iseq1) return                                             upd.892 
      if (after) then                                                       upd.893 
         k=iact(1,k1)                                                       upd.894 
         id3=id(k)                                                          upd.895 
         n3=iact(3,k1)                                                      upd.896 
         call insert(id3,n3)                                                upd.897 
      else                                                                  upd.898 
         k=iact(1,k1)                                                       upd.899 
         id3=id(k)                                                          upd.900 
         n3=iact(2,k1)                                                      upd.901 
         call before(id3,n3)                                                upd.902 
      endif                                                                 upd.903 
c                                                                           upd.904 
c     ***finished with delete                                               upd.905 
      return                                                                upd.906 
      end                                                                   upd.907 
c                                                                           upd.908 
      subroutine insert(id1,n1)                                             upd.909 
c     ******************************************************************    upd.910 
c     insert lines                                                          upd.911 
c     ******************************************************************    upd.912 
      character*(*) id1                                                     upd.913 
      integer n1                                                            upd.914 
      common /upd1/ nid,nact,ndecks                                         upd.915 
      common /upd2/ iseq,iseq1                                              upd.916 
      common /upd4/ iact(3,9999)                                          jul97.18 
      character*10 id                                                       upd.918 
      common /upd5/ id(1000)                                                upd.919 
      common /upd6/ lid(1000)                                               upd.920 
c                                                                           upd.921 
c     ***check the insert id string                                         upd.922 
      i1=0                                                                  upd.923 
      do 110 i=1,nid                                                        upd.924 
      if (id1.eq.id(i)) i1=i                                                upd.925 
  110 continue                                                              upd.926 
      if (i1.eq.0) call error('unknown identifier for insert')              upd.927 
c                                                                           upd.928 
c     ***check the insert line number                                       upd.929 
      k1=1                                                                  upd.930 
  120 if (i1.eq.iact(1,k1)                                                  upd.931 
     1  .and.n1.ge.iact(2,k1).and.n1.le.iact(3,k1)) go to 130               upd.932 
      k1=k1+1                                                               upd.933 
      if (k1.le.nact) go to 120                                             upd.934 
      call error('line is not active for insert')                           upd.935 
c                                                                           upd.936 
c     ***special case for insert after last line in block                   upd.937 
  130 if (n1.lt.iact(3,k1)) go to 170                                       upd.938 
      n=nact-k1                                                             upd.939 
      if (n.eq.0) go to 160                                                 upd.940 
      do 150 j=1,n                                                          upd.941 
      k=nact-j+1                                                            upd.942 
      do 140 l=1,3                                                          upd.943 
      iact(l,k+1)=iact(l,k)                                                 upd.944 
  140 continue                                                              upd.945 
  150 continue                                                              upd.946 
  160 nact=nact+1                                                           upd.947 
      if (nact.gt.9999)                                                   jul97.19 
     1   call error('too many active line entries (9999 max)')            jul97.20 
      iact(1,k1+1)=nid                                                      upd.950 
      iact(2,k1+1)=iseq1                                                    upd.951 
      iact(3,k1+1)=iseq-1                                                   upd.952 
      go to 200                                                             upd.953 
c                                                                           upd.954 
c     ***open up space in the active lines table                            upd.955 
c     ***and update the active line entries                                 upd.956 
  170 n=nact-k1+1                                                           upd.957 
      do 190 j=1,n                                                          upd.958 
      k=nact-j+1                                                            upd.959 
      do 180 l=1,3                                                          upd.960 
      iact(l,k+2)=iact(l,k)                                                 upd.961 
  180 continue                                                              upd.962 
  190 continue                                                              upd.963 
      nact=nact+2                                                           upd.964 
      if (nact.gt.9999)                                                   jul97.21 
     1   call error('too many active line entries (9999 max)')            jul97.22 
      iact(1,k1+2)=iact(1,k1)                                               upd.967 
      iact(2,k1+2)=n1+1                                                     upd.968 
      iact(3,k1+2)=iact(3,k1)                                               upd.969 
      iact(1,k1+1)=nid                                                      upd.970 
      iact(2,k1+1)=iseq1                                                    upd.971 
      iact(3,k1+1)=iseq-1                                                   upd.972 
      iact(3,k1)=n1                                                         upd.973 
  200 continue                                                              upd.974 
c                                                                           upd.975 
      return                                                                upd.976 
      end                                                                   upd.977 
c                                                                           upd.978 
      subroutine packl(name,number,label)                                   upd.979 
c     ******************************************************************    upd.980 
c     pack the name and number into an upd identifier                       upd.981 
c     format= <7 chars right justified>.<5 digits left justified>           upd.982 
c     ******************************************************************    upd.983 
      character*(*) name                                                    upd.984 
      integer number                                                        upd.985 
      character*(*) label                                                   upd.986 
      character*5 num                                                       upd.987 
      character*6 blank                                                     upd.988 
c                                                                           upd.989 
      blank='      '                                                        upd.990 
      n=len(name)                                                           upd.991 
      do 110 i=1,n                                                          upd.992 
      j=i                                                                   upd.993 
      if (name(i:i).eq.' ') go to 120                                       upd.994 
  110 continue                                                              upd.995 
  120 j=j-1                                                                 upd.996 
      write (num,'(i5)') number                                             upd.997 
      do 130 i=1,5                                                          upd.998 
      k=i                                                                   upd.999 
      if (num(i:i).ne.' ') go to 140                                        upd.1000
  130 continue                                                              upd.1001
  140 l=7-j                                                                 upd.1002
      if (l.eq.0) then                                                      upd.1003
         label=name(1:7)//'.'//num(k:5)                                     upd.1004
      else                                                                  upd.1005
         label=blank(1:l)//name(1:j)//'.'//num(k:5)                         upd.1006
      endif                                                                 upd.1007
      return                                                                upd.1008
      end                                                                   upd.1009
c                                                                           upd.1010
      subroutine error(mess)                                                upd.1011
c     ******************************************************************    upd.1012
c     fatal error routine                                                   upd.1013
c     ******************************************************************    upd.1014
      character*(*) mess                                                    upd.1015
      common /upd3/ iupn,iout,jupn,kold                                   apr93.420 
c                                                                           upd.1017
      write (iout,'('' upd: fatal error''/                                  upd.1018
     1   '' upd: at upn line number '',i5/                                  upd.1019
     1   '' upd: '',a)') kold,mess                                        apr93.422 
      call abort                                                            upd.1021
      return                                                                upd.1022
      end                                                                   upd.1023
c                                                                           upd.1024
      character*10 function gettok(iline,idx,nn)                            upd.1025
c     ******************************************************************    upd.1026
c     get next token from an input line                                     upd.1027
c     ******************************************************************    upd.1028
      character*72 iline                                                    upd.1029
      character*1 ib,ic                                                     upd.1030
      data ib,ic/' ',','/                                                   upd.1031
c                                                                           upd.1032
      do 110 i=idx,nn                                                       upd.1033
      if(iline(i:i).ne.ib.and.iline(i:i).ne.ic) go to 120                   upd.1034
  110 continue                                                              upd.1035
      gettok=' '                                                            upd.1036
      return                                                                upd.1037
  120 istrt=i                                                               upd.1038
      do 130 i=istrt+1,nn                                                   upd.1039
      if(iline(i:i).eq.ib.or.iline(i:i).eq.ic) go to 140                    upd.1040
  130 continue                                                              upd.1041
      gettok=iline(istrt:nn)                                                upd.1042
      idx=nn+1                                                              upd.1043
      return                                                                upd.1044
  140 gettok=iline(istrt:i-1)                                               upd.1045
      idx=i+1                                                               upd.1046
      return                                                                upd.1047
      end                                                                   upd.1048
c                                                                           upd.1049
      subroutine skipb(iline,j)                                             upd.1050
c     ******************************************************************    upd.1051
c     skip blanks                                                           upd.1052
c     ******************************************************************    upd.1053
      character*72 iline                                                    upd.1054
      nn=len(iline)                                                         upd.1055
      do 110 jj=j,nn                                                        upd.1056
      if (iline(jj:jj).eq.' ') go to 110                                    upd.1057
      j=jj                                                                  upd.1058
      return                                                                upd.1059
  110 continue                                                              upd.1060
      return                                                                upd.1061
      end                                                                   upd.1062
      subroutine getcd(cdnames,cdid,idid,id1,n1,id2,n2)                   apr93.424 
c      ***********************************************************        apr93.425 
c      get index to active list of comdecks for update                    apr93.426 
c      ***********************************************************        apr93.427 
      common /upd7/ lcds(500),lcde(500),lcdn(500),ncmdk,jc,jcd,           apr93.428 
     x iseqs(500),iptcd(100),ncdid,jdx1,jdx2,noid,nlns                    apr93.429 
      common /upd8/ nupn,ncdu                                             apr93.430 
      character*10 cdnames(500),id1,id2,cdid(100),idid                    apr93.431 
      logical noid                                                        apr93.432 
      jdx1=0                                                              apr93.433 
      jdx2=0                                                              apr93.434 
      do 10 i=1,ncmdk                                                     apr93.435 
      if(id1.eq.cdnames(i))then                                           apr93.436 
         if(n1.ge.iseqs(i).and.n1.le.iseqs(i)+(lcde(i)-lcds(i)))then      apr93.437 
            jdx1=i                                                        apr93.438 
            go to 15                                                      apr93.439 
         endif                                                            apr93.440 
      endif                                                               apr93.441 
 10   continue                                                            apr93.442 
 15   if(n2.eq.0) return                                                  apr93.443 
      do 20 i=1,ncmdk                                                     apr93.444 
      if(id2.eq.cdnames(i))then                                           apr93.445 
         if(n2.ge.iseqs(i).and.n2.le.iseqs(i)+(lcde(i)-lcds(i)))then      apr93.446 
           jdx2=i                                                         apr93.447 
           return                                                         apr93.448 
         endif                                                            apr93.449 
      endif                                                               apr93.450 
 20   continue                                                            apr93.451 
      return                                                              apr93.452 
      end                                                                 apr93.453 
c                                                                         apr93.454 
      subroutine fixcd(cdnames,cdid,idid,opn,id1,n1,id2,n2,iline)         apr93.455 
c     ***********************************************************         apr93.456 
c     fix active lists of comdecks to accomodate updates                  apr93.457 
c     ***********************************************************         apr93.458 
      common /upd7/ lcds(500),lcde(500),lcdn(500),ncmdk,jc,jcd,           apr93.459 
     x iseqs(500),iptcd(100),ncdid,jdx1,jdx2,noid,nlns                    apr93.460 
      common /upd8/ nupn,ncdu                                             apr93.461 
      character*10 cdnames(500),id1,id2,cdid(100),opn,idid                apr93.462 
      character*72 iline                                                  apr93.463 
      logical noid                                                        apr93.464 
      isvpt=0                                                             apr93.465 
 10   m=iseqs(jdx1)                                                       apr93.466 
      n=m+(lcde(jdx1)-lcds(jdx1))                                         apr93.467 
 25   if(opn.eq.'*b') then                                                apr93.468 
         if(n1.eq.m) then                                                 apr93.469 
c     *** add block before existing blocks                                apr93.470 
            ncmdk=ncmdk+1                                                 apr93.471 
            iseqs(ncmdk)=jcd +1                                           apr93.472 
            call addblk(cdnames,idid,id1,n1,id2,n2,iline)                 apr93.473 
            if (nlns.eq.0) then                                           apr93.474 
               ncmdk=ncmdk-1                                              apr93.475 
               return                                                     apr93.476 
            endif                                                         apr93.477 
            do 20 i=1,ncmdk-1                                             apr93.478 
            if(lcdn(i).eq.jdx1) then                                      apr93.479 
c     *** fix block that points to this one                               apr93.480 
               lcdn(ncmdk)=lcdn(i)                                        apr93.481 
               lcdn(i)=ncmdk                                              apr93.482 
               return                                                     apr93.483 
            endif                                                         apr93.484 
 20         continue                                                      apr93.485 
c     *** no block pointing to this one so must be first                  apr93.486 
            do 30 i=1,ncdid                                               apr93.487 
            if(isvpt.gt.0) then                                           apr93.488 
               lcdn(ncmdk)=0                                              apr93.489 
               iptcd(isvpt)=ncmdk                                         apr93.490 
               return                                                     apr93.491 
           endif                                                          apr93.492 
           if(jdx1.eq.iptcd(i)) then                                      apr93.493 
               lcdn(ncmdk)=jdx1                                           apr93.494 
               iptcd(i)=ncmdk                                             apr93.495 
               return                                                     apr93.496 
            endif                                                         apr93.497 
 30         continue                                                      apr93.498 
            call error('cant find comdeck reference')                     apr93.499 
         endif                                                            apr93.500 
c      *** add block in middle                                            apr93.501 
         ncmdk=ncmdk+1                                                    apr93.502 
         call addblk(cdnames,idid,id1,n1,id2,n2,iline)                    apr93.503 
         if(nlns.eq.0) then                                               apr93.504 
            ncmdk=ncmdk-1                                                 apr93.505 
            return                                                        apr93.506 
         endif                                                            apr93.507 
         lcdn(ncmdk+1)=lcdn(jdx1)                                         apr93.508 
         lcdn(jdx1)=ncmdk                                                 apr93.509 
         lcdn(ncmdk)=ncmdk+1                                              apr93.510 
         ncmdk=ncmdk+1                                                    apr93.511 
         cdnames(ncmdk)=cdnames(jdx1)                                     apr93.512 
         lcde(ncmdk)=lcde(jdx1)                                           apr93.513 
         lcde(jdx1)=lcds(jdx1)+(n1-iseqs(jdx1)-1)                         apr93.514 
         lcds(ncmdk)=(lcde(jdx1)+1)                                       apr93.515 
         iseqs(jdx1)=n1-1                                                 apr93.516 
         iseqs(ncmdk)=n1                                                  apr93.517 
      endif                                                               apr93.518 
 35   if(opn.eq.'*i') then                                                apr93.519 
         if(n1.eq.n) then                                                 apr93.520 
c      *** add block at end of chain                                      apr93.521 
            ncmdk=ncmdk+1                                                 apr93.522 
            call addblk(cdnames,idid,id1,n1,id2,n2,iline)                 apr93.523 
            if(nlns.eq.0) then                                            apr93.524 
               ncmdk=ncmdk-1                                              apr93.525 
               return                                                     apr93.526 
            endif                                                         apr93.527 
            lcdn(ncmdk)=lcdn(jdx1)                                        apr93.528 
            lcdn(jdx1)=ncmdk                                              apr93.529 
            return                                                        apr93.530 
         endif                                                            apr93.531 
c      *** add block in middle                                            apr93.532 
         ncmdk=ncmdk+1                                                    apr93.533 
         iseqs(ncmdk)=jcd+1                                               apr93.534 
         call addblk(cdnames,idid,id1,n1,id2,n2,iline)                    apr93.535 
         if (nlns.eq.0) then                                              apr93.536 
            ncmdk=ncmdk-1                                                 apr93.537 
            return                                                        apr93.538 
         endif                                                            apr93.539 
         lcdn(ncmdk+1)=lcdn(jdx1)                                         apr93.540 
         lcdn(jdx1)=ncmdk                                                 apr93.541 
         lcdn(ncmdk)=ncmdk+1                                              apr93.542 
         ncmdk=ncmdk+1                                                    apr93.543 
         cdnames(ncmdk)=cdnames(jdx1)                                     apr93.544 
         lcde(ncmdk)=lcde(jdx1)                                           apr93.545 
         lcde(jdx1)=lcds(jdx1)+(n1-iseqs(jdx1))                           apr93.546 
         lcds(ncmdk)=(lcde(jdx1)+1)                                       apr93.547 
         iseqs(jdx1)=n1                                                   apr93.548 
         iseqs(ncmdk)=n1+1                                                apr93.549 
      endif                                                               apr93.550 
      if(opn.eq.'*d') then                                                apr93.551 
         if(jdx1.eq.jdx2) then                                            apr93.552 
c     *** delete is all in one block                                      apr93.553 
            num=lcde(jdx1)-lcds(jdx1)                                     apr93.554 
            if(n1.eq.iseqs(jdx1).and.n2.eq.iseqs(jdx1)+num) then          apr93.555 
               do 40 i=1,ncmdk                                            apr93.556 
               if(lcdn(i).eq.jdx1) then                                   apr93.557 
                  lcdn(i)=lcdn(jdx1)                                      apr93.558 
                  n=iseqs(i)+(lcdn(i)-lcds(i))                            apr93.559 
                  m=iseqs(i)                                              apr93.560 
                  n1=n                                                    apr93.561 
                  opn='*i'                                                apr93.562 
                  go to 35                                                apr93.563 
               endif                                                      apr93.564 
 40            continue                                                   apr93.565 
               do 50 i=1,ncdid                                            apr93.566 
               if(iptcd(i).eq.jdx1) then                                  apr93.567 
                  isvpt=i                                                 apr93.568 
                  iptcd(i)=lcdn(jdx1)                                     apr93.569 
                  n1=iseqs(jdx1)                                          apr93.570 
                  opn='*b'                                                apr93.571 
                  go to 25                                                apr93.572 
               endif                                                      apr93.573 
 50            continue                                                   apr93.574 
               call error('cant find comdeck pointer')                    apr93.575 
            elseif(n1.eq.iseqs(jdx1)) then                                apr93.576 
                  iseqs(jdx1)=n2+1                                        apr93.577 
                  lcds(jdx1)=lcds(jdx1)+(n2-n1+1)                         apr93.578 
                  n1=iseqs(jdx1)                                          apr93.579 
                  opn='*b'                                                apr93.580 
                  go to 10                                                apr93.581 
            elseif(n2.eq.iseqs(jdx1)+num) then                            apr93.582 
               lcde(jdx1)=lcds(jdx1)+(n1-1-m)                             apr93.583 
               n1=n1-1                                                    apr93.584 
               opn='*i'                                                   apr93.585 
               go to 10                                                   apr93.586 
            else                                                          apr93.587 
               lcde(ncmdk+1)=lcde(jdx1)                                   apr93.588 
               lcde(jdx1)=lcds(jdx1)+(n1-iseqs(jdx1)-1)                   apr93.589 
               ncmdk=ncmdk+1                                              apr93.590 
               cdnames(ncmdk)=cdnames(jdx1)                               apr93.591 
               iseqs(ncmdk)=n2+1                                          apr93.592 
               lcdn(ncmdk)=lcdn(jdx1)                                     apr93.593 
               lcdn(jdx1)=ncmdk                                           apr93.594 
               lcds(ncmdk)=lcde(jdx1)+1+n2-n1+1                           apr93.595 
               n1=iseqs(ncmdk)                                            apr93.596 
               opn='*b'                                                   apr93.597 
               jdx1=ncmdk                                                 apr93.598 
               go to 10                                                   apr93.599 
            endif                                                         apr93.600 
         else                                                             apr93.601 
c      *** delete spans blocks                                            apr93.602 
c      *** get rid of full blocks                                         apr93.603 
            num1=lcde(jdx1)-lcds(jdx1)                                    apr93.604 
            num2=lcde(jdx2)-lcds(jdx2)                                    apr93.605 
            j=lcdn(jdx1)                                                  apr93.606 
 60         if(j.ne.jdx2) then                                            apr93.607 
               lcdn(jdx1)=lcdn(j)                                         apr93.608 
               j=lcdn(j)                                                  apr93.609 
               if(j.eq.0) call error('comdeck chain error')               apr93.610 
               go to 60                                                   apr93.611 
            endif                                                         apr93.612 
            if(n1.eq.iseqs(jdx1)) then                                    apr93.613 
c      *** delete first block                                             apr93.614 
               do 70 i=1,ncmdk                                            apr93.615 
               if(lcdn(i).eq.jdx1) then                                   apr93.616 
                  if(n2.eq.iseqs(jdx2)+num2) then                         apr93.617 
                     lcdn(i)=lcdn(jdx2)                                   apr93.618 
                     jdx1=i                                               apr93.619 
                     n1=iseqs(i)+(lcdn(i)-lcde(i))                        apr93.620 
                     go to 10                                             apr93.621 
                  else                                                    apr93.622 
                     lcdn(i)=jdx2                                         apr93.623 
                     iseqs(jdx2)=n2+1                                     apr93.624 
                     lcds(jdx2)=lcds(jdx2)+n2-iseqs(jdx2)+1               apr93.625 
                     n1=n2+1                                              apr93.626 
                     jdx1=jdx2                                            apr93.627 
                     opn='*b'                                             apr93.628 
                     go to 10                                             apr93.629 
                  endif                                                   apr93.630 
               endif                                                      apr93.631 
 70            continue                                                   apr93.632 
               do 80 i=1,ncdid                                            apr93.633 
               if(iptcd(i).eq.jdx1) then                                  apr93.634 
                  if(n2.eq.iseqs(jdx2)+num2) then                         apr93.635 
                    isvpt=i                                               apr93.636 
                     iptcd(i)=lcdn(jdx2)                                  apr93.637 
                     jdx1=jdx2                                            apr93.638 
                     opn='*b'                                             apr93.639 
                     n1=iseqs(jdx1)                                       apr93.640 
                     go to 10                                             apr93.641 
                  else                                                    apr93.642 
                     iptcd(i)=jdx2                                        apr93.643 
                     iseqs(jdx2)=n2+1                                     apr93.644 
                     lcds(jdx2)=lcds(jdx2)+n2-iseqs(jdx2)+1               apr93.645 
                     jdx1=jdx2                                            apr93.646 
                     n1=n2+1                                              apr93.647 
                     opn='*b'                                             apr93.648 
                     go to 10                                             apr93.649 
                  endif                                                   apr93.650 
               endif                                                      apr93.651 
 80            continue                                                   apr93.652 
               call error('comdeck chain error')                          apr93.653 
            else                                                          apr93.654 
               if(n2.eq.iseqs(jdx2)+num2) then                            apr93.655 
                  lcdn(jdx1)=lcdn(jdx2)                                   apr93.656 
                  lcde(jdx1)=lcds(jdx1)+(n1-iseqs(jdx1)-1)                apr93.657 
                  n1=n1-1                                                 apr93.658 
                  opn='*i'                                                apr93.659 
                  n=n1                                                    apr93.660 
                  go to 35                                                apr93.661 
               else                                                       apr93.662 
                  lcde(jdx1)=lcds(jdx1)+(n1-iseqs(jdx1)-1)                apr93.663 
                  lcdn(jdx1)=jdx2                                         apr93.664 
                  lcds(jdx2)=lcds(jdx2)+n2-iseqs(jdx2)+1                  apr93.665 
                  iseqs(jdx2)=n2+1                                        apr93.666 
                  n1=n1-1                                                 apr93.667 
                  opn='*i'                                                apr93.668 
                  n=n1                                                    apr93.669 
                  go to 35                                                apr93.670 
               endif                                                      apr93.671 
           endif                                                          apr93.672 
        endif                                                             apr93.673 
      endif                                                               apr93.674 
      end                                                                 apr93.675 
      subroutine addblk(cdnames,idid,id1,n1,id2,n2,kline)                 apr93.676 
c      **********************************************************         apr93.677 
c      add a block to the active list of comdecks                         apr93.678 
c      **********************************************************         apr93.679 
      common /upd3/ iupn,iout,jupn,kold                                   apr93.680 
      common /upd7/ lcds(500),lcde(500),lcdn(500),ncmdk,jc,jcd,           apr93.681 
     x iseqs(500),iptcd(100),ncdid,jdx1,jdx2,noid,nlns                    apr93.682 
      common /upd8/ nupn,ncdu                                             apr93.683 
      character*10 cdnames(500),idid                                      apr93.684 
      logical noid                                                        apr93.685 
      character*72 kline                                                  apr93.686 
      character*10 label                                                  apr93.687 
      lcds(ncmdk)=jc+1                                                    apr93.688 
      nlns=0                                                              apr93.689 
      cdnames(ncmdk)=idid                                                 apr93.690 
 10   read(nupn,'(a)',end=100) kline                                      apr93.691 
      jupn=jupn+1                                                         apr93.692 
      if(kline(1:1).eq.'*') then                                          apr93.693 
         lcde(ncmdk)=jc                                                   apr93.694 
         return                                                           apr93.695 
      else                                                                apr93.696 
         iupn=iupn +1                                                     apr93.697 
         jc=jc+1                                                          apr93.698 
         nlns=nlns+1                                                      apr93.699 
         jcd=jcd+1                                                        apr93.700 
         if(noid) then                                                    apr93.701 
            label=' '                                                     apr93.702 
         else                                                             apr93.703 
            call packl(idid,jcd,label)                                    apr93.704 
         endif                                                            apr93.705 
         write(ncdu,rec=jc) kline,label                                   apr93.706 
         go to 10                                                         apr93.707 
      endif                                                               apr93.708 
 100  lcde(ncmdk)=jc                                                      apr93.709 
      return                                                              apr93.710 
      end                                                                 apr93.711 
