source: LMDZ5/branches/LF-private/libf/dyn3dmem/conf_dat2d.F @ 5394

Last change on this file since 5394 was 1632, checked in by Laurent Fairhead, 12 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: 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.