*=*=*=*= linearb.html =*=*=*=*
subroutine linearb

subroutine linearb


      subroutine linearb(imdep, jmdep, xdata, ydata,
     .                   imar, jmar, x, y,
     .                   iix, jjx, ix, jx, sx, airnx, icount)
c         avec conservation forcee du flux
c=======================================================================
c    A. HARZALLAH (14/08/90).
c    Modifie le 15/12/93 par L. Fairhead (LMD/CNRS)
c                        pour en faire une subroutine
c
c Input: imdep, nbre de long de la grille de depart
c        jmdep,  "   "  lat   "     "   "    "    "
c        xdata, longitudes de la grille de depart
c        ydata, latitudes   "   "    "     "   "
c        imar,  nbre de long de la grille d'arrivee
c        jmar,  nbre de lat  de la grille d'arrivee
c        x, longitudes de la grille d'arrivee
c        y, latitudes de la grille d'arrivee
C Output: iix, jjx, ix, jx indices pour les connections
c         sx et airnx  poids et aires
C=======================================================================
C  ce programme prepare les interconnections entre les aires
c  de la grille initiale et de la nouvelle grille
C=======================================================================
      implicit none
      INTEGER imdep, jmdep
      REAL xdata(imdep),ydata(jmdep)
      REAL a(360),b(360),c(360),d(360),air(360,360)
c------------nouvelle grille---------------------------------
      INTEGER imar, jmar
      REAL x(imar),y(jmar),airnx(1)
      REAL an(360),bn(360),cn(360),dn(360), airn(360,360)
      INTEGER icount
      INTEGER i, j, ii, jj
      INTEGER iix(1), jjx(1), ix(1), jx(1)
      REAL sx(1)
      REAL pi, eps, s, aa1, aa2, aa3, aa4
      pi=acos(-1.)
c----------------------airs de la grille initiale-----------------------
      eps=0.	
      a(1)=xdata(1)-(xdata(imdep)-xdata(imdep-1))/2.
      do i=2,imdep
        a(i)=xdata(i-1)+(xdata(i)-xdata(i-1))/2.
      enddo

      do i=1,imdep-1	
        b(i)=xdata(i)+(xdata(i+1)-xdata(i))/2.
      enddo
      b(imdep)=xdata(imdep)+(xdata(2)-xdata(1))/2.

      c(1)=ydata(1)-(ydata(jmdep)-ydata(jmdep-1))/2.
      do j=2,jmdep
        c(j)=ydata(j-1)+(ydata(j)-ydata(j-1))/2.
      enddo

      do j=1,jmdep-1
        d(j)=ydata(j)+(ydata(j+1)-ydata(j))/2.
      enddo
      d(jmdep)=ydata(jmdep)+(ydata(2)-ydata(1))/2.

      do i=1,imdep
        do j=1,jmdep
          air(i,j)=(b(i)-a(i))*(d(j)-c(j))
        enddo
      enddo
c----------------------airs de la nouvelle grille-----------------------
      	
      an(1)=a(1)
      do i=2,imar	
        an(i)=x(i-1)+(x(i)-x(i-1))/2.
      enddo

      do i=1,imar-1	
        bn(i)=x(i)+(x(i+1)-x(i))/2.
      enddo
      bn(imar)=b(imdep)

      cn(1)=c(1)
      do j=2,jmar
        cn(j)=y(j-1)+(y(j)-y(j-1))/2.
      enddo
      	
      do j=1,jmar-1
        dn(j)=y(j)+(y(j+1)-y(j))/2.
      enddo
      dn(jmar)=d(jmdep)

      do i=1,imar
        do j=1,jmar
          airn(i,j)=(bn(i)-an(i))*(dn(j)-cn(j))
        enddo
      enddo
c===============definition des connections des airs=====================
      icount = 0
      do ii=1,imar
        do jj=1,jmar
          do i=1,imdep
c           if(an(ii).ge.b(i)) goto 3041
c           if(bn(ii).le.a(i)) goto 3041
            if(an(ii).lt.b(i).and.bn(ii).gt.a(i)) then
              do j=1,jmdep
c               if(cn(jj).lt.d(j)) goto 3042
c               if(dn(jj).gt.c(j)) goto 3042
                if(cn(jj).ge.d(j).and.dn(jj).le.c(j)) then
                  if(bn(ii).le.b(i)) aa1=bn(ii)
                  if(bn(ii).gt.b(i)) aa1=b(i)
                  if(an(ii).ge.a(i)) aa2=an(ii)
                  if(an(ii).lt.a(i)) aa2=a(i)
                  if(dn(jj).gt.d(j)) aa3=dn(jj)
                  if(dn(jj).le.d(j)) aa3=d(j)
                  if(cn(jj).lt.c(j)) aa4=cn(jj)
                  if(cn(jj).ge.c(j)) aa4=c(j)
                  s=(aa1-aa2)*(aa3-aa4)	
                  icount = icount + 1
                  iix(icount) = ii
                  jjx(icount) = jj
                  ix(icount) = i
                  jx(icount) = j
                  sx(icount) = s
                  airnx(icount) = airn(ii,jj)
                endif
              enddo
            endif
          enddo
        enddo
      enddo
      return
      end