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

Last change on this file since 259 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: 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
48      DO i = 1, lons
49       xtemp(i) = xd(i)
50      ENDDO
51      DO j = 1, lats
52       ytemp(j) = yd(j)
53      ENDDO
54
55      pi   = 2. * ASIN(1.)
56      pis2 = pi/2.
57      depi = 2. * pi
58
59            radianlon = .FALSE.
60      IF( xtemp(1).GE.-pi-0.5.AND. xtemp(lons).LE.pi+0.5 )  THEN
61            radianlon = .TRUE.
62            invlon    = .FALSE.
63      ELSE IF (xtemp(1).GE.-0.5.AND.xtemp(lons).LE.depi+0.5 ) THEN
64            radianlon = .TRUE.
65            invlon    = .TRUE.
66      ELSE IF ( xtemp(1).GE.-180.5.AND. xtemp(lons).LE.180.5 )   THEN
67            radianlon = .FALSE.
68            invlon    = .FALSE.
69      ELSE IF ( xtemp(1).GE.-0.5.AND.xtemp(lons).LE.360.5 )   THEN
70            radianlon = .FALSE.
71            invlon    = .TRUE.
72      ELSE
73        WRITE(6,*) 'Pbs. sur les longitudes des donnees pour le fichier'
74     ,  , title
75      ENDIF
76
77      invlat = .FALSE.
78     
79      IF( ytemp(1).LT.ytemp(lats) ) THEN
80        invlat = .TRUE.
81      ENDIF
82
83      rlatmin = MIN( ytemp(1), ytemp(lats) )
84      rlatmax = MAX( ytemp(1), ytemp(lats) )
85     
86      IF( rlatmin.GE.-pis2-0.5.AND.rlatmax.LE.pis2+0.5)THEN
87             radianlat = .TRUE.
88      ELSE IF ( rlatmin.GE.-90.-0.5.AND.rlatmax.LE.90.+0.5 ) THEN
89             radianlat = .FALSE.
90      ELSE
91        WRITE(6,*) ' Pbs. sur les latitudes des donnees pour le fichier'
92     ,  , title
93      ENDIF
94
95       IF( .NOT. radianlon )  THEN
96         DO i = 1, lons
97          xtemp(i) = xtemp(i) * pi/180.
98         ENDDO
99       ENDIF
100
101       IF( .NOT. radianlat )  THEN
102         DO j = 1, lats
103          ytemp(j) = ytemp(j) * pi/180.
104         ENDDO   
105       ENDIF
106
107
108        IF ( invlon )   THEN
109
110           ALLOCATE(champf(lons,lats))
111           alloc = .TRUE.
112
113           DO i = 1 ,lons
114            xf(i) = xtemp(i)
115           ENDDO
116c
117c    ***  On tourne les longit.  pour avoir  - pi  a  +  pi  ****
118c
119           DO i=1,lons
120            IF( xf(i).GT. pi )  THEN
121            GO TO 88
122            ENDIF
123           ENDDO
124
12588         CONTINUE
126c
127           ip180 = i
128
129           DO i = 1,lons
130            IF (xf(i).GT. pi)  THEN
131             xf(i) = xf(i) - depi
132            ENDIF
133           ENDDO
134
135           DO i= ip180,lons
136            ind = i-ip180 +1
137            xtemp(ind) = xf(i)
138           ENDDO
139
140           DO i= ind +1,lons
141            xtemp(i) = xf(i-ind)
142           ENDDO
143
144c   .....    on tourne les longitudes  pour  champf ....
145c
146           DO j = 1,lats
147
148             DO i = ip180,lons
149              ind  = i-ip180 +1
150              champd (ind,j) = champf (i,j)
151             ENDDO
152   
153             DO i= ind +1,lons
154              champd (i,j)  = champf (i-ind,j)
155             ENDDO
156
157           ENDDO
158
159
160        ENDIF
161c
162c    *****   fin  de   IF(invlon)   ****
163
164         IF ( invlat )    THEN
165
166           IF(.NOT.alloc)  THEN
167            ALLOCATE(champf(lons,lats))
168            alloc = .TRUE.
169           ENDIF
170
171           DO j = 1,lats
172            yf(j) = ytemp(j)
173           ENDDO
174
175           DO j = 1, lats
176             DO i = 1,lons
177              champf(i,j) = champd(i,j)
178             ENDDO
179           ENDDO
180
181           DO j = 1, lats
182              ytemp( lats-j+1 ) = yf(j)
183              DO i = 1, lons
184               champd (i,lats-j+1) = champf (i,j)
185              ENDDO
186           ENDDO
187
188
189         ENDIF
190
191c    *****  fin  de  IF(invlat)   ****
192
193c       
194      IF( interbar )  THEN
195        oldxd1 = xtemp(1)
196        DO i = 1, lons -1
197          xtemp(i) = 0.5 * ( xtemp(i) + xtemp(i+1) )
198        ENDDO
199          xtemp(lons) = 0.5 * ( xtemp(lons) + oldxd1 + depi )
200
201        DO j = 1, lats -1
202          ytemp(j) = 0.5 * ( ytemp(j) + ytemp(j+1) )
203        ENDDO
204
205      ENDIF
206c
207       IF(alloc) DEALLOCATE(champf)
208
209       DO i = 1, lons
210        xf(i) = xtemp(i)
211       ENDDO
212       DO j = 1, lats
213        yf(j) = ytemp(j)
214       ENDDO
215
216      RETURN
217      END
Note: See TracBrowser for help on using the repository browser.