/[lmdze]/trunk/dyn3d/Inter_barxy/inter_barx.f
ViewVC logotype

Annotation of /trunk/dyn3d/Inter_barxy/inter_barx.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 98 - (hide annotations)
Tue May 13 17:23:16 2014 UTC (10 years ago) by guez
File size: 5122 byte(s) 
Split inter_barxy.f : one procedure per module, one module per
file. Grouped the files into a directory.

Split orbite.f.

Value of raz_date read from the namelist is taken into account
(resetting the step counter) even if annee_ref == anneeref and day_ref
== dayref. raz_date is no longer modified by gcm main unit. (Following
LMDZ.)

Removed argument klon of interfsur_lim. Renamed arguments lmt_alb,
lmt_rug to alb_new, z0_new (same name as corresponding actual
arguments in interfsurf_hq).

Removed argument klon of interfsurf_hq.

Removed arguments qs and d_qs of diagetpq. Were always
zero. Downgraded arguments d_qw, d_ql of diagetpq to local variables,
they were not used in physiq. Removed all computations for solid water
in diagetpq, was just zero.


Downgraded arguments fs_bound, fq_bound of diagphy to local variables,
they were not used in physiq. Encapsulated in a test on iprt all
computations in diagphy.

Removed parameter nbtr of module dimphy. Replaced it everywhere in the
program by nqmx - 2.

Removed parameter rnpb of procedure physiq. Kept the true case in
physiq and phytrac. Could not work with false case anyway.

Removed arguments klon, llm, airephy of qcheck. Removed argument ftsol
of initrrnpb, was not used.
1 guez 98 module inter_barx_m
2    
3     implicit none
4    
5     contains
6    
7    
8     !******************************
9    
10     function inter_barx(dlonid, fdat, rlonimod)
11    
12     ! From dyn3d/inter_barx.F, v 1.1.1.1 2004/05/19 12:53:06
13    
14     ! Auteurs : Robert Sadourny, P. Le Van
15    
16     ! INTERPOLATION BARYCENTRIQUE BASEE SUR LES AIRES
17     ! VERSION UNIDIMENSIONNELLE , EN LONGITUDE .
18    
19     ! idat : indice du champ de donnees, de 1 a idatmax
20     ! imod : indice du champ du modele, de 1 a imodmax
21     ! fdat(idat) : champ de donnees (entrees)
22     ! inter_barx(imod) : champ du modele (sorties)
23     ! dlonid(idat): abscisses des interfaces des mailles donnees
24     ! rlonimod(imod): abscisses des interfaces des mailles modele
25     ! ( L'indice 1 correspond a l'interface mailLE 1 / maille 2)
26     ! ( Les abscisses sont exprimées en degres)
27    
28     use nr_util, only: assert_eq
29    
30    
31     REAL, intent(in):: dlonid(:)
32     real, intent(in):: fdat(:)
33     real, intent(in):: rlonimod(:)
34    
35     real inter_barx(size(rlonimod))
36    
37     ! ... Variables locales ...
38    
39     INTEGER idatmax, imodmax
40     REAL xxid(size(dlonid)+1), xxd(size(dlonid)+1), fdd(size(dlonid)+1)
41     REAL fxd(size(dlonid)+1), xchan(size(dlonid)+1), fdchan(size(dlonid)+1)
42     REAL xxim(size(rlonimod))
43    
44     REAL x0, xim0, dx, dxm
45     REAL chmin, chmax, pi
46    
47     INTEGER imod, idat, i, ichang, id0, id1, nid, idatmax1
48    
49     !-----------------------------------------------------
50    
51     idatmax = assert_eq(size(dlonid), size(fdat), "inter_barx idatmax")
52     imodmax = size(rlonimod)
53    
54     pi = 2. * ASIN(1.)
55    
56     ! REDEFINITION DE L'ORIGINE DES ABSCISSES
57     ! A L'INTERFACE OUEST DE LA PREMIERE MAILLE DU MODELE
58     DO imod = 1, imodmax
59     xxim(imod) = rlonimod(imod)
60     ENDDO
61    
62     CALL minmax( imodmax, xxim, chmin, chmax)
63     IF( chmax.LT.6.50 ) THEN
64     DO imod = 1, imodmax
65     xxim(imod) = xxim(imod) * 180./pi
66     ENDDO
67     ENDIF
68    
69     xim0 = xxim(imodmax) - 360.
70    
71     DO imod = 1, imodmax
72     xxim(imod) = xxim(imod) - xim0
73     ENDDO
74    
75     idatmax1 = idatmax +1
76    
77     DO idat = 1, idatmax
78     xxd(idat) = dlonid(idat)
79     ENDDO
80    
81     CALL minmax( idatmax, xxd, chmin, chmax)
82     IF( chmax.LT.6.50 ) THEN
83     DO idat = 1, idatmax
84     xxd(idat) = xxd(idat) * 180./pi
85     ENDDO
86     ENDIF
87    
88     DO idat = 1, idatmax
89     xxd(idat) = AMOD( xxd(idat) - xim0, 360. )
90     fdd(idat) = fdat (idat)
91     ENDDO
92    
93     i = 2
94     DO while (xxd(i) >= xxd(i-1) .and. i < idatmax)
95     i = i + 1
96     ENDDO
97     IF (xxd(i) < xxd(i-1)) THEN
98     ichang = i
99     ! *** reorganisation des longitudes entre 0. et 360. degres ****
100     nid = idatmax - ichang +1
101     DO i = 1, nid
102     xchan (i) = xxd(i+ichang -1 )
103     fdchan(i) = fdd(i+ichang -1 )
104     ENDDO
105     DO i=1, ichang -1
106     xchan (i+ nid) = xxd(i)
107     fdchan(i+nid) = fdd(i)
108     ENDDO
109     DO i =1, idatmax
110     xxd(i) = xchan(i)
111     fdd(i) = fdchan(i)
112     ENDDO
113     end IF
114    
115     ! translation des champs de donnees par rapport
116     ! a la nouvelle origine, avec redondance de la
117     ! maille a cheval sur les bords
118    
119     id0 = 0
120     id1 = 0
121    
122     DO idat = 1, idatmax
123     IF ( xxd( idatmax1- idat ).LT.360.) exit
124     id1 = id1 + 1
125     ENDDO
126    
127     DO idat = 1, idatmax
128     IF (xxd(idat).GT.0.) exit
129     id0 = id0 + 1
130     END DO
131    
132     IF( id1 /= 0 ) then
133     DO idat = 1, id1
134     xxid(idat) = xxd(idatmax - id1 + idat) - 360.
135     fxd (idat) = fdd(idatmax - id1 + idat)
136     END DO
137     DO idat = 1, idatmax - id1
138     xxid(idat + id1) = xxd(idat)
139     fxd (idat + id1) = fdd(idat)
140     END DO
141     end IF
142    
143     IF(id0 /= 0) then
144     DO idat = 1, idatmax - id0
145     xxid(idat) = xxd(idat + id0)
146     fxd (idat) = fdd(idat + id0)
147     END DO
148    
149     DO idat = 1, id0
150     xxid (idatmax - id0 + idat) = xxd(idat) + 360.
151     fxd (idatmax - id0 + idat) = fdd(idat)
152     END DO
153     else
154     DO idat = 1, idatmax
155     xxid(idat) = xxd(idat)
156     fxd (idat) = fdd(idat)
157     ENDDO
158     end IF
159     xxid(idatmax1) = xxid(1) + 360.
160     fxd (idatmax1) = fxd(1)
161    
162     ! initialisation du champ du modele
163    
164     inter_barx(:) = 0.
165    
166     ! iteration
167    
168     x0 = xim0
169     dxm = 0.
170     imod = 1
171     idat = 1
172    
173     do while (imod <= imodmax)
174     do while (xxim(imod).GT.xxid(idat))
175     dx = xxid(idat) - x0
176     dxm = dxm + dx
177     inter_barx(imod) = inter_barx(imod) + dx * fxd(idat)
178     x0 = xxid(idat)
179     idat = idat + 1
180     end do
181     IF (xxim(imod).LT.xxid(idat)) THEN
182     dx = xxim(imod) - x0
183     dxm = dxm + dx
184     inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm
185     x0 = xxim(imod)
186     dxm = 0.
187     imod = imod + 1
188     ELSE
189     dx = xxim(imod) - x0
190     dxm = dxm + dx
191     inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm
192     x0 = xxim(imod)
193     dxm = 0.
194     imod = imod + 1
195     idat = idat + 1
196     END IF
197     end do
198    
199     END function inter_barx
200    
201     end module inter_barx_m
  ViewVC Help
Powered by ViewVC 1.1.21