Context Navigation

diaobs.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Property svn:keywords set to Id

File size: 46.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	!! History : 1.0 ! 2006-03 (K. Mogensen) Original code
8	!! - ! 2006-05 (K. Mogensen, A. Weaver) Reformatted
9	!! - ! 2006-10 (A. Weaver) Cleaning and add controls
10	!! - ! 2007-03 (K. Mogensen) General handling of profiles
11	!! - ! 2007-04 (G. Smith) Generalized surface operators
12	!! 2.0 ! 2008-10 (M. Valdivieso) obs operator for velocity profiles
13	!! 3.4 ! 2014-08 (J. While) observation operator for profiles in all vertical coordinates
14	!! - ! Incorporated SST bias correction
15	!! 3.6 ! 2015-02 (M. Martin) Simplification of namelist and code
16	!! - ! 2015-08 (M. Martin) Combined surface/profile routines.
17	!! 4.0 ! 2017-11 (G. Madec) style only
18	!!----------------------------------------------------------------------
19
20	!!----------------------------------------------------------------------
21	!! dia_obs_init : Reading and prepare observations
22	!! dia_obs : Compute model equivalent to observations
23	!! dia_obs_wri : Write observational diagnostics
24	!! calc_date : Compute the date of timestep in YYYYMMDD.HHMMSS format
25	!! ini_date : Compute the initial date YYYYMMDD.HHMMSS
26	!! fin_date : Compute the final date YYYYMMDD.HHMMSS
27	!!----------------------------------------------------------------------
28	USE par_kind ! Precision variables
29	USE in_out_manager ! I/O manager
30	USE par_oce ! ocean parameter
31	USE dom_oce ! Ocean space and time domain variables
32	USE sbc_oce ! Sea-ice fraction
33	!
34	USE obs_read_prof ! Reading and allocation of profile obs
35	USE obs_read_surf ! Reading and allocation of surface obs
36	USE obs_sstbias ! Bias correction routine for SST
37	USE obs_readmdt ! Reading and allocation of MDT for SLA.
38	USE obs_prep ! Preparation of obs. (grid search etc).
39	USE obs_oper ! Observation operators
40	USE obs_write ! Writing of observation related diagnostics
41	USE obs_grid ! Grid searching
42	USE obs_read_altbias ! Bias treatment for altimeter
43	USE obs_profiles_def ! Profile data definitions
44	USE obs_surf_def ! Surface data definitions
45	USE obs_types ! Definitions for observation types
46	!
47	USE mpp_map ! MPP mapping
48	USE lib_mpp ! For ctl_warn/stop
49
50	IMPLICIT NONE
51	PRIVATE
52
53	PUBLIC dia_obs_init ! Initialize and read observations
54	PUBLIC dia_obs ! Compute model equivalent to observations
55	PUBLIC dia_obs_wri ! Write model equivalent to observations
56	PUBLIC dia_obs_dealloc ! Deallocate dia_obs data
57	PUBLIC calc_date ! Compute the date of a timestep
58
59	LOGICAL, PUBLIC :: ln_diaobs !: Logical switch for the obs operator
60	LOGICAL :: ln_sstnight ! Logical switch for night mean SST obs
61	LOGICAL :: ln_sla_fp_indegs ! T=> SLA obs footprint size specified in degrees, F=> in metres
62	LOGICAL :: ln_sst_fp_indegs ! T=> SST obs footprint size specified in degrees, F=> in metres
63	LOGICAL :: ln_sss_fp_indegs ! T=> SSS obs footprint size specified in degrees, F=> in metres
64	LOGICAL :: ln_sic_fp_indegs ! T=> sea-ice obs footprint size specified in degrees, F=> in metres
65
66	REAL(wp) :: rn_sla_avglamscl ! E/W diameter of SLA observation footprint (metres)
67	REAL(wp) :: rn_sla_avgphiscl ! N/S diameter of SLA observation footprint (metres)
68	REAL(wp) :: rn_sst_avglamscl ! E/W diameter of SST observation footprint (metres)
69	REAL(wp) :: rn_sst_avgphiscl ! N/S diameter of SST observation footprint (metres)
70	REAL(wp) :: rn_sss_avglamscl ! E/W diameter of SSS observation footprint (metres)
71	REAL(wp) :: rn_sss_avgphiscl ! N/S diameter of SSS observation footprint (metres)
72	REAL(wp) :: rn_sic_avglamscl ! E/W diameter of sea-ice observation footprint (metres)
73	REAL(wp) :: rn_sic_avgphiscl ! N/S diameter of sea-ice observation footprint (metres)
74
75	INTEGER :: nn_1dint ! Vertical interpolation method
76	INTEGER :: nn_2dint ! Default horizontal interpolation method
77	INTEGER :: nn_2dint_sla ! SLA horizontal interpolation method
78	INTEGER :: nn_2dint_sst ! SST horizontal interpolation method
79	INTEGER :: nn_2dint_sss ! SSS horizontal interpolation method
80	INTEGER :: nn_2dint_sic ! Seaice horizontal interpolation method
81	INTEGER, DIMENSION(imaxavtypes) :: nn_profdavtypes ! Profile data types representing a daily average
82	INTEGER :: nproftypes ! Number of profile obs types
83	INTEGER :: nsurftypes ! Number of surface obs types
84	INTEGER , DIMENSION(:), ALLOCATABLE :: nvarsprof, nvarssurf ! Number of profile & surface variables
85	INTEGER , DIMENSION(:), ALLOCATABLE :: nextrprof, nextrsurf ! Number of profile & surface extra variables
86	INTEGER , DIMENSION(:), ALLOCATABLE :: n2dintsurf ! Interpolation option for surface variables
87	REAL(wp), DIMENSION(:), ALLOCATABLE :: zavglamscl, zavgphiscl ! E/W & N/S diameter of averaging footprint for surface variables
88	LOGICAL , DIMENSION(:), ALLOCATABLE :: lfpindegs ! T=> surface obs footprint size specified in degrees, F=> in metres
89	LOGICAL , DIMENSION(:), ALLOCATABLE :: llnightav ! Logical for calculating night-time averages
90
91	TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) :: surfdata !: Initial surface data
92	TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) :: surfdataqc !: Surface data after quality control
93	TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) :: profdata !: Initial profile data
94	TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) :: profdataqc !: Profile data after quality control
95
96	CHARACTER(len=6), PUBLIC, DIMENSION(:), ALLOCATABLE :: cobstypesprof, cobstypessurf !: Profile & surface obs types
97
98	!!----------------------------------------------------------------------
99	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
100	!! $Id$
101	!! Software governed by the CeCILL license (see ./LICENSE)
102	!!----------------------------------------------------------------------
103	CONTAINS
104
105	SUBROUTINE dia_obs_init( Kmm )
106	!!----------------------------------------------------------------------
107	!! * ROUTINE dia_obs_init *
108	!!
109	!! ** Purpose : Initialize and read observations
110	!!
111	!! ** Method : Read the namelist and call reading routines
112	!!
113	!! ** Action : Read the namelist and call reading routines
114	!!
115	!!----------------------------------------------------------------------
116	INTEGER, INTENT(in) :: Kmm ! ocean time level indices
117	INTEGER, PARAMETER :: jpmaxnfiles = 1000 ! Maximum number of files for each obs type
118	INTEGER, DIMENSION(:), ALLOCATABLE :: ifilesprof, ifilessurf ! Number of profile & surface files
119	INTEGER :: ios ! Local integer output status for namelist read
120	INTEGER :: jtype ! Counter for obs types
121	INTEGER :: jvar ! Counter for variables
122	INTEGER :: jfile ! Counter for files
123	INTEGER :: jnumsstbias
124	!
125	CHARACTER(len=128), DIMENSION(jpmaxnfiles) :: &
126	& cn_profbfiles, & ! T/S profile input filenames
127	& cn_sstfbfiles, & ! Sea surface temperature input filenames
128	& cn_sssfbfiles, & ! Sea surface salinity input filenames
129	& cn_slafbfiles, & ! Sea level anomaly input filenames
130	& cn_sicfbfiles, & ! Seaice concentration input filenames
131	& cn_velfbfiles, & ! Velocity profile input filenames
132	& cn_sstbiasfiles ! SST bias input filenames
133	CHARACTER(LEN=128) :: &
134	& cn_altbiasfile ! Altimeter bias input filename
135	CHARACTER(len=128), DIMENSION(:,:), ALLOCATABLE :: &
136	& clproffiles, & ! Profile filenames
137	& clsurffiles ! Surface filenames
138	!
139	LOGICAL :: ln_t3d ! Logical switch for temperature profiles
140	LOGICAL :: ln_s3d ! Logical switch for salinity profiles
141	LOGICAL :: ln_sla ! Logical switch for sea level anomalies
142	LOGICAL :: ln_sst ! Logical switch for sea surface temperature
143	LOGICAL :: ln_sss ! Logical switch for sea surface salinity
144	LOGICAL :: ln_sic ! Logical switch for sea ice concentration
145	LOGICAL :: ln_vel3d ! Logical switch for velocity (u,v) obs
146	LOGICAL :: ln_nea ! Logical switch to remove obs near land
147	LOGICAL :: ln_altbias ! Logical switch for altimeter bias
148	LOGICAL :: ln_sstbias ! Logical switch for bias corection of SST
149	LOGICAL :: ln_ignmis ! Logical switch for ignoring missing files
150	LOGICAL :: ln_s_at_t ! Logical switch to compute model S at T obs
151	LOGICAL :: ln_bound_reject ! Logical to remove obs near boundaries in LAMs.
152	LOGICAL :: llvar1 ! Logical for profile variable 1
153	LOGICAL :: llvar2 ! Logical for profile variable 1
154	LOGICAL, DIMENSION(jpmaxnfiles) :: lmask ! Used for finding number of sstbias files
155	!
156	REAL(dp) :: rn_dobsini ! Obs window start date YYYYMMDD.HHMMSS
157	REAL(dp) :: rn_dobsend ! Obs window end date YYYYMMDD.HHMMSS
158	REAL(wp), DIMENSION(jpi,jpj) :: zglam1, zglam2 ! Model longitudes for profile variable 1 & 2
159	REAL(wp), DIMENSION(jpi,jpj) :: zgphi1, zgphi2 ! Model latitudes for profile variable 1 & 2
160	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask1, zmask2 ! Model land/sea mask associated with variable 1 & 2
161	!!
162	NAMELIST/namobs/ln_diaobs, ln_t3d, ln_s3d, ln_sla, &
163	& ln_sst, ln_sic, ln_sss, ln_vel3d, &
164	& ln_altbias, ln_sstbias, ln_nea, &
165	& ln_grid_global, ln_grid_search_lookup, &
166	& ln_ignmis, ln_s_at_t, ln_bound_reject, &
167	& ln_sstnight, &
168	& ln_sla_fp_indegs, ln_sst_fp_indegs, &
169	& ln_sss_fp_indegs, ln_sic_fp_indegs, &
170	& cn_profbfiles, cn_slafbfiles, &
171	& cn_sstfbfiles, cn_sicfbfiles, &
172	& cn_velfbfiles, cn_sssfbfiles, &
173	& cn_sstbiasfiles, cn_altbiasfile, &
174	& cn_gridsearchfile, rn_gridsearchres, &
175	& rn_dobsini, rn_dobsend, &
176	& rn_sla_avglamscl, rn_sla_avgphiscl, &
177	& rn_sst_avglamscl, rn_sst_avgphiscl, &
178	& rn_sss_avglamscl, rn_sss_avgphiscl, &
179	& rn_sic_avglamscl, rn_sic_avgphiscl, &
180	& nn_1dint, nn_2dint, &
181	& nn_2dint_sla, nn_2dint_sst, &
182	& nn_2dint_sss, nn_2dint_sic, &
183	& nn_msshc, rn_mdtcorr, rn_mdtcutoff, &
184	& nn_profdavtypes
185	!-----------------------------------------------------------------------
186
187	!-----------------------------------------------------------------------
188	! Read namelist parameters
189	!-----------------------------------------------------------------------
190	! Some namelist arrays need initialising
191	cn_profbfiles (:) = ''
192	cn_slafbfiles (:) = ''
193	cn_sstfbfiles (:) = ''
194	cn_sicfbfiles (:) = ''
195	cn_velfbfiles (:) = ''
196	cn_sssfbfiles (:) = ''
197	cn_sstbiasfiles(:) = ''
198	nn_profdavtypes(:) = -1
199
200	CALL ini_date( rn_dobsini )
201	CALL fin_date( rn_dobsend )
202
203	! Read namelist namobs : control observation diagnostics
204	READ ( numnam_ref, namobs, IOSTAT = ios, ERR = 901)
205	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namobs in reference namelist' )
206	READ ( numnam_cfg, namobs, IOSTAT = ios, ERR = 902 )
207	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namobs in configuration namelist' )
208	IF(lwm) WRITE ( numond, namobs )
209
210	IF( .NOT.ln_diaobs ) THEN
211	IF(lwp) WRITE(numout,*)
212	IF(lwp) WRITE(numout,*) 'dia_obs_init : NO Observation diagnostic used'
213	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
214	RETURN
215	ENDIF
216
217	IF(lwp) THEN
218	WRITE(numout,*)
219	WRITE(numout,*) 'dia_obs_init : Observation diagnostic initialization'
220	WRITE(numout,*) '~~~~~~~~~~~~'
221	WRITE(numout,*) ' Namelist namobs : set observation diagnostic parameters'
222	WRITE(numout,*) ' Logical switch for T profile observations ln_t3d = ', ln_t3d
223	WRITE(numout,*) ' Logical switch for S profile observations ln_s3d = ', ln_s3d
224	WRITE(numout,*) ' Logical switch for SLA observations ln_sla = ', ln_sla
225	WRITE(numout,*) ' Logical switch for SST observations ln_sst = ', ln_sst
226	WRITE(numout,*) ' Logical switch for Sea Ice observations ln_sic = ', ln_sic
227	WRITE(numout,*) ' Logical switch for velocity observations ln_vel3d = ', ln_vel3d
228	WRITE(numout,*) ' Logical switch for SSS observations ln_sss = ', ln_sss
229	WRITE(numout,*) ' Global distribution of observations ln_grid_global = ', ln_grid_global
230	WRITE(numout,*) ' Logical switch for obs grid search lookup ln_grid_search_lookup = ', ln_grid_search_lookup
231	IF (ln_grid_search_lookup) &
232	WRITE(numout,*) ' Grid search lookup file header cn_gridsearchfile = ', cn_gridsearchfile
233	WRITE(numout,*) ' Initial date in window YYYYMMDD.HHMMSS rn_dobsini = ', rn_dobsini
234	WRITE(numout,*) ' Final date in window YYYYMMDD.HHMMSS rn_dobsend = ', rn_dobsend
235	WRITE(numout,*) ' Type of vertical interpolation method nn_1dint = ', nn_1dint
236	WRITE(numout,*) ' Type of horizontal interpolation method nn_2dint = ', nn_2dint
237	WRITE(numout,*) ' Rejection of observations near land switch ln_nea = ', ln_nea
238	WRITE(numout,*) ' Rejection of obs near open bdys ln_bound_reject = ', ln_bound_reject
239	WRITE(numout,*) ' MSSH correction scheme nn_msshc = ', nn_msshc
240	WRITE(numout,*) ' MDT correction rn_mdtcorr = ', rn_mdtcorr
241	WRITE(numout,*) ' MDT cutoff for computed correction rn_mdtcutoff = ', rn_mdtcutoff
242	WRITE(numout,*) ' Logical switch for alt bias ln_altbias = ', ln_altbias
243	WRITE(numout,*) ' Logical switch for sst bias ln_sstbias = ', ln_sstbias
244	WRITE(numout,*) ' Logical switch for ignoring missing files ln_ignmis = ', ln_ignmis
245	WRITE(numout,*) ' Daily average types nn_profdavtypes = ', nn_profdavtypes
246	WRITE(numout,*) ' Logical switch for night-time SST obs ln_sstnight = ', ln_sstnight
247	ENDIF
248	!-----------------------------------------------------------------------
249	! Set up list of observation types to be used
250	! and the files associated with each type
251	!-----------------------------------------------------------------------
252
253	nproftypes = COUNT( (/ln_t3d .OR. ln_s3d, ln_vel3d /) )
254	nsurftypes = COUNT( (/ln_sla, ln_sst, ln_sic, ln_sss /) )
255
256	IF( ln_sstbias ) THEN
257	lmask(:) = .FALSE.
258	WHERE( cn_sstbiasfiles(:) /= '' ) lmask(:) = .TRUE.
259	jnumsstbias = COUNT(lmask)
260	lmask(:) = .FALSE.
261	ENDIF
262
263	IF( nproftypes == 0 .AND. nsurftypes == 0 ) THEN
264	CALL ctl_warn( 'dia_obs_init: ln_diaobs is set to true, but all obs operator logical flags', &
265	& ' (ln_t3d, ln_s3d, ln_sla, ln_sst, ln_sic, ln_vel3d)', &
266	& ' are set to .FALSE. so turning off calls to dia_obs' )
267	ln_diaobs = .FALSE.
268	RETURN
269	ENDIF
270
271	IF( nproftypes > 0 ) THEN
272	!
273	ALLOCATE( cobstypesprof(nproftypes) )
274	ALLOCATE( ifilesprof (nproftypes) )
275	ALLOCATE( clproffiles (nproftypes,jpmaxnfiles) )
276	!
277	jtype = 0
278	IF( ln_t3d .OR. ln_s3d ) THEN
279	jtype = jtype + 1
280	CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'prof ', &
281	& cn_profbfiles, ifilesprof, cobstypesprof, clproffiles )
282	ENDIF
283	IF( ln_vel3d ) THEN
284	jtype = jtype + 1
285	CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'vel ', &
286	& cn_velfbfiles, ifilesprof, cobstypesprof, clproffiles )
287	ENDIF
288	!
289	ENDIF
290
291	IF( nsurftypes > 0 ) THEN
292	!
293	ALLOCATE( cobstypessurf(nsurftypes) )
294	ALLOCATE( ifilessurf (nsurftypes) )
295	ALLOCATE( clsurffiles (nsurftypes,jpmaxnfiles) )
296	ALLOCATE( n2dintsurf (nsurftypes) )
297	ALLOCATE( zavglamscl (nsurftypes) )
298	ALLOCATE( zavgphiscl (nsurftypes) )
299	ALLOCATE( lfpindegs (nsurftypes) )
300	ALLOCATE( llnightav (nsurftypes) )
301	!
302	jtype = 0
303	IF( ln_sla ) THEN
304	jtype = jtype + 1
305	CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sla ', &
306	& cn_slafbfiles, ifilessurf, cobstypessurf, clsurffiles )
307	CALL obs_setinterpopts( nsurftypes, jtype, 'sla ', &
308	& nn_2dint, nn_2dint_sla, &
309	& rn_sla_avglamscl, rn_sla_avgphiscl, &
310	& ln_sla_fp_indegs, .FALSE., &
311	& n2dintsurf, zavglamscl, zavgphiscl, &
312	& lfpindegs, llnightav )
313	ENDIF
314	IF( ln_sst ) THEN
315	jtype = jtype + 1
316	CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sst ', &
317	& cn_sstfbfiles, ifilessurf, cobstypessurf, clsurffiles )
318	CALL obs_setinterpopts( nsurftypes, jtype, 'sst ', &
319	& nn_2dint, nn_2dint_sst, &
320	& rn_sst_avglamscl, rn_sst_avgphiscl, &
321	& ln_sst_fp_indegs, ln_sstnight, &
322	& n2dintsurf, zavglamscl, zavgphiscl, &
323	& lfpindegs, llnightav )
324	ENDIF
325	#if defined key_si3 \|\| defined key_cice
326	IF( ln_sic ) THEN
327	jtype = jtype + 1
328	CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sic ', &
329	& cn_sicfbfiles, ifilessurf, cobstypessurf, clsurffiles )
330	CALL obs_setinterpopts( nsurftypes, jtype, 'sic ', &
331	& nn_2dint, nn_2dint_sic, &
332	& rn_sic_avglamscl, rn_sic_avgphiscl, &
333	& ln_sic_fp_indegs, .FALSE., &
334	& n2dintsurf, zavglamscl, zavgphiscl, &
335	& lfpindegs, llnightav )
336	ENDIF
337	#endif
338	IF( ln_sss ) THEN
339	jtype = jtype + 1
340	CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sss ', &
341	& cn_sssfbfiles, ifilessurf, cobstypessurf, clsurffiles )
342	CALL obs_setinterpopts( nsurftypes, jtype, 'sss ', &
343	& nn_2dint, nn_2dint_sss, &
344	& rn_sss_avglamscl, rn_sss_avgphiscl, &
345	& ln_sss_fp_indegs, .FALSE., &
346	& n2dintsurf, zavglamscl, zavgphiscl, &
347	& lfpindegs, llnightav )
348	ENDIF
349	!
350	ENDIF
351
352
353	!-----------------------------------------------------------------------
354	! Obs operator parameter checking and initialisations
355	!-----------------------------------------------------------------------
356	!
357	IF( ln_vel3d .AND. .NOT.ln_grid_global ) THEN
358	CALL ctl_stop( 'Velocity data only works with ln_grid_global=.true.' )
359	RETURN
360	ENDIF
361	!
362	IF( ln_grid_global ) THEN
363	CALL ctl_warn( 'dia_obs_init: ln_grid_global=T may cause memory issues when used with a large number of processors' )
364	ENDIF
365	!
366	IF( nn_1dint < 0 .OR. nn_1dint > 1 ) THEN
367	CALL ctl_stop('dia_obs_init: Choice of vertical (1D) interpolation method is not available')
368	ENDIF
369	!
370	IF( nn_2dint < 0 .OR. nn_2dint > 6 ) THEN
371	CALL ctl_stop('dia_obs_init: Choice of horizontal (2D) interpolation method is not available')
372	ENDIF
373	!
374	CALL obs_typ_init
375	IF( ln_grid_global ) CALL mppmap_init
376	!
377	CALL obs_grid_setup( )
378
379	!-----------------------------------------------------------------------
380	! Depending on switches read the various observation types
381	!-----------------------------------------------------------------------
382	!
383	IF( nproftypes > 0 ) THEN
384	!
385	ALLOCATE( profdata (nproftypes) , nvarsprof (nproftypes) )
386	ALLOCATE( profdataqc(nproftypes) , nextrprof (nproftypes) )
387	!
388	DO jtype = 1, nproftypes
389	!
390	nvarsprof(jtype) = 2
391	IF ( TRIM(cobstypesprof(jtype)) == 'prof' ) THEN
392	nextrprof(jtype) = 1
393	llvar1 = ln_t3d
394	llvar2 = ln_s3d
395	zglam1 = glamt
396	zgphi1 = gphit
397	zmask1 = tmask
398	zglam2 = glamt
399	zgphi2 = gphit
400	zmask2 = tmask
401	ENDIF
402	IF ( TRIM(cobstypesprof(jtype)) == 'vel' ) THEN
403	nextrprof(jtype) = 2
404	llvar1 = ln_vel3d
405	llvar2 = ln_vel3d
406	zglam1 = glamu
407	zgphi1 = gphiu
408	zmask1 = umask
409	zglam2 = glamv
410	zgphi2 = gphiv
411	zmask2 = vmask
412	ENDIF
413	!
414	! Read in profile or profile obs types
415	CALL obs_rea_prof( profdata(jtype), ifilesprof(jtype), &
416	& clproffiles(jtype,1:ifilesprof(jtype)), &
417	& nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, &
418	& rn_dobsini, rn_dobsend, llvar1, llvar2, &
419	& ln_ignmis, ln_s_at_t, .FALSE., &
420	& kdailyavtypes = nn_profdavtypes )
421	!
422	DO jvar = 1, nvarsprof(jtype)
423	CALL obs_prof_staend( profdata(jtype), jvar )
424	END DO
425	!
426	CALL obs_pre_prof( profdata(jtype), profdataqc(jtype), &
427	& llvar1, llvar2, &
428	& jpi, jpj, jpk, &
429	& zmask1, zglam1, zgphi1, zmask2, zglam2, zgphi2, &
430	& ln_nea, ln_bound_reject, Kmm, &
431	& kdailyavtypes = nn_profdavtypes )
432	END DO
433	!
434	DEALLOCATE( ifilesprof, clproffiles )
435	!
436	ENDIF
437	!
438	IF( nsurftypes > 0 ) THEN
439	!
440	ALLOCATE( surfdata (nsurftypes) , nvarssurf(nsurftypes) )
441	ALLOCATE( surfdataqc(nsurftypes) , nextrsurf(nsurftypes) )
442	!
443	DO jtype = 1, nsurftypes
444	!
445	nvarssurf(jtype) = 1
446	nextrsurf(jtype) = 0
447	llnightav(jtype) = .FALSE.
448	IF( TRIM(cobstypessurf(jtype)) == 'sla' ) nextrsurf(jtype) = 2
449	IF( TRIM(cobstypessurf(jtype)) == 'sst' ) llnightav(jtype) = ln_sstnight
450	!
451	! Read in surface obs types
452	CALL obs_rea_surf( surfdata(jtype), ifilessurf(jtype), &
453	& clsurffiles(jtype,1:ifilessurf(jtype)), &
454	& nvarssurf(jtype), nextrsurf(jtype), nitend-nit000+2, &
455	& rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav(jtype) )
456	!
457	CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea, ln_bound_reject )
458	!
459	IF( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN
460	CALL obs_rea_mdt( surfdataqc(jtype), n2dintsurf(jtype), Kmm )
461	IF( ln_altbias ) &
462	& CALL obs_rea_altbias ( surfdataqc(jtype), n2dintsurf(jtype), cn_altbiasfile )
463	ENDIF
464	!
465	IF( TRIM(cobstypessurf(jtype)) == 'sst' .AND. ln_sstbias ) THEN
466	jnumsstbias = 0
467	DO jfile = 1, jpmaxnfiles
468	IF( TRIM(cn_sstbiasfiles(jfile)) /= '' ) jnumsstbias = jnumsstbias + 1
469	END DO
470	IF( jnumsstbias == 0 ) CALL ctl_stop("ln_sstbias set but no bias files to read in")
471	!
472	CALL obs_app_sstbias( surfdataqc(jtype), n2dintsurf(jtype) , &
473	& jnumsstbias , cn_sstbiasfiles(1:jnumsstbias) )
474	ENDIF
475	END DO
476	!
477	DEALLOCATE( ifilessurf, clsurffiles )
478	!
479	ENDIF
480	!
481	END SUBROUTINE dia_obs_init
482
483
484	SUBROUTINE dia_obs( kstp, Kmm )
485	!!----------------------------------------------------------------------
486	!! * ROUTINE dia_obs *
487	!!
488	!! ** Purpose : Call the observation operators on each time step
489	!!
490	!! ** Method : Call the observation operators on each time step to
491	!! compute the model equivalent of the following data:
492	!! - Profile data, currently T/S or U/V
493	!! - Surface data, currently SST, SLA or sea-ice concentration.
494	!!
495	!! ** Action :
496	!!----------------------------------------------------------------------
497	USE dom_oce, ONLY : gdept, gdept_1d ! Ocean space domain variables (Kmm time-level only)
498	USE phycst , ONLY : rday ! Physical constants
499	USE oce , ONLY : ts, uu, vv, ssh ! Ocean dynamics and tracers variables (Kmm time-level only)
500	USE phycst , ONLY : rday ! Physical constants
501	#if defined key_si3
502	USE ice , ONLY : at_i ! SI3 Ice model variables
503	#endif
504	#if defined key_cice
505	USE sbc_oce, ONLY : fr_i ! ice fraction
506	#endif
507
508	IMPLICIT NONE
509
510	!! * Arguments
511	INTEGER, INTENT(IN) :: kstp ! Current timestep
512	INTEGER, INTENT(in) :: Kmm ! ocean time level indices
513	!! * Local declarations
514	INTEGER :: idaystp ! Number of timesteps per day
515	INTEGER :: jtype ! Data loop variable
516	INTEGER :: jvar ! Variable number
517	INTEGER :: ji, jj ! Loop counters
518	REAL(wp), DIMENSION(jpi,jpj,jpk) :: &
519	& zprofvar1, & ! Model values for 1st variable in a prof ob
520	& zprofvar2 ! Model values for 2nd variable in a prof ob
521	REAL(wp), DIMENSION(jpi,jpj,jpk) :: &
522	& zprofmask1, & ! Mask associated with zprofvar1
523	& zprofmask2 ! Mask associated with zprofvar2
524	REAL(wp), DIMENSION(jpi,jpj) :: &
525	& zsurfvar, & ! Model values equivalent to surface ob.
526	& zsurfmask ! Mask associated with surface variable
527	REAL(wp), DIMENSION(jpi,jpj) :: &
528	& zglam1, & ! Model longitudes for prof variable 1
529	& zglam2, & ! Model longitudes for prof variable 2
530	& zgphi1, & ! Model latitudes for prof variable 1
531	& zgphi2 ! Model latitudes for prof variable 2
532
533	!-----------------------------------------------------------------------
534
535	IF(lwp) THEN
536	WRITE(numout,*)
537	WRITE(numout,*) 'dia_obs : Call the observation operators', kstp
538	WRITE(numout,*) '~~~~~~~'
539	ENDIF
540
541	idaystp = NINT( rday / rdt )
542
543	!-----------------------------------------------------------------------
544	! Call the profile and surface observation operators
545	!-----------------------------------------------------------------------
546
547	IF ( nproftypes > 0 ) THEN
548
549	DO jtype = 1, nproftypes
550
551	SELECT CASE ( TRIM(cobstypesprof(jtype)) )
552	CASE('prof')
553	zprofvar1(:,:,:) = ts(:,:,:,jp_tem,Kmm)
554	zprofvar2(:,:,:) = ts(:,:,:,jp_sal,Kmm)
555	zprofmask1(:,:,:) = tmask(:,:,:)
556	zprofmask2(:,:,:) = tmask(:,:,:)
557	zglam1(:,:) = glamt(:,:)
558	zglam2(:,:) = glamt(:,:)
559	zgphi1(:,:) = gphit(:,:)
560	zgphi2(:,:) = gphit(:,:)
561	CASE('vel')
562	zprofvar1(:,:,:) = uu(:,:,:,Kmm)
563	zprofvar2(:,:,:) = vv(:,:,:,Kmm)
564	zprofmask1(:,:,:) = umask(:,:,:)
565	zprofmask2(:,:,:) = vmask(:,:,:)
566	zglam1(:,:) = glamu(:,:)
567	zglam2(:,:) = glamv(:,:)
568	zgphi1(:,:) = gphiu(:,:)
569	zgphi2(:,:) = gphiv(:,:)
570	CASE DEFAULT
571	CALL ctl_stop( 'Unknown profile observation type '//TRIM(cobstypesprof(jtype))//' in dia_obs' )
572	END SELECT
573
574	CALL obs_prof_opt( profdataqc(jtype), kstp, jpi, jpj, jpk, &
575	& nit000, idaystp, &
576	& zprofvar1, zprofvar2, &
577	& gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm), &
578	& zprofmask1, zprofmask2, &
579	& zglam1, zglam2, zgphi1, zgphi2, &
580	& nn_1dint, nn_2dint, &
581	& kdailyavtypes = nn_profdavtypes )
582
583	END DO
584
585	ENDIF
586
587	IF ( nsurftypes > 0 ) THEN
588
589	DO jtype = 1, nsurftypes
590
591	!Defaults which might be changed
592	zsurfmask(:,:) = tmask(:,:,1)
593
594	SELECT CASE ( TRIM(cobstypessurf(jtype)) )
595	CASE('sst')
596	zsurfvar(:,:) = ts(:,:,1,jp_tem,Kmm)
597	CASE('sla')
598	zsurfvar(:,:) = ssh(:,:,Kmm)
599	CASE('sss')
600	zsurfvar(:,:) = ts(:,:,1,jp_sal,Kmm)
601	CASE('sic')
602	IF ( kstp == 0 ) THEN
603	IF ( lwp .AND. surfdataqc(jtype)%nsstpmpp(1) > 0 ) THEN
604	CALL ctl_warn( 'Sea-ice not initialised on zeroth '// &
605	& 'time-step but some obs are valid then.' )
606	WRITE(numout,*)surfdataqc(jtype)%nsstpmpp(1), &
607	& ' sea-ice obs will be missed'
608	ENDIF
609	surfdataqc(jtype)%nsurfup = surfdataqc(jtype)%nsurfup + &
610	& surfdataqc(jtype)%nsstp(1)
611	CYCLE
612	ELSE
613	#if defined key_cice \|\| defined key_si3
614	zsurfvar(:,:) = fr_i(:,:)
615	#else
616	CALL ctl_stop( ' Trying to run sea-ice observation operator', &
617	& ' but no sea-ice model appears to have been defined' )
618	#endif
619	ENDIF
620
621	END SELECT
622
623	CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj, &
624	& nit000, idaystp, zsurfvar, zsurfmask, &
625	& n2dintsurf(jtype), llnightav(jtype), &
626	& zavglamscl(jtype), zavgphiscl(jtype), &
627	& lfpindegs(jtype) )
628
629	END DO
630
631	ENDIF
632
633	END SUBROUTINE dia_obs
634
635	SUBROUTINE dia_obs_wri
636	!!----------------------------------------------------------------------
637	!! * ROUTINE dia_obs_wri *
638	!!
639	!! ** Purpose : Call observation diagnostic output routines
640	!!
641	!! ** Method : Call observation diagnostic output routines
642	!!
643	!! ** Action :
644	!!
645	!! History :
646	!! ! 06-03 (K. Mogensen) Original code
647	!! ! 06-05 (K. Mogensen) Reformatted
648	!! ! 06-10 (A. Weaver) Cleaning
649	!! ! 07-03 (K. Mogensen) General handling of profiles
650	!! ! 08-09 (M. Valdivieso) Velocity component (U,V) profiles
651	!! ! 15-08 (M. Martin) Combined writing for prof and surf types
652	!!----------------------------------------------------------------------
653	!! * Modules used
654	USE obs_rot_vel ! Rotation of velocities
655
656	IMPLICIT NONE
657
658	!! * Local declarations
659	INTEGER :: jtype ! Data set loop variable
660	INTEGER :: jo, jvar, jk
661	REAL(wp), DIMENSION(:), ALLOCATABLE :: &
662	& zu, &
663	& zv
664
665	!-----------------------------------------------------------------------
666	! Depending on switches call various observation output routines
667	!-----------------------------------------------------------------------
668
669	IF ( nproftypes > 0 ) THEN
670
671	DO jtype = 1, nproftypes
672
673	IF ( TRIM(cobstypesprof(jtype)) == 'vel' ) THEN
674
675	! For velocity data, rotate the model velocities to N/S, E/W
676	! using the compressed data structure.
677	ALLOCATE( &
678	& zu(profdataqc(jtype)%nvprot(1)), &
679	& zv(profdataqc(jtype)%nvprot(2)) &
680	& )
681
682	CALL obs_rotvel( profdataqc(jtype), nn_2dint, zu, zv )
683
684	DO jo = 1, profdataqc(jtype)%nprof
685	DO jvar = 1, 2
686	DO jk = profdataqc(jtype)%npvsta(jo,jvar), profdataqc(jtype)%npvend(jo,jvar)
687
688	IF ( jvar == 1 ) THEN
689	profdataqc(jtype)%var(jvar)%vmod(jk) = zu(jk)
690	ELSE
691	profdataqc(jtype)%var(jvar)%vmod(jk) = zv(jk)
692	ENDIF
693
694	END DO
695	END DO
696	END DO
697
698	DEALLOCATE( zu )
699	DEALLOCATE( zv )
700
701	END IF
702
703	CALL obs_prof_decompress( profdataqc(jtype), &
704	& profdata(jtype), .TRUE., numout )
705
706	CALL obs_wri_prof( profdata(jtype) )
707
708	END DO
709
710	ENDIF
711
712	IF ( nsurftypes > 0 ) THEN
713
714	DO jtype = 1, nsurftypes
715
716	CALL obs_surf_decompress( surfdataqc(jtype), &
717	& surfdata(jtype), .TRUE., numout )
718
719	CALL obs_wri_surf( surfdata(jtype) )
720
721	END DO
722
723	ENDIF
724
725	END SUBROUTINE dia_obs_wri
726
727	SUBROUTINE dia_obs_dealloc
728	IMPLICIT NONE
729	!!----------------------------------------------------------------------
730	!! * ROUTINE dia_obs_dealloc *
731	!!
732	!! ** Purpose : To deallocate data to enable the obs_oper online loop.
733	!! Specifically: dia_obs_init --> dia_obs --> dia_obs_wri
734	!!
735	!! ** Method : Clean up various arrays left behind by the obs_oper.
736	!!
737	!! ** Action :
738	!!
739	!!----------------------------------------------------------------------
740	! obs_grid deallocation
741	CALL obs_grid_deallocate
742
743	! diaobs deallocation
744	IF ( nproftypes > 0 ) &
745	& DEALLOCATE( cobstypesprof, profdata, profdataqc, nvarsprof, nextrprof )
746
747	IF ( nsurftypes > 0 ) &
748	& DEALLOCATE( cobstypessurf, surfdata, surfdataqc, nvarssurf, nextrsurf, &
749	& n2dintsurf, zavglamscl, zavgphiscl, lfpindegs, llnightav )
750
751	END SUBROUTINE dia_obs_dealloc
752
753	SUBROUTINE calc_date( kstp, ddobs )
754	!!----------------------------------------------------------------------
755	!! * ROUTINE calc_date *
756	!!
757	!! ** Purpose : Get date in double precision YYYYMMDD.HHMMSS format
758	!!
759	!! ** Method : Get date in double precision YYYYMMDD.HHMMSS format
760	!!
761	!! ** Action : Get date in double precision YYYYMMDD.HHMMSS format
762	!!
763	!! ** Action : Get initial date in double precision YYYYMMDD.HHMMSS format
764	!!
765	!! History :
766	!! ! 06-03 (K. Mogensen) Original code
767	!! ! 06-05 (K. Mogensen) Reformatted
768	!! ! 06-10 (A. Weaver) Cleaning
769	!! ! 06-10 (G. Smith) Calculates initial date the same as method for final date
770	!! ! 10-05 (D. Lea) Update to month length calculation for NEMO vn3.2
771	!! ! 2014-09 (D. Lea) New generic routine now deals with arbitrary initial time of day
772	!!----------------------------------------------------------------------
773	USE phycst, ONLY : & ! Physical constants
774	& rday
775	USE dom_oce, ONLY : & ! Ocean space and time domain variables
776	& rdt
777
778	IMPLICIT NONE
779
780	!! * Arguments
781	REAL(KIND=dp), INTENT(OUT) :: ddobs ! Date in YYYYMMDD.HHMMSS
782	INTEGER :: kstp
783
784	!! * Local declarations
785	INTEGER :: iyea ! date - (year, month, day, hour, minute)
786	INTEGER :: imon
787	INTEGER :: iday
788	INTEGER :: ihou
789	INTEGER :: imin
790	INTEGER :: imday ! Number of days in month.
791	REAL(wp) :: zdayfrc ! Fraction of day
792
793	INTEGER, DIMENSION(12) :: imonth_len !: length in days of the months of the current year
794
795	!!----------------------------------------------------------------------
796	!! Initial date initialization (year, month, day, hour, minute)
797	!!----------------------------------------------------------------------
798	iyea = ndate0 / 10000
799	imon = ( ndate0 - iyea * 10000 ) / 100
800	iday = ndate0 - iyea * 10000 - imon * 100
801	ihou = nn_time0 / 100
802	imin = ( nn_time0 - ihou * 100 )
803
804	!!----------------------------------------------------------------------
805	!! Compute number of days + number of hours + min since initial time
806	!!----------------------------------------------------------------------
807	zdayfrc = kstp * rdt / rday
808	zdayfrc = zdayfrc - aint(zdayfrc)
809	imin = imin + int( zdayfrc * 24 * 60 )
810	DO WHILE (imin >= 60)
811	imin=imin-60
812	ihou=ihou+1
813	END DO
814	DO WHILE (ihou >= 24)
815	ihou=ihou-24
816	iday=iday+1
817	END DO
818	iday = iday + kstp * rdt / rday
819
820	!-----------------------------------------------------------------------
821	! Convert number of days (iday) into a real date
822	!----------------------------------------------------------------------
823
824	CALL calc_month_len( iyea, imonth_len )
825
826	DO WHILE ( iday > imonth_len(imon) )
827	iday = iday - imonth_len(imon)
828	imon = imon + 1
829	IF ( imon > 12 ) THEN
830	imon = 1
831	iyea = iyea + 1
832	CALL calc_month_len( iyea, imonth_len ) ! update month lengths
833	ENDIF
834	END DO
835
836	!----------------------------------------------------------------------
837	! Convert it into YYYYMMDD.HHMMSS format.
838	!----------------------------------------------------------------------
839	ddobs = iyea * 10000_dp + imon * 100_dp + &
840	& iday + ihou * 0.01_dp + imin * 0.0001_dp
841
842	END SUBROUTINE calc_date
843
844	SUBROUTINE ini_date( ddobsini )
845	!!----------------------------------------------------------------------
846	!! * ROUTINE ini_date *
847	!!
848	!! ** Purpose : Get initial date in double precision YYYYMMDD.HHMMSS format
849	!!
850	!! ** Method :
851	!!
852	!! ** Action :
853	!!
854	!! History :
855	!! ! 06-03 (K. Mogensen) Original code
856	!! ! 06-05 (K. Mogensen) Reformatted
857	!! ! 06-10 (A. Weaver) Cleaning
858	!! ! 10-05 (D. Lea) Update to month length calculation for NEMO vn3.2
859	!! ! 2014-09 (D. Lea) Change to call generic routine calc_date
860	!!----------------------------------------------------------------------
861
862	IMPLICIT NONE
863
864	!! * Arguments
865	REAL(KIND=dp), INTENT(OUT) :: ddobsini ! Initial date in YYYYMMDD.HHMMSS
866
867	CALL calc_date( nit000 - 1, ddobsini )
868
869	END SUBROUTINE ini_date
870
871	SUBROUTINE fin_date( ddobsfin )
872	!!----------------------------------------------------------------------
873	!! * ROUTINE fin_date *
874	!!
875	!! ** Purpose : Get final date in double precision YYYYMMDD.HHMMSS format
876	!!
877	!! ** Method :
878	!!
879	!! ** Action :
880	!!
881	!! History :
882	!! ! 06-03 (K. Mogensen) Original code
883	!! ! 06-05 (K. Mogensen) Reformatted
884	!! ! 06-10 (A. Weaver) Cleaning
885	!! ! 10-05 (D. Lea) Update to month length calculation for NEMO vn3.2
886	!! ! 2014-09 (D. Lea) Change to call generic routine calc_date
887	!!----------------------------------------------------------------------
888
889	IMPLICIT NONE
890
891	!! * Arguments
892	REAL(dp), INTENT(OUT) :: ddobsfin ! Final date in YYYYMMDD.HHMMSS
893
894	CALL calc_date( nitend, ddobsfin )
895
896	END SUBROUTINE fin_date
897
898	SUBROUTINE obs_settypefiles( ntypes, jpmaxnfiles, jtype, ctypein, &
899	& cfilestype, ifiles, cobstypes, cfiles )
900
901	INTEGER, INTENT(IN) :: ntypes ! Total number of obs types
902	INTEGER, INTENT(IN) :: jpmaxnfiles ! Maximum number of files allowed for each type
903	INTEGER, INTENT(IN) :: jtype ! Index of the current type of obs
904	INTEGER, DIMENSION(ntypes), INTENT(INOUT) :: &
905	& ifiles ! Out appended number of files for this type
906
907	CHARACTER(len=6), INTENT(IN) :: ctypein
908	CHARACTER(len=128), DIMENSION(jpmaxnfiles), INTENT(IN) :: &
909	& cfilestype ! In list of files for this obs type
910	CHARACTER(len=6), DIMENSION(ntypes), INTENT(INOUT) :: &
911	& cobstypes ! Out appended list of obs types
912	CHARACTER(len=128), DIMENSION(ntypes, jpmaxnfiles), INTENT(INOUT) :: &
913	& cfiles ! Out appended list of files for all types
914
915	!Local variables
916	INTEGER :: jfile
917
918	cfiles(jtype,:) = cfilestype(:)
919	cobstypes(jtype) = ctypein
920	ifiles(jtype) = 0
921	DO jfile = 1, jpmaxnfiles
922	IF ( trim(cfiles(jtype,jfile)) /= '' ) &
923	ifiles(jtype) = ifiles(jtype) + 1
924	END DO
925
926	IF ( ifiles(jtype) == 0 ) THEN
927	CALL ctl_stop( 'Logical for observation type '//TRIM(ctypein)// &
928	& ' set to true but no files available to read' )
929	ENDIF
930
931	IF(lwp) THEN
932	WRITE(numout,*) ' '//cobstypes(jtype)//' input observation file names:'
933	DO jfile = 1, ifiles(jtype)
934	WRITE(numout,*) ' '//TRIM(cfiles(jtype,jfile))
935	END DO
936	ENDIF
937
938	END SUBROUTINE obs_settypefiles
939
940	SUBROUTINE obs_setinterpopts( ntypes, jtype, ctypein, &
941	& n2dint_default, n2dint_type, &
942	& zavglamscl_type, zavgphiscl_type, &
943	& lfp_indegs_type, lavnight_type, &
944	& n2dint, zavglamscl, zavgphiscl, &
945	& lfpindegs, lavnight )
946
947	INTEGER, INTENT(IN) :: ntypes ! Total number of obs types
948	INTEGER, INTENT(IN) :: jtype ! Index of the current type of obs
949	INTEGER, INTENT(IN) :: n2dint_default ! Default option for interpolation type
950	INTEGER, INTENT(IN) :: n2dint_type ! Option for interpolation type
951	REAL(wp), INTENT(IN) :: &
952	& zavglamscl_type, & !E/W diameter of obs footprint for this type
953	& zavgphiscl_type !N/S diameter of obs footprint for this type
954	LOGICAL, INTENT(IN) :: lfp_indegs_type !T=> footprint in degrees, F=> in metres
955	LOGICAL, INTENT(IN) :: lavnight_type !T=> obs represent night time average
956	CHARACTER(len=6), INTENT(IN) :: ctypein
957
958	INTEGER, DIMENSION(ntypes), INTENT(INOUT) :: &
959	& n2dint
960	REAL(wp), DIMENSION(ntypes), INTENT(INOUT) :: &
961	& zavglamscl, zavgphiscl
962	LOGICAL, DIMENSION(ntypes), INTENT(INOUT) :: &
963	& lfpindegs, lavnight
964
965	lavnight(jtype) = lavnight_type
966
967	IF ( (n2dint_type >= 1) .AND. (n2dint_type <= 6) ) THEN
968	n2dint(jtype) = n2dint_type
969	ELSE
970	n2dint(jtype) = n2dint_default
971	ENDIF
972
973	! For averaging observation footprints set options for size of footprint
974	IF ( (n2dint(jtype) > 4) .AND. (n2dint(jtype) <= 6) ) THEN
975	IF ( zavglamscl_type > 0._wp ) THEN
976	zavglamscl(jtype) = zavglamscl_type
977	ELSE
978	CALL ctl_stop( 'Incorrect value set for averaging footprint '// &
979	'scale (zavglamscl) for observation type '//TRIM(ctypein) )
980	ENDIF
981
982	IF ( zavgphiscl_type > 0._wp ) THEN
983	zavgphiscl(jtype) = zavgphiscl_type
984	ELSE
985	CALL ctl_stop( 'Incorrect value set for averaging footprint '// &
986	'scale (zavgphiscl) for observation type '//TRIM(ctypein) )
987	ENDIF
988
989	lfpindegs(jtype) = lfp_indegs_type
990
991	ENDIF
992
993	! Write out info
994	IF(lwp) THEN
995	IF ( n2dint(jtype) <= 4 ) THEN
996	WRITE(numout,*) ' '//TRIM(ctypein)// &
997	& ' model counterparts will be interpolated horizontally'
998	ELSE IF ( n2dint(jtype) <= 6 ) THEN
999	WRITE(numout,*) ' '//TRIM(ctypein)// &
1000	& ' model counterparts will be averaged horizontally'
1001	WRITE(numout,*) ' '//' with E/W scale: ',zavglamscl(jtype)
1002	WRITE(numout,*) ' '//' with N/S scale: ',zavgphiscl(jtype)
1003	IF ( lfpindegs(jtype) ) THEN
1004	WRITE(numout,*) ' '//' (in degrees)'
1005	ELSE
1006	WRITE(numout,*) ' '//' (in metres)'
1007	ENDIF
1008	ENDIF
1009	ENDIF
1010
1011	END SUBROUTINE obs_setinterpopts
1012
1013	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: NEMO/trunk/src/OCE/OBS/diaobs.F90 @ 12377

Download in other formats: