Context Navigation

regr_horiz_time_climoz_m.F90 @ 3412

Last change on this file since 3412 was 3278, checked in by dcugnet, 7 years ago
Fix of the rev. 3231 for ozone horizontal interpolation. Fields pre-r3231 were one point shifted in longitude in the easter part of the globe due to an index offset. Difference in small, thanks to the quasi-zonal symetry of the 3D ozone fields.
File size: 24.7 KB

Line
1	MODULE regr_horiz_time_climoz_m
2
3	USE interpolation, ONLY: locate
4	USE mod_grid_phy_lmdz, ONLY: nlon_ou => nbp_lon, nlat_ou => nbp_lat
5	USE nrtype, ONLY: pi
6	USE netcdf, ONLY: NF90_CLOBBER, NF90_FLOAT, NF90_GET_VAR, NF90_OPEN, &
7	NF90_NOWRITE, NF90_NOERR, NF90_GET_ATT, NF90_GLOBAL
8	USE netcdf95, ONLY: NF95_DEF_DIM, NF95_INQ_DIMID, NF95_INQUIRE_DIMENSION, &
9	NF95_DEF_VAR, NF95_INQ_VARID, NF95_INQUIRE_VARIABLE, &
10	NF95_OPEN, NF95_CREATE, NF95_GET_ATT, NF95_GW_VAR, HANDLE_ERR, &
11	NF95_CLOSE, NF95_ENDDEF, NF95_PUT_ATT, NF95_PUT_VAR, NF95_COPY_ATT
12	USE print_control_mod, ONLY: lunout
13	IMPLICIT NONE
14	PRIVATE
15	PUBLIC :: regr_horiz_time_climoz
16	REAL, PARAMETER :: deg2rad=pi/180.
17	CHARACTER(LEN=13), PARAMETER :: vars_in(2)=['tro3 ','tro3_daylight']
18
19	CONTAINS
20
21	!-------------------------------------------------------------------------------
22	!
23	SUBROUTINE regr_horiz_time_climoz(read_climoz,interpt)
24	!
25	!-------------------------------------------------------------------------------
26	! Purpose: Regrid horizontally and in time zonal or 3D ozone climatologies.
27	! * Read ozone climatology from netcdf file
28	! * Regrid it horizontaly to LMDZ grid (quasi-conservative method)
29	! * If interpt=T, interpolate linearly in time (one record each day)
30	! If interpt=F, keep original time sampling (14 months).
31	! * Save it to a new netcdf file.
32	!-------------------------------------------------------------------------------
33	! Remarks:
34	! * Up to 2 variables treated: "tro3" and "tro3_daylight" (if read_climoz=2)
35	! * Input fields coordinates: (longitudes, latitudes, pressure_levels, time)
36	! * Output grid cells centers coordinates given by [rlonv,] rlatu.
37	! * Output grid cells edges coordinates given by [rlonu,] rlatv.
38	! * Input file [longitudes and] latitudes given in degrees.
39	! * Input file pressure levels are given in Pa or hPa.
40	! * All coordinates variables are stricly monotonic.
41	! * Monthly fields are interpolated linearly in time to get daily values.
42	! * Fields are known at the middle of the months, so interpolation requires an
43	! additional record both for 1st half of january and 2nd half of december:
44	! - For a 14-records "climoz.nc": records 1 and 14.
45	! - For 12-records files:
46	! record 12 of "climoz_m.nc" if available, or record 1 of "climoz.nc".
47	! record 1 of "climoz_p.nc" if available, or record 12 of "climoz.nc".
48	! * Calendar is taken into account to get one record each day (not 360 always).
49	! * Missing values are filled in from sky to ground by copying lowest valid one.
50	! Attribute "missing_value" or "_FillValue" must be present in input file.
51	!-------------------------------------------------------------------------------
52	USE assert_m, ONLY: assert
53	USE cal_tools_m, ONLY: year_len, mid_month
54	USE control_mod, ONLY: anneeref
55	USE ioipsl, ONLY: ioget_year_len, ioget_calendar
56	USE regr_conserv_m, ONLY: regr_conserv
57	USE regr_lint_m, ONLY: regr_lint
58	USE regular_lonlat_mod, ONLY: boundslon_reg, boundslat_reg, south, west, east
59	USE slopes_m, ONLY: slopes
60	!-------------------------------------------------------------------------------
61	! Arguments:
62	INTEGER, INTENT(IN) :: read_climoz ! read ozone climatology, 1 or 2
63	! 1: read a single ozone climatology used day and night
64	! 2: same + read also a daylight climatology
65	LOGICAL, INTENT(IN) :: interpt ! TRUE => daily interpolation
66	! FALSE => no interpolation (14 months)
67	!-------------------------------------------------------------------------------
68	! Local variables:
69
70	!--- Input files variables
71	INTEGER :: nlon_in ! Number of longitudes
72	INTEGER :: nlat_in ! Number of latitudes
73	INTEGER :: nlev_in ! Number of pressure levels
74	INTEGER :: nmth_in ! Number of months
75	REAL, POINTER :: lon_in(:) ! Longitudes (ascending order, rad)
76	REAL, POINTER :: lat_in(:) ! Latitudes (ascending order, rad)
77	REAL, POINTER :: lev_in(:) ! Pressure levels (ascen. order, hPa)
78	REAL, ALLOCATABLE :: lon_in_edge(:) ! Longitude intervals edges
79	! (ascending order, / )
80	REAL, ALLOCATABLE :: sinlat_in_edge(:) ! Sinus of latitude intervals edges
81	! (ascending order, / )
82	LOGICAL :: ldec_lon, ldec_lat, ldec_lev ! Decreasing order in input file
83	CHARACTER(LEN=20) :: cal_in ! Calendar
84	REAL, ALLOCATABLE :: o3_in3(:,:,:,:,:) ! Ozone climatologies
85	REAL, ALLOCATABLE :: o3_in2 (:,:,:,:) ! Ozone climatologies
86	! last index: 1 for the day-night average, 2 for the daylight field.
87	REAL :: NaN
88
89	!--- Partially or totally regridded variables (:,:,nlev_in,:,read_climoz)
90	REAL, ALLOCATABLE :: o3_regr_lon (:,:,:,:,:) ! (nlon_ou,nlat_in,:,0:13 ,:)
91	REAL, ALLOCATABLE :: o3_regr_lonlat(:,:,:,:,:) ! (nlon_ou,nlat_ou,:,0:13 ,:)
92	REAL, ALLOCATABLE :: o3_out3 (:,:,:,:,:) ! (nlon_ou,nlat_ou,:,ntim_ou,:)
93	REAL, ALLOCATABLE :: o3_regr_lat (:,:,:,:) ! (nlat_in,:,0:13 ,:)
94	REAL, ALLOCATABLE :: o3_out2 (:,:,:,:) ! (nlat_ou,:,ntim_ou,:)
95	! Dimension number \| Interval \| Contains \| For variables:
96	! 1 (longitude) \| [rlonu(i-1), rlonu(i)] \| rlonv(i) \| all
97	! 2 (latitude) \| [rlatv(j), rlatv(j-1)] \| rlatu(j) \| all but o3_regr_lon
98	! 3 (press level) \| \| lev(k) \| all
99	! Note that rlatv(0)=pi/2 and rlatv(nlat_ou)=-pi/2.
100	! Dimension 4 is: month number (all vars but o3_out)
101	! days elapsed since Jan. 1st 0h at mid-day (o3_out only)
102	REAL, ALLOCATABLE :: v1(:)
103
104	!--- For NetCDF:
105	INTEGER :: fID_in_m, fID_in, levID_ou, dimid, vID_in(read_climoz), ntim_ou
106	INTEGER :: fID_in_p, fID_ou, timID_ou, varid, vID_ou(read_climoz), ndims, ncerr
107	INTEGER, POINTER :: dIDs(:)
108	CHARACTER(LEN=20) :: cal_ou !--- Calendar; no time inter => same as input
109	CHARACTER(LEN=80) :: press_unit !--- Pressure unit
110	REAL :: tmidmonth(0:13) !--- Elapsed days since Jan-1 0h at mid-months
111	! Additional records 0, 13 for interpolation
112	REAL, ALLOCATABLE :: tmidday(:) !--- Output times (mid-days since Jan 1st 0h)
113	LOGICAL :: lprev, lnext !--- Flags: previous/next files are present
114	LOGICAL :: l3D, l2D !--- Flag: input fields are 3D or zonal
115	INTEGER :: ii, i, j, k, l, m, dln, ib, ie, iv, dx1, dx2
116	INTEGER, ALLOCATABLE :: sta(:), cnt(:)
117	CHARACTER(LEN=80) :: sub, dim_nam, msg
118	!-------------------------------------------------------------------------------
119	sub="regr_horiz_time_climoz"
120	WRITE(lunout,*)"Call sequence information: "//TRIM(sub)
121	CALL assert(read_climoz == 1 .OR. read_climoz == 2, "regr_lat_time_climoz")
122
123	CALL NF95_OPEN("climoz.nc" , NF90_NOWRITE, fID_in)
124	lprev=NF90_OPEN("climoz_m.nc", NF90_NOWRITE, fID_in_m)==NF90_NOERR
125	lnext=NF90_OPEN("climoz_p.nc", NF90_NOWRITE, fID_in_p)==NF90_NOERR
126
127	!--- Get coordinates from the input file. Converts lon/lat in radians.
128	! Few inversions because "regr_conserv" and gcm need ascending vectors.
129	CALL NF95_INQ_VARID(fID_in, vars_in(1), varid)
130	CALL NF95_INQUIRE_VARIABLE(fID_in, varid, dimids=dIDs, ndims=ndims)
131	l3D=ndims==4; l2D=ndims==3
132	IF(l3D) WRITE(lunout,*)"Input files contain full 3D ozone fields."
133	IF(l2D) WRITE(lunout,*)"Input files contain zonal 2D ozone fields."
134	DO i=1,ndims
135	CALL NF95_INQUIRE_DIMENSION(fID_in, dIDs(i), name=dim_nam, nclen=dln)
136	CALL NF95_INQ_VARID(fID_in, dim_nam, varid)
137	ii=i; IF(l2D) ii=i+1 !--- ndims==3:NO LONGITUDE
138	SELECT CASE(ii)
139	CASE(1) !--- LONGITUDE
140	CALL NF95_GW_VAR(fID_in, varid, lon_in)
141	ldec_lon=lon_in(1)>lon_in(dln); IF(ldec_lon) lon_in=lon_in(dln:1:-1)
142	nlon_in=dln; lon_in=lon_in*deg2rad
143	CASE(2) !--- LATITUDE
144	CALL NF95_GW_VAR(fID_in, varid, lat_in)
145	ldec_lat=lat_in(1)>lat_in(dln); IF(ldec_lat) lat_in=lat_in(dln:1:-1)
146	nlat_in=dln; lat_in=lat_in*deg2rad
147	CASE(3) !--- PRESSURE LEVELS
148	CALL NF95_GW_VAR(fID_in, varid, lev_in)
149	ldec_lev=lev_in(1)>lev_in(dln); IF(ldec_lev) lev_in=lev_in(dln:1:-1)
150	nlev_in=dln
151	CALL NF95_GET_ATT(fID_in, varid, "units", press_unit)
152	k=LEN_TRIM(press_unit)
153	DO WHILE(ICHAR(press_unit(k:k))==0)
154	press_unit(k:k)=' '; k=LEN_TRIM(press_unit) !--- REMOVE NULL END CHAR
155	END DO
156	IF(press_unit == "Pa") THEN
157	lev_in = lev_in/100. !--- CONVERT TO hPa
158	ELSE IF(press_unit /= "hPa") THEN
159	CALL abort_physic(sub, "the only recognized units are Pa and hPa.",1)
160	END IF
161	CASE(4) !--- TIME
162	CALL NF95_INQUIRE_DIMENSION(fID_in, dIDs(i), nclen=nmth_in)
163	cal_in='gregorian'
164	IF(NF90_GET_ATT(fID_in, varid, 'calendar', cal_in)/=NF90_NOERR) &
165	WRITE(lunout,*)'WARNING: missing "calendar" attribute for "'// &
166	TRIM(dim_nam)//'" in "climoz.nc". Choosing default: "gregorian".'
167	k=LEN_TRIM(cal_in)
168	DO WHILE(ICHAR(cal_in(k:k))==0)
169	cal_in(k:k)=' '; k=LEN_TRIM(cal_in) !--- REMOVE NULL END CHAR
170	END DO
171	END SELECT
172	END DO
173
174	!--- Longitudes management:
175	! * Need to shift data if the origin of input file longitudes /= -pi
176	! * Need to add some margin in longitude to ensure input interval contains
177	! all the output intervals => at least one longitudes slice has to be
178	! duplicated, possibly more for undersampling.
179	IF(l3D) THEN
180	!--- Compute input edges longitudes vector (no end point yet)
181	ALLOCATE(v1(nlon_in+1))
182	v1(1)=(lon_in(nlon_in)+lon_in(1))/2.-pi
183	FORALL(i=2:nlon_in) v1(i)=(lon_in(i-1)+lon_in(i))/2.
184	v1(nlon_in+1)=v1(1)+2.*pi
185	DEALLOCATE(lon_in)
186
187	!--- Shift input longitudes vector until it contains first output point boundslon_reg(1,west)
188	v1=v1+2piREAL(FLOOR((boundslon_reg(1,west)-v1(1))/(2.*pi)))
189
190	!--- Ensure first input longitudes interval contains first output point boundslon_reg(1,west)
191	dx1=locate(v1,boundslon_reg(1,west))-1
192	v1=CSHIFT(v1,SHIFT=dx1,DIM=1); v1(nlon_in-dx1+2:)=v1(nlon_in-dx1+2:)+2.*pi
193
194	!--- Extend input longitudes vector until last interval contains boundslon_reg(nlon_ou,east)
195	dx2=0; DO WHILE(v1(1+dx2)+2.*pi<=boundslon_reg(nlon_ou,east)); dx2=dx2+1; END DO
196
197	!--- Final edges longitudes vector (with margin and end point)
198	ALLOCATE(lon_in_edge(nlon_in+dx2+1)); lon_in_edge=[v1,v1(2:1+dx2)+2.*pi]
199	DEALLOCATE(v1)
200	END IF
201
202	!--- Compute sinus of intervals edges latitudes:
203	ALLOCATE(sinlat_in_edge(nlat_in+1))
204	sinlat_in_edge(1) = -1. ; sinlat_in_edge(nlat_in+1) = 1.
205	FORALL(j=2:nlat_in) sinlat_in_edge(j)=SIN((lat_in(j-1)+lat_in(j))/2.)
206	DEALLOCATE(lat_in)
207
208	!--- Prepare quantities for time interpolation
209	tmidmonth=mid_month(anneeref, cal_in)
210	IF(interpt) THEN
211	ntim_ou=ioget_year_len(anneeref)
212	ALLOCATE(tmidday(ntim_ou))
213	tmidday=[(REAL(k)-0.5,k=1,ntim_ou)]
214	CALL ioget_calendar(cal_ou)
215	ELSE
216	ntim_ou=14
217	cal_ou=cal_in
218	END IF
219
220	!--- Create the output file and get the variable IDs:
221	CALL prepare_out(fID_in,nlev_in,ntim_ou, fID_ou,levID_ou,timID_ou,vID_ou, &
222	ndims, cal_ou)
223
224	!--- Write remaining coordinate variables:
225	CALL NF95_PUT_VAR(fID_ou, levID_ou, lev_in); DEALLOCATE(lev_in)
226	IF( interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidday)
227	IF(.NOT.interpt) CALL NF95_PUT_VAR(fID_ou, timID_ou, tmidmonth)
228
229	!--- Check for contiguous years:
230	ib=0; ie=13
231	IF(nmth_in == 14) THEN; lprev=.FALSE.; lnext=.FALSE.
232	WRITE(lunout,*)'Using 14 months ozone climatology "climoz.nc"...'
233	ELSE
234	IF( lprev) WRITE(lunout,*)'Using "climoz_m.nc" last record (previous year).'
235	IF(.NOT.lprev) WRITE(lunout,*)"No previous year file ; assuming periodicity."
236	IF( lnext) WRITE(lunout,*)'Using "climoz_p.nc" first record (next year).'
237	IF(.NOT.lnext) WRITE(lunout,*)"No next year file ; assuming periodicity."
238	IF(.NOT.lprev) ib=1
239	IF(.NOT.lnext) ie=12
240	END IF
241	ALLOCATE(sta(ndims),cnt(ndims)); sta(:)=1
242	IF(l3D) cnt=[nlon_in,nlat_in,nlev_in,1]
243	IF(l2D) cnt=[ nlat_in,nlev_in,1]
244	IF(l3D) ALLOCATE(o3_in3(nlon_in+dx2,nlat_in,nlev_in,ib:ie,read_climoz))
245	IF(l2D) ALLOCATE(o3_in2( nlat_in,nlev_in,ib:ie,read_climoz))
246
247	!--- Read full current file and one record each available contiguous file
248	DO iv=1,read_climoz
249	msg=TRIM(sub)//" NF90_GET_VAR "//TRIM(vars_in(iv))
250	CALL NF95_INQ_VARID(fID_in, vars_in(1), vID_in(iv))
251	IF(l3D) ncerr=NF90_GET_VAR(fID_in, vID_in(iv), o3_in3(1:nlon_in,:,:,1:12,iv))
252	IF(l2D) ncerr=NF90_GET_VAR(fID_in, vID_in(iv), o3_in2( :,:,1:12,iv))
253	CALL handle_err(TRIM(msg), ncerr, fID_in)
254	IF(lprev) THEN; sta(ndims)=12
255	CALL NF95_INQ_VARID(fID_in_m, vars_in(1), vID_in(iv))
256	IF(l3D) ncerr=NF90_GET_VAR(fID_in_m,vID_in(iv),o3_in3(1:nlon_in,:,:, 0,iv),sta,cnt)
257	IF(l2d) ncerr=NF90_GET_VAR(fID_in_m,vID_in(iv),o3_in2( :,:, 0,iv),sta,cnt)
258	CALL handle_err(TRIM(msg)//" previous", ncerr, fID_in_m)
259	END IF
260	IF(lnext) THEN; sta(ndims)=1
261	CALL NF95_INQ_VARID(fID_in_p, vars_in(1), vID_in(iv))
262	IF(l3D) ncerr=NF90_GET_VAR(fID_in_p,vID_in(iv),o3_in3(1:nlon_in,:,:,13,iv),sta,cnt)
263	IF(l2D) ncerr=NF90_GET_VAR(fID_in_p,vID_in(iv),o3_in2( :,:,13,iv),sta,cnt)
264	CALL handle_err(TRIM(msg)//" next", ncerr, fID_in_p)
265	END IF
266	END DO
267	IF(lprev.OR.lnext) DEALLOCATE(sta,cnt)
268	IF(lprev) CALL NF95_CLOSE(fID_in_m)
269	IF(lnext) CALL NF95_CLOSE(fID_in_p)
270
271	!--- Revert decreasing coordinates vector
272	IF(l3D) THEN
273	IF(ldec_lon) o3_in3(1:nlon_in,:,:,:,:) = o3_in3(nlon_in:1:-1,:,:,:,:)
274	IF(ldec_lat) o3_in3 = o3_in3(:,nlat_in:1:-1,:,:,:)
275	IF(ldec_lev) o3_in3 = o3_in3(:,:,nlev_in:1:-1,:,:)
276	!--- Shift values for longitude and duplicate some longitudes slices
277	o3_in3(1:nlon_in,:,:,:,:)=CSHIFT(o3_in3(1:nlon_in,:,:,:,:),SHIFT=dx1,DIM=1)
278	o3_in3(nlon_in+1:nlon_in+dx2,:,:,:,:)=o3_in3(1:dx2,:,:,:,:)
279	ELSE
280	IF(ldec_lat) o3_in2 = o3_in2( nlat_in:1:-1,:,:,:)
281	IF(ldec_lev) o3_in2 = o3_in2( :,nlev_in:1:-1,:,:)
282	END IF
283
284	!--- Deal with missing values
285	DO m=1, read_climoz
286	WRITE(msg,'(a,i0)')"regr_lat_time_climoz: field Nr.",m
287	IF(NF90_GET_ATT(fID_in,vID_in(m),"missing_value",NaN)/= NF90_NOERR) THEN
288	IF(NF90_GET_ATT(fID_in, vID_in(m),"_FillValue",NaN)/= NF90_NOERR) THEN
289	WRITE(lunout,*)TRIM(msg)//": no missing value attribute found."; CYCLE
290	END IF
291	END IF
292	WRITE(lunout,*)TRIM(msg)//": missing value attribute found."
293	WRITE(lunout,*)"Trying to fill in NaNs ; a full field would be better."
294
295	!--- Check top layer contains no NaNs & search NaNs from top to ground
296	msg=TRIM(sub)//": NaNs in top layer !"
297	IF(l3D) THEN
298	IF(ANY(o3_in3(:,:,1,:,m)==NaN)) CALL abort_physic(sub,msg,1)
299	DO k = 2,nlev_in
300	WHERE(o3_in3(:,:,k,:,m)==NaN) o3_in3(:,:,k,:,m)=o3_in3(:,:,k-1,:,m)
301	END DO
302	ELSE
303	IF(ANY(o3_in2( :,1,:,m)==NaN)) THEN
304	WRITE(lunout,*)msg
305	!--- Fill in latitudes where all values are missing
306	DO l=1,nmth_in
307	!--- Next to south pole
308	j=1; DO WHILE(o3_in2(j,1,l,m)==NaN); j=j+1; END DO
309	IF(j>1) &
310	o3_in2(:j-1,:,l,m)=SPREAD(o3_in2(j,:,l,m),DIM=1,ncopies=j-1)
311	!--- Next to north pole
312	j=nlat_in; DO WHILE(o3_in2(j,1,l,m)==NaN); j=j+1; END DO
313	IF(j<nlat_in) &
314	o3_in2(j+1:,:,l,m)=SPREAD(o3_in2(j,:,l,m),DIM=1,ncopies=nlat_in-j)
315	END DO
316	END IF
317
318	!--- Fill in high latitudes missing values
319	!--- Highest level been filled-in, so has always valid values.
320	DO k = 2,nlev_in
321	WHERE(o3_in2(:,k,:,m)==NaN) o3_in2(:,k,:,m)=o3_in2(:,k-1,:,m)
322	END DO
323	END IF
324	END DO
325	CALL NF95_CLOSE(fID_in)
326
327	!=============================================================================
328	IF(l3D) THEN !=== 3D FIELDS
329	!=============================================================================
330	!--- Regrid in longitude
331	ALLOCATE(o3_regr_lon(nlon_ou, nlat_in, nlev_in, ie-ib+1, read_climoz))
332	CALL regr_conserv(1, o3_in3, xs = lon_in_edge, &
333	xt = [boundslon_reg(1,west),boundslon_reg(:,east)], &
334	vt = o3_regr_lon, slope = slopes(1,o3_in3, lon_in_edge))
335	DEALLOCATE(o3_in3)
336
337	!--- Regrid in latitude: averaging with respect to SIN(lat) is
338	! equivalent to weighting by COS(lat)
339	!--- (inverted indices in "o3_regr_lonlat" because "rlatu" is decreasing)
340	ALLOCATE(o3_regr_lonlat(nlon_ou, nlat_ou, nlev_in, 0:13, read_climoz))
341	CALL regr_conserv(2, o3_regr_lon, xs = sinlat_in_edge, &
342	xt = [- 1., SIN(boundslat_reg(nlat_ou-1:1:-1,south)), 1.], &
343	vt = o3_regr_lonlat(:,nlat_ou:1:- 1,:,ib:ie,:), &
344	slope = slopes(2,o3_regr_lon, sinlat_in_edge))
345	DEALLOCATE(o3_regr_lon)
346
347	!--- Duplicate previous/next record(s) if they are not available
348	IF(.NOT.lprev) o3_regr_lonlat(:,:,:, 0,:) = o3_regr_lonlat(:,:,:,12,:)
349	IF(.NOT.lnext) o3_regr_lonlat(:,:,:,13,:) = o3_regr_lonlat(:,:,:, 1,:)
350
351	!--- Regrid in time by linear interpolation:
352	ALLOCATE(o3_out3(nlon_ou, nlat_ou, nlev_in, ntim_ou, read_climoz))
353	IF( interpt) CALL regr_lint(4,o3_regr_lonlat,tmidmonth,tmidday,o3_out3)
354	IF(.NOT.interpt) o3_out3=o3_regr_lonlat
355	DEALLOCATE(o3_regr_lonlat)
356
357	!--- Write to file (the order of "rlatu" is inverted in the output file):
358	DO m = 1, read_climoz
359	CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out3(:,nlat_ou:1:-1,:,:,m))
360	END DO
361
362	!=============================================================================
363	ELSE !=== ZONAL FIELDS
364	!=============================================================================
365	!--- Regrid in latitude: averaging with respect to SIN(lat) is
366	! equivalent to weighting by COS(lat)
367	!--- (inverted indices in "o3_regr_lat" because "rlatu" is decreasing)
368	ALLOCATE(o3_regr_lat(nlat_ou, nlev_in, 0:13, read_climoz))
369	CALL regr_conserv(1, o3_in2, xs = sinlat_in_edge, &
370	xt = [- 1., SIN(boundslat_reg(nlat_ou-1:1:-1,south)), 1.], &
371	vt = o3_regr_lat(nlat_ou:1:- 1,:,ib:ie,:), &
372	slope = slopes(1,o3_in2, sinlat_in_edge))
373	DEALLOCATE(o3_in2)
374
375	!--- Duplicate previous/next record(s) if they are not available
376	IF(.NOT.lprev) o3_regr_lat(:,:, 0,:) = o3_regr_lat(:,:,12,:)
377	IF(.NOT.lnext) o3_regr_lat(:,:,13,:) = o3_regr_lat(:,:, 1,:)
378
379	!--- Regrid in time by linear interpolation:
380	ALLOCATE(o3_out2(nlat_ou, nlev_in, ntim_ou, read_climoz))
381	IF( interpt) CALL regr_lint(3,o3_regr_lat, tmidmonth, tmidday, o3_out2)
382	IF(.NOT.interpt) o3_out2=o3_regr_lat
383	DEALLOCATE(o3_regr_lat)
384
385	!--- Write to file (the order of "rlatu" is inverted in the output file):
386	DO m = 1, read_climoz
387	CALL NF95_PUT_VAR(fID_ou, vID_ou(m), o3_out2(nlat_ou:1:-1,:,:,m))
388	END DO
389
390	!=============================================================================
391	END IF
392	!=============================================================================
393
394	CALL NF95_CLOSE(fID_ou)
395
396	END SUBROUTINE regr_horiz_time_climoz
397	!
398	!-------------------------------------------------------------------------------
399
400
401	!-------------------------------------------------------------------------------
402	!
403	SUBROUTINE prepare_out(fID_in, nlev_in, ntim_ou, fID_ou, vlevID, vtimID, &
404	vID_ou, ndims, cal_ou)
405	!-------------------------------------------------------------------------------
406	! Purpose: This subroutine creates the NetCDF output file, defines
407	! dimensions and variables, and writes some of the coordinate variables.
408	!-------------------------------------------------------------------------------
409	USE regular_lonlat_mod, ONLY: lon_reg, lat_reg
410	!-------------------------------------------------------------------------------
411	! Arguments:
412	INTEGER, INTENT(IN) :: fID_in, nlev_in, ntim_ou
413	INTEGER, INTENT(OUT) :: fID_ou, vlevID, vtimID
414	INTEGER, INTENT(OUT) :: vID_ou(:) ! dim(1/2) 1: O3day&night 2: O3daylight
415	INTEGER, INTENT(IN) :: ndims ! fields rank (3 or 4)
416	CHARACTER(LEN=*), INTENT(IN) :: cal_ou ! calendar
417	!-------------------------------------------------------------------------------
418	! Local variables:
419	INTEGER :: dlonID, dlatID, dlevID, dtimID, dIDs(4)
420	INTEGER :: vlonID, vlatID, ncerr, is
421	CHARACTER(LEN=80) :: sub
422	!-------------------------------------------------------------------------------
423	sub="prepare_out"
424	WRITE(lunout,*)"CALL sequence information: "//TRIM(sub)
425	CALL NF95_CREATE("climoz_LMDZ.nc", NF90_clobber, fID_ou)
426
427	!--- Dimensions:
428	IF(ndims==4) &
429	CALL NF95_DEF_DIM(fID_ou, "rlonv", nlon_ou, dlonID)
430	CALL NF95_DEF_DIM(fID_ou, "rlatu", nlat_ou, dlatID)
431	CALL NF95_DEF_DIM(fID_ou, "plev", nlev_in, dlevID)
432	CALL NF95_DEF_DIM(fID_ou, "time", ntim_ou, dtimID)
433
434	!--- Define coordinate variables:
435	IF(ndims==4) &
436	CALL NF95_DEF_VAR(fID_ou, "rlonv", NF90_FLOAT, dlonID, vlonID)
437	CALL NF95_DEF_VAR(fID_ou, "rlatu", NF90_FLOAT, dlatID, vlatID)
438	CALL NF95_DEF_VAR(fID_ou, "plev", NF90_FLOAT, dlevID, vlevID)
439	CALL NF95_DEF_VAR(fID_ou, "time", NF90_FLOAT, dtimID, vtimID)
440	IF(ndims==4) &
441	CALL NF95_PUT_ATT(fID_ou, vlonID, "units", "degrees_east")
442	CALL NF95_PUT_ATT(fID_ou, vlatID, "units", "degrees_north")
443	CALL NF95_PUT_ATT(fID_ou, vlevID, "units", "millibar")
444	CALL NF95_PUT_ATT(fID_ou, vtimID, "units", "days since 2000-1-1")
445	IF(ndims==4) &
446	CALL NF95_PUT_ATT(fID_ou, vlonID, "standard_name", "longitude")
447	CALL NF95_PUT_ATT(fID_ou, vlatID, "standard_name", "latitude")
448	CALL NF95_PUT_ATT(fID_ou, vlevID, "standard_name", "air_pressure")
449	CALL NF95_PUT_ATT(fID_ou, vtimID, "standard_name", "time")
450	CALL NF95_PUT_ATT(fID_ou, vlevID, "long_name", "air pressure")
451	CALL NF95_PUT_ATT(fID_ou, vtimID, "calendar", cal_ou)
452
453	!--- Define the main variables:
454	IF(ndims==3) dIDs(1:3) = [ dlatID, dlevID, dtimID]
455	IF(ndims==4) dIDs=[dlonID, dlatID, dlevID, dtimID]
456	CALL NF95_DEF_VAR(fID_ou, vars_in(1), NF90_FLOAT, dIDs(1:ndims), vID_ou(1))
457	CALL NF95_PUT_ATT(fID_ou, vID_ou(1), "long_name", "ozone mole fraction")
458	CALL NF95_PUT_ATT(fID_ou, vID_ou(1), "standard_name", "mole_fraction_of_ozone&
459	&_in_air")
460	IF(SIZE(vID_ou) == 2) THEN
461	CALL NF95_DEF_VAR(fID_ou, vars_in(2), NF90_FLOAT, dIDs(1:ndims), vID_ou(2))
462	CALL NF95_PUT_ATT(fID_ou, vID_ou(2), "long_name","ozone mole fraction in da&
463	&ylight")
464	END IF
465
466	!--- Global attributes:
467	! The following commands, copying attributes, may fail. That is OK.
468	! It should just mean that the attribute is not defined in the input file.
469	CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"Conventions",fID_ou,NF90_GLOBAL, ncerr)
470	CALL handle_err_copy_att("Conventions")
471	CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"title", fID_ou,NF90_GLOBAL, ncerr)
472	CALL handle_err_copy_att("title")
473	CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"institution",fID_ou,NF90_GLOBAL, ncerr)
474	CALL handle_err_copy_att("institution")
475	CALL NF95_COPY_ATT(fID_in,NF90_GLOBAL,"source", fID_ou,NF90_GLOBAL, ncerr)
476	CALL handle_err_copy_att("source")
477	CALL NF95_PUT_ATT (fID_ou,NF90_GLOBAL,"comment", "Regridded for LMDZ")
478	CALL NF95_ENDDEF(fID_ou)
479
480	!--- Write one of the coordinate variables:
481	IF(ndims==4) CALL NF95_PUT_VAR(fID_ou, vlonID, lon_reg/deg2rad)
482	CALL NF95_PUT_VAR(fID_ou, vlatID, lat_reg(nlat_ou:1:-1)/deg2rad)
483	! (convert from rad to degrees and sort in ascending order)
484
485	CONTAINS
486
487	!-------------------------------------------------------------------------------
488	!
489	SUBROUTINE handle_err_copy_att(att_name)
490	!
491	!-------------------------------------------------------------------------------
492	USE netcdf, ONLY: NF90_NOERR, NF90_strerror
493	!-------------------------------------------------------------------------------
494	! Arguments:
495	CHARACTER(LEN=*), INTENT(IN) :: att_name
496	!-------------------------------------------------------------------------------
497	IF(ncerr /= NF90_NOERR) &
498	WRITE(lunout,*)TRIM(sub)//" prepare_out NF95_COPY_ATT "//TRIM(att_name)// &
499	" -- "//TRIM(NF90_strerror(ncerr))
500
501	END SUBROUTINE handle_err_copy_att
502	!
503	!-------------------------------------------------------------------------------
504
505	END SUBROUTINE prepare_out
506	!
507	!-------------------------------------------------------------------------------
508
509	END MODULE regr_horiz_time_climoz_m
510	!
511	!-------------------------------------------------------------------------------

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format