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