source: LMDZ.3.3/trunk/libf/dyn3d/linearb.F @ 4587

Last change on this file since 4587 was 2, checked in by lmdz, 25 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 4.2 KB
RevLine 
[2]1      subroutine linearb(imdep, jmdep, xdata, ydata,
2     .                   imar, jmar, x, y,
3     .                   iix, jjx, ix, jx, sx, airnx, icount)
4c         avec conservation forcee du flux 
5c=======================================================================
6c    A. HARZALLAH (14/08/90).
7c    Modifie le 15/12/93 par L. Fairhead (LMD/CNRS)
8c                        pour en faire une subroutine
9c
10c Input: imdep, nbre de long de la grille de depart
11c        jmdep,  "   "  lat   "     "   "    "    "
12c        xdata, longitudes de la grille de depart
13c        ydata, latitudes   "   "    "     "   "
14c        imar,  nbre de long de la grille d'arrivee
15c        jmar,  nbre de lat  de la grille d'arrivee
16c        x, longitudes de la grille d'arrivee
17c        y, latitudes de la grille d'arrivee
18C Output: iix, jjx, ix, jx indices pour les connections
19c         sx et airnx  poids et aires
20C=======================================================================
21C  ce programme prepare les interconnections entre les aires
22c  de la grille initiale et de la nouvelle grille
23C=======================================================================
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)
28c------------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.)
38c----------------------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
65c----------------------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
92c===============definition des connections des airs=====================
93      icount = 0
94      do ii=1,imar
95        do jj=1,jmar 
96          do i=1,imdep   
97c           if(an(ii).ge.b(i)) goto 3041
98c           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
101c               if(cn(jj).lt.d(j)) goto 3042
102c               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
Note: See TracBrowser for help on using the repository browser.