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