c    @(#)pwscrt.f	1.2
c
      subroutine pwscrt (intl,a,b,m,mbdcnd,bda,bdb,c,d,n,nbdcnd,bdc,
     1                   bdd,elmbda,f,idimf,pertrb,ierror,w)
      dimension bda(n+1)     ,bdb(n+1)     ,bdc(m+1)     ,bdd(m+1)     ,
     1          f(idimf,n+1) ,w(6*n+8*m)
      ierror = 0
      if (a.ge.b) ierror = 1
      if (mbdcnd.lt.0.or.mbdcnd.gt.4) ierror = 2
      if (c.ge.d) ierror = 3
      if (ncheck(n).gt.1.or.n.le.2) ierror = 4
      if (nbdcnd.lt.0.or.nbdcnd.gt.4) ierror = 5
      if (ierror.ne.0) return
  101 nperod = nbdcnd
      nby2 = 0
      deltax = (b-a)/m
      twdelx = 2./deltax
      delxsq = 1./deltax**2
      deltay = (d-c)/n
      twdely = 2./deltay
      delysq = 1./deltay**2
      np = nbdcnd+1
      np1 = n+1
      mp = mbdcnd+1
      mp1 = m+1
      nstart = 1
      nstop = n
      nskip = 1
      go to (105,102,103,104,105),np
  102 nstart = 2
      go to 105
  103 nstart = 2
  104 nstop = np1
      nskip = 2
  105 nunk = nstop-nstart+1
      mstart = 1
      mstop = m
      mskip = 1
      go to (122,106,107,111,112),mp
  106 mstart = 2
      go to 108
  107 mstart = 2
      mstop = mp1
      mskip = 2
  108     do 110 j=nstart,nstop
  109     f(2,j) = f(2,j)-f(1,j)*delxsq
  110     continue
      go to 115
  111 mstop = mp1
      mskip = 2
  112     do 114 j=nstart,nstop
  113     f(1,j) = f(1,j)+bda(j)*twdelx
  114     continue
  115 go to (116,119),mskip
  116     do 118 j=nstart,nstop
  117     f(m,j) = f(m,j)-f(mp1,j)*delxsq
  118     continue
      go to 122
  119     do 121 j=nstart,nstop
  120     f(mp1,j) = f(mp1,j)-bdb(j)*twdelx
  121     continue
  122 munk = mstop-mstart+1
      go to (136,123,123,126,126),np
  123     do 125 i=mstart,mstop
  124     f(i,2) = f(i,2)-f(i,1)*delysq
  125     continue
      go to 129
  126     do 128 i=mstart,mstop
  127     f(i,1) = f(i,1)+bdc(i)*twdely
  128     continue
  129 go to (130,133),nskip
  130     do 132 i=mstart,mstop
  131     f(i,n) = f(i,n)-f(i,np1)*delysq
  132     continue
      go to 136
  133     do 135 i=mstart,mstop
  134     f(i,np1) = f(i,np1)-bdd(i)*twdely
  135     continue
  136 delysq = deltay*deltay
          do 139 i=mstart,mstop
              do 138 j=nstart,nstop
  137         f(i,j) = f(i,j)*delysq
  138         continue
  139     continue
  140 id1 = 5.25*nunk+5*munk
      id2 = id1+munk
      id3 = id2+munk
      id4 = id3+munk
      s = delysq*delxsq
      st2 = 2.*s
          do 142 i=1,munk
          w(id1+i) = s
          w(id2+i) = -st2+elmbda*delysq
  141     w(id3+i) = s
  142     continue
      go to (146,146,143,144,145),mp
  143 w(id2) = st2
      go to 146
  144 w(id2) = st2
  145 w(id3+1) = st2
  146 continue
      if (nbdcnd.ne.4) go to 151
      irev = 1
      nperod = 2
      nby2 = n/2
  147     do 150 j=1,nby2
              do 149 i=mstart,mstop
              a1 = f(i,j)
              f(i,j) = f(i,n+1-j)
  148         f(i,n+1-j) = a1
  149         continue
  150     continue
      go to (164,168),irev
  151 continue
      if (elmbda) 164,153,152
  152 ierror = 6
      go to 164
  153 if ((nbdcnd.eq.0.or.nbdcnd.eq.3).and.(mbdcnd.eq.0.or.mbdcnd.eq.3))
     1    go to 154
      go to 164
  154 a1 = 1.
      a2 = 1.
      if (nbdcnd.eq.3) a2 = 2.
      if (mbdcnd.eq.3) a1 = 2.
      s1 = 0.
      msp1 = mstart+1
      mstm1 = mstop-1
      nsp1 = nstart+1
      nstm1 = nstop-1
          do 158 j=nsp1,nstm1
          s = 0.
              do 156 i=msp1,mstm1
  155         s = s+f(i,j)
  156         continue
  157     s1 = s1+s*a1+f(mstart,j)+f(mstop,j)
  158     continue
      s1 = a2*s1
      s = 0.
          do 160 i=msp1,mstm1
  159     s = s+f(i,nstart)+f(i,nstop)
  160     continue
      s1 = s1+s*a1+f(mstart,nstart)+f(mstart,nstop)+f(mstop,nstart)+
     1     f(mstop,nstop)
      s = (2.+(nunk-2)*a2)*(2.+(munk-2)*a1)
      pertrb = s1/s
          do 163 j=nstart,nstop
              do 162 i=mstart,mstop
  161         f(i,j) = f(i,j)-pertrb
  162         continue
  163     continue
      pertrb = pertrb/delysq
  164 call pois (intl,nperod,nunk,mbdcnd,munk,w(id1+1),w(id2+1),
     1           w(id3+1),idimf,f(mstart,nstart),w)
      if (nby2.eq.0) go to 165
      irev = 2
      go to 147
  165 continue
      if (nbdcnd.ne.0) go to 168
          do 167 i=mstart,mstop
  166     f(i,np1) = f(i,1)
  167     continue
  168 if (mbdcnd.ne.0) go to 171
          do 170 j=nstart,nstop
  169     f(mp1,j) = f(1,j)
  170     continue
      if (nbdcnd.eq.0) f(mp1,np1) = f(1,np1)
  171 continue
      return
      end
