source: LMDZ.3.3/trunk/libf/dyn3d/inter_barx.F @ 5081

Last change on this file since 5081 was 269, checked in by lmdz, 23 years ago

Remplacement des allocates par des dimensionnements classiques. LeVan?
LF

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 5.6 KB
Line 
1       SUBROUTINE inter_barx ( idatmax,xidat,fdat,imodmax,ximod,fmod )
2
3c      .... Auteurs :  Robert Sadourny ,  P. Le Van  .....
4c
5       IMPLICIT NONE
6c    ----------------------------------------------------------
7c        INTERPOLATION BARYCENTRIQUE BASEE SUR LES AIRES
8c            VERSION UNIDIMENSIONNELLE  ,   EN  LONGITUDE .
9c    ----------------------------------------------------------
10c
11c     idat : indice du champ de donnees, de 1 a idatmax
12c     imod : indice du champ du modele,  de 1 a  imodmax
13c     fdat(idat) : champ de donnees (entrees)
14c     fmod(imod) : champ du modele (sorties)
15c     xidat(idat): abscisses des interfaces des mailles donnees
16c     ximod(imod): abscisses des interfaces des mailles modele
17c      ( L'indice 1 correspond a l'interface mailLE 1 / maille 2)
18c      ( Les abscisses sont exprimes en degres)
19
20
21      INTEGER idatmax, imodmax
22      REAL xidat(idatmax),fdat(idatmax),ximod(imodmax),fmod(imodmax)
23
24c    ...  Variables locales ...
25   
26      REAL xxid(idatmax+1), xxd(idatmax+1), fdd(idatmax+1)
27      REAL  fxd(idatmax+1), xchan(idatmax+1), fdchan(idatmax+1)
28      REAL  xxim(imodmax)
29
30      REAL x0,xim0,dx,dxm
31      REAL chmin,chmax,pi
32
33      INTEGER imod,idat,i,ichang,id0,id1,nid,idatmax1
34     
35      pi = 2. * ASIN(1.)
36
37c  -----------------------------------------------------
38c   REDEFINITION DE L'ORIGINE DES ABSCISSES
39c    A L'INTERFACE OUEST DE LA PREMIERE MAILLE DU MODELE 
40c  -----------------------------------------------------
41      DO imod = 1,imodmax
42       xxim(imod) = ximod(imod)
43      ENDDO
44
45      CALL minmax( imodmax,xxim,chmin,chmax)
46       IF( chmax.LT.6.50 )   THEN
47c        PRINT  3
48c        PRINT *,'   conversion des longit. ximod (donnees en radians)'
49c     , ,' en degres  .'
50c        PRINT  3
51        DO imod = 1, imodmax
52        xxim(imod) = xxim(imod) * 180./pi
53        ENDDO 
54       ENDIF
55
56      xim0 = xxim(imodmax) - 360.
57
58      DO imod = 1, imodmax
59       xxim(imod) = xxim(imod) - xim0
60      ENDDO
61
62      idatmax1 = idatmax +1
63
64      DO idat = 1, idatmax
65       xxd(idat) = xidat(idat)
66      ENDDO
67
68      CALL minmax( idatmax,xxd,chmin,chmax)
69       IF( chmax.LT.6.50 )  THEN
70c        PRINT  3
71c        PRINT *,'   conversion des longit. ximod (donnees en radians)'
72c     , ,' en degres  .'
73c        PRINT  3
74        DO idat = 1, idatmax
75        xxd(idat) = xxd(idat) * 180./pi
76        ENDDO 
77       ENDIF
78
79      DO idat = 1, idatmax
80       xxd(idat) = AMOD( xxd(idat) - xim0, 360. )
81       fdd(idat) = fdat (idat)
82      ENDDO
83c       PRINT *,' xxd redef. origine abscisses '
84c       PRINT 2,(xxd(i),i=1,idatmax)
85
86      DO i = 2, idatmax
87        IF( ( xxd(i) - xxd(i-1)).LT.0. )  THEN
88         ichang = i
89         GO TO 5
90        ENDIF
91      ENDDO
92      GO TO 6
93c
94c  ***  reorganisation  des longitudes entre 0. et 360. degres ****
95c
96 5    nid = idatmax - ichang +1
97      DO i = 1, nid
98        xchan (i) = xxd(i+ichang -1 )
99        fdchan(i) = fdd(i+ichang -1 )
100      ENDDO
101       DO i=1,ichang -1
102        xchan (i+ nid) = xxd(i)
103        fdchan(i+nid) = fdd(i)
104       ENDDO
105      DO i =1,idatmax
106       xxd(i) = xchan(i)
107       fdd(i) = fdchan(i)
108      ENDDO
109
110 6    continue
111
112
113c  ------------------------------------------------
114c    translation des champs de donnees par rapport
115c    a la nouvelle origine, avec redondance de la
116c       maille a cheval sur les bords
117c -----------------------------------------------
118
119      id0 = 0
120      id1 = 0
121
122      DO idat = 1, idatmax
123       IF ( xxd( idatmax1- idat ).LT.360.)   GO TO 10
124       id1 = id1 + 1
125      ENDDO
126
127 10   DO idat = 1, idatmax
128       IF (xxd(idat).GT.0.) GO TO 20
129       id0 = id0 + 1
130      END DO
131
132 20   IF( id1.EQ.0 ) GO TO 30
133      DO idat = 1, id1
134       xxid(idat) = xxd(idatmax - id1 + idat) - 360.
135       fxd (idat) = fdd(idatmax - id1 + idat)     
136      END DO
137      DO idat = 1, idatmax - id1
138       xxid(idat + id1) = xxd(idat)
139       fxd (idat + id1) = fdd(idat)
140      END DO
141
142  30  IF(id0.EQ.0) GO TO 40
143      DO idat = 1, idatmax - id0
144       xxid(idat) = xxd(idat + id0)
145       fxd (idat) = fdd(idat + id0)
146      END DO
147
148      DO idat = 1, id0
149       xxid (idatmax - id0 + idat) =  xxd(idat) + 360.
150       fxd  (idatmax - id0 + idat) =  fdd(idat)   
151      END DO
152      GO TO 50
153 
154 40   DO idat = 1, idatmax
155       xxid(idat)  = xxd(idat)
156       fxd (idat)  = fdd(idat)
157      ENDDO
158
159 50   xxid(idatmax1) = xxid(1) + 360.
160      fxd (idatmax1) = fxd(1)
161
162c  ------------------------------------
163c   initialisation du champ du modele
164
165      DO imod = 1, imodmax
166       fmod(imod) = 0.
167      END DO
168 
169c      PRINT *,' id0 id1 ',id0,id1
170c      PRINT *,' xxim apres translation  '
171c      PRINT 2,(xxim(i),i=1,imodmax)
172c      PRINT *,' xxid apres translation '
173c      PRINT 2,(xxid(i),i=1,idatmax)
174c ---------------------------------------
175c iteration
176
177      x0   = xim0
178      dxm  = 0.
179      imod = 1
180      idat = 1
181 
182 100  IF (xxim(imod).LT.xxid(idat)) THEN
183       dx   = xxim(imod) - x0
184       dxm  = dxm + dx
185       fmod(imod) = (fmod(imod) + dx * fxd(idat)) / dxm
186       x0   = xxim(imod)
187       dxm  = 0.
188       imod = imod + 1
189       IF (imod.LE.imodmax) GO TO 100
190 
191      ELSE IF (xxim(imod).GT.xxid(idat)) THEN
192       dx   = xxid(idat) - x0
193       dxm  = dxm + dx
194       fmod(imod) = fmod(imod) + dx * fxd(idat)
195       x0   = xxid(idat)
196       idat = idat + 1
197       GO TO 100
198 
199      ELSE
200       dx   = xxim(imod) - x0
201       dxm  = dxm + dx
202       fmod(imod) = (fmod(imod) + dx * fxd(idat)) / dxm
203       x0   = xxim(imod)
204       dxm  = 0.
205       imod = imod + 1
206       idat = idat + 1
207       IF (imod.LE.imodmax) GO TO 100
208      END IF
209     
210
2113      FORMAT(1x,70(1h-))
2122      FORMAT(1x,8f8.2)
213
214       RETURN
215       END
Note: See TracBrowser for help on using the repository browser.