Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

diaobs.F90

Last change on this file was 15764, checked in by jcastill, 2 years ago
Update with the latest changes in branches/UKMO/dev_r5518_obs_oper_update@15400
File size: 109.4 KB

Line
1	MODULE diaobs
2	!!======================================================================
3	!! * MODULE diaobs *
4	!! Observation diagnostics: Computation of the misfit between data and
5	!! their model equivalent
6	!!======================================================================
7
8	!!----------------------------------------------------------------------
9	!! dia_obs_init : Reading and prepare observations
10	!! dia_obs : Compute model equivalent to observations
11	!! dia_obs_wri : Write observational diagnostics
12	!! ini_date : Compute the initial date YYYYMMDD.HHMMSS
13	!! fin_date : Compute the final date YYYYMMDD.HHMMSS
14	!!----------------------------------------------------------------------
15	!! * Modules used
16	USE wrk_nemo ! Memory Allocation
17	USE par_kind ! Precision variables
18	USE in_out_manager ! I/O manager
19	USE par_oce
20	USE dom_oce ! Ocean space and time domain variables
21	USE obs_read_prof ! Reading and allocation of profile obs
22	USE obs_read_surf ! Reading and allocation of surface obs
23	USE obs_readmdt ! Reading and allocation of MDT for SLA.
24	USE obs_readsnowdepth ! Get model snow depth for conversion of freeboard to ice thickness
25	USE obs_prep ! Preparation of obs. (grid search etc).
26	USE obs_oper ! Observation operators
27	USE obs_write ! Writing of observation related diagnostics
28	USE obs_grid ! Grid searching
29	USE obs_read_altbias ! Bias treatment for altimeter
30	USE obs_sstbias ! Bias correction routine for SST
31	USE obs_profiles_def ! Profile data definitions
32	USE obs_surf_def ! Surface data definitions
33	USE obs_types ! Definitions for observation types
34	USE mpp_map ! MPP mapping
35	USE lib_mpp ! For ctl_warn/stop
36	USE tradmp ! For climatological temperature & salinity
37
38	IMPLICIT NONE
39
40	!! * Routine accessibility
41	PRIVATE
42	PUBLIC dia_obs_init, & ! Initialize and read observations
43	& dia_obs, & ! Compute model equivalent to observations
44	& dia_obs_wri, & ! Write model equivalent to observations
45	& dia_obs_dealloc ! Deallocate dia_obs data
46
47	!! * Module variables
48	LOGICAL, PUBLIC :: &
49	& lk_diaobs = .TRUE. !: Include this for backwards compatibility at NEMO 3.6.
50	LOGICAL :: ln_diaobs !: Logical switch for the obs operator
51	LOGICAL :: ln_sstnight !: Logical switch for night mean SST obs
52	LOGICAL :: ln_default_fp_indegs !: T=> Default obs footprint size specified in degrees, F=> in metres
53	LOGICAL :: ln_sla_fp_indegs !: T=> SLA obs footprint size specified in degrees, F=> in metres
54	LOGICAL :: ln_sst_fp_indegs !: T=> SST obs footprint size specified in degrees, F=> in metres
55	LOGICAL :: ln_sss_fp_indegs !: T=> SSS obs footprint size specified in degrees, F=> in metres
56	LOGICAL :: ln_ssv_fp_indegs !: T=> SSV obs footprint size specified in degrees, F=> in metres
57	LOGICAL :: ln_sic_fp_indegs !: T=> SIC obs footprint size specified in degrees, F=> in metres
58	LOGICAL :: ln_sit_fp_indegs !: T=> SIT obs footprint size specified in degrees, F=> in metres
59	LOGICAL :: ln_fbd_fp_indegs !: T=> SIT obs footprint size specified in degrees, F=> in metres
60	LOGICAL :: ln_output_clim !: Logical switch for interpolating and writing T/S climatology
61	LOGICAL :: ln_time_mean_sla_bkg !: Logical switch for applying time mean of SLA background to remove tidal signal
62
63	REAL(wp) :: rn_default_avglamscl !: Default E/W diameter of observation footprint
64	REAL(wp) :: rn_default_avgphiscl !: Default N/S diameter of observation footprint
65	REAL(wp) :: rn_sla_avglamscl !: E/W diameter of SLA observation footprint
66	REAL(wp) :: rn_sla_avgphiscl !: N/S diameter of SLA observation footprint
67	REAL(wp) :: rn_sst_avglamscl !: E/W diameter of SST observation footprint
68	REAL(wp) :: rn_sst_avgphiscl !: N/S diameter of SST observation footprint
69	REAL(wp) :: rn_sss_avglamscl !: E/W diameter of SSS observation footprint
70	REAL(wp) :: rn_sss_avgphiscl !: N/S diameter of SSS observation footprint
71	REAL(wp) :: rn_ssv_avglamscl !: E/W diameter of SSV observation footprint
72	REAL(wp) :: rn_ssv_avgphiscl !: N/S diameter of SSV observation footprint
73	REAL(wp) :: rn_sic_avglamscl !: E/W diameter of SIC observation footprint
74	REAL(wp) :: rn_sic_avgphiscl !: N/S diameter of SIC observation footprint
75	REAL(wp) :: rn_sit_avglamscl !: E/W diameter of SIT observation footprint
76	REAL(wp) :: rn_sit_avgphiscl !: N/S diameter of SIT observation footprint
77	REAL(wp) :: rn_fbd_avglamscl !: E/W diameter of FBD observation footprint
78	REAL(wp) :: rn_fbd_avgphiscl !: N/S diameter of FBD observation footprint
79	REAL(wp), PUBLIC :: &
80	& MeanPeriodHours = 24. + (5./6.) !: Meaning period for surface data.
81
82
83	INTEGER :: nn_1dint !: Vertical interpolation method
84	INTEGER :: nn_2dint_default !: Default horizontal interpolation method
85	INTEGER :: nn_2dint_sla !: SLA horizontal interpolation method (-1 = default)
86	INTEGER :: nn_2dint_sst !: SST horizontal interpolation method (-1 = default)
87	INTEGER :: nn_2dint_sss !: SSS horizontal interpolation method (-1 = default)
88	INTEGER :: nn_2dint_ssv !: SSV horizontal interpolation method (-1 = default)
89	INTEGER :: nn_2dint_sic !: SIC horizontal interpolation method (-1 = default)
90	INTEGER :: nn_2dint_sit !: SIT horizontal interpolation method (-1 = default)
91	INTEGER :: nn_2dint_fbd !: FBD horizontal interpolation method (-1 = default)
92
93	INTEGER, DIMENSION(imaxavtypes) :: &
94	& nn_profdavtypes !: Profile data types representing a daily average
95	INTEGER :: nproftypes !: Number of profile obs types
96	INTEGER :: nsurftypes !: Number of surface obs types
97	INTEGER, DIMENSION(:), ALLOCATABLE :: &
98	& nvarsprof, & !: Number of profile variables
99	& nvarssurf !: Number of surface variables
100	INTEGER, DIMENSION(:), ALLOCATABLE :: &
101	& nextrprof, & !: Number of profile extra variables
102	& nextrsurf !: Number of surface extra variables
103	INTEGER, DIMENSION(:), ALLOCATABLE :: &
104	& n2dintsurf !: Interpolation option for surface variables
105	REAL(wp), DIMENSION(:), ALLOCATABLE :: &
106	& ravglamscl, & !: E/W diameter of averaging footprint for surface variables
107	& ravgphiscl !: N/S diameter of averaging footprint for surface variables
108	LOGICAL, DIMENSION(:), ALLOCATABLE :: &
109	& lfpindegs, & !: T=> surface obs footprint size specified in degrees, F=> in metres
110	& llnightav !: Logical for calculating night-time averages
111
112	TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) :: &
113	& surfdata, & !: Initial surface data
114	& surfdataqc !: Surface data after quality control
115	TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) :: &
116	& profdata, & !: Initial profile data
117	& profdataqc !: Profile data after quality control
118
119	CHARACTER(len=8), PUBLIC, DIMENSION(:), ALLOCATABLE :: &
120	& cobstypesprof, & !: Profile obs types
121	& cobstypessurf !: Surface obs types
122
123	!!----------------------------------------------------------------------
124	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
125	!! $Id$
126	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
127	!!----------------------------------------------------------------------
128
129	!! * Substitutions
130	# include "domzgr_substitute.h90"
131	CONTAINS
132
133	SUBROUTINE dia_obs_init
134	!!----------------------------------------------------------------------
135	!! * ROUTINE dia_obs_init *
136	!!
137	!! ** Purpose : Initialize and read observations
138	!!
139	!! ** Method : Read the namelist and call reading routines
140	!!
141	!! ** Action : Read the namelist and call reading routines
142	!!
143	!! History :
144	!! ! 06-03 (K. Mogensen) Original code
145	!! ! 06-05 (A. Weaver) Reformatted
146	!! ! 06-10 (A. Weaver) Cleaning and add controls
147	!! ! 07-03 (K. Mogensen) General handling of profiles
148	!! ! 14-08 (J.While) Incorporated SST bias correction
149	!! ! 15-02 (M. Martin) Simplification of namelist and code
150	!!----------------------------------------------------------------------
151	#if defined key_cice
152	USE sbc_oce, ONLY : & ! CICE variables
153	& thick_s ! snow depth for freeboard conversion
154	#endif
155
156	IMPLICIT NONE
157
158	!! * Local declarations
159	INTEGER, PARAMETER :: &
160	& jpmaxnfiles = 1000 ! Maximum number of files for each obs type
161	INTEGER, DIMENSION(:), ALLOCATABLE :: &
162	& ifilesprof, & ! Number of profile files
163	& ifilessurf ! Number of surface files
164	INTEGER :: ios ! Local integer output status for namelist read
165	INTEGER :: jtype ! Counter for obs types
166	INTEGER :: jvar ! Counter for variables
167	INTEGER :: jfile ! Counter for files
168	INTEGER :: jnumsstbias ! Number of SST bias files to read and apply
169	INTEGER :: n2dint_type ! Local version of nn_2dint*
170
171	CHARACTER(len=128), DIMENSION(jpmaxnfiles) :: &
172	& cn_profbfiles, & ! T/S profile input filenames
173	& cn_sstfbfiles, & ! Sea surface temperature input filenames
174	& cn_slafbfiles, & ! Sea level anomaly input filenames
175	& cn_sicfbfiles, & ! Seaice concentration input filenames
176	& cn_sitfbfiles, & ! Seaice thickness input filenames
177	& cn_fbdfbfiles, & ! Seaice freeboard input filenames
178	& cn_velfbfiles, & ! Velocity profile input filenames
179	& cn_sssfbfiles, & ! Sea surface salinity input filenames
180	& cn_ssvfbfiles, & ! Sea surface velocity input filenames
181	& cn_slchltotfbfiles, & ! Surface total log10(chlorophyll) input filenames
182	& cn_slchldiafbfiles, & ! Surface diatom log10(chlorophyll) input filenames
183	& cn_slchlnonfbfiles, & ! Surface non-diatom log10(chlorophyll) input filenames
184	& cn_slchldinfbfiles, & ! Surface dinoflagellate log10(chlorophyll) input filenames
185	& cn_slchlmicfbfiles, & ! Surface microphytoplankton log10(chlorophyll) input filenames
186	& cn_slchlnanfbfiles, & ! Surface nanophytoplankton log10(chlorophyll) input filenames
187	& cn_slchlpicfbfiles, & ! Surface picophytoplankton log10(chlorophyll) input filenames
188	& cn_schltotfbfiles, & ! Surface total chlorophyll input filenames
189	& cn_slphytotfbfiles, & ! Surface total log10(phytoplankton carbon) input filenames
190	& cn_slphydiafbfiles, & ! Surface diatom log10(phytoplankton carbon) input filenames
191	& cn_slphynonfbfiles, & ! Surface non-diatom log10(phytoplankton carbon) input filenames
192	& cn_sspmfbfiles, & ! Surface suspended particulate matter input filenames
193	& cn_skd490fbfiles, & ! Surface Kd490 input filenames
194	& cn_sfco2fbfiles, & ! Surface fugacity of carbon dioxide input filenames
195	& cn_spco2fbfiles, & ! Surface partial pressure of carbon dioxide input filenames
196	& cn_plchltotfbfiles, & ! Profile total log10(chlorophyll) input filenames
197	& cn_pchltotfbfiles, & ! Profile total chlorophyll input filenames
198	& cn_pno3fbfiles, & ! Profile nitrate input filenames
199	& cn_psi4fbfiles, & ! Profile silicate input filenames
200	& cn_ppo4fbfiles, & ! Profile phosphate input filenames
201	& cn_pdicfbfiles, & ! Profile dissolved inorganic carbon input filenames
202	& cn_palkfbfiles, & ! Profile alkalinity input filenames
203	& cn_pphfbfiles, & ! Profile pH input filenames
204	& cn_po2fbfiles, & ! Profile dissolved oxygen input filenames
205	& cn_sstbiasfiles ! SST bias input filenames
206
207	CHARACTER(LEN=128) :: &
208	& cn_altbiasfile ! Altimeter bias input filename
209
210
211	LOGICAL :: ln_seaicetypes = .FALSE. ! Logical switch indicating data type is sea ice
212	LOGICAL :: ln_t3d ! Logical switch for temperature profiles
213	LOGICAL :: ln_s3d ! Logical switch for salinity profiles
214	LOGICAL :: ln_sla ! Logical switch for sea level anomalies
215	LOGICAL :: ln_sst ! Logical switch for sea surface temperature
216	LOGICAL :: ln_sic ! Logical switch for sea ice concentration
217	LOGICAL :: ln_sit ! Logical switch for sea ice thickness
218	LOGICAL :: ln_fbd ! Logical switch for sea ice freeboard
219	LOGICAL :: ln_sss ! Logical switch for sea surface salinity obs
220	LOGICAL :: ln_ssv ! Logical switch for sea surface velocity obs
221	LOGICAL :: ln_vel3d ! Logical switch for velocity (u,v) obs
222	LOGICAL :: ln_slchltot ! Logical switch for surface total log10(chlorophyll) obs
223	LOGICAL :: ln_slchldia ! Logical switch for surface diatom log10(chlorophyll) obs
224	LOGICAL :: ln_slchlnon ! Logical switch for surface non-diatom log10(chlorophyll) obs
225	LOGICAL :: ln_slchldin ! Logical switch for surface dinoflagellate log10(chlorophyll) obs
226	LOGICAL :: ln_slchlmic ! Logical switch for surface microphytoplankton log10(chlorophyll) obs
227	LOGICAL :: ln_slchlnan ! Logical switch for surface nanophytoplankton log10(chlorophyll) obs
228	LOGICAL :: ln_slchlpic ! Logical switch for surface picophytoplankton log10(chlorophyll) obs
229	LOGICAL :: ln_schltot ! Logical switch for surface total chlorophyll obs
230	LOGICAL :: ln_slphytot ! Logical switch for surface total log10(phytoplankton carbon) obs
231	LOGICAL :: ln_slphydia ! Logical switch for surface diatom log10(phytoplankton carbon) obs
232	LOGICAL :: ln_slphynon ! Logical switch for surface non-diatom log10(phytoplankton carbon) obs
233	LOGICAL :: ln_sspm ! Logical switch for surface suspended particulate matter obs
234	LOGICAL :: ln_skd490 ! Logical switch for surface Kd490
235	LOGICAL :: ln_sfco2 ! Logical switch for surface fugacity of carbon dioxide obs
236	LOGICAL :: ln_spco2 ! Logical switch for surface partial pressure of carbon dioxide obs
237	LOGICAL :: ln_plchltot ! Logical switch for profile total log10(chlorophyll) obs
238	LOGICAL :: ln_pchltot ! Logical switch for profile total chlorophyll obs
239	LOGICAL :: ln_pno3 ! Logical switch for profile nitrate obs
240	LOGICAL :: ln_psi4 ! Logical switch for profile silicate obs
241	LOGICAL :: ln_ppo4 ! Logical switch for profile phosphate obs
242	LOGICAL :: ln_pdic ! Logical switch for profile dissolved inorganic carbon obs
243	LOGICAL :: ln_palk ! Logical switch for profile alkalinity obs
244	LOGICAL :: ln_pph ! Logical switch for profile pH obs
245	LOGICAL :: ln_po2 ! Logical switch for profile dissolved oxygen obs
246	LOGICAL :: ln_nea ! Logical switch to remove obs near land
247	LOGICAL :: ln_altbias ! Logical switch for altimeter bias
248	LOGICAL :: ln_sstbias ! Logical switch for bias correction of SST
249	LOGICAL :: ln_ignmis ! Logical switch for ignoring missing files
250	LOGICAL :: ln_s_at_t ! Logical switch to compute model S at T obs
251	LOGICAL :: ln_bound_reject ! Logical switch for rejecting obs near the boundary
252
253	REAL(dp) :: rn_dobsini ! Obs window start date YYYYMMDD.HHMMSS
254	REAL(dp) :: rn_dobsend ! Obs window end date YYYYMMDD.HHMMSS
255
256	REAL(wp) :: ztype_avglamscl ! Local version of rn_*_avglamscl
257	REAL(wp) :: ztype_avgphiscl ! Local version of rn_*_avgphiscl
258
259	CHARACTER(len=128), DIMENSION(:,:), ALLOCATABLE :: &
260	& clproffiles, & ! Profile filenames
261	& clsurffiles ! Surface filenames
262	CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: clvars ! Expected variable names
263
264	LOGICAL, DIMENSION(:), ALLOCATABLE :: llvar ! Logical for profile variable read
265	LOGICAL :: ltype_fp_indegs ! Local version of ln_*_fp_indegs
266	LOGICAL :: ltype_night ! Local version of ln_sstnight (false for other variables)
267	LOGICAL :: ltype_clim ! Local version of ln_output_clim
268
269	REAL(wp), POINTER, DIMENSION(:,:,:) :: &
270	& zglam ! Model longitudes for profile variables
271	REAL(wp), POINTER, DIMENSION(:,:,:) :: &
272	& zgphi ! Model latitudes for profile variables
273	REAL(wp), POINTER, DIMENSION(:,:,:,:) :: &
274	& zmask ! Model land/sea mask associated with variables
275	REAL(wp), POINTER, DIMENSION(:,:,:) :: &
276	& zmask_surf ! Surface model land/sea mask associated with variables
277
278
279	NAMELIST/namobs/ln_diaobs, ln_t3d, ln_s3d, ln_sla, &
280	& ln_sst, ln_sic, ln_sit, ln_fbd, &
281	& ln_sss, ln_ssv, ln_vel3d, &
282	& ln_slchltot, ln_slchldia, ln_slchlnon, &
283	& ln_slchldin, ln_slchlmic, ln_slchlnan, &
284	& ln_slchlpic, ln_schltot, &
285	& ln_slphytot, ln_slphydia, ln_slphynon, &
286	& ln_sspm, ln_sfco2, ln_spco2, &
287	& ln_skd490, &
288	& ln_plchltot, ln_pchltot, ln_pno3, &
289	& ln_psi4, ln_ppo4, ln_pdic, &
290	& ln_palk, ln_pph, ln_po2, &
291	& ln_altbias, ln_sstbias, ln_nea, &
292	& ln_grid_global, ln_grid_search_lookup, &
293	& ln_ignmis, ln_s_at_t, ln_bound_reject, &
294	& ln_sstnight, ln_output_clim, &
295	& ln_time_mean_sla_bkg, ln_default_fp_indegs, &
296	& ln_sla_fp_indegs, ln_sst_fp_indegs, &
297	& ln_sss_fp_indegs, ln_ssv_fp_indegs, &
298	& ln_sic_fp_indegs, ln_sit_fp_indegs, &
299	& ln_fbd_fp_indegs, &
300	& cn_profbfiles, cn_slafbfiles, &
301	& cn_sstfbfiles, cn_sicfbfiles, &
302	& cn_sitfbfiles, cn_fbdfbfiles, &
303	& cn_velfbfiles, cn_sssfbfiles, cn_ssvfbfiles, &
304	& cn_slchltotfbfiles, cn_slchldiafbfiles, &
305	& cn_slchlnonfbfiles, cn_slchldinfbfiles, &
306	& cn_slchlmicfbfiles, cn_slchlnanfbfiles, &
307	& cn_slchlpicfbfiles, cn_schltotfbfiles, &
308	& cn_slphytotfbfiles, cn_slphydiafbfiles, &
309	& cn_slphynonfbfiles, cn_sspmfbfiles, &
310	& cn_skd490fbfiles, &
311	& cn_sfco2fbfiles, cn_spco2fbfiles, &
312	& cn_plchltotfbfiles, cn_pchltotfbfiles, &
313	& cn_pno3fbfiles, cn_psi4fbfiles, cn_ppo4fbfiles, &
314	& cn_pdicfbfiles, cn_palkfbfiles, cn_pphfbfiles, &
315	& cn_po2fbfiles, &
316	& cn_sstbiasfiles, cn_altbiasfile, &
317	& cn_gridsearchfile, rn_gridsearchres, &
318	& rn_dobsini, rn_dobsend, &
319	& rn_default_avglamscl, rn_default_avgphiscl, &
320	& rn_sla_avglamscl, rn_sla_avgphiscl, &
321	& rn_sst_avglamscl, rn_sst_avgphiscl, &
322	& rn_sss_avglamscl, rn_sss_avgphiscl, &
323	& rn_ssv_avglamscl, rn_ssv_avgphiscl, &
324	& rn_sic_avglamscl, rn_sic_avgphiscl, &
325	& rn_sit_avglamscl, rn_sit_avgphiscl, &
326	& rn_fbd_avglamscl, rn_fbd_avgphiscl, &
327	& nn_1dint, nn_2dint_default, &
328	& nn_2dint_sla, nn_2dint_sst, &
329	& nn_2dint_sss, nn_2dint_ssv, &
330	& nn_2dint_sic, nn_2dint_sit, &
331	& nn_2dint_fbd, &
332	& nn_msshc, rn_mdtcorr, rn_mdtcutoff, &
333	& nn_profdavtypes
334
335	!-----------------------------------------------------------------------
336	! Read namelist parameters
337	!-----------------------------------------------------------------------
338
339	cn_profbfiles(:) = ''
340	cn_slafbfiles(:) = ''
341	cn_sstfbfiles(:) = ''
342	cn_sicfbfiles(:) = ''
343	cn_sitfbfiles(:) = ''
344	cn_fbdfbfiles(:) = ''
345	cn_velfbfiles(:) = ''
346	cn_sssfbfiles(:) = ''
347	cn_ssvfbfiles(:) = ''
348	cn_slchltotfbfiles(:) = ''
349	cn_slchldiafbfiles(:) = ''
350	cn_slchlnonfbfiles(:) = ''
351	cn_slchldinfbfiles(:) = ''
352	cn_slchlmicfbfiles(:) = ''
353	cn_slchlnanfbfiles(:) = ''
354	cn_slchlpicfbfiles(:) = ''
355	cn_schltotfbfiles(:) = ''
356	cn_slphytotfbfiles(:) = ''
357	cn_slphydiafbfiles(:) = ''
358	cn_slphynonfbfiles(:) = ''
359	cn_sspmfbfiles(:) = ''
360	cn_skd490fbfiles(:) = ''
361	cn_sfco2fbfiles(:) = ''
362	cn_spco2fbfiles(:) = ''
363	cn_plchltotfbfiles(:) = ''
364	cn_pchltotfbfiles(:) = ''
365	cn_pno3fbfiles(:) = ''
366	cn_psi4fbfiles(:) = ''
367	cn_ppo4fbfiles(:) = ''
368	cn_pdicfbfiles(:) = ''
369	cn_palkfbfiles(:) = ''
370	cn_pphfbfiles(:) = ''
371	cn_po2fbfiles(:) = ''
372	cn_sstbiasfiles(:) = ''
373	nn_profdavtypes(:) = -1
374
375	CALL ini_date( rn_dobsini )
376	CALL fin_date( rn_dobsend )
377
378	! Read namelist namobs : control observation diagnostics
379	REWIND( numnam_ref ) ! Namelist namobs in reference namelist
380	READ ( numnam_ref, namobs, IOSTAT = ios, ERR = 901)
381	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namobs in reference namelist', lwp )
382
383	REWIND( numnam_cfg ) ! Namelist namobs in configuration namelist
384	READ ( numnam_cfg, namobs, IOSTAT = ios, ERR = 902 )
385	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namobs in configuration namelist', lwp )
386	IF(lwm) WRITE ( numond, namobs )
387
388	lk_diaobs = .FALSE.
389	#if defined key_diaobs
390	IF ( ln_diaobs ) lk_diaobs = .TRUE.
391	#endif
392
393	IF ( .NOT. lk_diaobs ) THEN
394	IF(lwp) WRITE(numout,cform_war)
395	IF(lwp) WRITE(numout,*)' ln_diaobs is set to false or key_diaobs is not set, so not calling dia_obs'
396	RETURN
397	ENDIF
398
399	IF(lwp) THEN
400	WRITE(numout,*)
401	WRITE(numout,*) 'dia_obs_init : Observation diagnostic initialization'
402	WRITE(numout,*) '~~~~~~~~~~~~'
403	WRITE(numout,*) ' Namelist namobs : set observation diagnostic parameters'
404	WRITE(numout,*) ' Logical switch for T profile observations ln_t3d = ', ln_t3d
405	WRITE(numout,*) ' Logical switch for S profile observations ln_s3d = ', ln_s3d
406	WRITE(numout,*) ' Logical switch for SLA observations ln_sla = ', ln_sla
407	WRITE(numout,*) ' Logical switch for SST observations ln_sst = ', ln_sst
408	WRITE(numout,*) ' Logical switch for SIC observations ln_sic = ', ln_sic
409	WRITE(numout,*) ' Logical switch for SIT observations ln_sit = ', ln_sit
410	WRITE(numout,*) ' Logical switch for FBD observations ln_fbd = ', ln_fbd
411	WRITE(numout,*) ' Logical switch for velocity observations ln_vel3d = ', ln_vel3d
412	WRITE(numout,*) ' Logical switch for SSS observations ln_sss = ', ln_sss
413	WRITE(numout,*) ' Logical switch for SSV observations ln_ssv = ', ln_ssv
414	WRITE(numout,*) ' Logical switch for surface total logchl obs ln_slchltot = ', ln_slchltot
415	WRITE(numout,*) ' Logical switch for surface diatom logchl obs ln_slchldia = ', ln_slchldia
416	WRITE(numout,*) ' Logical switch for surface non-diatom logchl obs ln_slchlnon = ', ln_slchlnon
417	WRITE(numout,*) ' Logical switch for surface dino logchl obs ln_slchldin = ', ln_slchldin
418	WRITE(numout,*) ' Logical switch for surface micro logchl obs ln_slchlmic = ', ln_slchlmic
419	WRITE(numout,*) ' Logical switch for surface nano logchl obs ln_slchlnan = ', ln_slchlnan
420	WRITE(numout,*) ' Logical switch for surface pico logchl obs ln_slchlpic = ', ln_slchlpic
421	WRITE(numout,*) ' Logical switch for surface total chl obs ln_schltot = ', ln_schltot
422	WRITE(numout,*) ' Logical switch for surface total log(phyC) obs ln_slphytot = ', ln_slphytot
423	WRITE(numout,*) ' Logical switch for surface diatom log(phyC) obs ln_slphydia = ', ln_slphydia
424	WRITE(numout,*) ' Logical switch for surface non-diatom log(phyC) obs ln_slphynon = ', ln_slphynon
425	WRITE(numout,*) ' Logical switch for surface SPM observations ln_sspm = ', ln_sspm
426	WRITE(numout,*) ' Logical switch for surface Kd490 observations ln_skd490 = ', ln_skd490
427	WRITE(numout,*) ' Logical switch for surface fCO2 observations ln_sfco2 = ', ln_sfco2
428	WRITE(numout,*) ' Logical switch for surface pCO2 observations ln_spco2 = ', ln_spco2
429	WRITE(numout,*) ' Logical switch for profile total logchl obs ln_plchltot = ', ln_plchltot
430	WRITE(numout,*) ' Logical switch for profile total chl obs ln_pchltot = ', ln_pchltot
431	WRITE(numout,*) ' Logical switch for profile nitrate obs ln_pno3 = ', ln_pno3
432	WRITE(numout,*) ' Logical switch for profile silicate obs ln_psi4 = ', ln_psi4
433	WRITE(numout,*) ' Logical switch for profile phosphate obs ln_ppo4 = ', ln_ppo4
434	WRITE(numout,*) ' Logical switch for profile DIC obs ln_pdic = ', ln_pdic
435	WRITE(numout,*) ' Logical switch for profile alkalinity obs ln_palk = ', ln_palk
436	WRITE(numout,*) ' Logical switch for profile pH obs ln_pph = ', ln_pph
437	WRITE(numout,*) ' Logical switch for profile oxygen obs ln_po2 = ', ln_po2
438	WRITE(numout,*) ' Global distribution of observations ln_grid_global = ', ln_grid_global
439	WRITE(numout,*) ' Logical switch for obs grid search lookup ln_grid_search_lookup = ', ln_grid_search_lookup
440	IF (ln_grid_search_lookup) &
441	WRITE(numout,*) ' Grid search lookup file header cn_gridsearchfile = ', cn_gridsearchfile
442	WRITE(numout,*) ' Initial date in window YYYYMMDD.HHMMSS rn_dobsini = ', rn_dobsini
443	WRITE(numout,*) ' Final date in window YYYYMMDD.HHMMSS rn_dobsend = ', rn_dobsend
444	WRITE(numout,*) ' Type of vertical interpolation method nn_1dint = ', nn_1dint
445	WRITE(numout,*) ' Default horizontal interpolation method nn_2dint_default = ', nn_2dint_default
446	WRITE(numout,*) ' Type of horizontal interpolation method for SLA nn_2dint_sla = ', nn_2dint_sla
447	WRITE(numout,*) ' Type of horizontal interpolation method for SST nn_2dint_sst = ', nn_2dint_sst
448	WRITE(numout,*) ' Type of horizontal interpolation method for SSS nn_2dint_sss = ', nn_2dint_sss
449	WRITE(numout,*) ' Type of horizontal interpolation method for SSV nn_2dint_ssv = ', nn_2dint_ssv
450	WRITE(numout,*) ' Type of horizontal interpolation method for SIC nn_2dint_sic = ', nn_2dint_sic
451	WRITE(numout,*) ' Type of horizontal interpolation method for SIT nn_2dint_sit = ', nn_2dint_sit
452	WRITE(numout,*) ' Type of horizontal interpolation method for FBD nn_2dint_fbd = ', nn_2dint_fbd
453	WRITE(numout,*) ' Default E/W diameter of obs footprint rn_default_avglamscl = ', rn_default_avglamscl
454	WRITE(numout,*) ' Default N/S diameter of obs footprint rn_default_avgphiscl = ', rn_default_avgphiscl
455	WRITE(numout,*) ' Default obs footprint in deg [T] or m [F] ln_default_fp_indegs = ', ln_default_fp_indegs
456	WRITE(numout,*) ' SLA E/W diameter of obs footprint rn_sla_avglamscl = ', rn_sla_avglamscl
457	WRITE(numout,*) ' SLA N/S diameter of obs footprint rn_sla_avgphiscl = ', rn_sla_avgphiscl
458	WRITE(numout,*) ' SLA obs footprint in deg [T] or m [F] ln_sla_fp_indegs = ', ln_sla_fp_indegs
459	WRITE(numout,*) ' SST E/W diameter of obs footprint rn_sst_avglamscl = ', rn_sst_avglamscl
460	WRITE(numout,*) ' SST N/S diameter of obs footprint rn_sst_avgphiscl = ', rn_sst_avgphiscl
461	WRITE(numout,*) ' SST obs footprint in deg [T] or m [F] ln_sst_fp_indegs = ', ln_sst_fp_indegs
462	WRITE(numout,*) ' SIC E/W diameter of obs footprint rn_sic_avglamscl = ', rn_sic_avglamscl
463	WRITE(numout,*) ' SIC N/S diameter of obs footprint rn_sic_avgphiscl = ', rn_sic_avgphiscl
464	WRITE(numout,*) ' SIC obs footprint in deg [T] or m [F] ln_sic_fp_indegs = ', ln_sic_fp_indegs
465	WRITE(numout,*) ' SIT E/W diameter of obs footprint rn_sit_avglamscl = ', rn_sit_avglamscl
466	WRITE(numout,*) ' SIT N/S diameter of obs footprint rn_sit_avgphiscl = ', rn_sit_avgphiscl
467	WRITE(numout,*) ' SIT obs footprint in deg [T] or m [F] ln_sit_fp_indegs = ', ln_sit_fp_indegs
468	WRITE(numout,*) ' FBD E/W diameter of obs footprint rn_fbd_avglamscl = ', rn_fbd_avglamscl
469	WRITE(numout,*) ' FBD N/S diameter of obs footprint rn_fbd_avgphiscl = ', rn_fbd_avgphiscl
470	WRITE(numout,*) ' FBD obs footprint in deg [T] or m [F] ln_fbd_fp_indegs = ', ln_fbd_fp_indegs
471	WRITE(numout,*) ' Rejection of observations near land switch ln_nea = ', ln_nea
472	WRITE(numout,*) ' Rejection of obs near open bdys ln_bound_reject = ', ln_bound_reject
473	WRITE(numout,*) ' MSSH correction scheme nn_msshc = ', nn_msshc
474	WRITE(numout,*) ' MDT correction rn_mdtcorr = ', rn_mdtcorr
475	WRITE(numout,*) ' MDT cutoff for computed correction rn_mdtcutoff = ', rn_mdtcutoff
476	WRITE(numout,*) ' Logical switch for alt bias ln_altbias = ', ln_altbias
477	WRITE(numout,*) ' Logical switch for sst bias ln_sstbias = ', ln_sstbias
478	WRITE(numout,*) ' Logical switch for ignoring missing files ln_ignmis = ', ln_ignmis
479	WRITE(numout,*) ' Daily average types nn_profdavtypes = ', nn_profdavtypes
480	WRITE(numout,*) ' Logical switch for night-time SST obs ln_sstnight = ', ln_sstnight
481	WRITE(numout,*) ' Logical switch for writing climat. at obs points ln_output_clim = ', ln_output_clim
482	WRITE(numout,*) ' Logical switch for time-mean of SLA ln_time_mean_sla_bkg = ', ln_time_mean_sla_bkg
483	ENDIF
484	!-----------------------------------------------------------------------
485	! Set up list of observation types to be used
486	! and the files associated with each type
487	!-----------------------------------------------------------------------
488
489	nproftypes = COUNT( (/ln_t3d .OR. ln_s3d, ln_vel3d, ln_plchltot, &
490	& ln_pchltot, ln_pno3, ln_psi4, ln_ppo4, &
491	& ln_pdic, ln_palk, ln_pph, ln_po2 /) )
492	nsurftypes = COUNT( (/ln_sla, ln_sst, ln_sic, ln_sit, ln_fbd, &
493	& ln_sss, ln_ssv, &
494	& ln_slchltot, ln_slchldia, ln_slchlnon, ln_slchldin, &
495	& ln_slchlmic, ln_slchlnan, ln_slchlpic, ln_schltot, &
496	& ln_slphytot, ln_slphydia, ln_slphynon, ln_sspm, &
497	& ln_skd490, ln_sfco2, ln_spco2 /) )
498
499	IF ( nproftypes == 0 .AND. nsurftypes == 0 ) THEN
500	IF(lwp) WRITE(numout,cform_war)
501	IF(lwp) WRITE(numout,*) ' ln_diaobs is set to true, but all obs operator logical flags', &
502	& ' are set to .FALSE. so turning off calls to dia_obs'
503	nwarn = nwarn + 1
504	lk_diaobs = .FALSE.
505	RETURN
506	ENDIF
507
508	IF ( ln_output_clim .AND. ( .NOT. ln_tradmp ) ) THEN
509	IF(lwp) WRITE(numout,cform_war)
510	IF(lwp) WRITE(numout,*) ' ln_output_clim is true, but ln_tradmp is false', &
511	& ' so climatological T/S not available and will not be output'
512	nwarn = nwarn + 1
513	ln_output_clim = .FALSE.
514	ENDIF
515
516	IF(lwp) WRITE(numout,*) ' Number of profile obs types: ',nproftypes
517	IF ( nproftypes > 0 ) THEN
518
519	ALLOCATE( cobstypesprof(nproftypes) )
520	ALLOCATE( ifilesprof(nproftypes) )
521	ALLOCATE( clproffiles(nproftypes,jpmaxnfiles) )
522
523	jtype = 0
524	IF (ln_t3d .OR. ln_s3d) THEN
525	jtype = jtype + 1
526	cobstypesprof(jtype) = 'prof'
527	clproffiles(jtype,:) = cn_profbfiles
528	ENDIF
529	IF (ln_vel3d) THEN
530	jtype = jtype + 1
531	cobstypesprof(jtype) = 'vel'
532	clproffiles(jtype,:) = cn_velfbfiles
533	ENDIF
534	IF (ln_plchltot) THEN
535	jtype = jtype + 1
536	cobstypesprof(jtype) = 'plchltot'
537	clproffiles(jtype,:) = cn_plchltotfbfiles
538	ENDIF
539	IF (ln_pchltot) THEN
540	jtype = jtype + 1
541	cobstypesprof(jtype) = 'pchltot'
542	clproffiles(jtype,:) = cn_pchltotfbfiles
543	ENDIF
544	IF (ln_pno3) THEN
545	jtype = jtype + 1
546	cobstypesprof(jtype) = 'pno3'
547	clproffiles(jtype,:) = cn_pno3fbfiles
548	ENDIF
549	IF (ln_psi4) THEN
550	jtype = jtype + 1
551	cobstypesprof(jtype) = 'psi4'
552	clproffiles(jtype,:) = cn_psi4fbfiles
553	ENDIF
554	IF (ln_ppo4) THEN
555	jtype = jtype + 1
556	cobstypesprof(jtype) = 'ppo4'
557	clproffiles(jtype,:) = cn_ppo4fbfiles
558	ENDIF
559	IF (ln_pdic) THEN
560	jtype = jtype + 1
561	cobstypesprof(jtype) = 'pdic'
562	clproffiles(jtype,:) = cn_pdicfbfiles
563	ENDIF
564	IF (ln_palk) THEN
565	jtype = jtype + 1
566	cobstypesprof(jtype) = 'palk'
567	clproffiles(jtype,:) = cn_palkfbfiles
568	ENDIF
569	IF (ln_pph) THEN
570	jtype = jtype + 1
571	cobstypesprof(jtype) = 'pph'
572	clproffiles(jtype,:) = cn_pphfbfiles
573	ENDIF
574	IF (ln_po2) THEN
575	jtype = jtype + 1
576	cobstypesprof(jtype) = 'po2'
577	clproffiles(jtype,:) = cn_po2fbfiles
578	ENDIF
579
580	CALL obs_settypefiles( nproftypes, jpmaxnfiles, ifilesprof, cobstypesprof, clproffiles )
581
582	ENDIF
583
584	IF(lwp) WRITE(numout,*)' Number of surface obs types: ',nsurftypes
585	IF ( nsurftypes > 0 ) THEN
586
587	ALLOCATE( cobstypessurf(nsurftypes) )
588	ALLOCATE( ifilessurf(nsurftypes) )
589	ALLOCATE( clsurffiles(nsurftypes, jpmaxnfiles) )
590	ALLOCATE(n2dintsurf(nsurftypes))
591	ALLOCATE(ravglamscl(nsurftypes))
592	ALLOCATE(ravgphiscl(nsurftypes))
593	ALLOCATE(lfpindegs(nsurftypes))
594	ALLOCATE(llnightav(nsurftypes))
595
596	jtype = 0
597	IF (ln_sla) THEN
598	jtype = jtype + 1
599	cobstypessurf(jtype) = 'sla'
600	clsurffiles(jtype,:) = cn_slafbfiles
601	ENDIF
602	IF (ln_sst) THEN
603	jtype = jtype + 1
604	cobstypessurf(jtype) = 'sst'
605	clsurffiles(jtype,:) = cn_sstfbfiles
606	ENDIF
607	IF (ln_sic) THEN
608	jtype = jtype + 1
609	cobstypessurf(jtype) = 'sic'
610	clsurffiles(jtype,:) = cn_sicfbfiles
611	ENDIF
612	IF (ln_sit) THEN
613	jtype = jtype + 1
614	cobstypessurf(jtype) = 'sit'
615	clsurffiles(jtype,:) = cn_sitfbfiles
616	ENDIF
617	IF (ln_fbd) THEN
618	jtype = jtype + 1
619	cobstypessurf(jtype) = 'fbd'
620	clsurffiles(jtype,:) = cn_fbdfbfiles
621	ENDIF
622	IF (ln_sss) THEN
623	jtype = jtype + 1
624	cobstypessurf(jtype) = 'sss'
625	clsurffiles(jtype,:) = cn_sssfbfiles
626	ENDIF
627	IF (ln_ssv) THEN
628	jtype = jtype + 1
629	cobstypessurf(jtype) = 'ssv'
630	clsurffiles(jtype,:) = cn_ssvfbfiles
631	ENDIF
632	IF (ln_slchltot) THEN
633	jtype = jtype + 1
634	cobstypessurf(jtype) = 'slchltot'
635	clsurffiles(jtype,:) = cn_slchltotfbfiles
636	ENDIF
637	IF (ln_slchldia) THEN
638	jtype = jtype + 1
639	cobstypessurf(jtype) = 'slchldia'
640	clsurffiles(jtype,:) = cn_slchldiafbfiles
641	ENDIF
642	IF (ln_slchlnon) THEN
643	jtype = jtype + 1
644	cobstypessurf(jtype) = 'slchlnon'
645	clsurffiles(jtype,:) = cn_slchlnonfbfiles
646	ENDIF
647	IF (ln_slchldin) THEN
648	jtype = jtype + 1
649	cobstypessurf(jtype) = 'slchldin'
650	clsurffiles(jtype,:) = cn_slchldinfbfiles
651	ENDIF
652	IF (ln_slchlmic) THEN
653	jtype = jtype + 1
654	cobstypessurf(jtype) = 'slchlmic'
655	clsurffiles(jtype,:) = cn_slchlmicfbfiles
656	ENDIF
657	IF (ln_slchlnan) THEN
658	jtype = jtype + 1
659	cobstypessurf(jtype) = 'slchlnan'
660	clsurffiles(jtype,:) = cn_slchlnanfbfiles
661	ENDIF
662	IF (ln_slchlpic) THEN
663	jtype = jtype + 1
664	cobstypessurf(jtype) = 'slchlpic'
665	clsurffiles(jtype,:) = cn_slchlpicfbfiles
666	ENDIF
667	IF (ln_schltot) THEN
668	jtype = jtype + 1
669	cobstypessurf(jtype) = 'schltot'
670	clsurffiles(jtype,:) = cn_schltotfbfiles
671	ENDIF
672	IF (ln_slphytot) THEN
673	jtype = jtype + 1
674	cobstypessurf(jtype) = 'slphytot'
675	clsurffiles(jtype,:) = cn_slphytotfbfiles
676	ENDIF
677	IF (ln_slphydia) THEN
678	jtype = jtype + 1
679	cobstypessurf(jtype) = 'slphydia'
680	clsurffiles(jtype,:) = cn_slphydiafbfiles
681	ENDIF
682	IF (ln_slphynon) THEN
683	jtype = jtype + 1
684	cobstypessurf(jtype) = 'slphynon'
685	clsurffiles(jtype,:) = cn_slphynonfbfiles
686	ENDIF
687	IF (ln_sspm) THEN
688	jtype = jtype + 1
689	cobstypessurf(jtype) = 'sspm'
690	clsurffiles(jtype,:) = cn_sspmfbfiles
691	ENDIF
692	IF (ln_skd490) THEN
693	jtype = jtype + 1
694	cobstypessurf(jtype) = 'skd490'
695	clsurffiles(jtype,:) = cn_skd490fbfiles
696	ENDIF
697	IF (ln_sfco2) THEN
698	jtype = jtype + 1
699	cobstypessurf(jtype) = 'sfco2'
700	clsurffiles(jtype,:) = cn_sfco2fbfiles
701	ENDIF
702	IF (ln_spco2) THEN
703	jtype = jtype + 1
704	cobstypessurf(jtype) = 'spco2'
705	clsurffiles(jtype,:) = cn_spco2fbfiles
706	ENDIF
707
708	CALL obs_settypefiles( nsurftypes, jpmaxnfiles, ifilessurf, cobstypessurf, clsurffiles )
709
710	DO jtype = 1, nsurftypes
711
712	IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN
713	IF ( nn_2dint_sla == -1 ) THEN
714	n2dint_type = nn_2dint_default
715	ELSE
716	n2dint_type = nn_2dint_sla
717	ENDIF
718	ztype_avglamscl = rn_sla_avglamscl
719	ztype_avgphiscl = rn_sla_avgphiscl
720	ltype_fp_indegs = ln_sla_fp_indegs
721	ltype_night = .FALSE.
722	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sst' ) THEN
723	IF ( nn_2dint_sst == -1 ) THEN
724	n2dint_type = nn_2dint_default
725	ELSE
726	n2dint_type = nn_2dint_sst
727	ENDIF
728	ztype_avglamscl = rn_sst_avglamscl
729	ztype_avgphiscl = rn_sst_avgphiscl
730	ltype_fp_indegs = ln_sst_fp_indegs
731	ltype_night = ln_sstnight
732	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sic' ) THEN
733	IF ( nn_2dint_sic == -1 ) THEN
734	n2dint_type = nn_2dint_default
735	ELSE
736	n2dint_type = nn_2dint_sic
737	ENDIF
738	ztype_avglamscl = rn_sic_avglamscl
739	ztype_avgphiscl = rn_sic_avgphiscl
740	ltype_fp_indegs = ln_sic_fp_indegs
741	ltype_night = .FALSE.
742	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sit' ) THEN
743	IF ( nn_2dint_sit == -1 ) THEN
744	n2dint_type = nn_2dint_default
745	ELSE
746	n2dint_type = nn_2dint_sit
747	ENDIF
748	ztype_avglamscl = rn_sit_avglamscl
749	ztype_avgphiscl = rn_sit_avgphiscl
750	ltype_fp_indegs = ln_sit_fp_indegs
751	ltype_night = .FALSE.
752	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'fbd' ) THEN
753	IF ( nn_2dint_fbd == -1 ) THEN
754	n2dint_type = nn_2dint_default
755	ELSE
756	n2dint_type = nn_2dint_fbd
757	ENDIF
758	ztype_avglamscl = rn_fbd_avglamscl
759	ztype_avgphiscl = rn_fbd_avgphiscl
760	ltype_fp_indegs = ln_fbd_fp_indegs
761	ltype_night = .FALSE.
762	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sss' ) THEN
763	IF ( nn_2dint_sss == -1 ) THEN
764	n2dint_type = nn_2dint_default
765	ELSE
766	n2dint_type = nn_2dint_sss
767	ENDIF
768	ztype_avglamscl = rn_sss_avglamscl
769	ztype_avgphiscl = rn_sss_avgphiscl
770	ltype_fp_indegs = ln_sss_fp_indegs
771	ltype_night = .FALSE.
772	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'ssv' ) THEN
773	IF ( nn_2dint_ssv == -1 ) THEN
774	n2dint_type = nn_2dint_default
775	ELSE
776	n2dint_type = nn_2dint_ssv
777	ENDIF
778	ztype_avglamscl = rn_ssv_avglamscl
779	ztype_avgphiscl = rn_ssv_avgphiscl
780	ltype_fp_indegs = ln_ssv_fp_indegs
781	ltype_night = .FALSE.
782	ELSE
783	n2dint_type = nn_2dint_default
784	ztype_avglamscl = rn_default_avglamscl
785	ztype_avgphiscl = rn_default_avgphiscl
786	ltype_fp_indegs = ln_default_fp_indegs
787	ltype_night = .FALSE.
788	ENDIF
789
790	CALL obs_setinterpopts( nsurftypes, jtype, TRIM(cobstypessurf(jtype)), &
791	& nn_2dint_default, n2dint_type, &
792	& ztype_avglamscl, ztype_avgphiscl, &
793	& ltype_fp_indegs, ltype_night, &
794	& n2dintsurf, ravglamscl, ravgphiscl, &
795	& lfpindegs, llnightav )
796
797	END DO
798
799	ENDIF
800
801	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
802
803
804	!-----------------------------------------------------------------------
805	! Obs operator parameter checking and initialisations
806	!-----------------------------------------------------------------------
807
808	IF ( ln_vel3d .AND. ( .NOT. ln_grid_global ) ) THEN
809	CALL ctl_stop( 'Velocity data only works with ln_grid_global=.true.' )
810	RETURN
811	ENDIF
812
813	IF ( ( nn_1dint < 0 ) .OR. ( nn_1dint > 1 ) ) THEN
814	CALL ctl_stop(' Choice of vertical (1D) interpolation method', &
815	& ' is not available')
816	ENDIF
817
818	IF ( ( nn_2dint_default < 0 ) .OR. ( nn_2dint_default > 6 ) ) THEN
819	CALL ctl_stop(' Choice of default horizontal (2D) interpolation method', &
820	& ' is not available')
821	ENDIF
822
823	CALL obs_typ_init
824
825	CALL mppmap_init
826
827	CALL obs_grid_setup( )
828
829	!-----------------------------------------------------------------------
830	! Depending on switches read the various observation types
831	!-----------------------------------------------------------------------
832
833	IF ( nproftypes > 0 ) THEN
834
835	ALLOCATE(profdata(nproftypes))
836	ALLOCATE(profdataqc(nproftypes))
837	ALLOCATE(nvarsprof(nproftypes))
838	ALLOCATE(nextrprof(nproftypes))
839
840	DO jtype = 1, nproftypes
841
842	ltype_clim = .FALSE.
843
844	IF ( TRIM(cobstypesprof(jtype)) == 'prof' ) THEN
845	nvarsprof(jtype) = 2
846	nextrprof(jtype) = 1
847	IF ( ln_output_clim ) ltype_clim = .TRUE.
848	ALLOCATE(llvar(nvarsprof(jtype)))
849	ALLOCATE(clvars(nvarsprof(jtype)))
850	CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zglam )
851	CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zgphi )
852	CALL wrk_alloc( jpi, jpj, jpk, nvarsprof(jtype), zmask )
853	llvar(1) = ln_t3d
854	llvar(2) = ln_s3d
855	zglam(:,:,1) = glamt(:,:)
856	zglam(:,:,2) = glamt(:,:)
857	zgphi(:,:,1) = gphit(:,:)
858	zgphi(:,:,2) = gphit(:,:)
859	zmask(:,:,:,1) = tmask(:,:,:)
860	zmask(:,:,:,2) = tmask(:,:,:)
861	ELSE IF ( TRIM(cobstypesprof(jtype)) == 'vel' ) THEN
862	nvarsprof(jtype) = 2
863	nextrprof(jtype) = 2
864	ALLOCATE(llvar(nvarsprof(jtype)))
865	ALLOCATE(clvars(nvarsprof(jtype)))
866	CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zglam )
867	CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zgphi )
868	CALL wrk_alloc( jpi, jpj, jpk, nvarsprof(jtype), zmask )
869	llvar(1) = ln_vel3d
870	llvar(2) = ln_vel3d
871	clvars(1) = 'UVEL'
872	clvars(2) = 'VVEL'
873	zglam(:,:,1) = glamu(:,:)
874	zglam(:,:,2) = glamv(:,:)
875	zgphi(:,:,1) = gphiu(:,:)
876	zgphi(:,:,2) = gphiv(:,:)
877	zmask(:,:,:,1) = umask(:,:,:)
878	zmask(:,:,:,2) = vmask(:,:,:)
879	ELSE
880	nvarsprof(jtype) = 1
881	nextrprof(jtype) = 0
882	ALLOCATE(llvar(nvarsprof(jtype)))
883	ALLOCATE(clvars(nvarsprof(jtype)))
884	CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zglam )
885	CALL wrk_alloc( jpi, jpj, nvarsprof(jtype), zgphi )
886	CALL wrk_alloc( jpi, jpj, jpk, nvarsprof(jtype), zmask )
887	llvar(1) = .TRUE.
888	zglam(:,:,1) = glamt(:,:)
889	zgphi(:,:,1) = gphit(:,:)
890	zmask(:,:,:,1) = tmask(:,:,:)
891	IF ( TRIM(cobstypesprof(jtype)) == 'plchltot' ) THEN
892	clvars(1) = 'PLCHLTOT'
893	ELSE IF ( TRIM(cobstypesprof(jtype)) == 'pchltot' ) THEN
894	clvars(1) = 'PCHLTOT'
895	ELSE IF ( TRIM(cobstypesprof(jtype)) == 'pno3' ) THEN
896	clvars(1) = 'PNO3'
897	ELSE IF ( TRIM(cobstypesprof(jtype)) == 'psi4' ) THEN
898	clvars(1) = 'PSI4'
899	ELSE IF ( TRIM(cobstypesprof(jtype)) == 'ppo4' ) THEN
900	clvars(1) = 'PPO4'
901	ELSE IF ( TRIM(cobstypesprof(jtype)) == 'pdic' ) THEN
902	clvars(1) = 'PDIC'
903	ELSE IF ( TRIM(cobstypesprof(jtype)) == 'palk' ) THEN
904	clvars(1) = 'PALK'
905	ELSE IF ( TRIM(cobstypesprof(jtype)) == 'pph' ) THEN
906	clvars(1) = 'PPH'
907	ELSE IF ( TRIM(cobstypesprof(jtype)) == 'po2' ) THEN
908	clvars(1) = 'PO2'
909	ENDIF
910	ENDIF
911
912	!Read in profile or profile obs types
913	CALL obs_rea_prof( profdata(jtype), ifilesprof(jtype), &
914	& clproffiles(jtype,1:ifilesprof(jtype)), &
915	& nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, &
916	& rn_dobsini, rn_dobsend, llvar, &
917	& ln_ignmis, ln_s_at_t, .FALSE., ltype_clim, clvars, &
918	& kdailyavtypes = nn_profdavtypes )
919
920	DO jvar = 1, nvarsprof(jtype)
921	CALL obs_prof_staend( profdata(jtype), jvar )
922	END DO
923
924	CALL obs_pre_prof( profdata(jtype), profdataqc(jtype), &
925	& llvar, &
926	& jpi, jpj, jpk, &
927	& zmask, zglam, zgphi, &
928	& ln_nea, ln_bound_reject, &
929	& kdailyavtypes = nn_profdavtypes )
930
931	DEALLOCATE( llvar )
932	CALL wrk_dealloc( jpi, jpj, nvarsprof(jtype), zglam )
933	CALL wrk_dealloc( jpi, jpj, nvarsprof(jtype), zgphi )
934	CALL wrk_dealloc( jpi, jpj, jpk, nvarsprof(jtype), zmask )
935
936	END DO
937
938	DEALLOCATE( ifilesprof, clproffiles )
939
940	ENDIF
941
942	IF ( nsurftypes > 0 ) THEN
943
944	ALLOCATE(surfdata(nsurftypes))
945	ALLOCATE(surfdataqc(nsurftypes))
946	ALLOCATE(nvarssurf(nsurftypes))
947	ALLOCATE(nextrsurf(nsurftypes))
948
949	DO jtype = 1, nsurftypes
950
951	ltype_clim = .FALSE.
952	IF ( ln_output_clim .AND. &
953	& ( ( TRIM(cobstypessurf(jtype)) == 'sst' ) .OR. &
954	& ( TRIM(cobstypessurf(jtype)) == 'sss' ) ) ) &
955	& ltype_clim = .TRUE.
956
957	IF ( (TRIM(cobstypessurf(jtype)) == 'sla') .OR. &
958	& (TRIM(cobstypessurf(jtype)) == 'sit') .OR. &
959	& (TRIM(cobstypessurf(jtype)) == 'fbd') ) THEN
960	nvarssurf(jtype) = 1
961	nextrsurf(jtype) = 2
962	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'ssv' ) THEN
963	nvarssurf(jtype) = 2
964	nextrsurf(jtype) = 0
965	ELSE
966	nvarssurf(jtype) = 1
967	nextrsurf(jtype) = 0
968	ENDIF
969
970	ALLOCATE( clvars( nvarssurf(jtype) ) )
971	CALL wrk_alloc( jpi, jpj, nvarssurf(jtype), zglam )
972	CALL wrk_alloc( jpi, jpj, nvarssurf(jtype), zgphi )
973	CALL wrk_alloc( jpi, jpj, nvarssurf(jtype), zmask_surf )
974
975	IF ( TRIM(cobstypessurf(jtype)) == 'ssv' ) THEN
976	zglam(:,:,1) = glamu(:,:)
977	zglam(:,:,2) = glamv(:,:)
978	zgphi(:,:,1) = gphiu(:,:)
979	zgphi(:,:,2) = gphiv(:,:)
980	zmask_surf(:,:,1) = umask(:,:,1)
981	zmask_surf(:,:,2) = vmask(:,:,1)
982	ELSE
983	DO jvar = 1, nvarssurf(jtype)
984	zglam(:,:,jvar) = glamt(:,:)
985	zgphi(:,:,jvar) = gphit(:,:)
986	zmask_surf(:,:,jvar) = tmask(:,:,1)
987	END DO
988	ENDIF
989
990	IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN
991	clvars(1) = 'SLA'
992	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sst' ) THEN
993	clvars(1) = 'SST'
994	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sic' ) THEN
995	clvars(1) = 'ICECONC'
996	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'fbd' ) THEN
997	clvars(1) = 'FBD'
998	ln_seaicetypes = .TRUE.
999	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sit' ) THEN
1000	clvars(1) = 'SIT'
1001	ln_seaicetypes = .TRUE.
1002	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sss' ) THEN
1003	clvars(1) = 'SSS'
1004	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'ssv' ) THEN
1005	clvars(1) = 'UVEL'
1006	clvars(2) = 'VVEL'
1007	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchltot' ) THEN
1008	clvars(1) = 'SLCHLTOT'
1009	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchldia' ) THEN
1010	clvars(1) = 'SLCHLDIA'
1011	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchlnon' ) THEN
1012	clvars(1) = 'SLCHLNON'
1013	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchldin' ) THEN
1014	clvars(1) = 'SLCHLDIN'
1015	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchlmic' ) THEN
1016	clvars(1) = 'SLCHLMIC'
1017	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchlnan' ) THEN
1018	clvars(1) = 'SLCHLNAN'
1019	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slchlpic' ) THEN
1020	clvars(1) = 'SLCHLPIC'
1021	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'schltot' ) THEN
1022	clvars(1) = 'SCHLTOT'
1023	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slphytot' ) THEN
1024	clvars(1) = 'SLPHYTOT'
1025	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slphydia' ) THEN
1026	clvars(1) = 'SLPHYDIA'
1027	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'slphynon' ) THEN
1028	clvars(1) = 'SLPHYNON'
1029	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sspm' ) THEN
1030	clvars(1) = 'SSPM'
1031	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'skd490' ) THEN
1032	clvars(1) = 'SKD490'
1033	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sfco2' ) THEN
1034	clvars(1) = 'SFCO2'
1035	ELSE IF ( TRIM(cobstypessurf(jtype)) == 'spco2' ) THEN
1036	clvars(1) = 'SPCO2'
1037	ENDIF
1038
1039	!Read in surface obs types
1040	CALL obs_rea_surf( surfdata(jtype), ifilessurf(jtype), &
1041	& clsurffiles(jtype,1:ifilessurf(jtype)), &
1042	& nvarssurf(jtype), nextrsurf(jtype), nitend-nit000+2, &
1043	& rn_dobsini, rn_dobsend, MeanPeriodHours, ln_ignmis, .FALSE., &
1044	& llnightav(jtype), ltype_clim, ln_time_mean_sla_bkg, clvars )
1045
1046	CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), &
1047	& jpi, jpj, &
1048	& zmask_surf, zglam, zgphi, &
1049	& ln_nea, ln_bound_reject, ln_seaicetypes )
1050
1051	IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN
1052	CALL obs_rea_mdt( surfdataqc(jtype), n2dintsurf(jtype) )
1053	IF ( ln_altbias ) &
1054	& CALL obs_rea_altbias ( surfdataqc(jtype), n2dintsurf(jtype), cn_altbiasfile )
1055	ENDIF
1056
1057	#if defined key_cice
1058	IF ( TRIM(cobstypessurf(jtype)) == 'fbd' ) THEN
1059	CALL obs_rea_snowdepth( surfdataqc(jtype), n2dintsurf(jtype), thick_s(:,:) )
1060	ENDIF
1061	#endif
1062
1063	IF ( TRIM(cobstypessurf(jtype)) == 'sst' .AND. ln_sstbias ) THEN
1064	jnumsstbias = 0
1065	DO jfile = 1, jpmaxnfiles
1066	IF ( TRIM(cn_sstbiasfiles(jfile)) /= '' ) &
1067	& jnumsstbias = jnumsstbias + 1
1068	END DO
1069	IF ( jnumsstbias == 0 ) THEN
1070	CALL ctl_stop("ln_sstbias set but no bias files to read in")
1071
1072	ENDIF
1073
1074	CALL obs_app_sstbias( surfdataqc(jtype), n2dintsurf(jtype), &
1075	& jnumsstbias, cn_sstbiasfiles(1:jnumsstbias) )
1076
1077	ENDIF
1078
1079	DEALLOCATE( clvars )
1080	CALL wrk_dealloc( jpi, jpj, nvarssurf(jtype), zglam )
1081	CALL wrk_dealloc( jpi, jpj, nvarssurf(jtype), zgphi )
1082	CALL wrk_dealloc( jpi, jpj, nvarssurf(jtype), zmask_surf )
1083
1084	END DO
1085
1086	DEALLOCATE( ifilessurf, clsurffiles )
1087
1088	ENDIF
1089
1090	END SUBROUTINE dia_obs_init
1091
1092	SUBROUTINE dia_obs( kstp )
1093	!!----------------------------------------------------------------------
1094	!! * ROUTINE dia_obs *
1095	!!
1096	!! ** Purpose : Call the observation operators on each time step
1097	!!
1098	!! ** Method : Call the observation operators on each time step to
1099	!! compute the model equivalent of the following data:
1100	!! - Profile data, currently T/S or U/V
1101	!! - Surface data, currently SST, SLA or sea-ice concentration.
1102	!!
1103	!! ** Action :
1104	!!
1105	!! History :
1106	!! ! 06-03 (K. Mogensen) Original code
1107	!! ! 06-05 (K. Mogensen) Reformatted
1108	!! ! 06-10 (A. Weaver) Cleaning
1109	!! ! 07-03 (K. Mogensen) General handling of profiles
1110	!! ! 07-04 (G. Smith) Generalized surface operators
1111	!! ! 08-10 (M. Valdivieso) obs operator for velocity profiles
1112	!! ! 15-08 (M. Martin) Combined surface/profile routines.
1113	!!----------------------------------------------------------------------
1114	!! * Modules used
1115	USE phycst, ONLY : & ! Physical constants
1116	#if defined key_fabm
1117	& rt0, &
1118	#endif
1119	& rday
1120	USE oce, ONLY : & ! Ocean dynamics and tracers variables
1121	& tsn, &
1122	& un, &
1123	& vn, &
1124	& sshn
1125	#if defined key_lim3
1126	USE ice, ONLY : & ! LIM3 Ice model variables
1127	& frld
1128	#endif
1129	#if defined key_lim2
1130	USE ice_2, ONLY : & ! LIM2 Ice model variables
1131	& frld
1132	#endif
1133	#if defined key_cice
1134	USE sbc_oce, ONLY : & ! CICE variables
1135	& fr_i, & ! ice fraction
1136	& thick_i ! ice thickness
1137	#endif
1138	#if defined key_top
1139	USE trc, ONLY : & ! Biogeochemical state variables
1140	& trn
1141	#endif
1142	#if defined key_hadocc
1143	USE par_hadocc ! HadOCC parameters
1144	USE trc, ONLY : &
1145	& HADOCC_CHL, &
1146	& HADOCC_FCO2, &
1147	& HADOCC_PCO2, &
1148	& HADOCC_FILL_FLT
1149	USE had_bgc_const, ONLY: c2n_p
1150	#elif defined key_medusa
1151	USE par_medusa ! MEDUSA parameters
1152	USE sms_medusa, ONLY: &
1153	& xthetapn, &
1154	& xthetapd
1155	#if defined key_roam
1156	USE sms_medusa, ONLY: &
1157	& f2_pco2w, &
1158	& f2_fco2w, &
1159	& f3_pH
1160	#endif
1161	#elif defined key_fabm
1162	USE par_fabm ! FABM parameters
1163	#endif
1164	#if defined key_spm
1165	USE par_spm, ONLY: & ! Sediment parameters
1166	& jp_spm
1167	#endif
1168
1169	IMPLICIT NONE
1170
1171	!! * Arguments
1172	INTEGER, INTENT(IN) :: kstp ! Current timestep
1173	!! * Local declarations
1174	INTEGER :: idaystp ! Number of timesteps per day
1175	INTEGER :: imeanstp ! Number of timesteps for sla averaging
1176	INTEGER :: jtype ! Data loop variable
1177	INTEGER :: jvar ! Variable number
1178	INTEGER :: ji, jj, jk ! Loop counters
1179	REAL(wp) :: tiny ! small number
1180	REAL(wp), POINTER, DIMENSION(:,:,:,:) :: &
1181	& zprofvar, & ! Model values for variables in a prof ob
1182	& zprofclim ! Climatology values for variables in a prof ob
1183	REAL(wp), POINTER, DIMENSION(:,:,:,:) :: &
1184	& zprofmask ! Mask associated with zprofvar
1185	REAL(wp), POINTER, DIMENSION(:,:,:) :: &
1186	& zsurfvar, & ! Model values equivalent to surface ob.
1187	& zsurfclim, & ! Climatology values for variables in a surface ob.
1188	& zsurfmask ! Mask associated with surface variable
1189	REAL(wp), POINTER, DIMENSION(:,:,:) :: &
1190	& zglam, & ! Model longitudes
1191	& zgphi ! Model latitudes
1192	LOGICAL :: llog10 ! Perform log10 transform of variable
1193	#if defined key_fabm
1194	REAL(wp), POINTER, DIMENSION(:,:,:) :: &
1195	& fabm_3d ! 3D variable from FABM
1196	#endif
1197
1198	IF(lwp) THEN
1199	WRITE(numout,*)
1200	WRITE(numout,*) 'dia_obs : Call the observation operators', kstp
1201	WRITE(numout,*) '~~~~~~~'
1202	CALL FLUSH(numout)
1203	ENDIF
1204
1205	idaystp = NINT( rday / rdt )
1206
1207	!-----------------------------------------------------------------------
1208	! Call the profile and surface observation operators
1209	!-----------------------------------------------------------------------
1210
1211	IF ( nproftypes > 0 ) THEN
1212
1213	DO jtype = 1, nproftypes
1214
1215	! Allocate local work arrays
1216	CALL wrk_alloc( jpi, jpj, jpk, profdataqc(jtype)%nvar, zprofvar )
1217	CALL wrk_alloc( jpi, jpj, jpk, profdataqc(jtype)%nvar, zprofmask )
1218	CALL wrk_alloc( jpi, jpj, profdataqc(jtype)%nvar, zglam )
1219	CALL wrk_alloc( jpi, jpj, profdataqc(jtype)%nvar, zgphi )
1220	CALL wrk_alloc( jpi, jpj, jpk, profdataqc(jtype)%nvar, zprofclim )
1221
1222	! Defaults which might change
1223	DO jvar = 1, profdataqc(jtype)%nvar
1224	zprofmask(:,:,:,jvar) = tmask(:,:,:)
1225	zglam(:,:,jvar) = glamt(:,:)
1226	zgphi(:,:,jvar) = gphit(:,:)
1227	zprofclim(:,:,:,jvar) = 0._wp
1228	END DO
1229
1230	SELECT CASE ( TRIM(cobstypesprof(jtype)) )
1231
1232	CASE('prof')
1233	zprofvar(:,:,:,1) = tsn(:,:,:,jp_tem)
1234	zprofvar(:,:,:,2) = tsn(:,:,:,jp_sal)
1235	IF ( ln_output_clim ) THEN
1236	zprofclim(:,:,:,1) = tclim(:,:,:)
1237	zprofclim(:,:,:,2) = sclim(:,:,:)
1238	ENDIF
1239
1240	CASE('vel')
1241	zprofvar(:,:,:,1) = un(:,:,:)
1242	zprofvar(:,:,:,2) = vn(:,:,:)
1243	zprofmask(:,:,:,1) = umask(:,:,:)
1244	zprofmask(:,:,:,2) = vmask(:,:,:)
1245	zglam(:,:,1) = glamu(:,:)
1246	zglam(:,:,2) = glamv(:,:)
1247	zgphi(:,:,1) = gphiu(:,:)
1248	zgphi(:,:,2) = gphiv(:,:)
1249
1250	CASE('plchltot')
1251	#if defined key_hadocc
1252	! Chlorophyll from HadOCC
1253	zprofvar(:,:,:,1) = HADOCC_CHL(:,:,:)
1254	#elif defined key_medusa
1255	! Add non-diatom and diatom chlorophyll from MEDUSA
1256	zprofvar(:,:,:,1) = trn(:,:,:,jpchn) + trn(:,:,:,jpchd)
1257	#elif defined key_fabm
1258	! Add all chlorophyll groups from ERSEM
1259	zprofvar(:,:,:,1) = trn(:,:,:,jp_fabm_m1+jp_fabm_chl1) + trn(:,:,:,jp_fabm_m1+jp_fabm_chl2) + &
1260	& trn(:,:,:,jp_fabm_m1+jp_fabm_chl3) + trn(:,:,:,jp_fabm_m1+jp_fabm_chl4)
1261	#else
1262	CALL ctl_stop( ' Trying to run plchltot observation operator', &
1263	& ' but no biogeochemical model appears to have been defined' )
1264	#endif
1265	! Take the log10 where we can, otherwise exclude
1266	tiny = 1.0e-20
1267	WHERE(zprofvar(:,:,:,:) > tiny .AND. zprofvar(:,:,:,:) /= obfillflt )
1268	zprofvar(:,:,:,:) = LOG10(zprofvar(:,:,:,:))
1269	ELSEWHERE
1270	zprofvar(:,:,:,:) = obfillflt
1271	zprofmask(:,:,:,:) = 0
1272	END WHERE
1273	! Mask out model below any excluded values,
1274	! to avoid interpolation issues
1275	DO jvar = 1, profdataqc(jtype)%nvar
1276	DO jj = 1, jpj
1277	DO ji = 1, jpi
1278	depth_loop: DO jk = 1, jpk
1279	IF ( zprofmask(ji,jj,jk,jvar) == 0 ) THEN
1280	zprofmask(ji,jj,jk:jpk,jvar) = 0
1281	EXIT depth_loop
1282	ENDIF
1283	END DO depth_loop
1284	END DO
1285	END DO
1286	END DO
1287
1288	CASE('pchltot')
1289	#if defined key_hadocc
1290	! Chlorophyll from HadOCC
1291	zprofvar(:,:,:,1) = HADOCC_CHL(:,:,:)
1292	#elif defined key_medusa
1293	! Add non-diatom and diatom chlorophyll from MEDUSA
1294	zprofvar(:,:,:,1) = trn(:,:,:,jpchn) + trn(:,:,:,jpchd)
1295	#elif defined key_fabm
1296	! Add all chlorophyll groups from ERSEM
1297	zprofvar(:,:,:,1) = trn(:,:,:,jp_fabm_m1+jp_fabm_chl1) + trn(:,:,:,jp_fabm_m1+jp_fabm_chl2) + &
1298	& trn(:,:,:,jp_fabm_m1+jp_fabm_chl3) + trn(:,:,:,jp_fabm_m1+jp_fabm_chl4)
1299	#else
1300	CALL ctl_stop( ' Trying to run pchltot observation operator', &
1301	& ' but no biogeochemical model appears to have been defined' )
1302	#endif
1303
1304	CASE('pno3')
1305	#if defined key_hadocc
1306	! Dissolved inorganic nitrogen from HadOCC
1307	zprofvar(:,:,:,1) = trn(:,:,:,jp_had_nut)
1308	#elif defined key_medusa
1309	! Dissolved inorganic nitrogen from MEDUSA
1310	zprofvar(:,:,:,1) = trn(:,:,:,jpdin)
1311	#elif defined key_fabm
1312	! Nitrate from ERSEM
1313	zprofvar(:,:,:,1) = trn(:,:,:,jp_fabm_m1+jp_fabm_n3n)
1314	#else
1315	CALL ctl_stop( ' Trying to run pno3 observation operator', &
1316	& ' but no biogeochemical model appears to have been defined' )
1317	#endif
1318
1319	CASE('psi4')
1320	#if defined key_hadocc
1321	CALL ctl_stop( ' Trying to run psi4 observation operator', &
1322	& ' but HadOCC does not simulate silicate' )
1323	#elif defined key_medusa
1324	! Silicate from MEDUSA
1325	zprofvar(:,:,:,1) = trn(:,:,:,jpsil)
1326	#elif defined key_fabm
1327	! Silicate from ERSEM
1328	zprofvar(:,:,:,1) = trn(:,:,:,jp_fabm_m1+jp_fabm_n5s)
1329	#else
1330	CALL ctl_stop( ' Trying to run psi4 observation operator', &
1331	& ' but no biogeochemical model appears to have been defined' )
1332	#endif
1333
1334	CASE('ppo4')
1335	#if defined key_hadocc
1336	CALL ctl_stop( ' Trying to run ppo4 observation operator', &
1337	& ' but HadOCC does not simulate phosphate' )
1338	#elif defined key_medusa
1339	CALL ctl_stop( ' Trying to run ppo4 observation operator', &
1340	& ' but MEDUSA does not simulate phosphate' )
1341	#elif defined key_fabm
1342	! Phosphate from ERSEM
1343	zprofvar(:,:,:,1) = trn(:,:,:,jp_fabm_m1+jp_fabm_n1p)
1344	#else
1345	CALL ctl_stop( ' Trying to run ppo4 observation operator', &
1346	& ' but no biogeochemical model appears to have been defined' )
1347	#endif
1348
1349	CASE('pdic')
1350	#if defined key_hadocc
1351	! Dissolved inorganic carbon from HadOCC
1352	zprofvar(:,:,:,1) = trn(:,:,:,jp_had_dic)
1353	#elif defined key_medusa
1354	! Dissolved inorganic carbon from MEDUSA
1355	zprofvar(:,:,:,1) = trn(:,:,:,jpdic)
1356	#elif defined key_fabm
1357	! Dissolved inorganic carbon from ERSEM
1358	zprofvar(:,:,:,1) = trn(:,:,:,jp_fabm_m1+jp_fabm_o3c)
1359	#else
1360	CALL ctl_stop( ' Trying to run pdic observation operator', &
1361	& ' but no biogeochemical model appears to have been defined' )
1362	#endif
1363
1364	CASE('palk')
1365	#if defined key_hadocc
1366	! Alkalinity from HadOCC
1367	zprofvar(:,:,:,1) = trn(:,:,:,jp_had_alk)
1368	#elif defined key_medusa
1369	! Alkalinity from MEDUSA
1370	zprofvar(:,:,:,1) = trn(:,:,:,jpalk)
1371	#elif defined key_fabm
1372	! Alkalinity from ERSEM
1373	zprofvar(:,:,:,1) = model%get_interior_diagnostic_data(jp_fabm_o3ta)
1374	#else
1375	CALL ctl_stop( ' Trying to run palk observation operator', &
1376	& ' but no biogeochemical model appears to have been defined' )
1377	#endif
1378
1379	CASE('pph')
1380	#if defined key_hadocc
1381	CALL ctl_stop( ' Trying to run pph observation operator', &
1382	& ' but HadOCC has no pH diagnostic defined' )
1383	#elif defined key_medusa && defined key_roam
1384	! pH from MEDUSA
1385	zprofvar(:,:,:,1) = f3_pH(:,:,:)
1386	#elif defined key_fabm
1387	! pH from ERSEM
1388	zprofvar(:,:,:,1) = model%get_interior_diagnostic_data(jp_fabm_o3ph)
1389	#else
1390	CALL ctl_stop( ' Trying to run pph observation operator', &
1391	& ' but no biogeochemical model appears to have been defined' )
1392	#endif
1393
1394	CASE('po2')
1395	#if defined key_hadocc
1396	CALL ctl_stop( ' Trying to run po2 observation operator', &
1397	& ' but HadOCC does not simulate oxygen' )
1398	#elif defined key_medusa
1399	! Oxygen from MEDUSA
1400	zprofvar(:,:,:,1) = trn(:,:,:,jpoxy)
1401	#elif defined key_fabm
1402	! Oxygen from ERSEM
1403	zprofvar(:,:,:,1) = trn(:,:,:,jp_fabm_m1+jp_fabm_o2o)
1404	#else
1405	CALL ctl_stop( ' Trying to run po2 observation operator', &
1406	& ' but no biogeochemical model appears to have been defined' )
1407	#endif
1408
1409	CASE DEFAULT
1410	CALL ctl_stop( 'Unknown profile observation type '//TRIM(cobstypesprof(jtype))//' in dia_obs' )
1411
1412	END SELECT
1413
1414	DO jvar = 1, profdataqc(jtype)%nvar
1415	CALL obs_prof_opt( profdataqc(jtype), kstp, jpi, jpj, jpk, &
1416	& nit000, idaystp, jvar, &
1417	& zprofvar(:,:,:,jvar), &
1418	& zprofclim(:,:,:,jvar), &
1419	& fsdept(:,:,:), fsdepw(:,:,:), &
1420	& zprofmask(:,:,:,jvar), &
1421	& zglam(:,:,jvar), zgphi(:,:,jvar), &
1422	& nn_1dint, nn_2dint_default, &
1423	& kdailyavtypes = nn_profdavtypes )
1424	END DO
1425
1426	CALL wrk_dealloc( jpi, jpj, jpk, profdataqc(jtype)%nvar, zprofvar )
1427	CALL wrk_dealloc( jpi, jpj, jpk, profdataqc(jtype)%nvar, zprofmask )
1428	CALL wrk_dealloc( jpi, jpj, profdataqc(jtype)%nvar, zglam )
1429	CALL wrk_dealloc( jpi, jpj, profdataqc(jtype)%nvar, zgphi )
1430	CALL wrk_dealloc( jpi, jpj, jpk, profdataqc(jtype)%nvar, zprofclim )
1431
1432	END DO
1433
1434	ENDIF
1435
1436	IF ( nsurftypes > 0 ) THEN
1437
1438	#if defined key_fabm
1439	CALL wrk_alloc( jpi, jpj, jpk, fabm_3d )
1440	#endif
1441
1442	DO jtype = 1, nsurftypes
1443
1444	!Allocate local work arrays
1445	CALL wrk_alloc( jpi, jpj, surfdataqc(jtype)%nvar, zsurfvar )
1446	CALL wrk_alloc( jpi, jpj, surfdataqc(jtype)%nvar, zsurfclim )
1447	CALL wrk_alloc( jpi, jpj, surfdataqc(jtype)%nvar, zsurfmask )
1448	CALL wrk_alloc( jpi, jpj, surfdataqc(jtype)%nvar, zglam )
1449	CALL wrk_alloc( jpi, jpj, surfdataqc(jtype)%nvar, zgphi )
1450
1451	!Defaults which might be changed
1452	DO jvar = 1, surfdataqc(jtype)%nvar
1453	zsurfmask(:,:,jvar) = tmask(:,:,1)
1454	zsurfclim(:,:,jvar) = 0._wp
1455	zglam(:,:,jvar) = glamt(:,:)
1456	zgphi(:,:,jvar) = gphit(:,:)
1457	END DO
1458	llog10 = .FALSE.
1459
1460	SELECT CASE ( TRIM(cobstypessurf(jtype)) )
1461	CASE('sst')
1462	zsurfvar(:,:,1) = tsn(:,:,1,jp_tem)
1463	IF ( ln_output_clim ) zsurfclim(:,:,1) = tclim(:,:,1)
1464	CASE('sla')
1465	zsurfvar(:,:,1) = sshn(:,:)
1466	CASE('sss')
1467	zsurfvar(:,:,1) = tsn(:,:,1,jp_sal)
1468	IF ( ln_output_clim ) zsurfclim(:,:,1) = sclim(:,:,1)
1469	CASE('ssv')
1470	zsurfvar(:,:,1) = un(:,:,1)
1471	zsurfvar(:,:,2) = vn(:,:,1)
1472	zsurfmask(:,:,1) = umask(:,:,1)
1473	zsurfmask(:,:,2) = vmask(:,:,1)
1474	zglam(:,:,1) = glamu(:,:)
1475	zglam(:,:,2) = glamv(:,:)
1476	zgphi(:,:,1) = gphiu(:,:)
1477	zgphi(:,:,2) = gphiv(:,:)
1478	CASE('sic')
1479	IF ( kstp == 0 ) THEN
1480	IF ( lwp .AND. surfdataqc(jtype)%nsstpmpp(1) > 0 ) THEN
1481	CALL ctl_warn( 'Sea-ice not initialised on zeroth '// &
1482	& 'time-step but some obs are valid then.' )
1483	WRITE(numout,*)surfdataqc(jtype)%nsstpmpp(1), &
1484	& ' sea-ice concentration obs will be missed'
1485	ENDIF
1486	ELSE
1487	#if defined key_cice
1488	zsurfvar(:,:,1) = fr_i(:,:)
1489	#elif defined key_lim2 \|\| defined key_lim3
1490	zsurfvar(:,:,1) = 1._wp - frld(:,:)
1491	#else
1492	CALL ctl_stop( ' Trying to run sea-ice concentration observation operator', &
1493	& ' but no sea-ice model appears to have been defined' )
1494	#endif
1495	ENDIF
1496
1497	CASE('sit')
1498	IF ( kstp == 0 ) THEN
1499	IF ( lwp .AND. surfdataqc(jtype)%nsstpmpp(1) > 0 ) THEN
1500	CALL ctl_warn( 'Sea-ice not initialised on zeroth '// &
1501	& 'time-step but some obs are valid then.' )
1502	WRITE(numout,*)surfdataqc(jtype)%nsstpmpp(1), &
1503	& ' sea-ice thickness obs will be missed and QC flag set to 4'
1504	ENDIF
1505	ELSE
1506	#if defined key_cice
1507	zsurfvar(:,:,1) = thick_i(:,:)
1508	#elif defined key_lim2 \|\| defined key_lim3
1509	CALL ctl_stop( ' No sea-ice thickness observation operator defined for LIM model' )
1510	#else
1511	CALL ctl_stop( ' Trying to run sea-ice thickness observation operator', &
1512	& ' but no sea-ice model appears to have been defined' )
1513	#endif
1514	ENDIF
1515
1516	CASE('fbd')
1517	IF ( kstp == 0 ) THEN
1518	IF ( lwp .AND. surfdataqc(jtype)%nsstpmpp(1) > 0 ) THEN
1519	CALL ctl_warn( 'Sea-ice not initialised on zeroth '// &
1520	& 'time-step but some obs are valid then.' )
1521	WRITE(numout,*)surfdataqc(jtype)%nsstpmpp(1), &
1522	& ' sea-ice freeboard obs will be missed and QC flag set to 4'
1523	ENDIF
1524	ELSE
1525	#if defined key_cice
1526	zsurfvar(:,:) = thick_i(:,:)
1527	#elif defined key_lim2 \|\| defined key_lim3
1528	CALL ctl_stop( ' No sea-ice freeboard observation operator defined for LIM model' )
1529	#else
1530	CALL ctl_stop( ' Trying to run sea-ice freeboard observation operator', &
1531	& ' but no sea-ice model appears to have been defined' )
1532	#endif
1533	ENDIF
1534
1535	CASE('slchltot')
1536	#if defined key_hadocc
1537	! Surface chlorophyll from HadOCC
1538	zsurfvar(:,:,1) = HADOCC_CHL(:,:,1)
1539	#elif defined key_medusa
1540	! Add non-diatom and diatom surface chlorophyll from MEDUSA
1541	zsurfvar(:,:,1) = trn(:,:,1,jpchn) + trn(:,:,1,jpchd)
1542	#elif defined key_fabm
1543	! Add all surface chlorophyll groups from ERSEM
1544	zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl1) + trn(:,:,1,jp_fabm_m1+jp_fabm_chl2) + &
1545	& trn(:,:,1,jp_fabm_m1+jp_fabm_chl3) + trn(:,:,1,jp_fabm_m1+jp_fabm_chl4)
1546	#else
1547	CALL ctl_stop( ' Trying to run slchltot observation operator', &
1548	& ' but no biogeochemical model appears to have been defined' )
1549	#endif
1550	llog10 = .TRUE.
1551
1552	CASE('slchldia')
1553	#if defined key_hadocc
1554	CALL ctl_stop( ' Trying to run slchldia observation operator', &
1555	& ' but HadOCC does not explicitly simulate diatoms' )
1556	#elif defined key_medusa
1557	! Diatom surface chlorophyll from MEDUSA
1558	zsurfvar(:,:,1) = trn(:,:,1,jpchd)
1559	#elif defined key_fabm
1560	! Diatom surface chlorophyll from ERSEM
1561	zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl1)
1562	#else
1563	CALL ctl_stop( ' Trying to run slchldia observation operator', &
1564	& ' but no biogeochemical model appears to have been defined' )
1565	#endif
1566	llog10 = .TRUE.
1567
1568	CASE('slchlnon')
1569	#if defined key_hadocc
1570	CALL ctl_stop( ' Trying to run slchlnon observation operator', &
1571	& ' but HadOCC does not explicitly simulate non-diatoms' )
1572	#elif defined key_medusa
1573	! Non-diatom surface chlorophyll from MEDUSA
1574	zsurfvar(:,:,1) = trn(:,:,1,jpchn)
1575	#elif defined key_fabm
1576	! Add all non-diatom surface chlorophyll groups from ERSEM
1577	zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl2) + &
1578	& trn(:,:,1,jp_fabm_m1+jp_fabm_chl3) + trn(:,:,1,jp_fabm_m1+jp_fabm_chl4)
1579	#else
1580	CALL ctl_stop( ' Trying to run slchlnon observation operator', &
1581	& ' but no biogeochemical model appears to have been defined' )
1582	#endif
1583	llog10 = .TRUE.
1584
1585	CASE('slchldin')
1586	#if defined key_hadocc
1587	CALL ctl_stop( ' Trying to run slchldin observation operator', &
1588	& ' but HadOCC does not explicitly simulate dinoflagellates' )
1589	#elif defined key_medusa
1590	CALL ctl_stop( ' Trying to run slchldin observation operator', &
1591	& ' but MEDUSA does not explicitly simulate dinoflagellates' )
1592	#elif defined key_fabm
1593	! Dinoflagellate surface chlorophyll from ERSEM
1594	zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl4)
1595	#else
1596	CALL ctl_stop( ' Trying to run slchldin observation operator', &
1597	& ' but no biogeochemical model appears to have been defined' )
1598	#endif
1599	llog10 = .TRUE.
1600
1601	CASE('slchlmic')
1602	#if defined key_hadocc
1603	CALL ctl_stop( ' Trying to run slchlmic observation operator', &
1604	& ' but HadOCC does not explicitly simulate microphytoplankton' )
1605	#elif defined key_medusa
1606	CALL ctl_stop( ' Trying to run slchlmic observation operator', &
1607	& ' but MEDUSA does not explicitly simulate microphytoplankton' )
1608	#elif defined key_fabm
1609	! Add diatom and dinoflagellate surface chlorophyll from ERSEM
1610	zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl1) + trn(:,:,1,jp_fabm_m1+jp_fabm_chl4)
1611	#else
1612	CALL ctl_stop( ' Trying to run slchlmic observation operator', &
1613	& ' but no biogeochemical model appears to have been defined' )
1614	#endif
1615	llog10 = .TRUE.
1616
1617	CASE('slchlnan')
1618	#if defined key_hadocc
1619	CALL ctl_stop( ' Trying to run slchlnan observation operator', &
1620	& ' but HadOCC does not explicitly simulate nanophytoplankton' )
1621	#elif defined key_medusa
1622	CALL ctl_stop( ' Trying to run slchlnan observation operator', &
1623	& ' but MEDUSA does not explicitly simulate nanophytoplankton' )
1624	#elif defined key_fabm
1625	! Nanophytoplankton surface chlorophyll from ERSEM
1626	zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl2)
1627	#else
1628	CALL ctl_stop( ' Trying to run slchlnan observation operator', &
1629	& ' but no biogeochemical model appears to have been defined' )
1630	#endif
1631	llog10 = .TRUE.
1632
1633	CASE('slchlpic')
1634	#if defined key_hadocc
1635	CALL ctl_stop( ' Trying to run slchlpic observation operator', &
1636	& ' but HadOCC does not explicitly simulate picophytoplankton' )
1637	#elif defined key_medusa
1638	CALL ctl_stop( ' Trying to run slchlpic observation operator', &
1639	& ' but MEDUSA does not explicitly simulate picophytoplankton' )
1640	#elif defined key_fabm
1641	! Picophytoplankton surface chlorophyll from ERSEM
1642	zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl3)
1643	#else
1644	CALL ctl_stop( ' Trying to run slchlpic observation operator', &
1645	& ' but no biogeochemical model appears to have been defined' )
1646	#endif
1647	llog10 = .TRUE.
1648
1649	CASE('schltot')
1650	#if defined key_hadocc
1651	! Surface chlorophyll from HadOCC
1652	zsurfvar(:,:,1) = HADOCC_CHL(:,:,1)
1653	#elif defined key_medusa
1654	! Add non-diatom and diatom surface chlorophyll from MEDUSA
1655	zsurfvar(:,:,1) = trn(:,:,1,jpchn) + trn(:,:,1,jpchd)
1656	#elif defined key_fabm
1657	! Add all surface chlorophyll groups from ERSEM
1658	zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_chl1) + trn(:,:,1,jp_fabm_m1+jp_fabm_chl2) + &
1659	& trn(:,:,1,jp_fabm_m1+jp_fabm_chl3) + trn(:,:,1,jp_fabm_m1+jp_fabm_chl4)
1660	#else
1661	CALL ctl_stop( ' Trying to run schltot observation operator', &
1662	& ' but no biogeochemical model appears to have been defined' )
1663	#endif
1664
1665	CASE('slphytot')
1666	#if defined key_hadocc
1667	! Surface phytoplankton nitrogen from HadOCC multiplied by C:N ratio
1668	zsurfvar(:,:,1) = trn(:,:,1,jp_had_phy) * c2n_p
1669	#elif defined key_medusa
1670	! Add non-diatom and diatom surface phytoplankton nitrogen from MEDUSA
1671	! multiplied by C:N ratio for each
1672	zsurfvar(:,:,1) = (trn(:,:,1,jpphn) * xthetapn) + (trn(:,:,1,jpphd) * xthetapd)
1673	#elif defined key_fabm
1674	! Add all surface phytoplankton carbon groups from ERSEM
1675	zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_p1c) + trn(:,:,1,jp_fabm_m1+jp_fabm_p2c) + &
1676	& trn(:,:,1,jp_fabm_m1+jp_fabm_p3c) + trn(:,:,1,jp_fabm_m1+jp_fabm_p4c)
1677	#else
1678	CALL ctl_stop( ' Trying to run slphytot observation operator', &
1679	& ' but no biogeochemical model appears to have been defined' )
1680	#endif
1681	llog10 = .TRUE.
1682
1683	CASE('slphydia')
1684	#if defined key_hadocc
1685	CALL ctl_stop( ' Trying to run slphydia observation operator', &
1686	& ' but HadOCC does not explicitly simulate diatoms' )
1687	#elif defined key_medusa
1688	! Diatom surface phytoplankton nitrogen from MEDUSA multiplied by C:N ratio
1689	zsurfvar(:,:,1) = trn(:,:,1,jpphd) * xthetapd
1690	#elif defined key_fabm
1691	! Diatom surface phytoplankton carbon from ERSEM
1692	zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_p1c)
1693	#else
1694	CALL ctl_stop( ' Trying to run slphydia observation operator', &
1695	& ' but no biogeochemical model appears to have been defined' )
1696	#endif
1697	llog10 = .TRUE.
1698
1699	CASE('slphynon')
1700	#if defined key_hadocc
1701	CALL ctl_stop( ' Trying to run slphynon observation operator', &
1702	& ' but HadOCC does not explicitly simulate non-diatoms' )
1703	#elif defined key_medusa
1704	! Non-diatom surface phytoplankton nitrogen from MEDUSA multiplied by C:N ratio
1705	zsurfvar(:,:,1) = trn(:,:,1,jpphn) * xthetapn
1706	#elif defined key_fabm
1707	! Add all non-diatom surface phytoplankton carbon groups from ERSEM
1708	zsurfvar(:,:,1) = trn(:,:,1,jp_fabm_m1+jp_fabm_p2c) + &
1709	& trn(:,:,1,jp_fabm_m1+jp_fabm_p3c) + trn(:,:,1,jp_fabm_m1+jp_fabm_p4c)
1710	#else
1711	CALL ctl_stop( ' Trying to run slphynon observation operator', &
1712	& ' but no biogeochemical model appears to have been defined' )
1713	#endif
1714	llog10 = .TRUE.
1715
1716	CASE('sspm')
1717	#if defined key_spm
1718	zsurfvar(:,:,1) = 0.0
1719	DO jn = 1, jp_spm
1720	zsurfvar(:,:,1) = zsurfvar(:,:,1) + trn(:,:,1,jn) ! sum SPM sizes
1721	END DO
1722	#else
1723	CALL ctl_stop( ' Trying to run sspm observation operator', &
1724	& ' but no spm model appears to have been defined' )
1725	#endif
1726
1727	CASE('skd490')
1728	#if defined key_hadocc
1729	CALL ctl_stop( ' Trying to run skd490 observation operator', &
1730	& ' but HadOCC does not explicitly simulate Kd490' )
1731	#elif defined key_medusa
1732	CALL ctl_stop( ' Trying to run skd490 observation operator', &
1733	& ' but MEDUSA does not explicitly simulate Kd490' )
1734	#elif defined key_fabm
1735	! light_Kd_band3 diagnostic variable if using spectral optical model
1736	! light_xEPS diagnostic variable if using standard ERSEM light model
1737	IF ( jp_fabm_kd490 /= -1 ) THEN
1738	fabm_3d(:,:,:) = model%get_interior_diagnostic_data(jp_fabm_kd490)
1739	ELSEIF ( jp_fabm_xeps /= -1 ) THEN
1740	fabm_3d(:,:,:) = model%get_interior_diagnostic_data(jp_fabm_xeps)
1741	ELSE
1742	CALL ctl_stop( ' Trying to run skd490 observation operator', &
1743	& ' but cannot access Kd490 from ERSEM' )
1744	ENDIF
1745	zsurfvar(:,:,1) = fabm_3d(:,:,1)
1746	#else
1747	CALL ctl_stop( ' Trying to run skd490 observation operator', &
1748	& ' but no biogeochemical model appears to have been defined' )
1749	#endif
1750
1751	CASE('sfco2')
1752	#if defined key_hadocc
1753	zsurfvar(:,:,1) = HADOCC_FCO2(:,:) ! fCO2 from HadOCC
1754	IF ( ( MINVAL( HADOCC_FCO2 ) == HADOCC_FILL_FLT ) .AND. &
1755	& ( MAXVAL( HADOCC_FCO2 ) == HADOCC_FILL_FLT ) ) THEN
1756	zsurfvar(:,:) = obfillflt
1757	zsurfmask(:,:,1) = 0
1758	CALL ctl_warn( ' HadOCC fCO2 values masked out for observation operator', &
1759	& ' as HADOCC_FCO2(:,:) == HADOCC_FILL_FLT' )
1760	ENDIF
1761	#elif defined key_medusa && defined key_roam
1762	zsurfvar(:,:,1) = f2_fco2w(:,:)
1763	#elif defined key_fabm
1764	! First, get pCO2 from FABM
1765	fabm_3d(:,:,:) = model%get_interior_diagnostic_data(jp_fabm_o3pc)
1766	zsurfvar(:,:,1) = fabm_3d(:,:,1)
1767	! Now, convert pCO2 to fCO2, based on SST in K. This follows the standard methodology of:
1768	! Pierrot et al. (2009), Recommendations for autonomous underway pCO2 measuring systems
1769	! and data reduction routines, Deep-Sea Research II, 56: 512-522.
1770	! and
1771	! Weiss (1974), Carbon dioxide in water and seawater: the solubility of a non-ideal gas,
1772	! Marine Chemistry, 2: 203-215.
1773	! In the implementation below, atmospheric pressure has been assumed to be 1 atm and so
1774	! not explicitly included - atmospheric pressure is not necessarily available so this is
1775	! the best assumption.
1776	! Further, the (1-xCO2)^2 term has been neglected. This is common practice
1777	! (see e.g. Zeebe and Wolf-Gladrow (2001), CO2 in Seawater: Equilibrium, Kinetics, Isotopes)
1778	! because xCO2 in atm is ~0, and so this term will only affect the result to the 3rd decimal
1779	! place for typical values, and xCO2 would need to be approximated from pCO2 anyway.
1780	zsurfvar(:,:,1) = zsurfvar(:,:,1) * EXP((-1636.75 + &
1781	& 12.0408 * (tsn(:,:,1,jp_tem)+rt0) - &
1782	& 0.0327957 * (tsn(:,:,1,jp_tem)+rt0)*(tsn(:,:,1,jp_tem)+rt0) + &
1783	& 0.0000316528 * (tsn(:,:,1,jp_tem)+rt0)(tsn(:,:,1,jp_tem)+rt0)(tsn(:,:,1,jp_tem)+rt0) + &
1784	& 2.0 * (57.7 - 0.118 * (tsn(:,:,1,jp_tem)+rt0))) / &
1785	& (82.0578 * (tsn(:,:,1,jp_tem)+rt0)))
1786	#else
1787	CALL ctl_stop( ' Trying to run sfco2 observation operator', &
1788	& ' but no biogeochemical model appears to have been defined' )
1789	#endif
1790
1791	CASE('spco2')
1792	#if defined key_hadocc
1793	zsurfvar(:,:,1) = HADOCC_PCO2(:,:) ! pCO2 from HadOCC
1794	IF ( ( MINVAL( HADOCC_PCO2 ) == HADOCC_FILL_FLT ) .AND. &
1795	& ( MAXVAL( HADOCC_PCO2 ) == HADOCC_FILL_FLT ) ) THEN
1796	zsurfvar(:,:,1) = obfillflt
1797	zsurfmask(:,:,1) = 0
1798	CALL ctl_warn( ' HadOCC pCO2 values masked out for observation operator', &
1799	& ' as HADOCC_PCO2(:,:) == HADOCC_FILL_FLT' )
1800	ENDIF
1801	#elif defined key_medusa && defined key_roam
1802	zsurfvar(:,:,1) = f2_pco2w(:,:)
1803	#elif defined key_fabm
1804	fabm_3d(:,:,:) = model%get_interior_diagnostic_data(jp_fabm_o3pc)
1805	zsurfvar(:,:,1) = fabm_3d(:,:,1)
1806	#else
1807	CALL ctl_stop( ' Trying to run spco2 observation operator', &
1808	& ' but no biogeochemical model appears to have been defined' )
1809	#endif
1810
1811	CASE DEFAULT
1812
1813	CALL ctl_stop( 'Unknown surface observation type '//TRIM(cobstypessurf(jtype))//' in dia_obs' )
1814
1815	END SELECT
1816
1817	IF ( llog10 ) THEN
1818	! Take the log10 where we can, otherwise exclude
1819	tiny = 1.0e-20
1820	WHERE(zsurfvar(:,:,1) > tiny .AND. zsurfvar(:,:,1) /= obfillflt )
1821	zsurfvar(:,:,1) = LOG10(zsurfvar(:,:,1))
1822	ELSEWHERE
1823	zsurfvar(:,:,1) = obfillflt
1824	zsurfmask(:,:,1) = 0
1825	END WHERE
1826	ENDIF
1827
1828	DO jvar = 1, surfdataqc(jtype)%nvar
1829
1830	IF ( TRIM(cobstypessurf(jtype)) == 'sla' .AND. &
1831	& ln_time_mean_sla_bkg ) THEN
1832	!Number of time-steps in meaning period
1833	imeanstp = NINT( ( MeanPeriodHours * 60. * 60. ) / rdt )
1834	CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj, &
1835	& nit000, idaystp, jvar, &
1836	& zsurfvar(:,:,jvar), &
1837	& zsurfclim(:,:,jvar), &
1838	& zsurfmask(:,:,jvar), &
1839	& zglam(:,:,jvar), zgphi(:,:,jvar), &
1840	& n2dintsurf(jtype), llnightav(jtype), &
1841	& ravglamscl(jtype), ravgphiscl(jtype), &
1842	& lfpindegs(jtype), kmeanstp = imeanstp )
1843
1844	ELSE
1845	CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj, &
1846	& nit000, idaystp, jvar, &
1847	& zsurfvar(:,:,jvar), &
1848	& zsurfclim(:,:,jvar), &
1849	& zsurfmask(:,:,jvar), &
1850	& zglam(:,:,jvar), zgphi(:,:,jvar), &
1851	& n2dintsurf(jtype), llnightav(jtype), &
1852	& ravglamscl(jtype), ravgphiscl(jtype), &
1853	& lfpindegs(jtype) )
1854	ENDIF
1855
1856	END DO
1857
1858	CALL wrk_dealloc( jpi, jpj, surfdataqc(jtype)%nvar, zsurfvar )
1859	CALL wrk_dealloc( jpi, jpj, surfdataqc(jtype)%nvar, zsurfclim )
1860	CALL wrk_dealloc( jpi, jpj, surfdataqc(jtype)%nvar, zsurfmask )
1861	CALL wrk_dealloc( jpi, jpj, surfdataqc(jtype)%nvar, zglam )
1862	CALL wrk_dealloc( jpi, jpj, surfdataqc(jtype)%nvar, zgphi )
1863
1864	END DO
1865	#if defined key_fabm
1866	CALL wrk_dealloc( jpi, jpj, jpk, fabm_3d )
1867	#endif
1868
1869	ENDIF
1870
1871	END SUBROUTINE dia_obs
1872
1873	SUBROUTINE dia_obs_wri
1874	!!----------------------------------------------------------------------
1875	!! * ROUTINE dia_obs_wri *
1876	!!
1877	!! ** Purpose : Call observation diagnostic output routines
1878	!!
1879	!! ** Method : Call observation diagnostic output routines
1880	!!
1881	!! ** Action :
1882	!!
1883	!! History :
1884	!! ! 06-03 (K. Mogensen) Original code
1885	!! ! 06-05 (K. Mogensen) Reformatted
1886	!! ! 06-10 (A. Weaver) Cleaning
1887	!! ! 07-03 (K. Mogensen) General handling of profiles
1888	!! ! 08-09 (M. Valdivieso) Velocity component (U,V) profiles
1889	!! ! 15-08 (M. Martin) Combined writing for prof and surf types
1890	!!----------------------------------------------------------------------
1891	!! * Modules used
1892	USE obs_rot_vel ! Rotation of velocities
1893
1894	IMPLICIT NONE
1895
1896	!! * Local declarations
1897	INTEGER :: jtype ! Data set loop variable
1898	INTEGER :: jo, jvar, jk
1899	REAL(wp), DIMENSION(:), ALLOCATABLE :: &
1900	& zu, &
1901	& zv
1902
1903	!-----------------------------------------------------------------------
1904	! Depending on switches call various observation output routines
1905	!-----------------------------------------------------------------------
1906
1907	IF ( nproftypes > 0 ) THEN
1908
1909	DO jtype = 1, nproftypes
1910
1911	IF ( TRIM(cobstypesprof(jtype)) == 'vel' ) THEN
1912
1913	! For velocity data, rotate the model velocities to N/S, E/W
1914	! using the compressed data structure.
1915	ALLOCATE( &
1916	& zu(profdataqc(jtype)%nvprot(1)), &
1917	& zv(profdataqc(jtype)%nvprot(2)) &
1918	& )
1919
1920	CALL obs_rotvel_pro( profdataqc(jtype), nn_2dint_default, zu, zv )
1921
1922	DO jo = 1, profdataqc(jtype)%nprof
1923	DO jvar = 1, 2
1924	DO jk = profdataqc(jtype)%npvsta(jo,jvar), profdataqc(jtype)%npvend(jo,jvar)
1925
1926	IF ( jvar == 1 ) THEN
1927	profdataqc(jtype)%var(jvar)%vmod(jk) = zu(jk)
1928	ELSE
1929	profdataqc(jtype)%var(jvar)%vmod(jk) = zv(jk)
1930	ENDIF
1931
1932	END DO
1933	END DO
1934	END DO
1935
1936	DEALLOCATE( zu )
1937	DEALLOCATE( zv )
1938
1939	END IF
1940
1941	CALL obs_prof_decompress( profdataqc(jtype), &
1942	& profdata(jtype), .TRUE., numout )
1943
1944	CALL obs_wri_prof( profdata(jtype) )
1945
1946	END DO
1947
1948	ENDIF
1949
1950	IF ( nsurftypes > 0 ) THEN
1951
1952	DO jtype = 1, nsurftypes
1953
1954	IF ( TRIM(cobstypessurf(jtype)) == 'vel' ) THEN
1955	! For velocity data, rotate the model velocities to N/S, E/W
1956	! using the compressed data structure.
1957	ALLOCATE( &
1958	& zu(surfdataqc(jtype)%nsurf), &
1959	& zv(surfdataqc(jtype)%nsurf) &
1960	& )
1961
1962	CALL obs_rotvel_surf( surfdataqc(jtype), nn_2dint_default, zu, zv )
1963
1964	DO jo = 1, surfdataqc(jtype)%nsurf
1965	surfdataqc(jtype)%rmod(jo,1) = zu(jo)
1966	surfdataqc(jtype)%rmod(jo,2) = zv(jo)
1967	END DO
1968
1969	DEALLOCATE( zu )
1970	DEALLOCATE( zv )
1971	END IF
1972
1973	CALL obs_surf_decompress( surfdataqc(jtype), &
1974	& surfdata(jtype), .TRUE., numout )
1975
1976	CALL obs_wri_surf( surfdata(jtype) )
1977
1978	END DO
1979
1980	ENDIF
1981
1982	END SUBROUTINE dia_obs_wri
1983
1984	SUBROUTINE dia_obs_dealloc
1985	IMPLICIT NONE
1986	!!----------------------------------------------------------------------
1987	!! * ROUTINE dia_obs_dealloc *
1988	!!
1989	!! ** Purpose : To deallocate data to enable the obs_oper online loop.
1990	!! Specifically: dia_obs_init --> dia_obs --> dia_obs_wri
1991	!!
1992	!! ** Method : Clean up various arrays left behind by the obs_oper.
1993	!!
1994	!! ** Action :
1995	!!
1996	!!----------------------------------------------------------------------
1997	! obs_grid deallocation
1998	CALL obs_grid_deallocate
1999
2000	! diaobs deallocation
2001	IF ( nproftypes > 0 ) &
2002	& DEALLOCATE( cobstypesprof, profdata, profdataqc, nvarsprof, nextrprof )
2003
2004	IF ( nsurftypes > 0 ) &
2005	& DEALLOCATE( cobstypessurf, surfdata, surfdataqc, nvarssurf, nextrsurf, &
2006	& n2dintsurf, ravglamscl, ravgphiscl, lfpindegs, llnightav )
2007
2008	END SUBROUTINE dia_obs_dealloc
2009
2010	SUBROUTINE ini_date( ddobsini )
2011	!!----------------------------------------------------------------------
2012	!! * ROUTINE ini_date *
2013	!!
2014	!! ** Purpose : Get initial date in double precision YYYYMMDD.HHMMSS format
2015	!!
2016	!! ** Method : Get initial date in double precision YYYYMMDD.HHMMSS format
2017	!!
2018	!! ** Action : Get initial date in double precision YYYYMMDD.HHMMSS format
2019	!!
2020	!! History :
2021	!! ! 06-03 (K. Mogensen) Original code
2022	!! ! 06-05 (K. Mogensen) Reformatted
2023	!! ! 06-10 (A. Weaver) Cleaning
2024	!! ! 06-10 (G. Smith) Calculates initial date the same as method for final date
2025	!! ! 10-05 (D. Lea) Update to month length calculation for NEMO vn3.2
2026	!!----------------------------------------------------------------------
2027	USE phycst, ONLY : & ! Physical constants
2028	& rday
2029	USE dom_oce, ONLY : & ! Ocean space and time domain variables
2030	& rdt
2031
2032	IMPLICIT NONE
2033
2034	!! * Arguments
2035	REAL(dp), INTENT(OUT) :: ddobsini ! Initial date in YYYYMMDD.HHMMSS
2036
2037	!! * Local declarations
2038	INTEGER :: iyea ! date - (year, month, day, hour, minute)
2039	INTEGER :: imon
2040	INTEGER :: iday
2041	INTEGER :: ihou
2042	INTEGER :: imin
2043	INTEGER :: imday ! Number of days in month.
2044	INTEGER, DIMENSION(12) :: &
2045	& imonth_len ! Length in days of the months of the current year
2046	REAL(wp) :: zdayfrc ! Fraction of day
2047
2048	!----------------------------------------------------------------------
2049	! Initial date initialization (year, month, day, hour, minute)
2050	! (This assumes that the initial date is for 00z))
2051	!----------------------------------------------------------------------
2052	iyea = ndate0 / 10000
2053	imon = ( ndate0 - iyea * 10000 ) / 100
2054	iday = ndate0 - iyea * 10000 - imon * 100
2055	ihou = 0
2056	imin = 0
2057
2058	!----------------------------------------------------------------------
2059	! Compute number of days + number of hours + min since initial time
2060	!----------------------------------------------------------------------
2061	iday = iday + ( nit000 -1 ) * rdt / rday
2062	zdayfrc = ( nit000 -1 ) * rdt / rday
2063	zdayfrc = zdayfrc - aint(zdayfrc)
2064	ihou = int( zdayfrc * 24 )
2065	imin = int( (zdayfrc * 24 - ihou) * 60 )
2066
2067	!-----------------------------------------------------------------------
2068	! Convert number of days (iday) into a real date
2069	!----------------------------------------------------------------------
2070
2071	CALL calc_month_len( iyea, imonth_len )
2072
2073	DO WHILE ( iday > imonth_len(imon) )
2074	iday = iday - imonth_len(imon)
2075	imon = imon + 1
2076	IF ( imon > 12 ) THEN
2077	imon = 1
2078	iyea = iyea + 1
2079	CALL calc_month_len( iyea, imonth_len ) ! update month lengths
2080	ENDIF
2081	END DO
2082
2083	!----------------------------------------------------------------------
2084	! Convert it into YYYYMMDD.HHMMSS format.
2085	!----------------------------------------------------------------------
2086	ddobsini = iyea * 10000_dp + imon * 100_dp + &
2087	& iday + ihou * 0.01_dp + imin * 0.0001_dp
2088
2089
2090	END SUBROUTINE ini_date
2091
2092	SUBROUTINE fin_date( ddobsfin )
2093	!!----------------------------------------------------------------------
2094	!! * ROUTINE fin_date *
2095	!!
2096	!! ** Purpose : Get final date in double precision YYYYMMDD.HHMMSS format
2097	!!
2098	!! ** Method : Get final date in double precision YYYYMMDD.HHMMSS format
2099	!!
2100	!! ** Action : Get final date in double precision YYYYMMDD.HHMMSS format
2101	!!
2102	!! History :
2103	!! ! 06-03 (K. Mogensen) Original code
2104	!! ! 06-05 (K. Mogensen) Reformatted
2105	!! ! 06-10 (A. Weaver) Cleaning
2106	!! ! 10-05 (D. Lea) Update to month length calculation for NEMO vn3.2
2107	!!----------------------------------------------------------------------
2108	USE phycst, ONLY : & ! Physical constants
2109	& rday
2110	USE dom_oce, ONLY : & ! Ocean space and time domain variables
2111	& rdt
2112
2113	IMPLICIT NONE
2114
2115	!! * Arguments
2116	REAL(dp), INTENT(OUT) :: ddobsfin ! Final date in YYYYMMDD.HHMMSS
2117
2118	!! * Local declarations
2119	INTEGER :: iyea ! date - (year, month, day, hour, minute)
2120	INTEGER :: imon
2121	INTEGER :: iday
2122	INTEGER :: ihou
2123	INTEGER :: imin
2124	INTEGER :: imday ! Number of days in month.
2125	INTEGER, DIMENSION(12) :: &
2126	& imonth_len ! Length in days of the months of the current year
2127	REAL(wp) :: zdayfrc ! Fraction of day
2128
2129	!-----------------------------------------------------------------------
2130	! Initial date initialization (year, month, day, hour, minute)
2131	! (This assumes that the initial date is for 00z)
2132	!-----------------------------------------------------------------------
2133	iyea = ndate0 / 10000
2134	imon = ( ndate0 - iyea * 10000 ) / 100
2135	iday = ndate0 - iyea * 10000 - imon * 100
2136	ihou = 0
2137	imin = 0
2138
2139	!-----------------------------------------------------------------------
2140	! Compute number of days + number of hours + min since initial time
2141	!-----------------------------------------------------------------------
2142	iday = iday + nitend * rdt / rday
2143	zdayfrc = nitend * rdt / rday
2144	zdayfrc = zdayfrc - AINT( zdayfrc )
2145	ihou = INT( zdayfrc * 24 )
2146	imin = INT( ( zdayfrc * 24 - ihou ) * 60 )
2147
2148	!-----------------------------------------------------------------------
2149	! Convert number of days (iday) into a real date
2150	!----------------------------------------------------------------------
2151
2152	CALL calc_month_len( iyea, imonth_len )
2153
2154	DO WHILE ( iday > imonth_len(imon) )
2155	iday = iday - imonth_len(imon)
2156	imon = imon + 1
2157	IF ( imon > 12 ) THEN
2158	imon = 1
2159	iyea = iyea + 1
2160	CALL calc_month_len( iyea, imonth_len ) ! update month lengths
2161	ENDIF
2162	END DO
2163
2164	!-----------------------------------------------------------------------
2165	! Convert it into YYYYMMDD.HHMMSS format
2166	!-----------------------------------------------------------------------
2167	ddobsfin = iyea * 10000_dp + imon * 100_dp + iday &
2168	& + ihou * 0.01_dp + imin * 0.0001_dp
2169
2170	END SUBROUTINE fin_date
2171
2172	SUBROUTINE obs_settypefiles( ntypes, jpmaxnfiles, ifiles, cobstypes, cfiles )
2173
2174	INTEGER, INTENT(IN) :: ntypes ! Total number of obs types
2175	INTEGER, INTENT(IN) :: jpmaxnfiles ! Maximum number of files allowed for each type
2176	INTEGER, DIMENSION(ntypes), INTENT(OUT) :: &
2177	& ifiles ! Out number of files for each type
2178	CHARACTER(len=8), DIMENSION(ntypes), INTENT(IN) :: &
2179	& cobstypes ! List of obs types
2180	CHARACTER(len=128), DIMENSION(ntypes, jpmaxnfiles), INTENT(IN) :: &
2181	& cfiles ! List of files for all types
2182
2183	!Local variables
2184	INTEGER :: jfile
2185	INTEGER :: jtype
2186
2187	DO jtype = 1, ntypes
2188
2189	ifiles(jtype) = 0
2190	DO jfile = 1, jpmaxnfiles
2191	IF ( trim(cfiles(jtype,jfile)) /= '' ) &
2192	ifiles(jtype) = ifiles(jtype) + 1
2193	END DO
2194
2195	IF ( ifiles(jtype) == 0 ) THEN
2196	CALL ctl_stop( 'Logical for observation type '//TRIM(cobstypes(jtype))// &
2197	& ' set to true but no files available to read' )
2198	ENDIF
2199
2200	IF(lwp) THEN
2201	WRITE(numout,*) ' '//cobstypes(jtype)//' input observation file names:'
2202	DO jfile = 1, ifiles(jtype)
2203	WRITE(numout,*) ' '//TRIM(cfiles(jtype,jfile))
2204	END DO
2205	ENDIF
2206
2207	END DO
2208
2209	END SUBROUTINE obs_settypefiles
2210
2211	SUBROUTINE obs_setinterpopts( ntypes, jtype, ctypein, &
2212	& n2dint_default, n2dint_type, &
2213	& ravglamscl_type, ravgphiscl_type, &
2214	& lfp_indegs_type, lavnight_type, &
2215	& n2dint, ravglamscl, ravgphiscl, &
2216	& lfpindegs, lavnight )
2217
2218	INTEGER, INTENT(IN) :: ntypes ! Total number of obs types
2219	INTEGER, INTENT(IN) :: jtype ! Index of the current type of obs
2220	INTEGER, INTENT(IN) :: n2dint_default ! Default option for interpolation type
2221	INTEGER, INTENT(IN) :: n2dint_type ! Option for interpolation type
2222	REAL(wp), INTENT(IN) :: &
2223	& ravglamscl_type, & !E/W diameter of obs footprint for this type
2224	& ravgphiscl_type !N/S diameter of obs footprint for this type
2225	LOGICAL, INTENT(IN) :: lfp_indegs_type !T=> footprint in degrees, F=> in metres
2226	LOGICAL, INTENT(IN) :: lavnight_type !T=> obs represent night time average
2227	CHARACTER(len=8), INTENT(IN) :: ctypein
2228
2229	INTEGER, DIMENSION(ntypes), INTENT(INOUT) :: &
2230	& n2dint
2231	REAL(wp), DIMENSION(ntypes), INTENT(INOUT) :: &
2232	& ravglamscl, ravgphiscl
2233	LOGICAL, DIMENSION(ntypes), INTENT(INOUT) :: &
2234	& lfpindegs, lavnight
2235
2236	lavnight(jtype) = lavnight_type
2237
2238	IF ( (n2dint_type >= 0) .AND. (n2dint_type <= 6) ) THEN
2239	n2dint(jtype) = n2dint_type
2240	ELSE IF ( n2dint_type == -1 ) THEN
2241	n2dint(jtype) = n2dint_default
2242	ELSE
2243	CALL ctl_stop(' Choice of '//TRIM(ctypein)//' horizontal (2D) interpolation method', &
2244	& ' is not available')
2245	ENDIF
2246
2247	! For averaging observation footprints set options for size of footprint
2248	IF ( (n2dint(jtype) > 4) .AND. (n2dint(jtype) <= 6) ) THEN
2249	IF ( ravglamscl_type > 0._wp ) THEN
2250	ravglamscl(jtype) = ravglamscl_type
2251	ELSE
2252	CALL ctl_stop( 'Incorrect value set for averaging footprint '// &
2253	'scale (ravglamscl) for observation type '//TRIM(ctypein) )
2254	ENDIF
2255
2256	IF ( ravgphiscl_type > 0._wp ) THEN
2257	ravgphiscl(jtype) = ravgphiscl_type
2258	ELSE
2259	CALL ctl_stop( 'Incorrect value set for averaging footprint '// &
2260	'scale (ravgphiscl) for observation type '//TRIM(ctypein) )
2261	ENDIF
2262
2263	lfpindegs(jtype) = lfp_indegs_type
2264
2265	ENDIF
2266
2267	! Write out info
2268	IF(lwp) THEN
2269	IF ( n2dint(jtype) <= 4 ) THEN
2270	WRITE(numout,*) ' '//TRIM(ctypein)// &
2271	& ' model counterparts will be interpolated horizontally'
2272	ELSE IF ( n2dint(jtype) <= 6 ) THEN
2273	WRITE(numout,*) ' '//TRIM(ctypein)// &
2274	& ' model counterparts will be averaged horizontally'
2275	WRITE(numout,*) ' '//' with E/W scale: ',ravglamscl(jtype)
2276	WRITE(numout,*) ' '//' with N/S scale: ',ravgphiscl(jtype)
2277	IF ( lfpindegs(jtype) ) THEN
2278	WRITE(numout,*) ' '//' (in degrees)'
2279	ELSE
2280	WRITE(numout,*) ' '//' (in metres)'
2281	ENDIF
2282	ENDIF
2283	ENDIF
2284
2285	END SUBROUTINE obs_setinterpopts
2286
2287	END MODULE diaobs

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: branches/UKMO/r6232_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

Download in other formats: