source: LMDZ4/branches/LMDZ4-dev/libf/dyn3d/inter_barx.F @ 1261

Last change on this file since 1261 was 1220, checked in by lguez, 15 years ago

-- Replaced "integer*4" declarations by "integer", "real*8" by

"real(kind=8)" and "real*4" by "real". Note that these are the only
modifications in the files "radiation_AR4.F" and "sw_aeroAR4.F90".

-- Corrected the kind of arguments to "max" and "min".

-- Replaced "nH" edit descriptors, which is a deleted feature in

Fortran 95, by character strings.

-- "regr_lat_time_climoz" now allows the pressure coordinate in the

input file to be in descending order.

-- Replaced call to not standard function "float" by call to intrinsic

function "real".

-- Included file "radepsi.h" in "physiq" was not used. Removed it.

The following set of modifications is related to the management of time.

-- In "gcm", "leapfrog" and "sortvarc0", "day_ini" was defined as 1

plus number of days between the reference date "(annee_ref,
day_ref)" and the first day of the current simulation. Changed
definition: "(annee_ref, day_ini)" is the first day of the current
simulation. There is an accompanying modification for "day_end".

-- Corrected bug in call to "ioconf_startdate" in "gcm".

-- Added call to "ioconf_calendar" in "create_etat0_limit".
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.6 KB
RevLine 
[524]1!
2! $Header$
3!
4       SUBROUTINE inter_barx ( idatmax,xidat,fdat,imodmax,ximod,fmod )
5
6c      .... Auteurs :  Robert Sadourny ,  P. Le Van  .....
7c
8       IMPLICIT NONE
9c    ----------------------------------------------------------
10c        INTERPOLATION BARYCENTRIQUE BASEE SUR LES AIRES
11c            VERSION UNIDIMENSIONNELLE  ,   EN  LONGITUDE .
12c    ----------------------------------------------------------
13c
14c     idat : indice du champ de donnees, de 1 a idatmax
15c     imod : indice du champ du modele,  de 1 a  imodmax
16c     fdat(idat) : champ de donnees (entrees)
17c     fmod(imod) : champ du modele (sorties)
18c     xidat(idat): abscisses des interfaces des mailles donnees
19c     ximod(imod): abscisses des interfaces des mailles modele
20c      ( L'indice 1 correspond a l'interface mailLE 1 / maille 2)
21c      ( Les abscisses sont exprimes en degres)
22
23
24      INTEGER idatmax, imodmax
25      REAL xidat(idatmax),fdat(idatmax),ximod(imodmax),fmod(imodmax)
26
27c    ...  Variables locales ...
28   
29      REAL xxid(idatmax+1), xxd(idatmax+1), fdd(idatmax+1)
30      REAL  fxd(idatmax+1), xchan(idatmax+1), fdchan(idatmax+1)
31      REAL  xxim(imodmax)
32
33      REAL x0,xim0,dx,dxm
34      REAL chmin,chmax,pi
35
36      INTEGER imod,idat,i,ichang,id0,id1,nid,idatmax1
37     
38      pi = 2. * ASIN(1.)
39
40c  -----------------------------------------------------
41c   REDEFINITION DE L'ORIGINE DES ABSCISSES
42c    A L'INTERFACE OUEST DE LA PREMIERE MAILLE DU MODELE 
43c  -----------------------------------------------------
44      DO imod = 1,imodmax
45       xxim(imod) = ximod(imod)
46      ENDDO
47
48      CALL minmax( imodmax,xxim,chmin,chmax)
49       IF( chmax.LT.6.50 )   THEN
50c        PRINT  3
51c        PRINT *,'   conversion des longit. ximod (donnees en radians)'
52c     , ,' en degres  .'
53c        PRINT  3
54        DO imod = 1, imodmax
55        xxim(imod) = xxim(imod) * 180./pi
56        ENDDO 
57       ENDIF
58
59      xim0 = xxim(imodmax) - 360.
60
61      DO imod = 1, imodmax
62       xxim(imod) = xxim(imod) - xim0
63      ENDDO
64
65      idatmax1 = idatmax +1
66
67      DO idat = 1, idatmax
68       xxd(idat) = xidat(idat)
69      ENDDO
70
71      CALL minmax( idatmax,xxd,chmin,chmax)
72       IF( chmax.LT.6.50 )  THEN
73c        PRINT  3
74c        PRINT *,'   conversion des longit. ximod (donnees en radians)'
75c     , ,' en degres  .'
76c        PRINT  3
77        DO idat = 1, idatmax
78        xxd(idat) = xxd(idat) * 180./pi
79        ENDDO 
80       ENDIF
81
82      DO idat = 1, idatmax
[784]83       xxd(idat) = MOD( xxd(idat) - xim0, 360. )
[524]84       fdd(idat) = fdat (idat)
85      ENDDO
86c       PRINT *,' xxd redef. origine abscisses '
87c       PRINT 2,(xxd(i),i=1,idatmax)
88
89      DO i = 2, idatmax
90        IF( ( xxd(i) - xxd(i-1)).LT.0. )  THEN
91         ichang = i
92         GO TO 5
93        ENDIF
94      ENDDO
95      GO TO 6
96c
97c  ***  reorganisation  des longitudes entre 0. et 360. degres ****
98c
99 5    nid = idatmax - ichang +1
100      DO i = 1, nid
101        xchan (i) = xxd(i+ichang -1 )
102        fdchan(i) = fdd(i+ichang -1 )
103      ENDDO
104       DO i=1,ichang -1
105        xchan (i+ nid) = xxd(i)
106        fdchan(i+nid) = fdd(i)
107       ENDDO
108      DO i =1,idatmax
109       xxd(i) = xchan(i)
110       fdd(i) = fdchan(i)
111      ENDDO
112
113 6    continue
114
115
116c  ------------------------------------------------
117c    translation des champs de donnees par rapport
118c    a la nouvelle origine, avec redondance de la
119c       maille a cheval sur les bords
120c -----------------------------------------------
121
122      id0 = 0
123      id1 = 0
124
125      DO idat = 1, idatmax
126       IF ( xxd( idatmax1- idat ).LT.360.)   GO TO 10
127       id1 = id1 + 1
128      ENDDO
129
130 10   DO idat = 1, idatmax
131       IF (xxd(idat).GT.0.) GO TO 20
132       id0 = id0 + 1
133      END DO
134
135 20   IF( id1.EQ.0 ) GO TO 30
136      DO idat = 1, id1
137       xxid(idat) = xxd(idatmax - id1 + idat) - 360.
138       fxd (idat) = fdd(idatmax - id1 + idat)     
139      END DO
140      DO idat = 1, idatmax - id1
141       xxid(idat + id1) = xxd(idat)
142       fxd (idat + id1) = fdd(idat)
143      END DO
144
145  30  IF(id0.EQ.0) GO TO 40
146      DO idat = 1, idatmax - id0
147       xxid(idat) = xxd(idat + id0)
148       fxd (idat) = fdd(idat + id0)
149      END DO
150
151      DO idat = 1, id0
152       xxid (idatmax - id0 + idat) =  xxd(idat) + 360.
153       fxd  (idatmax - id0 + idat) =  fdd(idat)   
154      END DO
155      GO TO 50
156 
157 40   DO idat = 1, idatmax
158       xxid(idat)  = xxd(idat)
159       fxd (idat)  = fdd(idat)
160      ENDDO
161
162 50   xxid(idatmax1) = xxid(1) + 360.
163      fxd (idatmax1) = fxd(1)
164
165c  ------------------------------------
166c   initialisation du champ du modele
167
168      DO imod = 1, imodmax
169       fmod(imod) = 0.
170      END DO
171 
172c      PRINT *,' id0 id1 ',id0,id1
173c      PRINT *,' xxim apres translation  '
174c      PRINT 2,(xxim(i),i=1,imodmax)
175c      PRINT *,' xxid apres translation '
176c      PRINT 2,(xxid(i),i=1,idatmax)
177c ---------------------------------------
178c iteration
179
180      x0   = xim0
181      dxm  = 0.
182      imod = 1
183      idat = 1
184 
185 100  IF (xxim(imod).LT.xxid(idat)) THEN
186       dx   = xxim(imod) - x0
187       dxm  = dxm + dx
188       fmod(imod) = (fmod(imod) + dx * fxd(idat)) / dxm
189       x0   = xxim(imod)
190       dxm  = 0.
191       imod = imod + 1
192       IF (imod.LE.imodmax) GO TO 100
193 
194      ELSE IF (xxim(imod).GT.xxid(idat)) THEN
195       dx   = xxid(idat) - x0
196       dxm  = dxm + dx
197       fmod(imod) = fmod(imod) + dx * fxd(idat)
198       x0   = xxid(idat)
199       idat = idat + 1
200       GO TO 100
201 
202      ELSE
203       dx   = xxim(imod) - x0
204       dxm  = dxm + dx
205       fmod(imod) = (fmod(imod) + dx * fxd(idat)) / dxm
206       x0   = xxim(imod)
207       dxm  = 0.
208       imod = imod + 1
209       idat = idat + 1
210       IF (imod.LE.imodmax) GO TO 100
211      END IF
212     
213
[1220]2143      FORMAT(1x,70("-"))
[524]2152      FORMAT(1x,8f8.2)
216
217       RETURN
[790]218       END
Note: See TracBrowser for help on using the repository browser.