source: LMDZ5/trunk/libf/dyn3dmem/conf_dat3d.F @ 1907

Last change on this file since 1907 was 1907, checked in by lguez, 10 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 6.9 KB
Line 
1!
2! $Header$
3!
4C
5C
6      SUBROUTINE conf_dat3d( title, lons,lats,levs,xd,yd,zd,xf,yf,zf,
7     ,                                 champd , interbar             )
8c
9c     Auteur : P. Le Van
10c
11c    Ce s-pr. configure le champ de donnees 3D 'champd' de telle facon
12c       qu'on ait     - pi    a    pi    en longitude
13c       qu'on ait      pi/2.  a - pi/2.  en latitude
14c      et qu'on ait les niveaux verticaux variant du sol vers le ht de l'atmos.
15c           (     en Pascals   ) .
16c
17c      xd et yd  sont les longitudes et latitudes initiales
18c      zd  les pressions initiales
19c
20c      xf et yf  sont les longitudes et latitudes en sortie , eventuellement
21c       modifiees pour etre configurees comme ci-dessus .
22c      zf  les pressions en sortie
23c
24c      champd   en meme temps le champ initial et  final
25c
26c      interbar = .TRUE.  si on appelle l'interpo. barycentrique inter_barxy
27c          sinon , l'interpolation   grille_m  ( grid_atob ) .
28c
29
30      IMPLICIT NONE
31 
32c    ***       Arguments en  entree      ***
33      CHARACTER*(*) :: title
34      INTEGER lons, lats, levs
35      REAL xd(lons), yd(lats), zd(levs)
36      LOGICAL interbar
37c
38c    ***       Arguments en  sortie      ***
39      REAL xf(lons), yf(lats), zf(levs)
40
41c    ***  Arguments en entree et  sortie ***
42      REAL  champd(lons,lats,levs)
43
44c    ***  Variables locales  ***
45c
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
57c      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
143c
144c    ***  On tourne les longit.  pour avoir  - pi  a  +  pi  ****
145c
146            DO i=1,lons
147             IF( xf(i).GT. pi )  THEN
148              GO TO 88
149             ENDIF
150            ENDDO
151
15288          CONTINUE
153c
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
171c   .....    on tourne les longitudes  pour champf  ....
172c
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
187c
188c    *****   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
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
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
Note: See TracBrowser for help on using the repository browser.