source: LMDZ.3.3/trunk/libf/dyn3d/conf_dat3d.F @ 507

Last change on this file since 507 was 426, checked in by lmdz, 22 years ago

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