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

Last change on this file since 363 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: 6.9 KB
RevLine 
[259]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            DEALLOCATE(xtemp)
185        ENDIF
186c
187c    *****   fin  de   IF(invlon)   ****
188         
189         IF ( invlat )    THEN
190
191           IF(.NOT.alloc)  THEN
192            ALLOCATE(champf(lons,lats,levs))
193            alloc = .TRUE.
194           ENDIF
195
196           DO j = 1, lats
197            yf(j) = ytemp(j)
198           ENDDO
199         
200           DO l = 1,levs
201            DO j = 1, lats
202             DO i = 1,lons
203              champf(i,j,l) = champd(i,j,l)
204             ENDDO
205            ENDDO
206
207            DO j = 1, lats
208              ytemp( lats-j+1 ) = yf(j)
209              DO i = 1, lons
210               champd (i,lats-j+1,l) = champf (i,j,l)
211              ENDDO
212            ENDDO
213          ENDDO
214
215          DEALLOCATE(ytemp)
216
217         ENDIF
218
219c    *****  fin  de  IF(invlat)   ****
220c
221c
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
233c
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          DEALLOCATE(ztemp)
277
278      ENDIF
279
280         IF(alloc)  DEALLOCATE(champf)
281
282         DO i = 1, lons
283           xf(i) = xtemp(i)
284         ENDDO
285         DO j = 1, lats
286           yf(j) = ytemp(j)
287         ENDDO
288         DO l = 1, levs
289           zf(l) = ztemp(l)
290         ENDDO
291
292      RETURN
293      END
Note: See TracBrowser for help on using the repository browser.