integer i, ihorz,ihsub,ivert,itime,ihalo, is,ih, n,ntot

        DO is = 1,3

            ihsub = is

              IF ((is .EQ. 1) .AND. (ih .EQ. 1)) THEN

      integer i,j,k,ih,im,is

      do 20 is=1,2

         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)

          denm=ts(i,j,k,is)/( 1.-rs(i,j,k,is)*rxa(i,j,k+1,1,is) )

          rra(i,j,k,1,is)=rr(i,j,k,is)+(td(i,j,k,is)

     *        *rra(i,j,k+1,1,is)+tt(i,j,k,is)*rxa(i,j,k+1,1,is))*denm

          rxa(i,j,k,1,is)= rs(i,j,k,is)+ts(i,j,k,is)

     *        *rxa(i,j,k+1,1,is)*denm

          rra(i,j,k,2,is)=rra(i,j,k,1,is)

          rxa(i,j,k,2,is)=rxa(i,j,k,1,is)

          denm=ts(i,j,k,im)/( 1.-rs(i,j,k,im)*rxa(i,j,k+1,im,is) )

          rra(i,j,k,im,is)= rr(i,j,k,im)+(td(i,j,k,im)

     *        *rra(i,j,k+1,im,is)+tt(i,j,k,im)*rxa(i,j,k+1,im,is))*denm

          rxa(i,j,k,im,is)= rs(i,j,k,im)+ts(i,j,k,im)

     *        *rxa(i,j,k+1,im,is)*denm

      do 100 is=1,2

         if(is.eq.1) then

          denm = ts(i,j,k,is)/( 1.-rsa(i,j,k-1,ih,im)*rs(i,j,k,is) )

          tda(i,j,k,ih,im)= tda(i,j,k-1,ih,im)*td(i,j,k,is)

          tta(i,j,k,ih,im)=  tda(i,j,k-1,ih,im)*tt(i,j,k,is)

     *         +(tda(i,j,k-1,ih,im)*rr(i,j,k,is)

          rsa(i,j,k,ih,im)= rs(i,j,k,is)+ts(i,j,k,is)

          denm =ts(i,j,k,ih)/(1.-rs(i,j,k,ih)*rxa(i,j,k+1,im,is))

          rra(i,j,k,im,is)= rr(i,j,k,ih)+(td(i,j,k,ih)

     *        *rra(i,j,k+1,im,is)+tt(i,j,k,ih)*rxa(i,j,k+1,im,is))*denm

          rxa(i,j,k,im,is)= rs(i,j,k,ih)+ts(i,j,k,ih)

     *        *rxa(i,j,k+1,im,is)*denm

         denm= 1./(1.- rxa(i,j,k,im,is)*rsa(i,j,k-1,ih,im))

         xx = tda(i,j,k-1,ih,im)*rra(i,j,k,im,is)

         fupdif= (xx+tta(i,j,k-1,ih,im)*rxa(i,j,k,im,is))*denm

         flxdn(i,j,1)=1.0-rra(i,j,1,im,is)

           if(ih.eq.1 .and. im.eq.1 .and. is.eq.1) then

      integer i, ihorz,ihsub,ivert,itime,ihalo, is,ih, n,ntot

        DO is = 1,3

            ihsub = is

              IF ((is .EQ. 1) .AND. (ih .EQ. 1)) THEN

      integer i, ihorz,ihsub,ivert,itime,ihalo, is,ih, n,ntot

        DO is = 1,3

            ihsub = is

              IF ((is .EQ. 1) .AND. (ih .EQ. 1)) THEN

      INTEGER i,j,k, n, nf, indf,indv, fid, nd, ngrid, is,ie, err

          is = mnc_f_info(indf,(j+1))

          DO k = is,ie

      subroutine NLOPPS(j,is,ie,ta,sa,gcmdz)

      integer is,ie,k2

      DO i=is,ie

    (e.g.: shared_code) which is both in the include path of the

    (e.g.: shared_code) which is both in the include path of the

    (e.g.: shared_code) which is both in the include path of the

        is = MAX(is,1)

     &       filePfx(1:ip), ' , ', fileSfx(1:is), ' , ', fileName(1:i)

      INTEGER ip, is, iL, i, ioUnit

      is = ILNBLNK(fileSfx)

      IF ( ip.EQ.0 ) is = 0

      IF ( i .LT. ip+is+8 ) THEN

     &    ' too small <', ip+is+8

      IF ( .NOT.fileExist .AND. is.GE.1 ) THEN

        WRITE(fileName,'(2A)') filePfx(1:ip), fileSfx(1:is)

      IF ( .NOT.fileExist .AND. is.GE.1 ) THEN

     &                 filePfx(1:ip), '.', iG, '.', jG, fileSfx(1:is)

      IF ( .NOT.fileExist .AND. is.GE.1 ) THEN

        WRITE(fileName,'(3A)') filePfx(1:ip),'.001.001', fileSfx(1:is)

         is = IFNBLNK(record(i1+1:i2-1))

         i = i1+is

         IF ( record(i:i).EQ.'-' .OR.  record(i:i).EQ.'+' ) is = is+1

         hasNum1 = ( is.GE.1 .AND. is.LE.ie )

          DO i=i1+is,i1+ie

         is = IFNBLNK(record(i2+1:ii-1))

         i = i2+is

         IF ( record(i:i).EQ.'-' .OR.  record(i:i).EQ.'+' ) is = is+1

         hasNum2 = ( is.GE.1 .AND. is.LE.ie )

          DO i=i2+is,i2+ie

      INTEGER nWd, is, ie, iUnit

      isize = is

      subroutine INSTORE( n, fc, gnorm0, is, m, jmin, jmax,

      integer n, is, m, jmin, jmax, ifail

     &          (188.74*invtk - 1.5998) * is +

     &          (35474*invtk - 771.54 + 114.723*dlogtk)*is -

     &          2698*invtk*is**1.5 + 1776*invtk*is2 +

        _RL  is

           is=19.924 _d 0*s/(1000. _d 0-1.005 _d 0*s)

           is2=is*is

           sqrtis=sqrt(is)

     &          (188.74 _d 0*invtk - 1.5998 _d 0) * is +

     &   (35474. _d 0*invtk - 771.54 _d 0 + 114.723 _d 0*dlogtk)*is -

     &          2698. _d 0*invtk*is**1.5 _d 0 + 1776. _d 0*invtk*is2 +

        _RL  is

           is=19.924*s/(1000.-1.005*s)

           is2=is*is

           sqrtis=sqrt(is)

     &                    .AND. exch2_jHi(ns,is).EQ.(tNy+1) ) THEN

            ip(1) = is

          IF ( ip(2).EQ.0 .AND. exch2_isSedge(is).EQ.1

     &                    .AND. exch2_jLo(ns,is).EQ. 0

     &                    .AND. exch2_jHi(ns,is).EQ. 0 ) THEN

            ip(2) = is

          IF ( ip(3).EQ.0 .AND. exch2_isEedge(is).EQ.1

     &                    .AND. exch2_iLo(ns,is).EQ.(tNx+1)

     &                    .AND. exch2_iHi(ns,is).EQ.(tNx+1) ) THEN

            ip(3) = is

          IF ( ip(4).EQ.0 .AND. exch2_isWedge(is).EQ.1

     &                    .AND. exch2_iLo(ns,is).EQ. 0

     &                    .AND. exch2_iHi(ns,is).EQ. 0 ) THEN

            ip(4) = is

      DO is=1,nTiles

       js  = exch2_myFace(is)

         fNx = exch2_mydNx(is)

         fNy = exch2_mydNy(is)

           tx = 1 + exch2_tBasex(is)/tNx

           ty = 1 + exch2_tBasey(is)/tNy

          WRITE(W2_oUnit,'(A,I5,3(A,I3),2A,2I5,2A,2I8)') '  tile',is,

     &    ' on facet', exch2_myFace(is),' (',tx,',',ty,'):',

     &         ' offset=', exch2_tBasex(is), exch2_tBasey(is),' ;',

     &    ' on Glob.Map=', exch2_txGlobalo(is),exch2_tyGlobalo(is)

      DO is=1,nTiles

       js  = exch2_myFace(is)

        IF ( exch2_nNeighbours(is).GT.exch2_nNeighbours(it) ) it = is

         WRITE(W2_oUnit,'(A,I5,A,I3,A,4(A,I2))') 'Tile',is,

     &    ' : nbNeighb=',exch2_nNeighbours(is),' ; is-at-Facet-Edge:',

     &        ' N=', exch2_isNedge(is), ' , S=', exch2_isSedge(is),

     &      ' , E=', exch2_isEedge(is), ' , W=', exch2_isWedge(is)

         DO ns=1,exch2_nNeighbours(is)

     &     ' ns:',ns,' it=',exch2_neighbourId(ns,is),

     &     ', iLo,iHi=', exch2_iLo(ns,is), exch2_iHi(ns,is),

     &     ', jLo,jHi=', exch2_jLo(ns,is), exch2_jHi(ns,is)

      INTEGER i, j, js, jp, jt, ii, is, it, ns, nt, k, tx, ty

       DO is=1,nTiles

        js  = exch2_myFace(is)

         fNx = exch2_mydNx(is)

         fNy = exch2_mydNy(is)

         DO ns=1,exch2_nNeighbours(is)

          IF ( ip(1).EQ.0 .AND. exch2_isNedge(is).EQ.1

     &                    .AND. exch2_jLo(ns,is).EQ.(tNy+1)

          internConnect = iHi.LT.exch2_mydNx(is)

          IF ( .NOT.internConnect ) exch2_isEedge(is) = 1

          IF ( .NOT.internConnect ) exch2_isWedge(is) = 1

               it = is + it*nbTx

               it = is + it

               exch2_neighbourId(ns,is) = it

               tile_edge2edge(ns,is) = 10*i + ii

               exch2_pij(1,ns,is) = 1

               exch2_pij(2,ns,is) = 0

               exch2_pij(3,ns,is) = 0

               exch2_pij(4,ns,is) = 1

               exch2_oi(ns,is) = 0

               exch2_oj(ns,is) = 0

               exch2_iLo(ns,is) = ii1 - ddi - exch2_tBasex(is)

               exch2_iHi(ns,is) = ii2 + ddi - exch2_tBasex(is)

               exch2_jLo(ns,is) = jj1 - ddj - exch2_tBasey(is)

               exch2_jHi(ns,is) = jj2 + ddj - exch2_tBasey(is)

               exch2_neighbourId(ns,is)  = it

               tile_edge2edge(ns,is) = 10*i + ii

                 exch2_pij(k,ns,is) = facet_pij(k,i,js)

               exch2_oi(ns,is) = facet_oi(i,js)

               exch2_oj(ns,is) = facet_oj(i,js)

               exch2_iLo(ns,is) = isbd1 - ddi - exch2_tBasex(is)

               exch2_iHi(ns,is) = isbd2 + ddi - exch2_tBasex(is)

               exch2_jLo(ns,is) = jsbd1 - ddj - exch2_tBasey(is)

               exch2_jHi(ns,is) = jsbd2 + ddj - exch2_tBasey(is)

        exch2_nNeighbours(is) = nbNeighb

     &    'Tile',is,' : nbNeighb=',nbNeighb,' ; is-at-Facet-Edge:',

     &        ' N=', exch2_isNedge(is), ' , S=', exch2_isSedge(is),

     &      ' , E=', exch2_isEedge(is), ' , W=', exch2_isWedge(is)

     &     ' ns:',ns,' it=',exch2_neighbourId(ns,is),

     &     ', iLo,iHi=', exch2_iLo(ns,is), exch2_iHi(ns,is),

     &     ', jLo,jHi=', exch2_jLo(ns,is), exch2_jHi(ns,is)

      DO is=1,nTiles

        IF ( exch2_nNeighbours(is).GT.nbNeighb ) THEN

          nbNeighb = exch2_nNeighbours(is)

          it = is

      DO is=1,nTiles

       DO ns=1,exch2_nNeighbours(is)

        i  = tile_edge2edge(ns,is)/10

        ii = MOD(tile_edge2edge(ns,is),10)

          exch2_neighbourDir(ns,is) = i

        it = exch2_neighbourId(ns,is)

          IF ( exch2_neighbourId(nt,it).EQ.is .AND. ii.EQ.i ) THEN

           IF ( exch2_opposingSend(ns,is).EQ.0 ) THEN

            exch2_opposingSend(ns,is) = nt

            nn = exch2_opposingSend(ns,is)

            WRITE(msgBuf,'(A,I5,2(A,I3),A,I5)') 'Tile',is,' neighb:',

     &      ns,' (',tile_edge2edge(ns,is),' ) has multiple connection'

        IF ( exch2_opposingSend(ns,is).EQ.0 ) THEN

            WRITE(msgBuf,'(A,I5,2(A,I3),A,I5)') 'Tile',is,' neighb:',

     &      ns,' (',tile_edge2edge(ns,is),' ) no connection from',it

      DO is=1,nTiles

       DO ns=1,exch2_nNeighbours(is)

        it = exch2_neighbourId(ns,is)

        nt = exch2_opposingSend(ns,is)

        IF ( ii.NE.is .OR. nn.NE.ns ) THEN

          WRITE(msgBuf,'(A,I5,2(A,I3),A)') 'Tile',is,' neighb:',

     &      ns,' (',tile_edge2edge(ns,is),' ) connected'

      INTEGER is, js, ns, it, jt, nt, tx, ty

      DO is=1,W2_maxNbTiles

        tile_edge2edge(ns,is) = 0

        exch2_neighbourDir(ns,is) = 0

      DO is=1,nTiles

       js  = exch2_myFace(is)

        js  = exch2_myFace(is)

        iLo = exch2_tBasex(is)+1

        iHi = exch2_tBasex(is)+exch2_tNx(is)

        jLo = exch2_tBasey(is)+1

        jHi = exch2_tBasey(is)+exch2_tNy(is)

          internConnect = jHi.LT.exch2_mydNy(is)

          IF ( .NOT.internConnect ) exch2_isNedge(is) = 1

          IF ( .NOT.internConnect ) exch2_isSedge(is) = 1