c    @(#)poisgn.f	1.3
c
      subroutine poisgn (nperod,n,iflag,m,ba,bb,bc,idimq,q,twocos,b,t,
     1                   d,w,tri)
	external tri
      dimension ba(m),bb(m),bc(m),q(idimq,n),
     1          twocos(6*n+5*m),b(m),t(m),d(6*n+5*m),
     2          w(6*n+5*m)
      if (iflag.ne.0) go to 101
      call poinit (nperod,m,n,iex2,iex3,iex5,n2pw,n2p3p,n2p3p5,ks3,ks5,
     1             twocos)
  101 mm1 = m-1
          do 106 j=1,n
              do 103 i=1,m
  102         b(i) = -q(i,j)
  103         continue
          call tri (1,1,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
              do 105 i=1,m
  104         q(i,j) = b(i)
  105         continue
  106     continue
      np = 1
  107 if (iex2.eq.0) go to 118
      l = iex2
      if (iex3+iex5.ne.0) go to 108
      if (nperod.eq.1) l = l-1
      if (l.eq.0) go to 156
  108     do 117 kount=1,l
          k = np
          np = 2*np
          k2 = np-1
          k3 = np
          k4 = 2*np-1
          jstart = np
          if (nperod.eq.3) jstart = 1
              do 116 j=jstart,n,np
              jm1 = j-k
              jp1 = j+k
              if (j.eq.1) jm1 = jp1
              if (j.ne.n) go to 109
              jp1 = jm1
              if (nperod.eq.0) jp1 = k
  109             do 111 i=1,m
  110             b(i) = q(i,jm1)+q(i,jp1)
  111             continue
              call tri (k,k2,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 113 i=1,m
                  t(i) = q(i,j)+b(i)
  112             b(i) = t(i)
  113             continue
              call tri (k3,k4,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 115 i=1,m
  114             q(i,j) = t(i)+2.*b(i)
  115             continue
  116         continue
  117     continue
  118 if (iex3.eq.0) go to 134
      l = iex3
      if (iex5.ne.0) go to 119
      if (nperod.eq.1) l = l-1
      if (l.eq.0) go to 156
  119 k2 = np-1
          do 133 kount=1,l
          k = np
          np = 3*np
          k1 = k2+1
          k2 = k2+k
          k3 = k2+1
          k4 = k2+np
          jstart = np
          if (nperod.eq.3) jstart = 1
              do 132 j=jstart,n,np
              if (j.ne.1) go to 120
              jm1 = j+k
              jm2 = jm1+k
              go to 122
  120         jm1 = j-k
              jm2 = jm1-k
              if (j.ne.n) go to 122
              if (nperod.eq.0) go to 121
              jp1 = jm1
              jp2 = jm2
              go to 123
  121         jp1 = k
              jp2 = jp1+k
              go to 123
  122         jp1 = j+k
              jp2 = jp1+k
  123             do 125 i=1,m
  124             b(i) = 2.*q(i,j)+q(i,jm2)+q(i,jp2)
  125             continue
              call tri (k1,k2,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 127 i=1,m
                  t(i) = b(i)+q(i,jm1)+q(i,jp1)
  126             b(i) = t(i)
  127             continue
              call tri (k1,k2,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 129 i=1,m
                  q(i,j) = q(i,j)+b(i)
  128             b(i) = t(i)
  129             continue
              call tri (k3,k4,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 131 i=1,m
  130             q(i,j) = q(i,j)+3.*b(i)
  131             continue
  132         continue
  133     continue
  134 l = iex5
  135 if (nperod.eq.1) l = l-1
      if (l.le.0) go to 156
      k2 = (n2pw+n2p3p)/2-1
          do 155 kount=1,l
          k = np
          np = 5*np
          k1 = k2+1
          k2 = k2+k
          k3 = k2+1
          k4 = k2+np
          jstart = np
          if (nperod.eq.3) jstart = 1
              do 154 j=jstart,n,np
              if (j.ne.1) go to 136
              jm1 = j+k
              jm2 = jm1+k
              jm3 = jm2+k
              jm4 = jm3+k
              go to 138
  136         jm1 = j-k
              jm2 = jm1-k
              jm3 = jm2-k
              jm4 = jm3-k
              if (j.ne.n) go to 138
              if (nperod.eq.0) go to 137
              jp1 = jm1
              jp2 = jm2
              jp3 = jm3
              jp4 = jm4
              go to 139
  137         jp1 = k
              jp2 = jp1+k
              jp3 = jp2+k
              jp4 = jp3+k
              go to 139
  138         jp1 = j+k
              jp2 = jp1+k
              jp3 = jp2+k
              jp4 = jp3+k
  139             do 141 i=1,m
  140             b(i) = 6.*q(i,j)+4.*(q(i,jm2)+q(i,jp2))+q(i,jm4)+
     1                   q(i,jp4)
  141             continue
              call tri (k1,k2,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 143 i=1,m
  142             b(i) = b(i)+3.*(q(i,jm1)+q(i,jp1))+q(i,jm3)+q(i,jp3)
  143             continue
              call tri (k1,k2,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 145 i=1,m
                  t(i) = b(i)
  144             b(i) = 2.*q(i,j)+q(i,jm2)+q(i,jp2)+b(i)
  145             continue
              call tri (k1,k2,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 147 i=1,m
  146             b(i) = b(i)+q(i,jm1)+q(i,jp1)
  147             continue
              call tri (k1,k2,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 149 i=1,m
                  temp = b(i)+q(i,j)
                  b(i) = 4.*q(i,j)+3.*(q(i,jm2)+q(i,jp2))+q(i,jm4)+
     1                   q(i,jp4)-t(i)
  148             q(i,j) = temp
  149             continue
              call tri (k1,k2,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 151 i=1,m
  150             b(i) = b(i)+2.*(q(i,jm1)+q(i,jp1))+q(i,jm3)+q(i,jp3)
  151             continue
              call tri (k3,k4,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 153 i=1,m
  152             q(i,j) = q(i,j)+5.*b(i)
  153             continue
  154         continue
  155     continue
  156 if (nperod.eq.1.or.nperod.eq.2) go to 171
      if (nperod.eq.0) go to 161
          do 158 i=1,m
  157     b(i) = 2.*q(i,1)
  158     continue
      call tri (k3,k4,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
          do 160 i=1,m
          q(i,n) = q(i,n)+b(i)
  159     b(i) = 4.*q(i,n)
  160     continue
      call tri (k4+1,k4+2*np-1,2,m,n,mm1,ba,bb,bc,b,twocos,d,w)
      go to 164
  161     do 163 i=1,m
  162     b(i) = 2.*q(i,n)
  163     continue
      call tri (k4+1,k4+np-1,2,m,n,mm1,ba,bb,bc,b,twocos,d,w)
  164     do 166 i=1,m
  165     q(i,n) = q(i,n)+b(i)
  166     continue
      if (nperod.eq.0) go to 171
          do 168 i=1,m
  167     b(i) = 2.*q(i,n)
  168     continue
      call tri (k3,k4,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
          do 170 i=1,m
  169     q(i,1) = q(i,1)+b(i)
  170     continue
  171 continue
      if (iex5.eq.0) go to 209
      np = n2p3p5
      k8 = ks5
      if (nperod.eq.1) k3 = k3+np/5
          do 208 kount=1,iex5
          k = np
          np = np/5
          k4 = k3-1
          k3 = k3-np
          k1 = k8+1
          k2 = k8+2*np
          k5 = k2+1
          k6 = k2+4*np
          k7 = k6+1
          k8 = k6+2*np
          jstart = np
          if (nperod.eq.3) jstart = 1+np
              do 207 j=jstart,n,k
              jm1 = j-np
              jp1 = j+np
              jp2 = jp1+np
              jp3 = jp2+np
              jp4 = jp3+np
              if (jm1.ne.0) go to 177
              if (nperod.eq.0) go to 174
                  do 173 i=1,m
  172             b(i) = q(i,jp1)
  173             continue
              go to 180
  174             do 176 i=1,m
  175             b(i) = q(i,jp1)+q(i,n)
  176             continue
              go to 180
  177             do 179 i=1,m
  178             b(i) = q(i,jp1)+q(i,jm1)
  179             continue
  180         call tri (k3,k4,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 182 i=1,m
                  q(i,j) = q(i,j)+b(i)
  181             b(i) = q(i,jp1)+q(i,jp3)
  182             continue
              call tri (k3,k4,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 184 i=1,m
  183             q(i,jp2) = q(i,jp2)+b(i)
  184             continue
              if (jp4.gt.n) go to 187
                  do 186 i=1,m
  185             b(i) = 2.*q(i,jp2)+q(i,j)+q(i,jp4)
  186             continue
              go to 190
  187             do 189 i=1,m
  188             b(i) = 2.*q(i,jp2)+q(i,j)
  189             continue
  190         call tri (k1,k2,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 192 i=1,m
                  q(i,jp2) = q(i,jp2)+b(i)
  191             b(i) = q(i,jp2)+q(i,j)
  192             continue
              call tri (k5,k6,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 194 i=1,m
                  q(i,jp2) = q(i,jp2)+b(i)
  193             b(i) = q(i,j)+q(i,jp2)
  194             continue
              call tri (k7,k8,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 196 i=1,m
                  q(i,j) = q(i,j)+b(i)
  195             b(i) = q(i,j)+q(i,jp2)
  196             continue
              call tri (k3,k4,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 198 i=1,m
  197             q(i,jp1) = q(i,jp1)+b(i)
  198             continue
              if (jp4.gt.n) go to 201
                  do 200 i=1,m
  199             b(i) = q(i,jp2)+q(i,jp4)
  200             continue
              go to 204
  201             do 203 i=1,m
  202             b(i) = q(i,jp2)
  203             continue
  204         call tri (k3,k4,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 206 i=1,m
  205             q(i,jp3) = q(i,jp3)+b(i)
  206             continue
  207         continue
  208     continue
  209 if (iex3.eq.0) go to 239
      np = n2p3p
      k2 = ks3
      if (nperod.eq.1.and.iex5.eq.0) k3 = k3+np/3
          do 238 kount=1,iex3
          k = np
          np = np/3
          k4 = k3-1
          k3 = k3-np
          k1 = k2+1
          k2 = k2+2*np
          jstart = np
          if (nperod.eq.3) jstart = np+1
              do 237 j=jstart,n,k
              jm1 = j-np
              jp1 = j+np
              jp2 = jp1+np
              if (jm1.eq.0) go to 212
                  do 211 i=1,m
  210             b(i) = q(i,jp1)+q(i,jm1)
  211             continue
              go to 218
  212         if (nperod.eq.0) go to 215
                  do 214 i=1,m
  213             b(i) = q(i,jp1)
  214             continue
              go to 218
  215             do 217 i=1,m
  216             b(i) = q(i,jp1)+q(i,n)
  217             continue
  218         call tri (k3,k4,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 220 i=1,m
  219             q(i,j) = q(i,j)+b(i)
  220             continue
              if (jp2.gt.n) go to 223
                  do 222 i=1,m
  221             b(i) = q(i,j)+q(i,jp2)
  222             continue
              go to 226
  223             do 225 i=1,m
  224             b(i) = q(i,j)
  225             continue
  226         call tri (k1,k2,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 228 i=1,m
  227             q(i,j) = q(i,j)+b(i)
  228             continue
              if (jp2.gt.n) go to 231
                  do 230 i=1,m
  229             b(i) = q(i,j)+q(i,jp2)
  230             continue
              go to 234
  231             do 233 i=1,m
  232             b(i) = q(i,j)
  233             continue
  234         call tri (k3,k4,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 236 i=1,m
  235             q(i,jp1) = q(i,jp1)+b(i)
  236             continue
  237         continue
  238     continue
  239 if (iex2.eq.0) go to 254
      np = n2pw
          do 253 kount=1,iex2
          k = np
          np = np/2
          k3 = k-1
          jstart = np
          if (nperod.eq.3) jstart = 1+np
              do 252 j=jstart,n,k
              jm1 = j-np
              jp1 = j+np
              if (jm1.ne.0) go to 243
              if (jp1.gt.n) go to 252
              if (nperod.eq.1.or.nperod.eq.2) go to 240
              jm1 = n
              go to 246
  240             do 242 i=1,m
  241             b(i) = q(i,jp1)
  242             continue
              go to 249
  243         if (jp1.le.n) go to 246
                  do 245 i=1,m
  244             b(i) = q(i,jm1)
  245             continue
              go to 249
  246             do 248 i=1,m
  247             b(i) = q(i,jm1)+q(i,jp1)
  248             continue
  249         call tri (np,k3,1,m,n,mm1,ba,bb,bc,b,twocos,d,w)
                  do 251 i=1,m
  250             q(i,j) = q(i,j)+b(i)
  251             continue
  252         continue
  253     continue
  254 return
      end
