source: LMDZ.3.3/trunk/libf/dyn3d/conf_dat2d.F @ 346

Last change on this file since 346 was 269, checked in by lmdz, 23 years ago

Remplacement des allocates par des dimensionnements classiques. 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: 5.0 KB
Line 
1C
2C $Header$
3C
4      SUBROUTINE conf_dat2d( title,lons,lats,xd,yd,xf,yf,champd ,
5     ,                           interbar                        )
6c
7c     Auteur :  P. Le Van
8
9c    Ce s-pr. configure le champ de donnees 2D 'champd' de telle facon que
10c       qu'on ait     - pi    a    pi    en longitude
11c       et qu'on ait   pi/2.  a - pi/2.  en latitude
12c
13c      xd et yd  sont les longitudes et latitudes initiales
14c      xf et yf  sont les longitudes et latitudes en sortie , eventuellement
15c      modifiees pour etre configurees comme ci-dessus .
16
17      IMPLICIT NONE
18 
19c    ***       Arguments en  entree      ***
20      INTEGER lons,lats
21      CHARACTER*25 title
22      REAL xd(lons),yd(lats)
23      LOGICAL interbar
24c
25c    ***       Arguments en  sortie      ***
26      REAL xf(lons),yf(lats)
27c
28c    ***  Arguments en entree et  sortie ***
29      REAL champd(lons,lats)
30
31c   ***     Variables  locales  ***
32c
33      REAL pi,pis2,depi
34      LOGICAL radianlon, invlon ,radianlat, invlat, alloc
35      REAL rlatmin,rlatmax,oldxd1
36      INTEGER i,j,ip180,ind
37
38      REAL, ALLOCATABLE :: xtemp(:)
39      REAL, ALLOCATABLE :: ytemp(:)
40      REAL, ALLOCATABLE :: champf(:,:)
41     
42c
43c      WRITE(6,*) ' conf_dat2d  pour la variable ', title
44
45      ALLOCATE( xtemp(lons) )
46      ALLOCATE( ytemp(lats) )
47      ALLOCATE( champf(lons,lats) )
48
49      DO i = 1, lons
50       xtemp(i) = xd(i)
51      ENDDO
52      DO j = 1, lats
53       ytemp(j) = yd(j)
54      ENDDO
55
56      pi   = 2. * ASIN(1.)
57      pis2 = pi/2.
58      depi = 2. * pi
59
60            radianlon = .FALSE.
61      IF( xtemp(1).GE.-pi-0.5.AND. xtemp(lons).LE.pi+0.5 )  THEN
62            radianlon = .TRUE.
63            invlon    = .FALSE.
64      ELSE IF (xtemp(1).GE.-0.5.AND.xtemp(lons).LE.depi+0.5 ) THEN
65            radianlon = .TRUE.
66            invlon    = .TRUE.
67      ELSE IF ( xtemp(1).GE.-180.5.AND. xtemp(lons).LE.180.5 )   THEN
68            radianlon = .FALSE.
69            invlon    = .FALSE.
70      ELSE IF ( xtemp(1).GE.-0.5.AND.xtemp(lons).LE.360.5 )   THEN
71            radianlon = .FALSE.
72            invlon    = .TRUE.
73      ELSE
74        WRITE(6,*) 'Pbs. sur les longitudes des donnees pour le fichier'
75     ,  , title
76      ENDIF
77
78      invlat = .FALSE.
79     
80      IF( ytemp(1).LT.ytemp(lats) ) THEN
81        invlat = .TRUE.
82      ENDIF
83
84      rlatmin = MIN( ytemp(1), ytemp(lats) )
85      rlatmax = MAX( ytemp(1), ytemp(lats) )
86     
87      IF( rlatmin.GE.-pis2-0.5.AND.rlatmax.LE.pis2+0.5)THEN
88             radianlat = .TRUE.
89      ELSE IF ( rlatmin.GE.-90.-0.5.AND.rlatmax.LE.90.+0.5 ) THEN
90             radianlat = .FALSE.
91      ELSE
92        WRITE(6,*) ' Pbs. sur les latitudes des donnees pour le fichier'
93     ,  , title
94      ENDIF
95
96       IF( .NOT. radianlon )  THEN
97         DO i = 1, lons
98          xtemp(i) = xtemp(i) * pi/180.
99         ENDDO
100       ENDIF
101
102       IF( .NOT. radianlat )  THEN
103         DO j = 1, lats
104          ytemp(j) = ytemp(j) * pi/180.
105         ENDDO   
106       ENDIF
107
108
109        IF ( invlon )   THEN
110
111           DO j = 1, lats
112            DO i = 1,lons
113             champf(i,j) = champd(i,j)
114            ENDDO
115           ENDDO
116
117           DO i = 1 ,lons
118            xf(i) = xtemp(i)
119           ENDDO
120c
121c    ***  On tourne les longit.  pour avoir  - pi  a  +  pi  ****
122c
123           DO i=1,lons
124            IF( xf(i).GT. pi )  THEN
125            GO TO 88
126            ENDIF
127           ENDDO
128
12988         CONTINUE
130c
131           ip180 = i
132
133           DO i = 1,lons
134            IF (xf(i).GT. pi)  THEN
135             xf(i) = xf(i) - depi
136            ENDIF
137           ENDDO
138
139           DO i= ip180,lons
140            ind = i-ip180 +1
141            xtemp(ind) = xf(i)
142           ENDDO
143
144           DO i= ind +1,lons
145            xtemp(i) = xf(i-ind)
146           ENDDO
147
148c   .....    on tourne les longitudes  pour  champf ....
149c
150           DO j = 1,lats
151
152             DO i = ip180,lons
153              ind  = i-ip180 +1
154              champd (ind,j) = champf (i,j)
155             ENDDO
156   
157             DO i= ind +1,lons
158              champd (i,j)  = champf (i-ind,j)
159             ENDDO
160
161           ENDDO
162
163
164        ENDIF
165c
166c    *****   fin  de   IF(invlon)   ****
167
168         IF ( invlat )    THEN
169
170           DO j = 1,lats
171            yf(j) = ytemp(j)
172           ENDDO
173
174           DO j = 1, lats
175             DO i = 1,lons
176              champf(i,j) = champd(i,j)
177             ENDDO
178           ENDDO
179
180           DO j = 1, lats
181              ytemp( lats-j+1 ) = yf(j)
182              DO i = 1, lons
183               champd (i,lats-j+1) = champf (i,j)
184              ENDDO
185           ENDDO
186
187
188         ENDIF
189
190c    *****  fin  de  IF(invlat)   ****
191
192c       
193      IF( interbar )  THEN
194        oldxd1 = xtemp(1)
195        DO i = 1, lons -1
196          xtemp(i) = 0.5 * ( xtemp(i) + xtemp(i+1) )
197        ENDDO
198          xtemp(lons) = 0.5 * ( xtemp(lons) + oldxd1 + depi )
199
200        DO j = 1, lats -1
201          ytemp(j) = 0.5 * ( ytemp(j) + ytemp(j+1) )
202        ENDDO
203
204      ENDIF
205c
206        DEALLOCATE(champf)
207
208       DO i = 1, lons
209        xf(i) = xtemp(i)
210       ENDDO
211       DO j = 1, lats
212        yf(j) = ytemp(j)
213       ENDDO
214
215      RETURN
216      END
Note: See TracBrowser for help on using the repository browser.