| 1 | subroutine linearb(imdep, jmdep, xdata, ydata, |
|---|
| 2 | . imar, jmar, x, y, |
|---|
| 3 | . iix, jjx, ix, jx, sx, airnx, icount) |
|---|
| 4 | c avec conservation forcee du flux |
|---|
| 5 | c======================================================================= |
|---|
| 6 | c A. HARZALLAH (14/08/90). |
|---|
| 7 | c Modifie le 15/12/93 par L. Fairhead (LMD/CNRS) |
|---|
| 8 | c pour en faire une subroutine |
|---|
| 9 | c |
|---|
| 10 | c Input: imdep, nbre de long de la grille de depart |
|---|
| 11 | c jmdep, " " lat " " " " " |
|---|
| 12 | c xdata, longitudes de la grille de depart |
|---|
| 13 | c ydata, latitudes " " " " " |
|---|
| 14 | c imar, nbre de long de la grille d'arrivee |
|---|
| 15 | c jmar, nbre de lat de la grille d'arrivee |
|---|
| 16 | c x, longitudes de la grille d'arrivee |
|---|
| 17 | c y, latitudes de la grille d'arrivee |
|---|
| 18 | C Output: iix, jjx, ix, jx indices pour les connections |
|---|
| 19 | c sx et airnx poids et aires |
|---|
| 20 | C======================================================================= |
|---|
| 21 | C ce programme prepare les interconnections entre les aires |
|---|
| 22 | c de la grille initiale et de la nouvelle grille |
|---|
| 23 | C======================================================================= |
|---|
| 24 | implicit none |
|---|
| 25 | integer imdep, jmdep |
|---|
| 26 | real xdata(imdep),ydata(jmdep) |
|---|
| 27 | real a(360),b(360),c(360),d(360),air(360,360) |
|---|
| 28 | c------------nouvelle grille--------------------------------- |
|---|
| 29 | integer imar, jmar |
|---|
| 30 | real x(imar),y(jmar),airnx(1) |
|---|
| 31 | real an(360),bn(360),cn(360),dn(360), airn(360,360) |
|---|
| 32 | integer icount |
|---|
| 33 | integer i, j, ii, jj |
|---|
| 34 | integer iix(1), jjx(1), ix(1), jx(1) |
|---|
| 35 | real sx(1) |
|---|
| 36 | real pi, eps, s, aa1, aa2, aa3, aa4 |
|---|
| 37 | pi=acos(-1.) |
|---|
| 38 | c----------------------airs de la grille initiale----------------------- |
|---|
| 39 | eps=0. |
|---|
| 40 | a(1)=xdata(1)-(xdata(imdep)-xdata(imdep-1))/2. |
|---|
| 41 | do i=2,imdep |
|---|
| 42 | a(i)=xdata(i-1)+(xdata(i)-xdata(i-1))/2. |
|---|
| 43 | enddo |
|---|
| 44 | |
|---|
| 45 | do i=1,imdep-1 |
|---|
| 46 | b(i)=xdata(i)+(xdata(i+1)-xdata(i))/2. |
|---|
| 47 | enddo |
|---|
| 48 | b(imdep)=xdata(imdep)+(xdata(2)-xdata(1))/2. |
|---|
| 49 | |
|---|
| 50 | c(1)=ydata(1)-(ydata(jmdep)-ydata(jmdep-1))/2. |
|---|
| 51 | do j=2,jmdep |
|---|
| 52 | c(j)=ydata(j-1)+(ydata(j)-ydata(j-1))/2. |
|---|
| 53 | enddo |
|---|
| 54 | |
|---|
| 55 | do j=1,jmdep-1 |
|---|
| 56 | d(j)=ydata(j)+(ydata(j+1)-ydata(j))/2. |
|---|
| 57 | enddo |
|---|
| 58 | d(jmdep)=ydata(jmdep)+(ydata(2)-ydata(1))/2. |
|---|
| 59 | |
|---|
| 60 | do i=1,imdep |
|---|
| 61 | do j=1,jmdep |
|---|
| 62 | air(i,j)=(b(i)-a(i))*(d(j)-c(j)) |
|---|
| 63 | enddo |
|---|
| 64 | enddo |
|---|
| 65 | c----------------------airs de la nouvelle grille----------------------- |
|---|
| 66 | |
|---|
| 67 | an(1)=a(1) |
|---|
| 68 | do i=2,imar |
|---|
| 69 | an(i)=x(i-1)+(x(i)-x(i-1))/2. |
|---|
| 70 | enddo |
|---|
| 71 | |
|---|
| 72 | do i=1,imar-1 |
|---|
| 73 | bn(i)=x(i)+(x(i+1)-x(i))/2. |
|---|
| 74 | enddo |
|---|
| 75 | bn(imar)=b(imdep) |
|---|
| 76 | |
|---|
| 77 | cn(1)=c(1) |
|---|
| 78 | do j=2,jmar |
|---|
| 79 | cn(j)=y(j-1)+(y(j)-y(j-1))/2. |
|---|
| 80 | enddo |
|---|
| 81 | |
|---|
| 82 | do j=1,jmar-1 |
|---|
| 83 | dn(j)=y(j)+(y(j+1)-y(j))/2. |
|---|
| 84 | enddo |
|---|
| 85 | dn(jmar)=d(jmdep) |
|---|
| 86 | |
|---|
| 87 | do i=1,imar |
|---|
| 88 | do j=1,jmar |
|---|
| 89 | airn(i,j)=(bn(i)-an(i))*(dn(j)-cn(j)) |
|---|
| 90 | enddo |
|---|
| 91 | enddo |
|---|
| 92 | c===============definition des connections des airs===================== |
|---|
| 93 | icount = 0 |
|---|
| 94 | do ii=1,imar |
|---|
| 95 | do jj=1,jmar |
|---|
| 96 | do i=1,imdep |
|---|
| 97 | c if(an(ii).ge.b(i)) goto 3041 |
|---|
| 98 | c if(bn(ii).le.a(i)) goto 3041 |
|---|
| 99 | if(an(ii).lt.b(i).and.bn(ii).gt.a(i)) then |
|---|
| 100 | do j=1,jmdep |
|---|
| 101 | c if(cn(jj).lt.d(j)) goto 3042 |
|---|
| 102 | c if(dn(jj).gt.c(j)) goto 3042 |
|---|
| 103 | if(cn(jj).ge.d(j).and.dn(jj).le.c(j)) then |
|---|
| 104 | if(bn(ii).le.b(i)) aa1=bn(ii) |
|---|
| 105 | if(bn(ii).gt.b(i)) aa1=b(i) |
|---|
| 106 | if(an(ii).ge.a(i)) aa2=an(ii) |
|---|
| 107 | if(an(ii).lt.a(i)) aa2=a(i) |
|---|
| 108 | if(dn(jj).gt.d(j)) aa3=dn(jj) |
|---|
| 109 | if(dn(jj).le.d(j)) aa3=d(j) |
|---|
| 110 | if(cn(jj).lt.c(j)) aa4=cn(jj) |
|---|
| 111 | if(cn(jj).ge.c(j)) aa4=c(j) |
|---|
| 112 | s=(aa1-aa2)*(aa3-aa4) |
|---|
| 113 | icount = icount + 1 |
|---|
| 114 | iix(icount) = ii |
|---|
| 115 | jjx(icount) = jj |
|---|
| 116 | ix(icount) = i |
|---|
| 117 | jx(icount) = j |
|---|
| 118 | sx(icount) = s |
|---|
| 119 | airnx(icount) = airn(ii,jj) |
|---|
| 120 | endif |
|---|
| 121 | enddo |
|---|
| 122 | endif |
|---|
| 123 | enddo |
|---|
| 124 | enddo |
|---|
| 125 | enddo |
|---|
| 126 | return |
|---|
| 127 | end |
|---|
