source: LMDZ5/branches/LF-private/libf/dyn3dmem/conf_dat3d.F @ 5440

Last change on this file since 5440 was 1632, checked in by Laurent Fairhead, 13 years ago

Import initial du répertoire dyn3dmem

Attention! ceci n'est qu'une version préliminaire du code "basse mémoire":
le code contenu dans ce répertoire est basé sur la r1320 et a donc besoin
d'être mis à jour par rapport à la dynamique parallèle d'aujourd'hui.
Ce code est toutefois mis à disposition pour circonvenir à des problèmes
de mémoire que certaines configurations du modèle pourraient rencontrer.
Dans l'état, il compile et tourne sur vargas et au CCRT

Initial import of dyn3dmem

Warning! this is just a preliminary version of the memory light code:
it is based on r1320 of the code and thus needs to be updated before
it can replace the present dyn3dpar code. It is nevertheless put at your
disposal to circumvent some memory problems some LMDZ configurations may
encounter. In its present state, it will compile and run on vargas and CCRT

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.