My Project
 All Classes Files Functions Variables Macros
conf_dat3d.F
Go to the documentation of this file.
1 !
2 ! $Header$
3 !
4 C
5 C
6  SUBROUTINE conf_dat3d( title, lons,lats,levs,xd,yd,zd,xf,yf,zf,
7  , champd , interbar )
8 c
9 c Auteur : P. Le Van
10 c
11 c Ce s-pr. configure le champ de donnees 3D 'champd' de telle facon
12 c qu'on ait - pi a pi en longitude
13 c qu'on ait pi/2. a - pi/2. en latitude
14 c et qu'on ait les niveaux verticaux variant du sol vers le ht de l'atmos.
15 c ( en Pascals ) .
16 c
17 c xd et yd sont les longitudes et latitudes initiales
18 c zd les pressions initiales
19 c
20 c xf et yf sont les longitudes et latitudes en sortie , eventuellement
21 c modifiees pour etre configurees comme ci-dessus .
22 c zf les pressions en sortie
23 c
24 c champd en meme temps le champ initial et final
25 c
26 c interbar = .TRUE. si on appelle l'interpo. barycentrique inter_barxy
27 c sinon , l'interpolation grille_m ( grid_atob ) .
28 c
29 
30  IMPLICIT NONE
31 
32 c *** Arguments en entree ***
33  CHARACTER*(*) :: title
34  INTEGER lons, lats, levs
35  REAL xd(lons), yd(lats), zd(levs)
36  LOGICAL interbar
37 c
38 c *** Arguments en sortie ***
39  REAL xf(lons), yf(lats), zf(levs)
40 
41 c *** Arguments en entree et sortie ***
42  REAL champd(lons,lats,levs)
43 
44 c *** Variables locales ***
45 c
46  REAL pi,pis2,depi,presmax
47  LOGICAL radianlon, invlon ,radianlat, invlat, invlev, alloc
48  REAL rlatmin,rlatmax,oldxd1
49  INTEGER i,j,ip180,ind,l
50 
51  REAL, ALLOCATABLE :: xtemp(:)
52  REAL, ALLOCATABLE :: ytemp(:)
53  REAL, ALLOCATABLE :: ztemp(:)
54  REAL, ALLOCATABLE :: champf(:,:,:)
55 
56 
57 c WRITE(6,*) ' Conf_dat3d pour ',title
58 
59  ALLOCATE(xtemp(lons))
60  ALLOCATE(ytemp(lats))
61  ALLOCATE(ztemp(levs))
62 
63  DO i = 1, lons
64  xtemp(i) = xd(i)
65  ENDDO
66  DO j = 1, lats
67  ytemp(j) = yd(j)
68  ENDDO
69  DO l = 1, levs
70  ztemp(l) = zd(l)
71  ENDDO
72 
73  pi = 2. * asin(1.)
74  pis2 = pi/2.
75  depi = 2. * pi
76 
77  IF( xtemp(1).GE.-pi-0.5.AND. xtemp(lons).LE.pi+0.5 ) THEN
78  radianlon = .true.
79  invlon = .false.
80  ELSE IF (xtemp(1).GE.-0.5.AND.xtemp(lons).LE.depi+0.5 ) THEN
81  radianlon = .true.
82  invlon = .true.
83  ELSE IF ( xtemp(1).GE.-180.5.AND. xtemp(lons).LE.180.5 ) THEN
84  radianlon = .false.
85  invlon = .false.
86  ELSE IF ( xtemp(1).GE.-0.5.AND.xtemp(lons).LE.360.5 ) THEN
87  radianlon = .false.
88  invlon = .true.
89  ELSE
90  WRITE(6,*) 'Pbs. sur les longitudes des donnees pour le fichier'
91  , , title
92  ENDIF
93 
94  invlat = .false.
95 
96  IF( ytemp(1).LT.ytemp(lats) ) THEN
97  invlat = .true.
98  ENDIF
99 
100  rlatmin = min( ytemp(1), ytemp(lats) )
101  rlatmax = max( ytemp(1), ytemp(lats) )
102 
103  IF( rlatmin.GE.-pis2-0.5.AND.rlatmax.LE.pis2+0.5)THEN
104  radianlat = .true.
105  ELSE IF ( rlatmin.GE.-90.-0.5.AND.rlatmax.LE.90.+0.5 ) THEN
106  radianlat = .false.
107  ELSE
108  WRITE(6,*) ' Pbs. sur les latitudes des donnees pour le fichier'
109  , , title
110  ENDIF
111 
112  IF( .NOT. radianlon ) THEN
113  DO i = 1, lons
114  xtemp(i) = xtemp(i) * pi/180.
115  ENDDO
116  ENDIF
117 
118  IF( .NOT. radianlat ) THEN
119  DO j = 1, lats
120  ytemp(j) = ytemp(j) * pi/180.
121  ENDDO
122  ENDIF
123 
124 
125  alloc =.false.
126 
127  IF ( invlon ) THEN
128 
129  ALLOCATE(champf(lons,lats,levs))
130  alloc = .true.
131 
132  DO i = 1 ,lons
133  xf(i) = xtemp(i)
134  ENDDO
135 
136  DO l = 1, levs
137  DO j = 1, lats
138  DO i= 1, lons
139  champf(i,j,l) = champd(i,j,l)
140  ENDDO
141  ENDDO
142  ENDDO
143 c
144 c *** On tourne les longit. pour avoir - pi a + pi ****
145 c
146  DO i=1,lons
147  IF( xf(i).GT. pi ) THEN
148  go to 88
149  ENDIF
150  ENDDO
151 
152 88 CONTINUE
153 c
154  ip180 = i
155 
156  DO i = 1,lons
157  IF (xf(i).GT. pi) THEN
158  xf(i) = xf(i) - depi
159  ENDIF
160  ENDDO
161 
162  DO i= ip180,lons
163  ind = i-ip180 +1
164  xtemp(ind) = xf(i)
165  ENDDO
166 
167  DO i= ind +1,lons
168  xtemp(i) = xf(i-ind)
169  ENDDO
170 
171 c ..... on tourne les longitudes pour champf ....
172 c
173  DO l = 1,levs
174  DO j = 1,lats
175  DO i = ip180,lons
176  ind = i-ip180 +1
177  champd(ind,j,l) = champf(i,j,l)
178  ENDDO
179 
180  DO i= ind +1,lons
181  champd(i,j,l) = champf(i-ind,j,l)
182  ENDDO
183  ENDDO
184  ENDDO
185 
186  ENDIF
187 c
188 c ***** fin de IF(invlon) ****
189 
190  IF ( invlat ) THEN
191 
192  IF(.NOT.alloc) THEN
193  ALLOCATE(champf(lons,lats,levs))
194  alloc = .true.
195  ENDIF
196 
197  DO j = 1, lats
198  yf(j) = ytemp(j)
199  ENDDO
200 
201  DO l = 1,levs
202  DO j = 1, lats
203  DO i = 1,lons
204  champf(i,j,l) = champd(i,j,l)
205  ENDDO
206  ENDDO
207 
208  DO j = 1, lats
209  ytemp( lats-j+1 ) = yf(j)
210  DO i = 1, lons
211  champd(i,lats-j+1,l) = champf(i,j,l)
212  ENDDO
213  ENDDO
214  ENDDO
215 
216 
217  ENDIF
218 
219 c ***** fin de IF(invlat) ****
220 c
221 c
222  IF( interbar ) THEN
223  oldxd1 = xtemp(1)
224  DO i = 1, lons -1
225  xtemp(i) = 0.5 * ( xtemp(i) + xtemp(i+1) )
226  ENDDO
227  xtemp(lons) = 0.5 * ( xtemp(lons) + oldxd1 + depi )
228 
229  DO j = 1, lats -1
230  ytemp(j) = 0.5 * ( ytemp(j) + ytemp(j+1) )
231  ENDDO
232  ENDIF
233 c
234 
235  invlev = .false.
236  IF( ztemp(1).LT.ztemp(levs) ) invlev = .true.
237 
238  presmax = max( ztemp(1), ztemp(levs) )
239  IF( presmax.LT.1200. ) THEN
240  DO l = 1,levs
241  ztemp(l) = ztemp(l) * 100.
242  ENDDO
243  ENDIF
244 
245  IF( invlev ) THEN
246 
247  IF(.NOT.alloc) THEN
248  ALLOCATE(champf(lons,lats,levs))
249  alloc = .true.
250  ENDIF
251 
252  DO l = 1,levs
253  zf(l) = ztemp(l)
254  ENDDO
255 
256  DO l = 1,levs
257  DO j = 1, lats
258  DO i = 1,lons
259  champf(i,j,l) = champd(i,j,l)
260  ENDDO
261  ENDDO
262  ENDDO
263 
264  DO l = 1,levs
265  ztemp(levs+1-l) = zf(l)
266  ENDDO
267 
268  DO l = 1,levs
269  DO j = 1, lats
270  DO i = 1,lons
271  champd(i,j,levs+1-l) = champf(i,j,l)
272  ENDDO
273  ENDDO
274  ENDDO
275 
276 
277  ENDIF
278 
279  IF(alloc) DEALLOCATE(champf)
280 
281  DO i = 1, lons
282  xf(i) = xtemp(i)
283  ENDDO
284  DO j = 1, lats
285  yf(j) = ytemp(j)
286  ENDDO
287  DO l = 1, levs
288  zf(l) = ztemp(l)
289  ENDDO
290 
291  DEALLOCATE(xtemp)
292  DEALLOCATE(ytemp)
293  DEALLOCATE(ztemp)
294 
295  RETURN
296  END