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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 266 - (show annotations)
Thu Apr 19 17:54:55 2018 UTC (5 years, 11 months ago) by guez
File size: 4834 byte(s)
Define macros of the preprocessor CPP_IIM, CPP_JJM, CPP_LLM so we can
control the resolution from the compilation command, and automate
compilation for several resolutions.

In module yoethf_m, transform variables into named constants. So we do
not need procedure yoethf any longer.

Bug fix in program test_inter_barxy, missing calls to fyhyp and fxhyp,
and definition of rlatu.

Remove variable iecri of module conf_gcm_m. The files dyn_hist*.nc are
written every time step. We are simplifying the output system, pending
replacement by a whole new system.

Modify possible value of vert_sampling from "param" to
"strato_custom", following LMDZ. Default values of corresponding
namelist variables are now the values used for LMDZ CMIP6.

1 module inter_barx_m
2
3 implicit none
4
5 contains
6
7 function inter_barx(dlonid, fdat, rlonimod)
8
9 ! From dyn3d/inter_barx.F, version 1.1.1.1, 2004/05/19 12:53:06
10
11 ! Authors: Robert Sadourny, P. Le Van
12
13 ! Interpolation barycentrique bas\'ee sur les aires. Version
14 ! unidimensionnelle, en longitude.
15
16 use nr_util, only: assert_eq, pi
17
18 REAL, intent(in):: dlonid(:) ! (idatmax)
19 ! abscisses des interfaces des mailles donn\'ees
20
21 real, intent(in):: fdat(:) ! (idatmax) champ de donn\'ees
22
23 real, intent(in):: rlonimod(:) ! (imodmax)
24 ! Abscisses des interfaces des mailles mod\`ele. L'indice 1
25 ! correspond a l'interface maille 1 / maille 2. Les abscisses sont
26 ! exprim\'ees en degres.
27
28 real inter_barx(size(rlonimod)) ! champ du mod\`ele
29
30 ! Local:
31 INTEGER idatmax, imodmax
32 REAL xxid(size(dlonid)+1), xxd(size(dlonid)+1), fdd(size(dlonid)+1)
33 REAL fxd(size(dlonid)+1), xchan(size(dlonid)+1), fdchan(size(dlonid)+1)
34 REAL xxim(size(rlonimod))
35 REAL x0, xim0, dx, dxm
36 REAL chmax
37 integer idat ! indice du champ de donnees, de 1 a idatmax
38 INTEGER imod ! indice du champ du modele, de 1 a imodmax
39 integer i, ichang, id0, id1, nid, idatmax1
40
41 !-----------------------------------------------------
42
43 idatmax = assert_eq(size(dlonid), size(fdat), "inter_barx idatmax")
44 imodmax = size(rlonimod)
45
46 ! Red\'efinition de l'origine des abscisses \`a l'interface ouest de
47 ! la premi\`ere maille du mod\`ele
48 DO imod = 1, imodmax
49 xxim(imod) = rlonimod(imod)
50 ENDDO
51
52 chmax = maxval(xxim)
53 IF(chmax < 6.50) THEN
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) = dlonid(idat)
69 ENDDO
70
71 chmax = maxval(xxd(:idatmax))
72 IF(chmax < 6.50) THEN
73 DO idat = 1, idatmax
74 xxd(idat) = xxd(idat) * 180./pi
75 ENDDO
76 ENDIF
77
78 DO idat = 1, idatmax
79 xxd(idat) = AMOD(xxd(idat) - xim0, 360.)
80 fdd(idat) = fdat (idat)
81 ENDDO
82
83 i = 2
84 DO while (xxd(i) >= xxd(i-1) .and. i < idatmax)
85 i = i + 1
86 ENDDO
87 IF (xxd(i) < xxd(i-1)) THEN
88 ichang = i
89 ! R\'eorganisation des longitudes entre 0 et 360 degr\'es
90 nid = idatmax - ichang +1
91 DO i = 1, nid
92 xchan (i) = xxd(i+ichang -1)
93 fdchan(i) = fdd(i+ichang -1)
94 ENDDO
95 DO i=1, ichang -1
96 xchan (i+ nid) = xxd(i)
97 fdchan(i+nid) = fdd(i)
98 ENDDO
99 DO i =1, idatmax
100 xxd(i) = xchan(i)
101 fdd(i) = fdchan(i)
102 ENDDO
103 end IF
104
105 ! Translation des champs de donn\'ees par rapport \`a la nouvelle
106 ! origine, avec redondance de la maille \`a cheval sur les bords
107
108 id0 = 0
109 id1 = 0
110
111 DO idat = 1, idatmax
112 IF (xxd(idatmax1- idat) < 360.) exit
113 id1 = id1 + 1
114 ENDDO
115
116 DO idat = 1, idatmax
117 IF (xxd(idat) > 0.) exit
118 id0 = id0 + 1
119 END DO
120
121 IF(id1 /= 0) then
122 DO idat = 1, id1
123 xxid(idat) = xxd(idatmax - id1 + idat) - 360.
124 fxd (idat) = fdd(idatmax - id1 + idat)
125 END DO
126 DO idat = 1, idatmax - id1
127 xxid(idat + id1) = xxd(idat)
128 fxd (idat + id1) = fdd(idat)
129 END DO
130 end IF
131
132 IF(id0 /= 0) then
133 DO idat = 1, idatmax - id0
134 xxid(idat) = xxd(idat + id0)
135 fxd (idat) = fdd(idat + id0)
136 END DO
137
138 DO idat = 1, id0
139 xxid (idatmax - id0 + idat) = xxd(idat) + 360.
140 fxd (idatmax - id0 + idat) = fdd(idat)
141 END DO
142 else
143 DO idat = 1, idatmax
144 xxid(idat) = xxd(idat)
145 fxd (idat) = fdd(idat)
146 ENDDO
147 end IF
148 xxid(idatmax1) = xxid(1) + 360.
149 fxd (idatmax1) = fxd(1)
150
151 ! Initialisation du champ du mod\`ele
152
153 inter_barx(:) = 0.
154
155 ! Iteration
156
157 x0 = xim0
158 dxm = 0.
159 imod = 1
160 idat = 1
161
162 do while (imod <= imodmax)
163 do while (xxim(imod) > xxid(idat))
164 dx = xxid(idat) - x0
165 dxm = dxm + dx
166 inter_barx(imod) = inter_barx(imod) + dx * fxd(idat)
167 x0 = xxid(idat)
168 idat = idat + 1
169 end do
170 IF (xxim(imod) < xxid(idat)) THEN
171 dx = xxim(imod) - x0
172 dxm = dxm + dx
173 inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm
174 x0 = xxim(imod)
175 dxm = 0.
176 imod = imod + 1
177 ELSE
178 dx = xxim(imod) - x0
179 dxm = dxm + dx
180 inter_barx(imod) = (inter_barx(imod) + dx * fxd(idat)) / dxm
181 x0 = xxim(imod)
182 dxm = 0.
183 imod = imod + 1
184 idat = idat + 1
185 END IF
186 end do
187
188 END function inter_barx
189
190 end module inter_barx_m

  ViewVC Help
Powered by ViewVC 1.1.21