DO np = 2, nPx*nPy

           pId = np - 1

              tN = W2_procTileList(bi,bj,np)

         DO np = 2, nPx*nPy

           pId = np - 1

              tN = W2_procTileList(bi,bj,np)

      INTEGER np, pId

      INTEGER np, ii, jj, bi, bj

         DO np=1,nPx*nPy

           W2_procTileList(bi,bj,np) = 0

        np = 1 + jj/nSy + (ii/nSx)*nPy

        W2_tileProc(I) = np

        W2_procTileList(bi,bj,np) = I

        IF ( np.EQ.thisProc ) W2_myTileList(bi,bj) = I

            np(1) = ns

            np(2) = ns

            np(3) = ns

            np(4) = ns

            it = exch2_neighbourId (np(i),ip(i))

            nt = exch2_opposingSend(np(i),ip(i))

     &      ' : pij=', (exch2_pij(k,np(i),ip(i)),k=1,4),

     &      ' ; oi,oj=',exch2_oi(np(i),ip(i)),exch2_oj(np(i),ip(i))

      INTEGER ip(4), np(4)

            it = exch2_neighbourId (np(i),ip(i))

            nt = exch2_opposingSend(np(i),ip(i))

     &      ' : pij=', (exch2_pij(k,np(i),ip(i)),k=1,4),

     &      ' ; oi,oj=',exch2_oi(np(i),ip(i)),exch2_oj(np(i),ip(i))

            np(i) = 0

       do k=1,np

         blayer(i,j,np+1)= ( ts(i,j)*(ts(i,j)*(ts(i,j)

       do k=1,np+1

        call COLUMN(m,n,np,pa,dt,dco2,sco3,scopre,scotem)

        call COLUMN(m,n,np,pa,dt,do3,sco3,scopre,scotem)

       do k= 1, np

       do k= 1, np

        call H2OEXPS(ib,m,n,np,dh2o,pa,dt,xkw,aw,bw,pm,mw,h2oexp)

        call CONEXPS(ib,m,n,np,dcont,xke,conexp)

        call CO2EXPS(m,n,np,dco2,pa,dt,co2exp)

        call N2OEXPS(ib,m,n,np,dn2o,pa,dt,n2oexp)

        call CH4EXPS(ib,m,n,np,dch4,pa,dt,ch4exp)

        call COMEXPS(ib,m,n,np,dco2,dt,comexp)

        call CFCEXPS(ib,m,n,np,a1,b1,fk1,a2,b2,fk2,df11,dt,f11exp)

        call CFCEXPS(ib,m,n,np,a1,b1,fk1,a2,b2,fk2,df12,dt,f12exp)

        call CFCEXPS(ib,m,n,np,a1,b1,fk1,a2,b2,fk2,df22,dt,f22exp)

        call B10EXPS(m,n,np,dh2o,dcont,dco2,dn2o,pa,dt

      do k=1,np+1

      do 2000 k1=1,np

      do 3000 k2=k1+1,np+1

           call TABLUP(k1,k2,m,n,np,nx,nh,nt,sh2o,swpre,swtem,

           call TABLUP(k1,k2,m,n,np,nx,nh,nt,sh2o,swpre,swtem,

           call TABLUP(k1,k2,m,n,np,nx,nh,nt,sh2o,swpre,swtem,

        call H2OKDIS(ib,m,n,np,k2-1,fkw,gkw,ne,h2oexp,conexp,

          call TABLUP(k1,k2,m,n,np,nx,nc,nt,sco3,scopre,scotem,

          call CO2KDIS(m,n,np,k2-1,co2exp,tco2,trant)

          call TABLUP(k1,k2,m,n,np,nx,no,nt,sco3,scopre,scotem,

          call N2OKDIS(ib,m,n,np,k2-1,n2oexp,tn2o,trant)

          call CH4KDIS(ib,m,n,np,k2-1,ch4exp,tch4,trant)

          call COMKDIS(ib,m,n,np,k2-1,comexp,tcom,trant)

          call CFCKDIS(m,n,np,k2-1,f11exp,tf11,trant)

          call CFCKDIS(m,n,np,k2-1,f12exp,tf12,trant)

          call CFCKDIS(m,n,np,k2-1,f22exp,tf22,trant)

          call B10KDIS(m,n,np,k2-1,h2oexp,conexp,co2exp,n2oexp

          flcu(i,j,np+1)=flcu(i,j,np+1)-blayer(i,j,np+1)

          flxu(i,j,np+1)=flxu(i,j,np+1)-blayer(i,j,np+1)

          st4(i,j)=st4(i,j)-blayer(i,j,np+1)

          dfdts(i,j,np+1)=dfdts(i,j,np+1)-dbs(i,j)

        do k=1, np+1

     *           flcd(i,j,np+1)*trantcr(i,j,k)*(1.-emiss(i,j,ib))

     *           flxd(i,j,np+1)*transfc(i,j,k)*(1.-emiss(i,j,ib))

      do k=1,np+1

      do k=1,np+1

      subroutine COLUMN (m,n,np,pa,dt,sabs0,sabs,spre,stem)

      integer m,n,np,i,j,k

      _RL pa(m,n,np),dt(m,n,np),sabs0(m,n,np)

      _RL sabs(m,n,np+1),spre(m,n,np+1),stem(m,n,np+1)

        do k=1,np

      subroutine H2OEXPS(ib,m,n,np,dh2o,pa,dt,xkw,aw,bw,pm,mw,h2oexp)

      integer ib,m,n,np,i,j,k,ik

      _RL dh2o(m,n,np),pa(m,n,np),dt(m,n,np)

      _RL h2oexp(m,n,np,6)

        do k=1,np

          do k=1,np

          do k=1,np

          do k=1,np

          do k=1,np

      subroutine CONEXPS(ib,m,n,np,dcont,xke,conexp)

      integer ib,m,n,np,i,j,k,iq

      _RL dcont(m,n,np)

      _RL conexp(m,n,np,3)

        do k=1,np

         do k=1,np

      subroutine CO2EXPS(m,n,np,dco2,pa,dt,co2exp)

      integer m,n,np,i,j,k

      _RL dco2(m,n,np),pa(m,n,np),dt(m,n,np)

      _RL co2exp(m,n,np,6,2)

        do k=1,np

      subroutine N2OEXPS(ib,m,n,np,dn2o,pa,dt,n2oexp)

      integer ib,m,n,np,i,j,k

      _RL dn2o(m,n,np),pa(m,n,np),dt(m,n,np)

      _RL n2oexp(m,n,np,4)

       do k=1,np

      subroutine CH4EXPS(ib,m,n,np,dch4,pa,dt,ch4exp)

      integer ib,m,n,np,i,j,k

      _RL dch4(m,n,np),pa(m,n,np),dt(m,n,np)

      _RL ch4exp(m,n,np,4)

       do k=1,np

      subroutine COMEXPS(ib,m,n,np,dcom,dt,comexp)

      integer ib,m,n,np,i,j,k

      _RL dcom(m,n,np),dt(m,n,np)

      _RL comexp(m,n,np,2)

       do k=1,np

      subroutine CFCEXPS(ib,m,n,np,a1,b1,fk1,a2,b2,fk2,dcfc,dt,cfcexp)

      integer ib,m,n,np,i,j,k

      _RL dcfc(m,n,np),dt(m,n,np)

      _RL cfcexp(m,n,np)

       do k=1,np

      subroutine B10EXPS(m,n,np,dh2o,dcont,dco2,dn2o,pa,dt

      integer m,n,np,i,j,k

      _RL dh2o(m,n,np),dcont(m,n,np),dn2o(m,n,np)

      _RL dco2(m,n,np),pa(m,n,np),dt(m,n,np)

      _RL h2oexp(m,n,np,6),conexp(m,n,np,3),co2exp(m,n,np,6,2)

     *    ,n2oexp(m,n,np,4)

        do k=1,np

      subroutine TABLUP(k1,k2,m,n,np,nx,nh,nt,sabs,spre,stem,w1,p1,

      integer k1,k2,m,n,np,nx,nh,nt,i,j

      _RL sabs(m,n,np+1),spre(m,n,np+1),stem(m,n,np+1)

      subroutine H2OKDIS(ib,m,n,np,k,fkw,gkw,ne,h2oexp,conexp,

      integer ib,m,n,np,k,i,j

      _RL conexp(m,n,np,3),h2oexp(m,n,np,6)

      subroutine CO2KDIS(m,n,np,k,co2exp,tco2,tran)

      integer m,n,np,k,i,j

      _RL co2exp(m,n,np,6,2)

      subroutine N2OKDIS(ib,m,n,np,k,n2oexp,tn2o,tran)

      integer ib,m,n,np,k,i,j

      _RL n2oexp(m,n,np,4)

      subroutine CH4KDIS(ib,m,n,np,k,ch4exp,tch4,tran)

      integer ib,m,n,np,k,i,j

      _RL ch4exp(m,n,np,4)

      subroutine COMKDIS(ib,m,n,np,k,comexp,tcom,tran)

      integer ib,m,n,np,k,i,j

      _RL comexp(m,n,np,2)

      subroutine CFCKDIS(m,n,np,k,cfcexp,tcfc,tran)

      integer m,n,np,k,i,j

      _RL cfcexp(m,n,np)

      subroutine B10KDIS(m,n,np,k,h2oexp,conexp,co2exp,n2oexp

      integer m,n,np,k,i,j

      _RL h2oexp(m,n,np,6),conexp(m,n,np,3),co2exp(m,n,np,6,2)

     *    ,n2oexp(m,n,np,4)

      subroutine IRRAD (m,n,ndim,np,pl,ta,wa,oa,ts,co2,

      integer m,n,ndim,np,ict,icb

      _RL pl(m,ndim,np+1),ta(m,ndim,np),wa(m,ndim,np),oa(m,ndim,np),

      _RL co2,n2o(np),ch4(np),cfc11,cfc12,cfc22,emiss(m,ndim,10)

      _RL cwc(m,ndim,np,3),taucl(m,ndim,np,3),reff(m,ndim,np,3),

     *     fcld(m,ndim,np)

      _RL taual(m,ndim,np,10),ssaal(m,ndim,np,10),asyal(m,ndim,np,10)

      _RL flx(m,ndim,np+1),flc(m,ndim,np+1),dfdts(m,ndim,np+1),

      _RL pa(m,n,np),dt(m,n,np)

      _RL sh2o(m,n,np+1),swpre(m,n,np+1),swtem(m,n,np+1)

      _RL sco3(m,n,np+1),scopre(m,n,np+1),scotem(m,n,np+1)

      _RL dh2o(m,n,np),dcont(m,n,np),dco2(m,n,np),do3(m,n,np)

      _RL dn2o(m,n,np),dch4(m,n,np)

      _RL df11(m,n,np),df12(m,n,np),df22(m,n,np)

      _RL h2oexp(m,n,np,6),conexp(m,n,np,3),co2exp(m,n,np,6,2)

      _RL n2oexp(m,n,np,4),ch4exp(m,n,np,4),comexp(m,n,np,2)

      _RL f11exp(m,n,np),  f12exp(m,n,np),  f22exp(m,n,np)

      _RL clr(m,n,0:np+1),fclr(m,n)

      _RL blayer(m,n,0:np+1),dlayer(m,n,np+1),dbs(m,n)

      _RL cwp(m,n,np,3)

      _RL trant(m,n),tranal(m,n),transfc(m,n,np+1),trantcr(m,n,np+1)

      _RL flxu(m,n,np+1),flxd(m,n,np+1),flcu(m,n,np+1),flcd(m,n,np+1)

      _RL rflx(m,n,np+1),rflc(m,n,np+1)

      do k=1,np

      do k=1,np

        call COLUMN(m,n,np,pa,dt,dh2o,sh2o,swpre,swtem)

        do k=1,np

        clr(i,j,np+1) = 0.0

        transfc(i,j,np+1)=1.0

        trantcr(i,j,np+1)=1.0

      do k=1,np+1

      integer m,n,ndim,np,ict,icb

      _RL  cosz(m,ndim),fcld(m,ndim,np),taucld(m,ndim,np,2)

      _RL  cc(m,n,3),tauclb(m,n,np),tauclf(m,n,np)

      do k=icb,np

      do k=1,np

      subroutine SOLIR (m,n,ndim,np,wh,taucld,tauclb,tauclf,reff,

      integer m,n,ndim,np,ict,icb

      _RL  taucld(m,ndim,np,2),reff(m,ndim,np,2),fcld(m,ndim,np)

      _RL  tauclb(m,n,np),tauclf(m,n,np),cc(m,n,3)

      _RL  wh(m,n,np),taual(m,ndim,np),csm(m,n)

      _RL  flx(m,ndim,np+1),flc(m,ndim,np+1)

      _RL  ssacl(m,n,np),asycl(m,n,np)

      _RL  rr(m,n,np+1,2),tt(m,n,np+1,2),td(m,n,np+1,2),

     *       rs(m,n,np+1,2),ts(m,n,np+1,2)

      _RL  fall(m,n,np+1),fclr(m,n,np+1)

         rr(i,j,np+1,1)=rsirbm(i,j)

         rr(i,j,np+1,2)=rsirbm(i,j)

         rs(i,j,np+1,1)=rsirdf(i,j)

         rs(i,j,np+1,2)=rsirdf(i,j)

         td(i,j,np+1,1)=0.0

         td(i,j,np+1,2)=0.0

         tt(i,j,np+1,1)=0.0

         tt(i,j,np+1,2)=0.0

         ts(i,j,np+1,1)=0.0

         ts(i,j,np+1,2)=0.0

       do k= 1, np

          do 300 k= 1, np

       do k= 1, np+1

        call CLDFLX (m,n,np,ict,icb,cc,rr,tt,td,rs,ts,

       do k= 1, np+1

      subroutine SOLUV (m,n,ndim,np,oh,dp,taucld,tauclb,tauclf,reff,

      integer m,n,ndim,np,ict,icb

      _RL  taucld(m,ndim,np,2),reff(m,ndim,np,2),fcld(m,ndim,np)

      _RL  tauclb(m,n,np),tauclf(m,n,np),cc(m,n,3)

      _RL  oh(m,n,np),dp(m,n,np),taual(m,ndim,np)

      _RL  flx(m,ndim,np+1),flc(m,ndim,np+1)

      _RL  taux,reff1,reff2,g1,g2,asycl(m,n,np)

      _RL  td(m,n,np+1,2),rr(m,n,np+1,2),tt(m,n,np+1,2),

     *       rs(m,n,np+1,2),ts(m,n,np+1,2)

      _RL  fall(m,n,np+1),fclr(m,n,np+1),fsdir(m,n),fsdif(m,n)

         rr(i,j,np+1,1)=rsuvbm(i,j)

         rr(i,j,np+1,2)=rsuvbm(i,j)

         rs(i,j,np+1,1)=rsuvdf(i,j)

         rs(i,j,np+1,2)=rsuvdf(i,j)

         td(i,j,np+1,1)=0.0

         td(i,j,np+1,2)=0.0

         tt(i,j,np+1,1)=0.0

         tt(i,j,np+1,2)=0.0

         ts(i,j,np+1,1)=0.0

         ts(i,j,np+1,2)=0.0

      do k= 1, np

       do 300 k= 1, np

       do k= 1, np+1

        call CLDFLX (m,n,np,ict,icb,cc,rr,tt,td,rs,ts,

       do k= 1, np+1

      subroutine CLDFLX (m,n,np,ict,icb,cc,rr,tt,td,rs,ts,

      integer m,n,np,ict,icb

      _RL  rr(m,n,np+1,2),tt(m,n,np+1,2),td(m,n,np+1,2)

      _RL  rs(m,n,np+1,2),ts(m,n,np+1,2)

      _RL  rra(m,n,np+1,2,2),tta(m,n,np+1,2,2),tda(m,n,np+1,2,2)

      _RL  rsa(m,n,np+1,2,2),rxa(m,n,np+1,2,2)

      _RL  ch(m,n),cm(m,n),ct(m,n),flxdn(m,n,np+1)

      _RL  fclr(m,n,np+1),fall(m,n,np+1)

      do k=1,np+1

         rra(i,j,np+1,1,is)=rr(i,j,np+1,is)

         rxa(i,j,np+1,1,is)=rs(i,j,np+1,is)

         rra(i,j,np+1,2,is)=rr(i,j,np+1,is)

         rxa(i,j,np+1,2,is)=rs(i,j,np+1,is)

       do k=np,icb,-1

       do k= icb, np

      do k=2,np+1

       do k=1,np+1

      subroutine FLXCO2(m,n,np,swc,swh,csm,df)

      integer m,n,np

      _RL  csm(m,n),swc(m,n,np+1),swh(m,n,np+1),cah(22,19)

      _RL  df(m,n,np+1)

      do k= 2, np+1

      subroutine SORAD(m,n,ndim,np,pl,ta,wa,oa,co2,

      integer m,n,ndim,np,ict,icb

      _RL pl(m,ndim,np+1),ta(m,ndim,np),wa(m,ndim,np),oa(m,ndim,np)

      _RL  taucld(m,ndim,np,2),reff(m,ndim,np,2)

      _RL  fcld(m,ndim,np),taual(m,ndim,np)

      _RL  flx(m,ndim,np+1),flc(m,ndim,np+1)

      _RL  cc(m,n,3),tauclb(m,n,np),tauclf(m,n,np)

      _RL  dp(m,n,np),wh(m,n,np),oh(m,n,np),scal(m,n,np)

      _RL  swh(m,n,np+1),so2(m,n,np+1),df(m,n,np+1)

      do k= 1, np

      call CLDSCALE(m,n,ndim,np,cosz,fcld,taucld,ict,icb,

      do k=1, np+1

      call SOLIR (m,n,ndim,np,wh,taucld,tauclb,tauclf,reff,ict,icb

      call SOLUV (m,n,ndim,np,oh,dp,taucld,tauclb,tauclf,reff,ict,icb

      do k= 1, np

       do k= 2, np+1

      do k= 1, np

      call FLXCO2(m,n,np,so2,swh,csm,df)

      do k= 2, np+1

      do k=1,np

         x = (-sdf(i,j)-df(i,j,np+1)*sclr(i,j))/x

      subroutine CLDSCALE (m,n,ndim,np,cosz,fcld,taucld,ict,icb,

               np = INT((tmp(2)-rcountstart)/rcountdelta+1)

               xpart(ip,np)  = SNGL(tmp(3))

               ypart(ip,np)  = SNGL(tmp(4))

               xpart(ip,np)  = SNGL(tmp(3))/1000.

               ypart(ip,np)  = SNGL(tmp(4))/1000.

               kpart(ip,np)  = SNGL(tmp(5))

               zeta(ip,np)   = SNGL(tmp(6))

                if (.not. preflag) uvel(ip,k,np)   = SNGL(tmp(6+k))

                if (.not. preflag) vvel(ip,k,np)   = SNGL(tmp(6+1*Nr+k))

                                   temp(ip,k,np)   = SNGL(tmp(6+2*Nr+k))

                if (.not. preflag) salt(ip,k,np)   = SNGL(tmp(6+3*Nr+k))

                  if (temp(ip,k,np) .eq. 0.) then

                    if (.not. preflag)  uvel(ip,k,np)   = spval

                    if (.not. preflag)  vvel(ip,k,np)   = spval

                                        temp(ip,k,np)   = spval

                    if (.not. preflag)  salt(ip,k,np)   = spval

               np = INT((tmp(2)-rcountstart)/rcountdelta+1)

                  temp(ip,k,np)   = SNGL(tmp(6+3*Nr+k))

                     temp(ip,k,np)   = spval

               np = INT((tmp(2)-rcountstart)/rcountdelta+1)

                  temp(ip,k,np)   = SNGL(tmp(6+k))

                     temp(ip,k,np)   = spval

               np = INT((tmp(2)-rcountstart)/rcountdelta+1)

                  temp(ip,k,np)   = SNGL(tmp(6+1*Nr+k))

                     temp(ip,k,np)   = spval

         np = 1

            biG = (mpi_myXGlobalLo(np)-1)/sNx+bi

            bjG = (mpi_myYGlobalLo(np)-1)/sNy+bj

         DO np = 2, nPx*nPy

          pId = np - 1

             biG = (mpi_myXGlobalLo(np)-1)/sNx+bi

             bjG = (mpi_myYGlobalLo(np)-1)/sNy+bj

         DO np = 2, nPx*nPy

          pId = np - 1

      INTEGER biG, bjG, np, pId

       DO np = 1, nPx*nPy

          pId = np - 1

          mpi_myXGlobalLo(np) = itemp(1)

          mpi_myYGlobalLo(np) = itemp(2)

      INTEGER np, pId, itemp(2)