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

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

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