source: branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90 @ 10388

Last change on this file since 10388 was 10388, checked in by dford, 20 months ago

Updates for running with FABM-ERSEM. See internal Met Office NEMO ticket 760.

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