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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 15799 – NEMO

Changeset 15799


Ignore:
Timestamp:
2022-04-25T17:15:21+02:00 (2 years ago)
Author:
dford
Message:

More generic interface and structure for OBS code. See Met Office utils tickets 471 and 530.

Location:
NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package
Files:
2 deleted
16 edited
3 copied

Legend:

Unmodified
Added
Removed

  • NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/cfgs/SHARED/namelist_ref

    r15731 r15799  
    12421242!!                                                                    !! 
    12431243!!   namobs       observation and model comparison                      (default: OFF) 
     1244!!   namobs_dta   observation and model comparison - external data      (see: namobs) 
    12441245!!   nam_asminc   assimilation increments                               ('key_asminc') 
    12451246!!====================================================================== 
    12461247! 
    12471248!----------------------------------------------------------------------- 
    1248 &namobs        !  observation usage switch                              (default: OFF) 
    1249 !----------------------------------------------------------------------- 
    1250    ln_diaobs   = .false.             ! Logical switch for the observation operator 
    1251    ! 
    1252    ln_t3d      = .false.             ! Logical switch for T profile observations 
    1253    ln_s3d      = .false.             ! Logical switch for S profile observations 
    1254    ln_sla      = .false.             ! Logical switch for SLA observations 
    1255    ln_sst      = .false.             ! Logical switch for SST observations 
    1256    ln_sss      = .false.             ! Logical swithc for SSS observations 
    1257    ln_sic      = .false.             ! Logical switch for Sea Ice observations 
    1258    ln_vel3d    = .false.             ! Logical switch for velocity observations 
    1259    ln_altbias  = .false.             ! Logical switch for altimeter bias correction 
    1260    ln_sstbias  = .false.             ! Logical switch for SST bias correction 
    1261    ln_nea      = .false.             ! Logical switch for rejection of observations near land 
    1262    ln_grid_global = .true.           ! Logical switch for global distribution of observations 
    1263    ln_grid_search_lookup = .false.   ! Logical switch for obs grid search w/lookup table 
    1264    ln_ignmis   = .true.              ! Logical switch for ignoring missing files 
    1265    ln_s_at_t   = .false.             ! Logical switch for computing model S at T obs if not there 
    1266    ln_sstnight = .false.             ! Logical switch for calculating night-time average for SST obs 
    1267    ln_bound_reject  = .false.        ! Logical to remove obs near boundaries in LAMs. 
    1268    ln_sla_fp_indegs = .true.         ! Logical for SLA: T=> averaging footprint is in degrees, F=> in metres 
    1269    ln_sst_fp_indegs = .true.         ! Logical for SST: T=> averaging footprint is in degrees, F=> in metres 
    1270    ln_sss_fp_indegs = .true.         ! Logical for SSS: T=> averaging footprint is in degrees, F=> in metres 
    1271    ln_sic_fp_indegs = .true.         ! Logical for SIC: T=> averaging footprint is in degrees, F=> in metres 
    1272 ! All of the *files* variables below are arrays. Use namelist_cfg to add more files 
    1273    cn_profbfiles = 'profiles_01.nc'  ! Profile feedback input observation file names 
    1274    cn_slafbfiles = 'sla_01.nc'       ! SLA feedback input observation file names 
    1275    cn_sstfbfiles = 'sst_01.nc'       ! SST feedback input observation file names 
    1276    cn_sssfbfiles = 'sss_01.nc'       ! SSS feedback input observation file names 
    1277    cn_sicfbfiles = 'sic_01.nc'       ! SIC feedback input observation file names 
    1278    cn_velfbfiles = 'vel_01.nc'       ! Velocity feedback input observation file names 
    1279    cn_altbiasfile = 'altbias.nc'     ! Altimeter bias input file name 
    1280    cn_sstbiasfiles = 'sstbias.nc'    ! SST bias input file name 
    1281    cn_gridsearchfile ='gridsearch.nc' ! Grid search file name 
    1282    rn_gridsearchres = 0.5            ! Grid search resolution 
    1283    rn_mdtcorr  = 1.61                ! MDT  correction 
    1284    rn_mdtcutoff = 65.0               ! MDT cutoff for computed correction 
    1285    rn_dobsini  = 00010101.000000     ! Initial date in window YYYYMMDD.HHMMSS 
    1286    rn_dobsend  = 00010102.000000     ! Final date in window YYYYMMDD.HHMMSS 
    1287    rn_sla_avglamscl = 0.             ! E/W diameter of SLA observation footprint (metres/degrees) 
    1288    rn_sla_avgphiscl = 0.             ! N/S diameter of SLA observation footprint (metres/degrees) 
    1289    rn_sst_avglamscl = 0.             ! E/W diameter of SST observation footprint (metres/degrees) 
    1290    rn_sst_avgphiscl = 0.             ! N/S diameter of SST observation footprint (metres/degrees) 
    1291    rn_sss_avglamscl = 0.             ! E/W diameter of SSS observation footprint (metres/degrees) 
    1292    rn_sss_avgphiscl = 0.             ! N/S diameter of SSS observation footprint (metres/degrees) 
    1293    rn_sic_avglamscl = 0.             ! E/W diameter of SIC observation footprint (metres/degrees) 
    1294    rn_sic_avgphiscl = 0.             ! N/S diameter of SIC observation footprint (metres/degrees) 
    1295    nn_1dint = 0                      ! Type of vertical interpolation method 
    1296    nn_2dint = 0                      ! Default horizontal interpolation method 
    1297    nn_2dint_sla = 0                  ! Horizontal interpolation method for SLA 
    1298    nn_2dint_sst = 0                  ! Horizontal interpolation method for SST 
    1299    nn_2dint_sss = 0                  ! Horizontal interpolation method for SSS 
    1300    nn_2dint_sic = 0                  ! Horizontal interpolation method for SIC 
    1301    nn_msshc     = 0                  ! MSSH correction scheme 
    1302    nn_profdavtypes = -1              ! Profile daily average types - array 
     1249&namobs       !  observation and model comparison                       (default: OFF) 
     1250!----------------------------------------------------------------------- 
     1251   ln_diaobs             = .false.         ! Logical switch for the observation operator 
     1252   nn_obsgroups          = 0               ! Number of observation group namelists (namobs_dta) to read in 
     1253   ln_grid_global        = .true.          ! Logical switch for global distribution of observations 
     1254   ln_grid_search_lookup = .false.         ! Logical switch for obs grid search w/lookup table 
     1255   cn_gridsearchfile     = 'grid_search'   ! Grid search file name header 
     1256   rn_gridsearchres      = 0.5             ! Grid search resolution 
     1257   rn_dobsini            = 00010101.000000 ! Initial date in window YYYYMMDD.HHMMSS 
     1258   rn_dobsend            = 00010102.000000 ! Final date in window YYYYMMDD.HHMMSS 
     1259/ 
     1260!----------------------------------------------------------------------- 
     1261&namobs_dta    !  observation and model comparison - external data      (see: namobs) 
     1262!----------------------------------------------------------------------- 
     1263   cn_groupname           = ''             ! Name of obs group (output file will be cn_groupname//'fb_????.nc') 
     1264   ln_enabled             = .true.         ! Logical switch for group being processed not ignored 
     1265   ln_prof                = .false.        ! Logical switch for profile data 
     1266   ln_surf                = .false.        ! Logical switch for surface data 
     1267   cn_obsfiles            = ''             ! Observation file names 
     1268   cn_obstypes            = ''             ! Observation types to read from files 
     1269   ln_nea                 = .false.        ! Logical switch for rejecting observations near land 
     1270   ln_bound_reject        = .false.        ! Logical switch for rejecting obs near the boundary 
     1271   ln_ignmis              = .true.         ! Logical switch for ignoring missing files 
     1272   nn_2dint               = 0              ! Type of horizontal interpolation method 
     1273                                           ! Relevant if ln_prof = .true.: 
     1274   nn_1dint               = 0              !    Type of vertical interpolation method 
     1275   nn_profdavtypes        = -1             !    Profile data types representing a daily average 
     1276   ln_all_at_all          = .false.        !    Logical switch for computing all model variables at all obs points 
     1277                                           ! Relevant if ln_surf = .true.: 
     1278   ln_fp_indegs           = .true.         !    Logical: T=> averaging footprint is in degrees, F=> in metres 
     1279   rn_avglamscl           = 0.             !    E/W diameter of observation footprint (metres/degrees) 
     1280   rn_avgphiscl           = 0.             !    N/S diameter of observation footprint (metres/degrees) 
     1281   ln_night               = .false.        !    Logical switch for calculating night-time average for obs 
     1282   ln_time_mean_bkg       = .false.        !    Logical switch for applying time mean of background (e.g. to remove tidal signal) 
     1283   rn_time_mean_period    = 24.8333        !    Meaning period in hours if ln_time_mean_bkg (default is AMM tidal period) 
     1284   ln_obsbias             = .false.        !    Logical switch for bias correction 
     1285   cn_obsbiasfiles        = ''             !    Bias input file names 
     1286   cn_type_to_biascorrect = ''             !    Observation type to bias correct 
     1287   cn_obsbiasfile_varname = ''             !    Bias variable name in input file 
     1288                                           ! Relevant if 'SLA' in cn_obstypes: 
     1289   ln_altbias             = .false.        !    Logical switch for altimeter bias correction 
     1290   cn_altbiasfile         = ''             !    Altimeter bias input file name 
     1291   nn_msshc               = 0              !    MSSH correction scheme 
     1292   rn_mdtcorr             = 1.61           !    MDT correction 
     1293   rn_mdtcutoff           = 65.0           !    MDT cutoff for computed correction 
     1294                                           ! Relevant if 'POTM', 'PSAL', 'SST', or 'SSS' in cn_obstypes: 
     1295   ln_output_clim         = .false.        !    Logical switch to output climatological temperature/salinity (if ln_tradmp) 
    13031296/ 
    13041297!----------------------------------------------------------------------- 

  • NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/doc/namelists/namobs

    r11703 r15799  
    2020   ln_sstnight = .false.             ! Logical switch for calculating night-time average for SST obs 
    2121   ln_bound_reject  = .false.        ! Logical to remove obs near boundaries in LAMs. 
     22   ln_default_fp_indegs = .true.     ! Logical: T=> averaging footprint is in degrees, F=> in metres 
    2223   ln_sla_fp_indegs = .true.         ! Logical for SLA: T=> averaging footprint is in degrees, F=> in metres 
    2324   ln_sst_fp_indegs = .true.         ! Logical for SST: T=> averaging footprint is in degrees, F=> in metres 
    … …  
    3940   rn_dobsini  = 00010101.000000     ! Initial date in window YYYYMMDD.HHMMSS 
    4041   rn_dobsend  = 00010102.000000     ! Final date in window YYYYMMDD.HHMMSS 
     42   rn_default_avglamscl = 0.         ! Default E/W diameter of observation footprint (metres/degrees) 
     43   rn_default_avgphiscl = 0.         ! Default N/S diameter of observation footprint (metres/degrees) 
    4144   rn_sla_avglamscl = 0.             ! E/W diameter of SLA observation footprint (metres/degrees) 
    4245   rn_sla_avgphiscl = 0.             ! N/S diameter of SLA observation footprint (metres/degrees) 
    … …  
    4851   rn_sic_avgphiscl = 0.             ! N/S diameter of SIC observation footprint (metres/degrees) 
    4952   nn_1dint = 0                      ! Type of vertical interpolation method 
    50    nn_2dint = 0                      ! Default horizontal interpolation method 
     53   nn_2dint_default = 0              ! Default horizontal interpolation method 
    5154   nn_2dint_sla = 0                  ! Horizontal interpolation method for SLA 
    5255   nn_2dint_sst = 0                  ! Horizontal interpolation method for SST 

  • NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS/diaobs.F90

    r14075 r15799  
    2626   !!   fin_date      : Compute the final date YYYYMMDD.HHMMSS 
    2727   !!---------------------------------------------------------------------- 
    28    USE par_kind       ! Precision variables 
    29    USE in_out_manager ! I/O manager 
    30    USE par_oce        ! ocean parameter 
    31    USE dom_oce        ! Ocean space and time domain variables 
    32    USE sbc_oce        ! Sea-ice fraction 
     28   USE par_kind          ! Precision variables 
     29   USE in_out_manager    ! I/O manager 
     30   USE timing            ! Timing 
     31   USE par_oce           ! ocean parameter 
     32   USE dom_oce           ! Ocean space and time domain variables 
     33   USE sbc_oce           ! Sea-ice fraction 
    3334   ! 
    34    USE obs_read_prof  ! Reading and allocation of profile obs 
    35    USE obs_read_surf  ! Reading and allocation of surface obs 
    36    USE obs_sstbias    ! Bias correction routine for SST  
    37    USE obs_readmdt    ! Reading and allocation of MDT for SLA. 
    38    USE obs_prep       ! Preparation of obs. (grid search etc). 
    39    USE obs_oper       ! Observation operators 
    40    USE obs_write      ! Writing of observation related diagnostics 
    41    USE obs_grid       ! Grid searching 
    42    USE obs_read_altbias ! Bias treatment for altimeter 
    43    USE obs_profiles_def ! Profile data definitions 
    44    USE obs_surf_def   ! Surface data definitions 
    45    USE obs_types      ! Definitions for observation types 
     35   USE obs_read_prof     ! Reading and allocation of profile obs 
     36   USE obs_read_surf     ! Reading and allocation of surface obs 
     37   USE obs_bias          ! Bias correction routine 
     38   USE obs_readmdt       ! Reading and allocation of MDT for SLA. 
     39   USE obs_readsnowdepth ! Get model snow depth for conversion of freeboard to ice thickness 
     40   USE obs_prep          ! Preparation of obs. (grid search etc). 
     41   USE obs_oper          ! Observation operators 
     42   USE obs_write         ! Writing of observation related diagnostics 
     43   USE obs_grid          ! Grid searching 
     44   USE obs_read_altbias  ! Bias treatment for altimeter 
     45   USE obs_profiles_def  ! Profile data definitions 
     46   USE obs_surf_def      ! Surface data definitions 
     47   USE obs_types         ! Definitions for observation types 
     48   USE obs_group_def     ! Definitions for observation groups 
    4649   ! 
    47    USE mpp_map        ! MPP mapping 
    48    USE lib_mpp        ! For ctl_warn/stop 
     50   USE mpp_map           ! MPP mapping 
     51   USE lib_mpp           ! For ctl_warn/stop 
    4952 
    5053   IMPLICIT NONE 
    … …  
    5457   PUBLIC dia_obs          ! Compute model equivalent to observations 
    5558   PUBLIC dia_obs_wri      ! Write model equivalent to observations 
    56    PUBLIC dia_obs_dealloc  ! Deallocate dia_obs data 
    5759   PUBLIC calc_date        ! Compute the date of a timestep 
    5860 
    59    LOGICAL, PUBLIC :: ln_diaobs          !: Logical switch for the obs operator 
    60    LOGICAL         :: ln_sstnight        !  Logical switch for night mean SST obs 
    61    LOGICAL         :: ln_sla_fp_indegs   !  T=> SLA obs footprint size specified in degrees, F=> in metres 
    62    LOGICAL         :: ln_sst_fp_indegs   !  T=> SST obs footprint size specified in degrees, F=> in metres 
    63    LOGICAL         :: ln_sss_fp_indegs   !  T=> SSS obs footprint size specified in degrees, F=> in metres 
    64    LOGICAL         :: ln_sic_fp_indegs   !  T=> sea-ice obs footprint size specified in degrees, F=> in metres 
    65  
    66    REAL(wp) ::   rn_sla_avglamscl   ! E/W diameter of SLA observation footprint (metres) 
    67    REAL(wp) ::   rn_sla_avgphiscl   ! N/S diameter of SLA observation footprint (metres) 
    68    REAL(wp) ::   rn_sst_avglamscl   ! E/W diameter of SST observation footprint (metres) 
    69    REAL(wp) ::   rn_sst_avgphiscl   ! N/S diameter of SST observation footprint (metres) 
    70    REAL(wp) ::   rn_sss_avglamscl   ! E/W diameter of SSS observation footprint (metres) 
    71    REAL(wp) ::   rn_sss_avgphiscl   ! N/S diameter of SSS observation footprint (metres) 
    72    REAL(wp) ::   rn_sic_avglamscl   ! E/W diameter of sea-ice observation footprint (metres) 
    73    REAL(wp) ::   rn_sic_avgphiscl   ! N/S diameter of sea-ice observation footprint (metres) 
    74  
    75    INTEGER :: nn_1dint       ! Vertical interpolation method 
    76    INTEGER :: nn_2dint       ! Default horizontal interpolation method 
    77    INTEGER :: nn_2dint_sla   ! SLA horizontal interpolation method  
    78    INTEGER :: nn_2dint_sst   ! SST horizontal interpolation method  
    79    INTEGER :: nn_2dint_sss   ! SSS horizontal interpolation method  
    80    INTEGER :: nn_2dint_sic   ! Seaice horizontal interpolation method  
    81    INTEGER, DIMENSION(imaxavtypes) ::   nn_profdavtypes   ! Profile data types representing a daily average 
    82    INTEGER :: nproftypes     ! Number of profile obs types 
    83    INTEGER :: nsurftypes     ! Number of surface obs types 
    84    INTEGER , DIMENSION(:), ALLOCATABLE ::   nvarsprof, nvarssurf   ! Number of profile & surface variables 
    85    INTEGER , DIMENSION(:), ALLOCATABLE ::   nextrprof, nextrsurf   ! Number of profile & surface extra variables 
    86    INTEGER , DIMENSION(:), ALLOCATABLE ::   n2dintsurf             ! Interpolation option for surface variables 
    87    REAL(wp), DIMENSION(:), ALLOCATABLE ::   zavglamscl, zavgphiscl ! E/W & N/S diameter of averaging footprint for surface variables 
    88    LOGICAL , DIMENSION(:), ALLOCATABLE ::   lfpindegs              ! T=> surface obs footprint size specified in degrees, F=> in metres 
    89    LOGICAL , DIMENSION(:), ALLOCATABLE ::   llnightav              ! Logical for calculating night-time averages 
    90  
    91    TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) ::   surfdata     !: Initial surface data 
    92    TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) ::   surfdataqc   !: Surface data after quality control 
    93    TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) ::   profdata     !: Initial profile data 
    94    TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) ::   profdataqc   !: Profile data after quality control 
    95  
    96    CHARACTER(len=6), PUBLIC, DIMENSION(:), ALLOCATABLE ::   cobstypesprof, cobstypessurf   !: Profile & surface obs types 
     61   LOGICAL, PUBLIC :: ln_diaobs            !: Logical switch for the obs operator 
     62    
     63   INTEGER :: nn_obsgroups 
     64 
     65   TYPE(obs_group), DIMENSION(:), ALLOCATABLE ::   sobsgroups   ! Obs groups 
    9766 
    9867   !!---------------------------------------------------------------------- 
    … …  
    11483      !! 
    11584      !!---------------------------------------------------------------------- 
    116       INTEGER, PARAMETER ::   jpmaxnfiles = 1000    ! Maximum number of files for each obs type 
    117       INTEGER, DIMENSION(:), ALLOCATABLE ::   ifilesprof, ifilessurf   ! Number of profile & surface files 
     85#if defined key_si3 
     86      USE ice, ONLY : &     ! Sea ice variables 
     87         & hm_s             ! Snow depth for freeboard conversion 
     88#elif defined key_cice 
     89      USE sbc_oce, ONLY : & ! Sea ice variables 
     90         & thick_s          ! Snow depth for freeboard conversion 
     91#endif 
     92      USE obs_fbm, ONLY : & 
     93         & fbrmdi           ! Real missing data indicator 
     94 
     95      IMPLICIT NONE 
     96 
     97      INTEGER, PARAMETER ::   jpmaxngroups = 1000    ! Maximum number of obs groups 
    11898      INTEGER :: ios             ! Local integer output status for namelist read 
    11999      INTEGER :: jtype           ! Counter for obs types 
    120100      INTEGER :: jvar            ! Counter for variables 
    121101      INTEGER :: jfile           ! Counter for files 
    122       INTEGER :: jnumsstbias 
     102      INTEGER :: jenabled 
     103      INTEGER :: jgroup 
    123104      ! 
    124       CHARACTER(len=128), DIMENSION(jpmaxnfiles) :: & 
    125          & cn_profbfiles, &      ! T/S profile input filenames 
    126          & cn_sstfbfiles, &      ! Sea surface temperature input filenames 
    127          & cn_sssfbfiles, &      ! Sea surface salinity input filenames 
    128          & cn_slafbfiles, &      ! Sea level anomaly input filenames 
    129          & cn_sicfbfiles, &      ! Seaice concentration input filenames 
    130          & cn_velfbfiles, &      ! Velocity profile input filenames 
    131          & cn_sstbiasfiles      ! SST bias input filenames 
    132       CHARACTER(LEN=128) :: & 
    133          & cn_altbiasfile        ! Altimeter bias input filename 
    134       CHARACTER(len=128), DIMENSION(:,:), ALLOCATABLE :: & 
    135          & clproffiles, &        ! Profile filenames 
    136          & clsurffiles           ! Surface filenames 
    137          ! 
    138       LOGICAL :: ln_t3d          ! Logical switch for temperature profiles 
    139       LOGICAL :: ln_s3d          ! Logical switch for salinity profiles 
    140       LOGICAL :: ln_sla          ! Logical switch for sea level anomalies  
    141       LOGICAL :: ln_sst          ! Logical switch for sea surface temperature 
    142       LOGICAL :: ln_sss          ! Logical switch for sea surface salinity 
    143       LOGICAL :: ln_sic          ! Logical switch for sea ice concentration 
    144       LOGICAL :: ln_vel3d        ! Logical switch for velocity (u,v) obs 
    145       LOGICAL :: ln_nea          ! Logical switch to remove obs near land 
    146       LOGICAL :: ln_altbias      ! Logical switch for altimeter bias 
    147       LOGICAL :: ln_sstbias      ! Logical switch for bias corection of SST  
    148       LOGICAL :: ln_ignmis       ! Logical switch for ignoring missing files 
    149       LOGICAL :: ln_s_at_t       ! Logical switch to compute model S at T obs 
    150       LOGICAL :: ln_bound_reject ! Logical to remove obs near boundaries in LAMs. 
    151       LOGICAL :: llvar1          ! Logical for profile variable 1 
    152       LOGICAL :: llvar2          ! Logical for profile variable 1 
    153       LOGICAL, DIMENSION(jpmaxnfiles) :: lmask ! Used for finding number of sstbias files 
     105      LOGICAL, DIMENSION(:), ALLOCATABLE :: llvar 
    154106      ! 
    155       REAL(dp) :: rn_dobsini     ! Obs window start date YYYYMMDD.HHMMSS 
    156       REAL(dp) :: rn_dobsend     ! Obs window end date   YYYYMMDD.HHMMSS 
    157       REAL(wp), DIMENSION(jpi,jpj)     ::   zglam1, zglam2   ! Model longitudes for profile variable 1 & 2 
    158       REAL(wp), DIMENSION(jpi,jpj)     ::   zgphi1, zgphi2   ! Model latitudes  for profile variable 1 & 2 
    159       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask1, zmask2   ! Model land/sea mask associated with variable 1 & 2 
    160       !! 
    161       NAMELIST/namobs/ln_diaobs, ln_t3d, ln_s3d, ln_sla,              & 
    162          &            ln_sst, ln_sic, ln_sss, ln_vel3d,               & 
    163          &            ln_altbias, ln_sstbias, ln_nea,                 & 
    164          &            ln_grid_global, ln_grid_search_lookup,          & 
    165          &            ln_ignmis, ln_s_at_t, ln_bound_reject,          & 
    166          &            ln_sstnight,                                    & 
    167          &            ln_sla_fp_indegs, ln_sst_fp_indegs,             & 
    168          &            ln_sss_fp_indegs, ln_sic_fp_indegs,             & 
    169          &            cn_profbfiles, cn_slafbfiles,                   & 
    170          &            cn_sstfbfiles, cn_sicfbfiles,                   & 
    171          &            cn_velfbfiles, cn_sssfbfiles,                   & 
    172          &            cn_sstbiasfiles, cn_altbiasfile,                & 
    173          &            cn_gridsearchfile, rn_gridsearchres,            & 
    174          &            rn_dobsini, rn_dobsend,                         & 
    175          &            rn_sla_avglamscl, rn_sla_avgphiscl,             & 
    176          &            rn_sst_avglamscl, rn_sst_avgphiscl,             & 
    177          &            rn_sss_avglamscl, rn_sss_avgphiscl,             & 
    178          &            rn_sic_avglamscl, rn_sic_avgphiscl,             & 
    179          &            nn_1dint, nn_2dint,                             & 
    180          &            nn_2dint_sla, nn_2dint_sst,                     & 
    181          &            nn_2dint_sss, nn_2dint_sic,                     & 
    182          &            nn_msshc, rn_mdtcorr, rn_mdtcutoff,             & 
    183          &            nn_profdavtypes 
     107      REAL(dp) :: rn_dobsini      ! Obs window start date YYYYMMDD.HHMMSS 
     108      REAL(dp) :: rn_dobsend      ! Obs window end date   YYYYMMDD.HHMMSS 
     109      !! 
     110      NAMELIST/namobs/ln_diaobs, nn_obsgroups,               & 
     111         &            ln_grid_global, ln_grid_search_lookup, & 
     112         &            cn_gridsearchfile, rn_gridsearchres,   & 
     113         &            rn_dobsini, rn_dobsend 
    184114      !----------------------------------------------------------------------- 
    185115 
    … …  
    187117      ! Read namelist parameters 
    188118      !----------------------------------------------------------------------- 
    189       ! Some namelist arrays need initialising 
    190       cn_profbfiles  (:) = '' 
    191       cn_slafbfiles  (:) = '' 
    192       cn_sstfbfiles  (:) = '' 
    193       cn_sicfbfiles  (:) = '' 
    194       cn_velfbfiles  (:) = '' 
    195       cn_sssfbfiles  (:) = '' 
    196       cn_sstbiasfiles(:) = '' 
    197       nn_profdavtypes(:) = -1 
    198  
     119      ! Initialise time window 
    199120      CALL ini_date( rn_dobsini ) 
    200121      CALL fin_date( rn_dobsend ) 
    … …  
    220141         WRITE(numout,*) 'dia_obs_init : Observation diagnostic initialization' 
    221142         WRITE(numout,*) '~~~~~~~~~~~~' 
    222          WRITE(numout,*) '   Namelist namobs : set observation diagnostic parameters'  
    223          WRITE(numout,*) '      Logical switch for T profile observations                ln_t3d = ', ln_t3d 
    224          WRITE(numout,*) '      Logical switch for S profile observations                ln_s3d = ', ln_s3d 
    225          WRITE(numout,*) '      Logical switch for SLA observations                      ln_sla = ', ln_sla 
    226          WRITE(numout,*) '      Logical switch for SST observations                      ln_sst = ', ln_sst 
    227          WRITE(numout,*) '      Logical switch for Sea Ice observations                  ln_sic = ', ln_sic 
    228          WRITE(numout,*) '      Logical switch for velocity observations               ln_vel3d = ', ln_vel3d 
    229          WRITE(numout,*) '      Logical switch for SSS observations                      ln_sss = ', ln_sss 
     143         WRITE(numout,*) '   Namelist namobs : set observation diagnostic parameters' 
     144         WRITE(numout,*) '      Number of namobs_dta namelists to read             nn_obsgroups = ', nn_obsgroups 
    230145         WRITE(numout,*) '      Global distribution of observations              ln_grid_global = ', ln_grid_global 
    231146         WRITE(numout,*) '      Logical switch for obs grid search lookup ln_grid_search_lookup = ', ln_grid_search_lookup 
    232          IF (ln_grid_search_lookup) & 
     147         IF (ln_grid_search_lookup) THEN 
    233148            WRITE(numout,*) '      Grid search lookup file header                cn_gridsearchfile = ', cn_gridsearchfile 
    234          WRITE(numout,*) '      Initial date in window YYYYMMDD.HHMMSS               rn_dobsini = ', rn_dobsini 
    235          WRITE(numout,*) '      Final date in window YYYYMMDD.HHMMSS                 rn_dobsend = ', rn_dobsend 
    236          WRITE(numout,*) '      Type of vertical interpolation method                  nn_1dint = ', nn_1dint 
    237          WRITE(numout,*) '      Type of horizontal interpolation method                nn_2dint = ', nn_2dint 
    238          WRITE(numout,*) '      Rejection of observations near land switch               ln_nea = ', ln_nea 
    239          WRITE(numout,*) '      Rejection of obs near open bdys                 ln_bound_reject = ', ln_bound_reject 
    240          WRITE(numout,*) '      MSSH correction scheme                                 nn_msshc = ', nn_msshc 
    241          WRITE(numout,*) '      MDT  correction                                      rn_mdtcorr = ', rn_mdtcorr 
    242          WRITE(numout,*) '      MDT cutoff for computed correction                 rn_mdtcutoff = ', rn_mdtcutoff 
    243          WRITE(numout,*) '      Logical switch for alt bias                          ln_altbias = ', ln_altbias 
    244          WRITE(numout,*) '      Logical switch for sst bias                          ln_sstbias = ', ln_sstbias 
    245          WRITE(numout,*) '      Logical switch for ignoring missing files             ln_ignmis = ', ln_ignmis 
    246          WRITE(numout,*) '      Daily average types                             nn_profdavtypes = ', nn_profdavtypes 
    247          WRITE(numout,*) '      Logical switch for night-time SST obs               ln_sstnight = ', ln_sstnight 
     149            WRITE(numout,*) '      Grid search resolution                         rn_gridsearchres = ', rn_gridsearchres 
     150         ENDIF 
    248151      ENDIF 
    249       !----------------------------------------------------------------------- 
    250       ! Set up list of observation types to be used 
    251       ! and the files associated with each type 
    252       !----------------------------------------------------------------------- 
    253  
    254       nproftypes = COUNT( (/ln_t3d .OR. ln_s3d, ln_vel3d /) ) 
    255       nsurftypes = COUNT( (/ln_sla, ln_sst, ln_sic, ln_sss /) ) 
    256  
    257       IF( ln_sstbias ) THEN  
    258          lmask(:) = .FALSE.  
    259          WHERE( cn_sstbiasfiles(:) /= '' )   lmask(:) = .TRUE.  
    260          jnumsstbias = COUNT(lmask)  
    261          lmask(:) = .FALSE.  
    262       ENDIF       
    263  
    264       IF( nproftypes == 0 .AND. nsurftypes == 0 ) THEN 
    265          CALL ctl_warn( 'dia_obs_init: ln_diaobs is set to true, but all obs operator logical flags',   & 
    266             &           ' (ln_t3d, ln_s3d, ln_sla, ln_sst, ln_sic, ln_vel3d)',                          & 
    267             &           ' are set to .FALSE. so turning off calls to dia_obs'  ) 
     152 
     153      IF( ln_grid_global ) THEN 
     154         CALL ctl_warn( 'dia_obs_init: ln_grid_global=T may cause memory issues when used with a large number of processors' ) 
     155      ENDIF 
     156 
     157      !----------------------------------------------------------------------- 
     158      ! Read namobs_dta namelists and set up observation groups 
     159      !----------------------------------------------------------------------- 
     160 
     161      IF( nn_obsgroups == 0 ) THEN 
     162         CALL ctl_warn( 'dia_obs_init: ln_diaobs is set to true, but nn_obsgroups == 0',   & 
     163            &           ' so turning off calls to dia_obs'  ) 
    268164         ln_diaobs = .FALSE. 
    269165         RETURN 
    270166      ENDIF 
    271167 
    272       IF( nproftypes > 0 ) THEN 
    273          ! 
    274          ALLOCATE( cobstypesprof(nproftypes)             ) 
    275          ALLOCATE( ifilesprof   (nproftypes)             ) 
    276          ALLOCATE( clproffiles  (nproftypes,jpmaxnfiles) ) 
    277          ! 
    278          jtype = 0 
    279          IF( ln_t3d .OR. ln_s3d ) THEN 
    280             jtype = jtype + 1 
    281             CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'prof  ', & 
    282                &                   cn_profbfiles, ifilesprof, cobstypesprof, clproffiles ) 
     168      ALLOCATE( sobsgroups(nn_obsgroups) ) 
     169 
     170      jenabled = 0 
     171      DO jgroup = 1, nn_obsgroups 
     172         CALL obs_group_read_namelist( sobsgroups(jgroup) ) 
     173         CALL obs_group_check( sobsgroups(jgroup), jgroup ) 
     174         IF (sobsgroups(jgroup)%lenabled) THEN 
     175            jenabled = jenabled + 1 
    283176         ENDIF 
    284          IF( ln_vel3d ) THEN 
    285             jtype = jtype + 1 
    286             CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'vel   ', & 
    287                &                   cn_velfbfiles, ifilesprof, cobstypesprof, clproffiles ) 
    288          ENDIF 
    289          ! 
    290       ENDIF 
    291  
    292       IF( nsurftypes > 0 ) THEN 
    293          ! 
    294          ALLOCATE( cobstypessurf(nsurftypes)             ) 
    295          ALLOCATE( ifilessurf   (nsurftypes)             ) 
    296          ALLOCATE( clsurffiles  (nsurftypes,jpmaxnfiles) ) 
    297          ALLOCATE( n2dintsurf   (nsurftypes)             ) 
    298          ALLOCATE( zavglamscl   (nsurftypes)             ) 
    299          ALLOCATE( zavgphiscl   (nsurftypes)             ) 
    300          ALLOCATE( lfpindegs    (nsurftypes)             ) 
    301          ALLOCATE( llnightav    (nsurftypes)             ) 
    302          ! 
    303          jtype = 0 
    304          IF( ln_sla ) THEN 
    305             jtype = jtype + 1 
    306             CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sla   ', & 
    307                &                   cn_slafbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
    308             CALL obs_setinterpopts( nsurftypes, jtype, 'sla   ',      & 
    309                &                  nn_2dint, nn_2dint_sla,             & 
    310                &                  rn_sla_avglamscl, rn_sla_avgphiscl, & 
    311                &                  ln_sla_fp_indegs, .FALSE.,          & 
    312                &                  n2dintsurf, zavglamscl, zavgphiscl, & 
    313                &                  lfpindegs, llnightav ) 
    314          ENDIF 
    315          IF( ln_sst ) THEN 
    316             jtype = jtype + 1 
    317             CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sst   ', & 
    318                &                   cn_sstfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
    319             CALL obs_setinterpopts( nsurftypes, jtype, 'sst   ',      & 
    320                &                  nn_2dint, nn_2dint_sst,             & 
    321                &                  rn_sst_avglamscl, rn_sst_avgphiscl, & 
    322                &                  ln_sst_fp_indegs, ln_sstnight,      & 
    323                &                  n2dintsurf, zavglamscl, zavgphiscl, & 
    324                &                  lfpindegs, llnightav ) 
    325          ENDIF 
    326 #if defined key_si3 || defined key_cice 
    327          IF( ln_sic ) THEN 
    328             jtype = jtype + 1 
    329             CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sic   ', & 
    330                &                   cn_sicfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
    331             CALL obs_setinterpopts( nsurftypes, jtype, 'sic   ',      & 
    332                &                  nn_2dint, nn_2dint_sic,             & 
    333                &                  rn_sic_avglamscl, rn_sic_avgphiscl, & 
    334                &                  ln_sic_fp_indegs, .FALSE.,          & 
    335                &                  n2dintsurf, zavglamscl, zavgphiscl, & 
    336                &                  lfpindegs, llnightav ) 
    337          ENDIF 
    338 #endif 
    339          IF( ln_sss ) THEN 
    340             jtype = jtype + 1 
    341             CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sss   ', & 
    342                &                   cn_sssfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
    343             CALL obs_setinterpopts( nsurftypes, jtype, 'sss   ',      & 
    344                &                  nn_2dint, nn_2dint_sss,             & 
    345                &                  rn_sss_avglamscl, rn_sss_avgphiscl, & 
    346                &                  ln_sss_fp_indegs, .FALSE.,          & 
    347                &                  n2dintsurf, zavglamscl, zavgphiscl, & 
    348                &                  lfpindegs, llnightav ) 
    349          ENDIF 
    350          ! 
    351       ENDIF 
    352  
    353  
    354       !----------------------------------------------------------------------- 
    355       ! Obs operator parameter checking and initialisations 
    356       !----------------------------------------------------------------------- 
    357       ! 
    358       IF( ln_vel3d  .AND.  .NOT.ln_grid_global ) THEN 
    359          CALL ctl_stop( 'Velocity data only works with ln_grid_global=.true.' ) 
     177      END DO 
     178 
     179      IF( jenabled == 0 ) THEN 
     180         CALL ctl_warn( 'dia_obs_init: ln_diaobs is set to true, and nn_obsgroups > 0',   & 
     181            &           ' but no groups are enabled so turning off calls to dia_obs'  ) 
     182         ln_diaobs = .FALSE. 
    360183         RETURN 
    361184      ENDIF 
    362       ! 
    363       IF( ln_grid_global ) THEN 
    364          CALL ctl_warn( 'dia_obs_init: ln_grid_global=T may cause memory issues when used with a large number of processors' ) 
    365       ENDIF 
    366       ! 
    367       IF( nn_1dint < 0  .OR.  nn_1dint > 1 ) THEN 
    368          CALL ctl_stop('dia_obs_init: Choice of vertical (1D) interpolation method is not available') 
    369       ENDIF 
    370       ! 
    371       IF( nn_2dint < 0  .OR.  nn_2dint > 6  ) THEN 
    372          CALL ctl_stop('dia_obs_init: Choice of horizontal (2D) interpolation method is not available') 
    373       ENDIF 
     185 
     186      !----------------------------------------------------------------------- 
     187      ! Obs operator parameter checking and initialisations 
     188      !----------------------------------------------------------------------- 
    374189      ! 
    375190      CALL obs_typ_init 
    … …  
    382197      !----------------------------------------------------------------------- 
    383198      ! 
    384       IF( nproftypes > 0 ) THEN 
    385          ! 
    386          ALLOCATE( profdata  (nproftypes) , nvarsprof (nproftypes) ) 
    387          ALLOCATE( profdataqc(nproftypes) , nextrprof (nproftypes) ) 
    388          ! 
    389          DO jtype = 1, nproftypes 
    390             ! 
    391             nvarsprof(jtype) = 2 
    392             IF ( TRIM(cobstypesprof(jtype)) == 'prof' ) THEN 
    393                nextrprof(jtype) = 1 
    394                llvar1 = ln_t3d 
    395                llvar2 = ln_s3d 
    396                zglam1 = glamt 
    397                zgphi1 = gphit 
    398                zmask1 = tmask 
    399                zglam2 = glamt 
    400                zgphi2 = gphit 
    401                zmask2 = tmask 
     199      DO jgroup = 1, nn_obsgroups 
     200         IF ( sobsgroups(jgroup)%lenabled ) THEN 
     201            IF ( sobsgroups(jgroup)%lprof ) THEN 
     202               ! 
     203               ! Read in profile or profile obs types 
     204               ! 
     205               ALLOCATE( llvar(sobsgroups(jgroup)%nobstypes) ) 
     206               llvar(:) = .TRUE. 
     207               ! 
     208               CALL obs_rea_prof( sobsgroups(jgroup)%sprofdata,   & 
     209                  &               sobsgroups(jgroup)%nobsfiles,   & 
     210                  &               sobsgroups(jgroup)%cobsfiles,   & 
     211                  &               sobsgroups(jgroup)%nobstypes,   & 
     212                  &               sobsgroups(jgroup)%naddvars,    & 
     213                  &               sobsgroups(jgroup)%nextvars,    & 
     214                  &               nitend-nit000+2,                & 
     215                  &               rn_dobsini,                     & 
     216                  &               rn_dobsend,                     & 
     217                  &               llvar,                          & 
     218                  &               sobsgroups(jgroup)%lignmis,     & 
     219                  &               sobsgroups(jgroup)%lall_at_all, & 
     220                  &               .FALSE.,                        & 
     221                  &               sobsgroups(jgroup)%cobstypes,   & 
     222                  &               kdailyavtypes = sobsgroups(jgroup)%nprofdavtypes ) 
     223               ! 
     224               DO jvar = 1, sobsgroups(jgroup)%nobstypes 
     225                  CALL obs_prof_staend( sobsgroups(jgroup)%sprofdata, jvar ) 
     226               END DO 
     227               ! 
     228               IF ( sobsgroups(jgroup)%sprofdata%next > 0 ) THEN 
     229                  CALL obs_prof_staend_ext( sobsgroups(jgroup)%sprofdata ) 
     230               ENDIF 
     231               ! 
     232               IF( sobsgroups(jgroup)%loutput_clim ) THEN 
     233                  sobsgroups(jgroup)%sprofdata%caddvars(sobsgroups(jgroup)%nadd_clm)  = 'CLM' 
     234                  DO jvar = 1, sobsgroups(jgroup)%nobstypes 
     235                     sobsgroups(jgroup)%sprofdata%var(jvar)%vadd(:,sobsgroups(jgroup)%nadd_clm) = fbrmdi 
     236                     sobsgroups(jgroup)%sprofdata%caddlong(sobsgroups(jgroup)%nadd_clm,jvar) = 'Climatology' 
     237                     sobsgroups(jgroup)%sprofdata%caddunit(sobsgroups(jgroup)%nadd_clm,jvar) = sobsgroups(jgroup)%sprofdata%cunit(jvar) 
     238                  END DO 
     239               ENDIF 
     240               ! 
     241               sobsgroups(jgroup)%sprofdata%cgrid = sobsgroups(jgroup)%cgrid 
     242               ! 
     243               CALL obs_pre_prof( sobsgroups(jgroup)%sprofdata,     & 
     244                  &               sobsgroups(jgroup)%sprofdataqc,   & 
     245                  &               llvar,                            & 
     246                  &               jpi, jpj, jpk,                    & 
     247                  &               sobsgroups(jgroup)%rmask,         & 
     248                  &               sobsgroups(jgroup)%rglam,         & 
     249                  &               sobsgroups(jgroup)%rgphi,         & 
     250                  &               sobsgroups(jgroup)%lnea,          & 
     251                  &               sobsgroups(jgroup)%lbound_reject, & 
     252                  &               kdailyavtypes = sobsgroups(jgroup)%nprofdavtypes ) 
     253               ! 
     254               DEALLOCATE( llvar ) 
     255               ! 
     256            ELSEIF (sobsgroups(jgroup)%lsurf) THEN 
     257               ! 
     258               ! Read in surface obs types 
     259               ! 
     260               CALL obs_rea_surf( sobsgroups(jgroup)%ssurfdata,         & 
     261                  &               sobsgroups(jgroup)%nobsfiles,         & 
     262                  &               sobsgroups(jgroup)%cobsfiles,         & 
     263                  &               sobsgroups(jgroup)%nobstypes,         & 
     264                  &               sobsgroups(jgroup)%naddvars,          & 
     265                  &               sobsgroups(jgroup)%nextvars,          & 
     266                  &               nitend-nit000+2,                      & 
     267                  &               rn_dobsini,                           & 
     268                  &               rn_dobsend,                           & 
     269                  &               sobsgroups(jgroup)%rtime_mean_period, & 
     270                  &               sobsgroups(jgroup)%ltime_mean_bkg,    & 
     271                  &               sobsgroups(jgroup)%lignmis,           & 
     272                  &               .FALSE.,                              & 
     273                  &               sobsgroups(jgroup)%lnight,            & 
     274                  &               sobsgroups(jgroup)%cobstypes ) 
     275               ! 
     276               IF( sobsgroups(jgroup)%lsla ) THEN 
     277                  sobsgroups(jgroup)%ssurfdata%cextvars(sobsgroups(jgroup)%next_mdt) = 'MDT' 
     278                  sobsgroups(jgroup)%ssurfdata%cextlong(sobsgroups(jgroup)%next_mdt) = 'Mean dynamic topography' 
     279                  sobsgroups(jgroup)%ssurfdata%cextunit(sobsgroups(jgroup)%next_mdt) = 'Metres' 
     280                  sobsgroups(jgroup)%ssurfdata%caddvars(sobsgroups(jgroup)%nadd_ssh) = 'SSH' 
     281                  DO jvar = 1, sobsgroups(jgroup)%nobstypes 
     282                     sobsgroups(jgroup)%ssurfdata%caddlong(sobsgroups(jgroup)%nadd_ssh,jvar) = 'Model Sea surface height' 
     283                     sobsgroups(jgroup)%ssurfdata%caddunit(sobsgroups(jgroup)%nadd_ssh,jvar) = 'Metres' 
     284                  END DO 
     285               ENDIF 
     286               ! 
     287               IF( sobsgroups(jgroup)%lfbd ) THEN 
     288                  sobsgroups(jgroup)%ssurfdata%cextvars(sobsgroups(jgroup)%next_snow) = 'SNOW' 
     289                  sobsgroups(jgroup)%ssurfdata%cextlong(sobsgroups(jgroup)%next_snow) = 'Snow thickness' 
     290                  sobsgroups(jgroup)%ssurfdata%cextunit(sobsgroups(jgroup)%next_snow) = 'Metres' 
     291                  sobsgroups(jgroup)%ssurfdata%caddvars(sobsgroups(jgroup)%nadd_fbd)  = 'FBD' 
     292                  DO jvar = 1, sobsgroups(jgroup)%nobstypes 
     293                     sobsgroups(jgroup)%ssurfdata%caddlong(sobsgroups(jgroup)%nadd_fbd,jvar) = 'Freeboard' 
     294                     sobsgroups(jgroup)%ssurfdata%caddunit(sobsgroups(jgroup)%nadd_fbd,jvar) = 'Metres' 
     295                  END DO 
     296               ENDIF 
     297               ! 
     298               IF( sobsgroups(jgroup)%loutput_clim ) THEN 
     299                  sobsgroups(jgroup)%ssurfdata%caddvars(sobsgroups(jgroup)%nadd_clm)  = 'CLM' 
     300                  DO jvar = 1, sobsgroups(jgroup)%nobstypes 
     301                     sobsgroups(jgroup)%ssurfdata%radd(:,:,jvar) = fbrmdi 
     302                     sobsgroups(jgroup)%ssurfdata%caddlong(sobsgroups(jgroup)%nadd_clm,jvar) = 'Climatology' 
     303                     sobsgroups(jgroup)%ssurfdata%caddunit(sobsgroups(jgroup)%nadd_clm,jvar) = sobsgroups(jgroup)%ssurfdata%cunit(jvar) 
     304                  END DO 
     305               ENDIF 
     306               ! 
     307               sobsgroups(jgroup)%ssurfdata%cgrid = sobsgroups(jgroup)%cgrid 
     308               ! 
     309               CALL obs_pre_surf( sobsgroups(jgroup)%ssurfdata,      & 
     310                  &               sobsgroups(jgroup)%ssurfdataqc,    & 
     311                  &               jpi, jpj,                          & 
     312                  &               sobsgroups(jgroup)%rmask(:,:,1,:), & 
     313                  &               sobsgroups(jgroup)%rglam,          & 
     314                  &               sobsgroups(jgroup)%rgphi,          & 
     315                  &               sobsgroups(jgroup)%lnea,           & 
     316                  &               sobsgroups(jgroup)%lbound_reject ) 
     317               ! 
     318               IF( sobsgroups(jgroup)%lsla ) THEN 
     319                  CALL obs_rea_mdt( sobsgroups(jgroup)%ssurfdataqc, & 
     320                     &              sobsgroups(jgroup)%n2dint,      & 
     321                     &              sobsgroups(jgroup)%next_mdt,    & 
     322                     &              sobsgroups(jgroup)%nmsshc,      & 
     323                     &              sobsgroups(jgroup)%rmdtcorr,    & 
     324                     &              sobsgroups(jgroup)%rmdtcutoff ) 
     325                  IF( sobsgroups(jgroup)%laltbias ) THEN 
     326                     CALL obs_app_bias( sobsgroups(jgroup)%ssurfdataqc,   & 
     327                        &               sobsgroups(jgroup)%next_mdt,      &  
     328                        &               sobsgroups(jgroup)%n2dint,        &  
     329                        &               1,                                & 
     330                        &               sobsgroups(jgroup)%caltbiasfile,  & 
     331                        &               'altbias',                        & 
     332                        &               ld_extvar=.TRUE. )  
     333                  ENDIF 
     334               ENDIF 
     335               ! 
     336#if defined key_si3 
     337               IF( sobsgroups(jgroup)%lfbd ) THEN 
     338                  CALL obs_rea_snowdepth( sobsgroups(jgroup)%ssurfdataqc, & 
     339                     &                    sobsgroups(jgroup)%n2dint,      & 
     340                     &                    sobsgroups(jgroup)%next_snow,   & 
     341                     &                    hm_s(:,:) ) 
     342               ENDIF 
     343#elif defined key_cice 
     344               IF( sobsgroups(jgroup)%lfbd ) THEN 
     345                  CALL obs_rea_snowdepth( sobsgroups(jgroup)%ssurfdataqc, & 
     346                     &                    sobsgroups(jgroup)%n2dint,      & 
     347                     &                    sobsgroups(jgroup)%next_snow,   & 
     348                     &                    thick_s(:,:) ) 
     349               ENDIF 
     350#endif 
     351               ! 
     352               IF( sobsgroups(jgroup)%lobsbias ) THEN 
     353                  CALL obs_app_bias( sobsgroups(jgroup)%ssurfdataqc,   & 
     354                     &               sobsgroups(jgroup)%nbiasvar,      &  
     355                     &               sobsgroups(jgroup)%n2dint,        &  
     356                     &               sobsgroups(jgroup)%nobsbiasfiles, & 
     357                     &               sobsgroups(jgroup)%cobsbiasfiles, & 
     358                     &               sobsgroups(jgroup)%cbiasvarname )  
     359               ENDIF 
     360               ! 
    402361            ENDIF 
    403             IF ( TRIM(cobstypesprof(jtype)) == 'vel' )  THEN 
    404                nextrprof(jtype) = 2 
    405                llvar1 = ln_vel3d 
    406                llvar2 = ln_vel3d 
    407                zglam1 = glamu 
    408                zgphi1 = gphiu 
    409                zmask1 = umask 
    410                zglam2 = glamv 
    411                zgphi2 = gphiv 
    412                zmask2 = vmask 
    413             ENDIF 
    414             ! 
    415             ! Read in profile or profile obs types 
    416             CALL obs_rea_prof( profdata(jtype), ifilesprof(jtype),       & 
    417                &               clproffiles(jtype,1:ifilesprof(jtype)), & 
    418                &               nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, & 
    419                &               rn_dobsini, rn_dobsend, llvar1, llvar2, & 
    420                &               ln_ignmis, ln_s_at_t, .FALSE., & 
    421                &               kdailyavtypes = nn_profdavtypes ) 
    422                ! 
    423             DO jvar = 1, nvarsprof(jtype) 
    424                CALL obs_prof_staend( profdata(jtype), jvar ) 
    425             END DO 
    426             ! 
    427             CALL obs_pre_prof( profdata(jtype), profdataqc(jtype), & 
    428                &               llvar1, llvar2, & 
    429                &               jpi, jpj, jpk, & 
    430                &               zmask1, zglam1, zgphi1, zmask2, zglam2, zgphi2,  & 
    431                &               ln_nea, ln_bound_reject, & 
    432                &               kdailyavtypes = nn_profdavtypes ) 
    433          END DO 
    434          ! 
    435          DEALLOCATE( ifilesprof, clproffiles ) 
    436          ! 
    437       ENDIF 
    438       ! 
    439       IF( nsurftypes > 0 ) THEN 
    440          ! 
    441          ALLOCATE( surfdata  (nsurftypes) , nvarssurf(nsurftypes) ) 
    442          ALLOCATE( surfdataqc(nsurftypes) , nextrsurf(nsurftypes) ) 
    443          ! 
    444          DO jtype = 1, nsurftypes 
    445             ! 
    446             nvarssurf(jtype) = 1 
    447             nextrsurf(jtype) = 0 
    448             llnightav(jtype) = .FALSE. 
    449             IF( TRIM(cobstypessurf(jtype)) == 'sla' )   nextrsurf(jtype) = 2 
    450             IF( TRIM(cobstypessurf(jtype)) == 'sst' )   llnightav(jtype) = ln_sstnight 
    451             ! 
    452             ! Read in surface obs types 
    453             CALL obs_rea_surf( surfdata(jtype), ifilessurf(jtype), & 
    454                &               clsurffiles(jtype,1:ifilessurf(jtype)), & 
    455                &               nvarssurf(jtype), nextrsurf(jtype), nitend-nit000+2, & 
    456                &               rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav(jtype) ) 
    457                ! 
    458             CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea, ln_bound_reject ) 
    459             ! 
    460             IF( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN 
    461                CALL obs_rea_mdt( surfdataqc(jtype), n2dintsurf(jtype) ) 
    462                IF( ln_altbias )   & 
    463                   & CALL obs_rea_altbias ( surfdataqc(jtype), n2dintsurf(jtype), cn_altbiasfile ) 
    464             ENDIF 
    465             ! 
    466             IF( TRIM(cobstypessurf(jtype)) == 'sst' .AND. ln_sstbias ) THEN 
    467                jnumsstbias = 0 
    468                DO jfile = 1, jpmaxnfiles 
    469                   IF( TRIM(cn_sstbiasfiles(jfile)) /= '' )   jnumsstbias = jnumsstbias + 1 
    470                END DO 
    471                IF( jnumsstbias == 0 )   CALL ctl_stop("ln_sstbias set but no bias files to read in")     
    472                ! 
    473                CALL obs_app_sstbias( surfdataqc(jtype), n2dintsurf(jtype)             ,   &  
    474                   &                  jnumsstbias      , cn_sstbiasfiles(1:jnumsstbias) )  
    475             ENDIF 
    476          END DO 
    477          ! 
    478          DEALLOCATE( ifilessurf, clsurffiles ) 
    479          ! 
    480       ENDIF 
     362         ENDIF 
     363      END DO 
    481364      ! 
    482365   END SUBROUTINE dia_obs_init 
    … …  
    500383      USE oce    , ONLY : tsn, un, vn, sshn   ! Ocean dynamics and tracers variables 
    501384      USE phycst , ONLY : rday                ! Physical constants 
    502 #if defined  key_si3 
    503       USE ice    , ONLY : at_i                ! SI3 Ice model variables 
     385#if defined key_si3 
     386      USE ice    , ONLY : at_i, hm_i          ! SI3 Ice model variables 
     387#elif defined key_cice 
     388      USE sbc_oce, ONLY : fr_i, thick_i       ! CICE Ice model variables 
    504389#endif 
    505 #if defined key_cice 
    506       USE sbc_oce, ONLY : fr_i     ! ice fraction 
    507 #endif 
     390      USE tradmp,  ONLY : tclim, sclim        ! T&S climatology 
     391      USE obs_fbm, ONLY : fbrmdi              ! Real missing data indicator 
    508392 
    509393      IMPLICIT NONE 
    … …  
    513397      !! * Local declarations 
    514398      INTEGER :: idaystp           ! Number of timesteps per day 
     399      INTEGER :: imeanstp          ! Number of timesteps for time averaging 
    515400      INTEGER :: jtype             ! Data loop variable 
    516401      INTEGER :: jvar              ! Variable number 
    517       INTEGER :: ji, jj            ! Loop counters 
    518       REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 
    519          & zprofvar1, &            ! Model values for 1st variable in a prof ob 
    520          & zprofvar2               ! Model values for 2nd variable in a prof ob 
    521       REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 
    522          & zprofmask1, &           ! Mask associated with zprofvar1 
    523          & zprofmask2              ! Mask associated with zprofvar2 
    524       REAL(wp), DIMENSION(jpi,jpj) :: & 
    525          & zsurfvar, &             ! Model values equivalent to surface ob. 
    526          & zsurfmask               ! Mask associated with surface variable 
    527       REAL(wp), DIMENSION(jpi,jpj) :: & 
    528          & zglam1,    &            ! Model longitudes for prof variable 1 
    529          & zglam2,    &            ! Model longitudes for prof variable 2 
    530          & zgphi1,    &            ! Model latitudes for prof variable 1 
    531          & zgphi2                  ! Model latitudes for prof variable 2 
    532  
    533       !----------------------------------------------------------------------- 
     402      INTEGER :: jgroup 
     403      INTEGER :: ji, jj, jobs      ! Loop counters 
     404      LOGICAL :: lstp0             ! Flag special treatment on zeroth time step 
     405      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
     406         & zprofvar, &             ! Model values for variables in a prof ob 
     407         & zprofclim               ! Climatology values for variables in a prof ob 
     408      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: & 
     409         & zsurfvar, &             ! Model values for variables in a surf ob 
     410         & zsurfclim               ! Climatology values for variables in a surf ob 
     411 
     412      !----------------------------------------------------------------------- 
     413 
     414      IF( ln_timing )   CALL timing_start('dia_obs') 
    534415 
    535416      IF(lwp) THEN 
    … …  
    545426      !----------------------------------------------------------------------- 
    546427 
    547       IF ( nproftypes > 0 ) THEN 
    548  
    549          DO jtype = 1, nproftypes 
    550  
    551             SELECT CASE ( TRIM(cobstypesprof(jtype)) ) 
    552             CASE('prof') 
    553                zprofvar1(:,:,:) = tsn(:,:,:,jp_tem) 
    554                zprofvar2(:,:,:) = tsn(:,:,:,jp_sal) 
    555                zprofmask1(:,:,:) = tmask(:,:,:) 
    556                zprofmask2(:,:,:) = tmask(:,:,:) 
    557                zglam1(:,:) = glamt(:,:) 
    558                zglam2(:,:) = glamt(:,:) 
    559                zgphi1(:,:) = gphit(:,:) 
    560                zgphi2(:,:) = gphit(:,:) 
    561             CASE('vel') 
    562                zprofvar1(:,:,:) = un(:,:,:) 
    563                zprofvar2(:,:,:) = vn(:,:,:) 
    564                zprofmask1(:,:,:) = umask(:,:,:) 
    565                zprofmask2(:,:,:) = vmask(:,:,:) 
    566                zglam1(:,:) = glamu(:,:) 
    567                zglam2(:,:) = glamv(:,:) 
    568                zgphi1(:,:) = gphiu(:,:) 
    569                zgphi2(:,:) = gphiv(:,:) 
    570             CASE DEFAULT 
    571                CALL ctl_stop( 'Unknown profile observation type '//TRIM(cobstypesprof(jtype))//' in dia_obs' ) 
    572             END SELECT 
    573  
    574             CALL obs_prof_opt( profdataqc(jtype), kstp, jpi, jpj, jpk,  & 
    575                &               nit000, idaystp,                         & 
    576                &               zprofvar1, zprofvar2,                    & 
    577                &               gdept_n(:,:,:), gdepw_n(:,:,:),            &  
    578                &               zprofmask1, zprofmask2,                  & 
    579                &               zglam1, zglam2, zgphi1, zgphi2,          & 
    580                &               nn_1dint, nn_2dint,                      & 
    581                &               kdailyavtypes = nn_profdavtypes ) 
    582  
    583          END DO 
    584  
    585       ENDIF 
    586  
    587       IF ( nsurftypes > 0 ) THEN 
    588  
    589          DO jtype = 1, nsurftypes 
    590  
    591             !Defaults which might be changed 
    592             zsurfmask(:,:) = tmask(:,:,1) 
    593  
    594             SELECT CASE ( TRIM(cobstypessurf(jtype)) ) 
    595             CASE('sst') 
    596                zsurfvar(:,:) = tsn(:,:,1,jp_tem) 
    597             CASE('sla') 
    598                zsurfvar(:,:) = sshn(:,:) 
    599             CASE('sss') 
    600                zsurfvar(:,:) = tsn(:,:,1,jp_sal) 
    601             CASE('sic') 
    602                IF ( kstp == 0 ) THEN 
    603                   IF ( lwp .AND. surfdataqc(jtype)%nsstpmpp(1) > 0 ) THEN 
    604                      CALL ctl_warn( 'Sea-ice not initialised on zeroth '// & 
    605                         &           'time-step but some obs are valid then.' ) 
    606                      WRITE(numout,*)surfdataqc(jtype)%nsstpmpp(1), & 
    607                         &           ' sea-ice obs will be missed' 
     428      ALLOCATE( zprofvar(jpi,jpj,jpk),  & 
     429         &      zprofclim(jpi,jpj,jpk), & 
     430         &      zsurfvar(jpi,jpj),      & 
     431         &      zsurfclim(jpi,jpj) ) 
     432 
     433      DO jgroup = 1, nn_obsgroups 
     434         IF ( sobsgroups(jgroup)%lenabled ) THEN 
     435 
     436            IF ( sobsgroups(jgroup)%lprof ) THEN 
     437 
     438               zprofclim(:,:,:) = fbrmdi 
     439 
     440               DO jvar = 1, sobsgroups(jgroup)%nobstypes 
     441 
     442                  SELECT CASE ( TRIM(sobsgroups(jgroup)%cobstypes(jvar)) ) 
     443                  CASE('POTM') 
     444                     zprofvar(:,:,:) = tsn(:,:,:,jp_tem) 
     445                     IF (sobsgroups(jgroup)%loutput_clim) THEN 
     446                        zprofclim(:,:,:) = tclim(:,:,:) 
     447                     ENDIF 
     448                  CASE('PSAL') 
     449                     zprofvar(:,:,:) = tsn(:,:,:,jp_sal) 
     450                     IF (sobsgroups(jgroup)%loutput_clim) THEN 
     451                        zprofclim(:,:,:) = sclim(:,:,:) 
     452                     ENDIF 
     453                  CASE('UVEL') 
     454                     zprofvar(:,:,:) = un(:,:,:) 
     455                  CASE('VVEL') 
     456                     zprofvar(:,:,:) = vn(:,:,:) 
     457                  CASE DEFAULT 
     458                     CALL ctl_stop( 'Unknown profile observation type '//TRIM(sobsgroups(jgroup)%cobstypes(jvar))//' in dia_obs' ) 
     459                  END SELECT 
     460 
     461                  CALL obs_prof_opt( sobsgroups(jgroup)%sprofdataqc,       & 
     462                     &               kstp, jpi, jpj, jpk,                  & 
     463                     &               nit000, idaystp, jvar,                & 
     464                     &               zprofvar,                             & 
     465                     &               sobsgroups(jgroup)%loutput_clim,      & 
     466                     &               sobsgroups(jgroup)%nadd_clm,          & 
     467                     &               zprofclim,                            & 
     468                     &               gdept_n,                              & 
     469                     &               gdepw_n,                              &  
     470                     &               sobsgroups(jgroup)%rmask(:,:,:,jvar), & 
     471                     &               sobsgroups(jgroup)%rglam(:,:,jvar),   & 
     472                     &               sobsgroups(jgroup)%rgphi(:,:,jvar),   & 
     473                     &               sobsgroups(jgroup)%n1dint,            & 
     474                     &               sobsgroups(jgroup)%n2dint,            & 
     475                     &               kdailyavtypes = sobsgroups(jgroup)%nprofdavtypes ) 
     476 
     477               END DO 
     478 
     479            ELSEIF (sobsgroups(jgroup)%lsurf) THEN 
     480 
     481               zsurfclim(:,:) = fbrmdi 
     482 
     483               DO jvar = 1, sobsgroups(jgroup)%nobstypes 
     484 
     485                  lstp0 = .FALSE. 
     486                  SELECT CASE ( TRIM(sobsgroups(jgroup)%cobstypes(jvar)) ) 
     487                  CASE('SST') 
     488                     zsurfvar(:,:) = tsn(:,:,1,jp_tem) 
     489                     IF (sobsgroups(jgroup)%loutput_clim) THEN 
     490                        zsurfclim(:,:) = tclim(:,:,1) 
     491                     ENDIF 
     492                  CASE('SLA') 
     493                     zsurfvar(:,:) = sshn(:,:) 
     494                  CASE('SSS') 
     495                     zsurfvar(:,:) = tsn(:,:,1,jp_sal) 
     496                     IF (sobsgroups(jgroup)%loutput_clim) THEN 
     497                        zsurfclim(:,:) = sclim(:,:,1) 
     498                     ENDIF 
     499                  CASE('UVEL') 
     500                     zsurfvar(:,:) = un(:,:,1) 
     501                  CASE('VVEL') 
     502                     zsurfvar(:,:) = vn(:,:,1) 
     503                  CASE('ICECONC') 
     504                     IF ( kstp == 0 ) THEN 
     505                        lstp0 = .TRUE. 
     506                     ELSE 
     507#if defined key_si3 
     508                        zsurfvar(:,:) = at_i(:,:) 
     509#elif defined key_cice 
     510                        zsurfvar(:,:) = fr_i(:,:) 
     511#else 
     512                        CALL ctl_stop( ' Trying to run sea-ice observation operator', & 
     513                           &           ' but no sea-ice model appears to have been defined' ) 
     514#endif 
     515                     ENDIF 
     516                  CASE('SIT','FBD') 
     517                     IF ( kstp == 0 ) THEN 
     518                        lstp0 = .TRUE. 
     519                     ELSE 
     520#if defined key_si3 
     521                        zsurfvar(:,:) = hm_i(:,:) 
     522#elif defined key_cice 
     523                        zsurfvar(:,:) = thick_i(:,:) 
     524#else 
     525                        CALL ctl_stop( ' Trying to run sea-ice observation operator', & 
     526                           &           ' but no sea-ice model appears to have been defined' ) 
     527#endif 
     528                     ENDIF 
     529                  END SELECT 
     530 
     531                  IF ( lstp0 ) THEN 
     532                     IF ( sobsgroups(jgroup)%ssurfdataqc%nsstpmpp(1) > 0 ) THEN 
     533                        DO jobs = sobsgroups(jgroup)%ssurfdataqc%nsurfup + 1, & 
     534                           &      sobsgroups(jgroup)%ssurfdataqc%nsurfup + sobsgroups(jgroup)%ssurfdataqc%nsstp(1) 
     535                           sobsgroups(jgroup)%ssurfdata%nqc(jobs) = IBSET(sobsgroups(jgroup)%ssurfdata%nqc(jobs),13) 
     536                        END DO 
     537                        IF ( lwp ) THEN 
     538                           CALL ctl_warn( TRIM(sobsgroups(jgroup)%cobstypes(jvar))// & 
     539                              &           ' not initialised on zeroth '           // & 
     540                              &           'time-step but some obs are valid then.' ) 
     541                           WRITE(numout,*)sobsgroups(jgroup)%ssurfdataqc%nsstpmpp(1), & 
     542                              &           TRIM(sobsgroups(jgroup)%cobstypes(jvar)),   & 
     543                              &           'observations will be flagged as bad' 
     544                        ENDIF 
     545                     ENDIF 
     546                     IF ( jvar == sobsgroups(jgroup)%ssurfdataqc%nvar ) THEN 
     547                        sobsgroups(jgroup)%ssurfdataqc%nsurfup = sobsgroups(jgroup)%ssurfdataqc%nsurfup + & 
     548                           &                                     sobsgroups(jgroup)%ssurfdataqc%nsstp(1) 
     549                     ENDIF 
     550                  ELSE 
     551                     IF ( sobsgroups(jgroup)%ltime_mean_bkg ) THEN 
     552                        ! Number of time-steps in meaning period 
     553                        imeanstp = NINT( ( sobsgroups(jgroup)%rtime_mean_period * 60.0 * 60.0 ) / rdt ) 
     554                     ENDIF 
     555                     CALL obs_surf_opt( sobsgroups(jgroup)%ssurfdataqc,       & 
     556                        &               kstp, jpi, jpj,                       & 
     557                        &               nit000, idaystp,                      & 
     558                        &               jvar, zsurfvar,                       & 
     559                        &               sobsgroups(jgroup)%loutput_clim,      & 
     560                        &               sobsgroups(jgroup)%nadd_clm,          & 
     561                        &               zsurfclim,                            & 
     562                        &               sobsgroups(jgroup)%rmask(:,:,1,jvar), & 
     563                        &               sobsgroups(jgroup)%n2dint,            & 
     564                        &               sobsgroups(jgroup)%lnight,            & 
     565                        &               sobsgroups(jgroup)%ravglamscl,        & 
     566                        &               sobsgroups(jgroup)%ravgphiscl,        & 
     567                        &               sobsgroups(jgroup)%lfp_indegs,        & 
     568                        &               sobsgroups(jgroup)%ltime_mean_bkg,    & 
     569                        &               imeanstp,                             & 
     570                        &               kssh=sobsgroups(jgroup)%nadd_ssh,     & 
     571                        &               kmdt=sobsgroups(jgroup)%next_mdt,     & 
     572                        &               kfbd=sobsgroups(jgroup)%nadd_fbd,     & 
     573                        &               ksnow=sobsgroups(jgroup)%next_snow ) 
    608574                  ENDIF 
    609                   surfdataqc(jtype)%nsurfup = surfdataqc(jtype)%nsurfup + & 
    610                      &                        surfdataqc(jtype)%nsstp(1) 
    611                   CYCLE 
    612                ELSE 
    613 #if defined key_cice || defined key_si3 
    614                   zsurfvar(:,:) = fr_i(:,:) 
    615 #else 
    616                   CALL ctl_stop( ' Trying to run sea-ice observation operator', & 
    617                      &           ' but no sea-ice model appears to have been defined' ) 
    618 #endif 
    619                ENDIF 
    620  
    621             END SELECT 
    622  
    623             CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj,       & 
    624                &               nit000, idaystp, zsurfvar, zsurfmask,    & 
    625                &               n2dintsurf(jtype), llnightav(jtype),     & 
    626                &               zavglamscl(jtype), zavgphiscl(jtype),     & 
    627                &               lfpindegs(jtype) ) 
    628  
    629          END DO 
    630  
    631       ENDIF 
     575 
     576               END DO 
     577 
     578            ENDIF 
     579 
     580         ENDIF 
     581      END DO 
     582 
     583      DEALLOCATE( zprofvar, zprofclim, & 
     584         &        zsurfvar, zsurfclim ) 
     585 
     586      IF( ln_timing )   CALL timing_stop('dia_obs') 
    632587 
    633588   END SUBROUTINE dia_obs 
    … …  
    657612 
    658613      !! * Local declarations 
    659       INTEGER :: jtype                    ! Data set loop variable 
    660       INTEGER :: jo, jvar, jk 
     614      INTEGER :: jgroup                   ! Data set loop variable 
     615      INTEGER :: jo, jvar, jk, jadd, jext, jadd2, jext2 
     616      INTEGER :: iuvar, ivvar 
    661617      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    662618         & zu, & 
    663619         & zv 
     620      LOGICAL, DIMENSION(:), ALLOCATABLE :: ll_write 
     621      TYPE(obswriinfo) :: sladd, slext 
     622 
     623      IF( ln_timing )   CALL timing_start('dia_obs_wri') 
    664624 
    665625      !----------------------------------------------------------------------- 
    … …  
    667627      !----------------------------------------------------------------------- 
    668628 
    669       IF ( nproftypes > 0 ) THEN 
    670  
    671          DO jtype = 1, nproftypes 
    672  
    673             IF ( TRIM(cobstypesprof(jtype)) == 'vel' ) THEN 
    674  
    675                ! For velocity data, rotate the model velocities to N/S, E/W 
    676                ! using the compressed data structure. 
    677                ALLOCATE( & 
    678                   & zu(profdataqc(jtype)%nvprot(1)), & 
    679                   & zv(profdataqc(jtype)%nvprot(2))  & 
    680                   & ) 
    681  
    682                CALL obs_rotvel( profdataqc(jtype), nn_2dint, zu, zv ) 
    683  
    684                DO jo = 1, profdataqc(jtype)%nprof 
    685                   DO jvar = 1, 2 
    686                      DO jk = profdataqc(jtype)%npvsta(jo,jvar), profdataqc(jtype)%npvend(jo,jvar) 
    687  
    688                         IF ( jvar == 1 ) THEN 
    689                            profdataqc(jtype)%var(jvar)%vmod(jk) = zu(jk) 
    690                         ELSE 
    691                            profdataqc(jtype)%var(jvar)%vmod(jk) = zv(jk) 
     629      DO jgroup = 1, nn_obsgroups 
     630         IF (sobsgroups(jgroup)%lenabled) THEN 
     631 
     632            IF (sobsgroups(jgroup)%lprof) THEN 
     633 
     634               IF (sobsgroups(jgroup)%lvel) THEN 
     635                  iuvar = 0 
     636                  ivvar = 0 
     637                  DO jvar = 1, sobsgroups(jgroup)%nobstypes 
     638                     IF ( TRIM(sobsgroups(jgroup)%cobstypes(jvar)) == cobsname_uvel ) THEN 
     639                        iuvar = jvar 
     640                     ELSEIF ( TRIM(sobsgroups(jgroup)%cobstypes(jvar)) == cobsname_vvel ) THEN 
     641                        ivvar = jvar 
     642                     ENDIF 
     643                  END DO 
     644                  IF ( (iuvar > 0) .AND. (ivvar > 0) ) THEN 
     645 
     646                     ! For velocity data, rotate the model velocities to N/S, E/W 
     647                     ! using the compressed data structure. 
     648                     ALLOCATE( & 
     649                        & zu(sobsgroups(jgroup)%sprofdataqc%nvprot(iuvar)), & 
     650                        & zv(sobsgroups(jgroup)%sprofdataqc%nvprot(ivvar))  & 
     651                        & ) 
     652 
     653                     CALL obs_rotvel_pro( sobsgroups(jgroup)%sprofdataqc, sobsgroups(jgroup)%n2dint, & 
     654                        &                 iuvar, ivvar, zu, zv ) 
     655 
     656                     DO jo = 1, sobsgroups(jgroup)%sprofdataqc%nprof 
     657                        DO jk = sobsgroups(jgroup)%sprofdataqc%npvsta(jo,iuvar), sobsgroups(jgroup)%sprofdataqc%npvend(jo,iuvar) 
     658                           sobsgroups(jgroup)%sprofdataqc%var(iuvar)%vmod(jk) = zu(jk) 
     659                        END DO 
     660                        DO jk = sobsgroups(jgroup)%sprofdataqc%npvsta(jo,ivvar), sobsgroups(jgroup)%sprofdataqc%npvend(jo,ivvar) 
     661                           sobsgroups(jgroup)%sprofdataqc%var(ivvar)%vmod(jk) = zv(jk) 
     662                        END DO 
     663                     END DO 
     664 
     665                     DEALLOCATE( zu ) 
     666                     DEALLOCATE( zv ) 
     667 
     668                  ELSE 
     669                     CALL ctl_stop( 'Could not identify velocity observation variables to rotate' ) 
     670                  END IF 
     671               END IF 
     672 
     673               CALL obs_prof_decompress( sobsgroups(jgroup)%sprofdataqc, & 
     674                  &                      sobsgroups(jgroup)%sprofdata, .TRUE., numout ) 
     675 
     676               ! Put additional and extra variable information into obswriinfo structure 
     677               ! used by obs_write. 
     678               ! add/ext variables generated by the OBS code (1...sobsgroups(jgroup)%naddvars) 
     679               ! may duplicate ones read in (%naddvars+1...sobsgroups(jgroup)%sprofdata%nadd) 
     680               ! Check for this, and if so only write out the version generated by the OBS code 
     681               sladd%inum = sobsgroups(jgroup)%sprofdata%nadd 
     682               ALLOCATE( ll_write(sobsgroups(jgroup)%sprofdata%nadd) ) 
     683               ll_write(:) = .TRUE. 
     684               IF ( (sobsgroups(jgroup)%naddvars > 0) .AND. & 
     685                  & (sobsgroups(jgroup)%sprofdata%nadd > sobsgroups(jgroup)%naddvars) ) THEN 
     686                  DO jadd = sobsgroups(jgroup)%naddvars + 1, sobsgroups(jgroup)%sprofdata%nadd 
     687                     DO jadd2 = 1, sobsgroups(jgroup)%naddvars 
     688                        IF ( TRIM(sobsgroups(jgroup)%sprofdata%caddvars(jadd )) == & 
     689                           & TRIM(sobsgroups(jgroup)%sprofdata%caddvars(jadd2)) ) THEN 
     690                           sladd%inum = sladd%inum - 1 
     691                           ll_write(jadd) = .FALSE. 
    692692                        ENDIF 
    693  
    694693                     END DO 
    695694                  END DO 
    696                END DO 
    697  
    698                DEALLOCATE( zu ) 
    699                DEALLOCATE( zv ) 
    700  
    701             END IF 
    702  
    703             CALL obs_prof_decompress( profdataqc(jtype), & 
    704                &                      profdata(jtype), .TRUE., numout ) 
    705  
    706             CALL obs_wri_prof( profdata(jtype) ) 
    707  
    708          END DO 
    709  
    710       ENDIF 
    711  
    712       IF ( nsurftypes > 0 ) THEN 
    713  
    714          DO jtype = 1, nsurftypes 
    715  
    716             CALL obs_surf_decompress( surfdataqc(jtype), & 
    717                &                      surfdata(jtype), .TRUE., numout ) 
    718  
    719             CALL obs_wri_surf( surfdata(jtype) ) 
    720  
    721          END DO 
    722  
    723       ENDIF 
     695               ENDIF 
     696               IF ( sladd%inum > 0 ) THEN 
     697                  ALLOCATE( sladd%ipoint(sladd%inum),                                   & 
     698                     &      sladd%cdname(sladd%inum),                                   & 
     699                     &      sladd%cdlong(sladd%inum,sobsgroups(jgroup)%sprofdata%nvar), & 
     700                     &      sladd%cdunit(sladd%inum,sobsgroups(jgroup)%sprofdata%nvar) ) 
     701                  jadd2 = 0 
     702                  DO jadd = 1, sobsgroups(jgroup)%sprofdata%nadd 
     703                     IF ( ll_write(jadd) ) THEN 
     704                        jadd2 = jadd2 + 1 
     705                        sladd%ipoint(jadd2) = jadd 
     706                        sladd%cdname(jadd2) = sobsgroups(jgroup)%sprofdata%caddvars(jadd) 
     707                        DO jvar = 1, sobsgroups(jgroup)%sprofdata%nvar 
     708                           sladd%cdlong(jadd2,jvar) = sobsgroups(jgroup)%sprofdata%caddlong(jadd,jvar) 
     709                           sladd%cdunit(jadd2,jvar) = sobsgroups(jgroup)%sprofdata%caddunit(jadd,jvar) 
     710                        END DO 
     711                     ENDIF 
     712                  END DO 
     713               ENDIF 
     714               DEALLOCATE( ll_write ) 
     715                
     716               slext%inum = sobsgroups(jgroup)%sprofdata%next 
     717               ALLOCATE( ll_write(sobsgroups(jgroup)%sprofdata%next) ) 
     718               ll_write(:) = .TRUE. 
     719               IF ( (sobsgroups(jgroup)%nextvars > 0) .AND. & 
     720                  & (sobsgroups(jgroup)%sprofdata%next > sobsgroups(jgroup)%nextvars) ) THEN 
     721                  DO jext = sobsgroups(jgroup)%nextvars + 1, sobsgroups(jgroup)%sprofdata%next 
     722                     DO jext2 = 1, sobsgroups(jgroup)%nextvars 
     723                        IF ( TRIM(sobsgroups(jgroup)%sprofdata%cextvars(jext )) == & 
     724                           & TRIM(sobsgroups(jgroup)%sprofdata%cextvars(jext2)) ) THEN 
     725                           slext%inum = slext%inum - 1 
     726                           ll_write(jext) = .FALSE. 
     727                        ENDIF 
     728                     END DO 
     729                  END DO 
     730               ENDIF 
     731               IF ( slext%inum > 0 ) THEN 
     732                  ALLOCATE( slext%ipoint(slext%inum),   & 
     733                     &      slext%cdname(slext%inum),   & 
     734                     &      slext%cdlong(slext%inum,1), & 
     735                     &      slext%cdunit(slext%inum,1) ) 
     736                  jext2 = 0 
     737                  DO jext = 1, sobsgroups(jgroup)%sprofdata%next 
     738                     IF ( ll_write(jext) ) THEN 
     739                        jext2 = jext2 + 1 
     740                        slext%ipoint(jext2)   = jext 
     741                        slext%cdname(jext2)   = sobsgroups(jgroup)%sprofdata%cextvars(jext) 
     742                        slext%cdlong(jext2,1) = sobsgroups(jgroup)%sprofdata%cextlong(jext) 
     743                        slext%cdunit(jext2,1) = sobsgroups(jgroup)%sprofdata%cextunit(jext) 
     744                     ENDIF 
     745                  END DO 
     746               ENDIF 
     747               DEALLOCATE( ll_write ) 
     748 
     749               CALL obs_wri_prof( sobsgroups(jgroup)%sprofdata, sobsgroups(jgroup)%cgroupname, sladd, slext ) 
     750 
     751               IF ( sladd%inum > 0 ) THEN 
     752                  DEALLOCATE( sladd%ipoint, sladd%cdname, sladd%cdlong, sladd%cdunit ) 
     753               ENDIF 
     754               IF ( slext%inum > 0 ) THEN 
     755                  DEALLOCATE( slext%ipoint, slext%cdname, slext%cdlong, slext%cdunit ) 
     756               ENDIF 
     757 
     758            ELSEIF (sobsgroups(jgroup)%lsurf) THEN 
     759 
     760               IF (sobsgroups(jgroup)%lvel) THEN 
     761                  iuvar = 0 
     762                  ivvar = 0 
     763                  DO jvar = 1, sobsgroups(jgroup)%nobstypes 
     764                     IF ( TRIM(sobsgroups(jgroup)%cobstypes(jvar)) == cobsname_uvel ) THEN 
     765                        iuvar = jvar 
     766                     ELSEIF ( TRIM(sobsgroups(jgroup)%cobstypes(jvar)) == cobsname_vvel ) THEN 
     767                        ivvar = jvar 
     768                     ENDIF 
     769                  END DO 
     770                  IF ( (iuvar > 0) .AND. (ivvar > 0) ) THEN 
     771 
     772                     ! For velocity data, rotate the model velocities to N/S, E/W 
     773                     ! using the compressed data structure. 
     774                     ALLOCATE( & 
     775                        & zu(sobsgroups(jgroup)%ssurfdataqc%nsurf), & 
     776                        & zv(sobsgroups(jgroup)%ssurfdataqc%nsurf)  & 
     777                        & ) 
     778 
     779                     CALL obs_rotvel_surf( sobsgroups(jgroup)%ssurfdataqc, sobsgroups(jgroup)%n2dint, & 
     780                        &                  iuvar, ivvar, zu, zv ) 
     781 
     782                     DO jo = 1, sobsgroups(jgroup)%ssurfdataqc%nsurf 
     783                        sobsgroups(jgroup)%ssurfdataqc%rmod(jo,iuvar) = zu(jo) 
     784                        sobsgroups(jgroup)%ssurfdataqc%rmod(jo,ivvar) = zv(jo) 
     785                     END DO 
     786 
     787                     DEALLOCATE( zu ) 
     788                     DEALLOCATE( zv ) 
     789 
     790                  ELSE 
     791                     CALL ctl_stop( 'Could not identify velocity observation variables to rotate' ) 
     792                  END IF 
     793               END IF 
     794 
     795               CALL obs_surf_decompress( sobsgroups(jgroup)%ssurfdataqc, & 
     796                  &                      sobsgroups(jgroup)%ssurfdata, .TRUE., numout ) 
     797 
     798               IF (sobsgroups(jgroup)%lfbd) THEN 
     799                  ! Input observations were freeboard, but we're outputting ice thickness 
     800                  DO jvar = 1, sobsgroups(jgroup)%nobstypes 
     801                     IF ( sobsgroups(jgroup)%cobstypes(jvar) == cobsname_fbd ) THEN 
     802                        sobsgroups(jgroup)%ssurfdata%cvars(jvar) = 'SIT' 
     803                        sobsgroups(jgroup)%ssurfdata%clong(jvar) = 'Sea ice thickness' 
     804                        sobsgroups(jgroup)%ssurfdata%cunit(jvar) = 'm' 
     805                        EXIT 
     806                     ENDIF 
     807                  END DO 
     808               ENDIF 
     809 
     810               ! Put additional and extra variable information into obswriinfo structure 
     811               ! used by obs_write. 
     812               ! add/ext variables generated by the OBS code (1...sobsgroups(jgroup)%naddvars) 
     813               ! may duplicate ones read in (%naddvars+1...sobsgroups(jgroup)%ssurfdata%nadd) 
     814               ! Check for this, and if so only write out the version generated by the OBS code 
     815               sladd%inum = sobsgroups(jgroup)%ssurfdata%nadd 
     816               ALLOCATE( ll_write(sobsgroups(jgroup)%ssurfdata%nadd) ) 
     817               ll_write(:) = .TRUE. 
     818               IF ( (sobsgroups(jgroup)%naddvars > 0) .AND. & 
     819                  & (sobsgroups(jgroup)%ssurfdata%nadd > sobsgroups(jgroup)%naddvars) ) THEN 
     820                  DO jadd = sobsgroups(jgroup)%naddvars + 1, sobsgroups(jgroup)%ssurfdata%nadd 
     821                     DO jadd2 = 1, sobsgroups(jgroup)%naddvars 
     822                        IF ( TRIM(sobsgroups(jgroup)%ssurfdata%caddvars(jadd )) == & 
     823                           & TRIM(sobsgroups(jgroup)%ssurfdata%caddvars(jadd2)) ) THEN 
     824                           sladd%inum = sladd%inum - 1 
     825                           ll_write(jadd) = .FALSE. 
     826                        ENDIF 
     827                     END DO 
     828                  END DO 
     829               ENDIF 
     830               IF ( sladd%inum > 0 ) THEN 
     831                  ALLOCATE( sladd%ipoint(sladd%inum),                                   & 
     832                     &      sladd%cdname(sladd%inum),                                   & 
     833                     &      sladd%cdlong(sladd%inum,sobsgroups(jgroup)%ssurfdata%nvar), & 
     834                     &      sladd%cdunit(sladd%inum,sobsgroups(jgroup)%ssurfdata%nvar) ) 
     835                  jadd2 = 0 
     836                  DO jadd = 1, sobsgroups(jgroup)%ssurfdata%nadd 
     837                     IF ( ll_write(jadd) ) THEN 
     838                        jadd2 = jadd2 + 1 
     839                        sladd%ipoint(jadd2) = jadd 
     840                        sladd%cdname(jadd2) = sobsgroups(jgroup)%ssurfdata%caddvars(jadd) 
     841                        DO jvar = 1, sobsgroups(jgroup)%ssurfdata%nvar 
     842                           sladd%cdlong(jadd2,jvar) = sobsgroups(jgroup)%ssurfdata%caddlong(jadd,jvar) 
     843                           sladd%cdunit(jadd2,jvar) = sobsgroups(jgroup)%ssurfdata%caddunit(jadd,jvar) 
     844                        END DO 
     845                     ENDIF 
     846                  END DO 
     847               ENDIF 
     848               DEALLOCATE( ll_write ) 
     849                
     850               slext%inum = sobsgroups(jgroup)%ssurfdata%nextra 
     851               ALLOCATE( ll_write(sobsgroups(jgroup)%ssurfdata%nextra) ) 
     852               ll_write(:) = .TRUE. 
     853               IF ( (sobsgroups(jgroup)%nextvars > 0) .AND. & 
     854                  & (sobsgroups(jgroup)%ssurfdata%nextra > sobsgroups(jgroup)%nextvars) ) THEN 
     855                  DO jext = sobsgroups(jgroup)%nextvars + 1, sobsgroups(jgroup)%ssurfdata%nextra 
     856                     DO jext2 = 1, sobsgroups(jgroup)%nextvars 
     857                        IF ( TRIM(sobsgroups(jgroup)%ssurfdata%cextvars(jext )) == & 
     858                           & TRIM(sobsgroups(jgroup)%ssurfdata%cextvars(jext2)) ) THEN 
     859                           slext%inum = slext%inum - 1 
     860                           ll_write(jext) = .FALSE. 
     861                        ENDIF 
     862                     END DO 
     863                  END DO 
     864               ENDIF 
     865               IF ( slext%inum > 0 ) THEN 
     866                  ALLOCATE( slext%ipoint(slext%inum),   & 
     867                     &      slext%cdname(slext%inum),   & 
     868                     &      slext%cdlong(slext%inum,1), & 
     869                     &      slext%cdunit(slext%inum,1) ) 
     870                  jext2 = 0 
     871                  DO jext = 1, sobsgroups(jgroup)%ssurfdata%nextra 
     872                     IF ( ll_write(jext) ) THEN 
     873                        jext2 = jext2 + 1 
     874                        slext%ipoint(jext2)   = jext 
     875                        slext%cdname(jext2)   = sobsgroups(jgroup)%ssurfdata%cextvars(jext) 
     876                        slext%cdlong(jext2,1) = sobsgroups(jgroup)%ssurfdata%cextlong(jext) 
     877                        slext%cdunit(jext2,1) = sobsgroups(jgroup)%ssurfdata%cextunit(jext) 
     878                     ENDIF 
     879                  END DO 
     880               ENDIF 
     881               DEALLOCATE( ll_write ) 
     882 
     883               CALL obs_wri_surf( sobsgroups(jgroup)%ssurfdata, sobsgroups(jgroup)%cgroupname, sladd, slext ) 
     884 
     885               IF ( sladd%inum > 0 ) THEN 
     886                  DEALLOCATE( sladd%ipoint, sladd%cdname, sladd%cdlong, sladd%cdunit ) 
     887               ENDIF 
     888               IF ( slext%inum > 0 ) THEN 
     889                  DEALLOCATE( slext%ipoint, slext%cdname, slext%cdlong, slext%cdunit ) 
     890               ENDIF 
     891 
     892            ENDIF 
     893 
     894         ENDIF 
     895 
     896      END DO 
     897 
     898      IF( ln_timing )   CALL timing_stop('dia_obs_wri') 
    724899 
    725900   END SUBROUTINE dia_obs_wri 
    726  
    727    SUBROUTINE dia_obs_dealloc 
    728       IMPLICIT NONE 
    729       !!---------------------------------------------------------------------- 
    730       !!                    *** ROUTINE dia_obs_dealloc *** 
    731       !! 
    732       !!  ** Purpose : To deallocate data to enable the obs_oper online loop. 
    733       !!               Specifically: dia_obs_init --> dia_obs --> dia_obs_wri 
    734       !! 
    735       !!  ** Method : Clean up various arrays left behind by the obs_oper. 
    736       !! 
    737       !!  ** Action : 
    738       !! 
    739       !!---------------------------------------------------------------------- 
    740       ! obs_grid deallocation 
    741       CALL obs_grid_deallocate 
    742  
    743       ! diaobs deallocation 
    744       IF ( nproftypes > 0 ) & 
    745          &   DEALLOCATE( cobstypesprof, profdata, profdataqc, nvarsprof, nextrprof ) 
    746  
    747       IF ( nsurftypes > 0 ) & 
    748          &   DEALLOCATE( cobstypessurf, surfdata, surfdataqc, nvarssurf, nextrsurf, & 
    749          &               n2dintsurf, zavglamscl, zavgphiscl, lfpindegs, llnightav ) 
    750  
    751    END SUBROUTINE dia_obs_dealloc 
    752901 
    753902   SUBROUTINE calc_date( kstp, ddobs ) 
    … …  
    8951044 
    8961045   END SUBROUTINE fin_date 
    897     
    898     SUBROUTINE obs_settypefiles( ntypes, jpmaxnfiles, jtype, ctypein, & 
    899        &                         cfilestype, ifiles, cobstypes, cfiles ) 
    900  
    901     INTEGER, INTENT(IN) :: ntypes      ! Total number of obs types 
    902     INTEGER, INTENT(IN) :: jpmaxnfiles ! Maximum number of files allowed for each type 
    903     INTEGER, INTENT(IN) :: jtype       ! Index of the current type of obs 
    904     INTEGER, DIMENSION(ntypes), INTENT(INOUT) :: & 
    905        &                   ifiles      ! Out appended number of files for this type 
    906  
    907     CHARACTER(len=6), INTENT(IN) :: ctypein  
    908     CHARACTER(len=128), DIMENSION(jpmaxnfiles), INTENT(IN) :: & 
    909        &                   cfilestype  ! In list of files for this obs type 
    910     CHARACTER(len=6), DIMENSION(ntypes), INTENT(INOUT) :: & 
    911        &                   cobstypes   ! Out appended list of obs types 
    912     CHARACTER(len=128), DIMENSION(ntypes, jpmaxnfiles), INTENT(INOUT) :: & 
    913        &                   cfiles      ! Out appended list of files for all types 
    914  
    915     !Local variables 
    916     INTEGER :: jfile 
    917  
    918     cfiles(jtype,:) = cfilestype(:) 
    919     cobstypes(jtype) = ctypein 
    920     ifiles(jtype) = 0 
    921     DO jfile = 1, jpmaxnfiles 
    922        IF ( trim(cfiles(jtype,jfile)) /= '' ) & 
    923                  ifiles(jtype) = ifiles(jtype) + 1 
    924     END DO 
    925  
    926     IF ( ifiles(jtype) == 0 ) THEN 
    927          CALL ctl_stop( 'Logical for observation type '//TRIM(ctypein)//   & 
    928             &           ' set to true but no files available to read' ) 
    929     ENDIF 
    930  
    931     IF(lwp) THEN     
    932        WRITE(numout,*) '             '//cobstypes(jtype)//' input observation file names:' 
    933        DO jfile = 1, ifiles(jtype) 
    934           WRITE(numout,*) '                '//TRIM(cfiles(jtype,jfile)) 
    935        END DO 
    936     ENDIF 
    937  
    938     END SUBROUTINE obs_settypefiles 
    939  
    940     SUBROUTINE obs_setinterpopts( ntypes, jtype, ctypein,             & 
    941                &                  n2dint_default, n2dint_type,        & 
    942                &                  zavglamscl_type, zavgphiscl_type,   & 
    943                &                  lfp_indegs_type, lavnight_type,     & 
    944                &                  n2dint, zavglamscl, zavgphiscl,     & 
    945                &                  lfpindegs, lavnight ) 
    946  
    947     INTEGER, INTENT(IN)  :: ntypes             ! Total number of obs types 
    948     INTEGER, INTENT(IN)  :: jtype              ! Index of the current type of obs 
    949     INTEGER, INTENT(IN)  :: n2dint_default     ! Default option for interpolation type 
    950     INTEGER, INTENT(IN)  :: n2dint_type        ! Option for interpolation type 
    951     REAL(wp), INTENT(IN) :: & 
    952        &                    zavglamscl_type, & !E/W diameter of obs footprint for this type 
    953        &                    zavgphiscl_type    !N/S diameter of obs footprint for this type 
    954     LOGICAL, INTENT(IN)  :: lfp_indegs_type    !T=> footprint in degrees, F=> in metres 
    955     LOGICAL, INTENT(IN)  :: lavnight_type      !T=> obs represent night time average 
    956     CHARACTER(len=6), INTENT(IN) :: ctypein  
    957  
    958     INTEGER, DIMENSION(ntypes), INTENT(INOUT) :: & 
    959        &                    n2dint  
    960     REAL(wp), DIMENSION(ntypes), INTENT(INOUT) :: & 
    961        &                    zavglamscl, zavgphiscl 
    962     LOGICAL, DIMENSION(ntypes), INTENT(INOUT) :: & 
    963        &                    lfpindegs, lavnight 
    964  
    965     lavnight(jtype) = lavnight_type 
    966  
    967     IF ( (n2dint_type >= 1) .AND. (n2dint_type <= 6) ) THEN 
    968        n2dint(jtype) = n2dint_type 
    969     ELSE 
    970        n2dint(jtype) = n2dint_default 
    971     ENDIF 
    972  
    973     ! For averaging observation footprints set options for size of footprint  
    974     IF ( (n2dint(jtype) > 4) .AND. (n2dint(jtype) <= 6) ) THEN 
    975        IF ( zavglamscl_type > 0._wp ) THEN 
    976           zavglamscl(jtype) = zavglamscl_type 
    977        ELSE 
    978           CALL ctl_stop( 'Incorrect value set for averaging footprint '// & 
    979                          'scale (zavglamscl) for observation type '//TRIM(ctypein) )       
    980        ENDIF 
    981  
    982        IF ( zavgphiscl_type > 0._wp ) THEN 
    983           zavgphiscl(jtype) = zavgphiscl_type 
    984        ELSE 
    985           CALL ctl_stop( 'Incorrect value set for averaging footprint '// & 
    986                          'scale (zavgphiscl) for observation type '//TRIM(ctypein) )       
    987        ENDIF 
    988  
    989        lfpindegs(jtype) = lfp_indegs_type  
    990  
    991     ENDIF 
    992  
    993     ! Write out info  
    994     IF(lwp) THEN 
    995        IF ( n2dint(jtype) <= 4 ) THEN 
    996           WRITE(numout,*) '             '//TRIM(ctypein)// & 
    997              &            ' model counterparts will be interpolated horizontally' 
    998        ELSE IF ( n2dint(jtype) <= 6 ) THEN 
    999           WRITE(numout,*) '             '//TRIM(ctypein)// & 
    1000              &            ' model counterparts will be averaged horizontally' 
    1001           WRITE(numout,*) '             '//'    with E/W scale: ',zavglamscl(jtype) 
    1002           WRITE(numout,*) '             '//'    with N/S scale: ',zavgphiscl(jtype) 
    1003           IF ( lfpindegs(jtype) ) THEN 
    1004               WRITE(numout,*) '             '//'    (in degrees)' 
    1005           ELSE 
    1006               WRITE(numout,*) '             '//'    (in metres)' 
    1007           ENDIF 
    1008        ENDIF 
    1009     ENDIF 
    1010  
    1011     END SUBROUTINE obs_setinterpopts 
    10121046 
    10131047END MODULE diaobs 

  • NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS/obs_grid.F90

    r14075 r15799  
    687687      IF (ln_grid_search_lookup) THEN 
    688688          
    689          WRITE(numout,*) 'Calling obs_grid_setup' 
     689         IF(lwp) WRITE(numout,*) 'Calling obs_grid_setup' 
    690690          
    691691         IF(lwp) WRITE(numout,*) 
    … …  
    724724            ! initially assume size is as defined (to be fixed) 
    725725             
    726             WRITE(numout,*) 'Reading: ',cfname 
     726            IF(lwp) WRITE(numout,*) 'Reading: ',cfname 
    727727             
    728728            CALL chkerr( nf90_open( TRIM( cfname ), nf90_nowrite, idfile ), & 

  • NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS/obs_level_search.h90

    r14075 r15799  
    1313      !! ** Method  : Straightforward search 
    1414      !! 
    15       !! ** Action  :  
     15      !! ** Action  : Will return level associated with T-point below the obs 
     16      !!              depth, except when observation is in the top box will  
     17      !!              return level 2. Also, if obs depth greater than depth  
     18      !!              of last wet T-point (kpk-1) will return level kpk. 
    1619      !! 
    1720      !! History : 
    … …  
    4346      DO ji = 1, kobs  
    4447         kobsk(ji) = 1 
    45          depk: DO jk = 2, kgrd 
     48         depk: DO jk = 2, kgrd-1 
    4649            IF ( pgrddep(jk) >= pobsdep(ji) ) EXIT depk 
    4750         END DO depk 

  • NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS/obs_oper.F90

    r14075 r15799  
    1818   USE lib_mpp,       ONLY :   ctl_warn, ctl_stop           ! Warning and stopping routines 
    1919   USE sbcdcy,        ONLY :   sbc_dcy, nday_qsr            ! For calculation of where it is night-time 
    20    USE obs_grid,      ONLY :   obs_level_search      
     20   USE obs_grid,      ONLY :   obs_level_search 
     21   USE obs_group_def, ONLY : cobsname_sla, cobsname_fbd, imaxavtypes 
     22#if defined key_si3 || defined key_cice 
     23   USE phycst,        ONLY : rhos, rhoi, rhow               ! For conversion from sea ice freeboard to thickness 
     24#endif 
    2125   ! 
    2226   USE par_kind     , ONLY :   wp   ! Precision variables 
    … …  
    2832   PUBLIC   obs_prof_opt   !: Compute the model counterpart of profile obs 
    2933   PUBLIC   obs_surf_opt   !: Compute the model counterpart of surface obs 
    30  
    31    INTEGER, PARAMETER, PUBLIC ::   imaxavtypes = 20   !: Max number of daily avgd obs types 
    3234 
    3335   !!---------------------------------------------------------------------- 
    … …  
    3840CONTAINS 
    3941 
    40    SUBROUTINE obs_prof_opt( prodatqc, kt, kpi, kpj, kpk,          & 
    41       &                     kit000, kdaystp,                      & 
    42       &                     pvar1, pvar2, pgdept, pgdepw,         & 
    43       &                     pmask1, pmask2,                       &   
    44       &                     plam1, plam2, pphi1, pphi2,           & 
     42   SUBROUTINE obs_prof_opt( prodatqc, kt, kpi, kpj, kpk, & 
     43      &                     kit000, kdaystp, kvar,       & 
     44      &                     pvar,                        & 
     45      &                     ldclim, kclim, pclim,        & 
     46      &                     pgdept, pgdepw,              & 
     47      &                     pmask,                       &   
     48      &                     plam, pphi,                  & 
    4549      &                     k1dint, k2dint, kdailyavtypes ) 
    4650      !!----------------------------------------------------------------------- 
    … …  
    103107      INTEGER       , INTENT(in   ) ::   k2dint          ! Horizontal interpolation type (see header) 
    104108      INTEGER       , INTENT(in   ) ::   kdaystp         ! Number of time steps per day 
    105       REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj,kpk) ::   pvar1 , pvar2    ! Model field     1 and 2 
    106       REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj,kpk) ::   pmask1, pmask2   ! Land-sea mask   1 and 2 
    107       REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj)     ::   plam1 , plam2    ! Model longitude 1 and 2 
    108       REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj)     ::   pphi1 , pphi2    ! Model latitudes 1 and 2 
     109      INTEGER       , INTENT(in   ) ::   kvar            ! Index of variable in prodatqc 
     110      INTEGER       , INTENT(in   ) ::   kclim           ! Index of climatology in prodatqc 
     111      LOGICAL       , INTENT(in   ) ::   ldclim          ! Switch to interpolate climatology 
     112      REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj,kpk) ::   pvar             ! Model field 
     113      REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj,kpk) ::   pclim            ! Climatology field 
     114      REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj,kpk) ::   pmask            ! Land-sea mask 
     115      REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj)     ::   plam             ! Model longitude 
     116      REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj)     ::   pphi             ! Model latitudes 
    109117      REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj,kpk) ::   pgdept, pgdepw   ! depth of T and W levels  
    110118      INTEGER, DIMENSION(imaxavtypes), OPTIONAL ::   kdailyavtypes             ! Types for daily averages 
    … …  
    126134         & idailyavtypes 
    127135      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
    128          & igrdi1, & 
    129          & igrdi2, & 
    130          & igrdj1, & 
    131          & igrdj2 
     136         & igrdi, & 
     137         & igrdj 
    132138      INTEGER, ALLOCATABLE, DIMENSION(:) :: iv_indic 
    133139 
    … …  
    136142      REAL(KIND=wp) :: zdaystp 
    137143      REAL(KIND=wp), DIMENSION(kpk) :: & 
    138          & zobsmask1, & 
    139          & zobsmask2, & 
    140          & zobsk,    & 
    141          & zobs2k 
     144         & zobsk,  & 
     145         & zobs2k, & 
     146         & zclm2k 
    142147      REAL(KIND=wp), DIMENSION(2,2,1) :: & 
    143148         & zweig1, & 
    144          & zweig2, & 
    145149         & zweig 
    146150      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: & 
    147          & zmask1, & 
    148          & zmask2, & 
    149          & zint1,  & 
    150          & zint2,  & 
    151          & zinm1,  & 
    152          & zinm2,  & 
     151         & zmask,  & 
     152         & zclim,  & 
     153         & zint,   & 
     154         & zinm,   & 
    153155         & zgdept, &  
    154156         & zgdepw 
    155157      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
    156          & zglam1, & 
    157          & zglam2, & 
    158          & zgphi1, & 
    159          & zgphi2 
    160       REAL(KIND=wp), DIMENSION(1) :: zmsk_1, zmsk_2    
     158         & zglam,  & 
     159         & zgphi 
     160      REAL(KIND=wp), DIMENSION(1) :: zmsk 
    161161      REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: interp_corner 
     162      REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: interp_corner_clim 
    162163 
    163164      LOGICAL :: ld_dailyav 
    … …  
    190191               DO jj = 1, jpj 
    191192                  DO ji = 1, jpi 
    192                      prodatqc%vdmean(ji,jj,jk,1) = 0.0 
    193                      prodatqc%vdmean(ji,jj,jk,2) = 0.0 
     193                     prodatqc%vdmean(ji,jj,jk,kvar) = 0.0 
    194194                  END DO 
    195195               END DO 
    … …  
    201201               DO ji = 1, jpi 
    202202                  ! Increment field 1 for computing daily mean 
    203                   prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) & 
    204                      &                        + pvar1(ji,jj,jk) 
    205                   ! Increment field 2 for computing daily mean 
    206                   prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) & 
    207                      &                        + pvar2(ji,jj,jk) 
     203                  prodatqc%vdmean(ji,jj,jk,kvar) = prodatqc%vdmean(ji,jj,jk,kvar) & 
     204                     &                           + pvar(ji,jj,jk) 
    208205               END DO 
    209206            END DO 
    … …  
    213210         zdaystp = 1.0 / REAL( kdaystp ) 
    214211         IF ( idayend == 0 ) THEN 
    215             IF (lwp) WRITE(numout,*) 'Calculating prodatqc%vdmean on time-step: ',kt 
     212            IF (lwp) WRITE(numout,*) 'Calculating prodatqc%vdmean on time-step: ', kt 
    216213            CALL FLUSH(numout) 
    217214            DO jk = 1, jpk 
    218215               DO jj = 1, jpj 
    219216                  DO ji = 1, jpi 
    220                      prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) & 
    221                         &                        * zdaystp 
    222                      prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) & 
    223                         &                        * zdaystp 
     217                     prodatqc%vdmean(ji,jj,jk,kvar) = prodatqc%vdmean(ji,jj,jk,kvar) & 
     218                        &                           * zdaystp 
    224219                  END DO 
    225220               END DO 
    … …  
    231226      ! Get the data for interpolation 
    232227      ALLOCATE( & 
    233          & igrdi1(2,2,ipro),      & 
    234          & igrdi2(2,2,ipro),      & 
    235          & igrdj1(2,2,ipro),      & 
    236          & igrdj2(2,2,ipro),      & 
    237          & zglam1(2,2,ipro),      & 
    238          & zglam2(2,2,ipro),      & 
    239          & zgphi1(2,2,ipro),      & 
    240          & zgphi2(2,2,ipro),      & 
    241          & zmask1(2,2,kpk,ipro),  & 
    242          & zmask2(2,2,kpk,ipro),  & 
    243          & zint1(2,2,kpk,ipro),   & 
    244          & zint2(2,2,kpk,ipro),   & 
    245          & zgdept(2,2,kpk,ipro),  &  
    246          & zgdepw(2,2,kpk,ipro)   &  
     228         & igrdi(2,2,ipro),      & 
     229         & igrdj(2,2,ipro),      & 
     230         & zglam(2,2,ipro),      & 
     231         & zgphi(2,2,ipro),      & 
     232         & zmask(2,2,kpk,ipro),  & 
     233         & zint(2,2,kpk,ipro),   & 
     234         & zgdept(2,2,kpk,ipro), &  
     235         & zgdepw(2,2,kpk,ipro)  &  
    247236         & ) 
     237 
     238      IF ( ldclim ) THEN 
     239         ALLOCATE( zclim(2,2,kpk,ipro) ) 
     240      ENDIF 
    248241 
    249242      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 
    250243         iobs = jobs - prodatqc%nprofup 
    251          igrdi1(1,1,iobs) = prodatqc%mi(jobs,1)-1 
    252          igrdj1(1,1,iobs) = prodatqc%mj(jobs,1)-1 
    253          igrdi1(1,2,iobs) = prodatqc%mi(jobs,1)-1 
    254          igrdj1(1,2,iobs) = prodatqc%mj(jobs,1) 
    255          igrdi1(2,1,iobs) = prodatqc%mi(jobs,1) 
    256          igrdj1(2,1,iobs) = prodatqc%mj(jobs,1)-1 
    257          igrdi1(2,2,iobs) = prodatqc%mi(jobs,1) 
    258          igrdj1(2,2,iobs) = prodatqc%mj(jobs,1) 
    259          igrdi2(1,1,iobs) = prodatqc%mi(jobs,2)-1 
    260          igrdj2(1,1,iobs) = prodatqc%mj(jobs,2)-1 
    261          igrdi2(1,2,iobs) = prodatqc%mi(jobs,2)-1 
    262          igrdj2(1,2,iobs) = prodatqc%mj(jobs,2) 
    263          igrdi2(2,1,iobs) = prodatqc%mi(jobs,2) 
    264          igrdj2(2,1,iobs) = prodatqc%mj(jobs,2)-1 
    265          igrdi2(2,2,iobs) = prodatqc%mi(jobs,2) 
    266          igrdj2(2,2,iobs) = prodatqc%mj(jobs,2) 
     244         igrdi(1,1,iobs) = prodatqc%mi(jobs,kvar)-1 
     245         igrdj(1,1,iobs) = prodatqc%mj(jobs,kvar)-1 
     246         igrdi(1,2,iobs) = prodatqc%mi(jobs,kvar)-1 
     247         igrdj(1,2,iobs) = prodatqc%mj(jobs,kvar) 
     248         igrdi(2,1,iobs) = prodatqc%mi(jobs,kvar) 
     249         igrdj(2,1,iobs) = prodatqc%mj(jobs,kvar)-1 
     250         igrdi(2,2,iobs) = prodatqc%mi(jobs,kvar) 
     251         igrdj(2,2,iobs) = prodatqc%mj(jobs,kvar) 
    267252      END DO 
    268253 
    … …  
    271256      zgdepw(:,:,:,:) = 0.0 
    272257 
    273       CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi1, igrdj1, plam1, zglam1 ) 
    274       CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi1, igrdj1, pphi1, zgphi1 ) 
    275       CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pmask1, zmask1 ) 
    276       CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pvar1,   zint1 ) 
    277        
    278       CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi2, igrdj2, plam2, zglam2 ) 
    279       CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi2, igrdj2, pphi2, zgphi2 ) 
    280       CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, pmask2, zmask2 ) 
    281       CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, pvar2,   zint2 ) 
    282  
    283       CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pgdept, zgdept )  
    284       CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pgdepw, zgdepw )  
     258      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi, igrdj, plam, zglam ) 
     259      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi, igrdj, pphi, zgphi ) 
     260      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pmask, zmask ) 
     261      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pvar,   zint ) 
     262 
     263      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pgdept, zgdept )  
     264      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pgdepw, zgdepw )  
     265 
     266      IF ( ldclim ) THEN 
     267         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pclim, zclim ) 
     268      ENDIF 
    285269 
    286270      ! At the end of the day also get interpolated means 
    287271      IF ( ld_dailyav .AND. idayend == 0 ) THEN 
    288272 
    289          ALLOCATE( & 
    290             & zinm1(2,2,kpk,ipro),  & 
    291             & zinm2(2,2,kpk,ipro)   & 
    292             & ) 
    293  
    294          CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, & 
    295             &                  prodatqc%vdmean(:,:,:,1), zinm1 ) 
    296          CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, & 
    297             &                  prodatqc%vdmean(:,:,:,2), zinm2 ) 
     273         ALLOCATE( zinm(2,2,kpk,ipro) ) 
     274 
     275         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, & 
     276            &                  prodatqc%vdmean(:,:,:,kvar), zinm ) 
    298277 
    299278      ENDIF 
    … …  
    330309         ! Horizontal weights  
    331310         ! Masked values are calculated later.   
    332          IF ( prodatqc%npvend(jobs,1) > 0 ) THEN 
     311         IF ( prodatqc%npvend(jobs,kvar) > 0 ) THEN 
    333312 
    334313            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,     & 
    335                &                   zglam1(:,:,iobs), zgphi1(:,:,iobs), & 
    336                &                   zmask1(:,:,1,iobs), zweig1, zmsk_1 ) 
    337  
    338          ENDIF 
    339  
    340          IF ( prodatqc%npvend(jobs,2) > 0 ) THEN 
    341  
    342             CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,     & 
    343                &                   zglam2(:,:,iobs), zgphi2(:,:,iobs), & 
    344                &                   zmask2(:,:,1,iobs), zweig2, zmsk_2 ) 
    345   
    346          ENDIF 
    347  
    348          IF ( prodatqc%npvend(jobs,1) > 0 ) THEN 
     314               &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
     315               &                   zmask(:,:,1,iobs), zweig1, zmsk ) 
     316 
     317         ENDIF 
     318 
     319         IF ( prodatqc%npvend(jobs,kvar) > 0 ) THEN 
    349320 
    350321            zobsk(:) = obfillflt 
    … …  
    356327 
    357328                  ! vertically interpolate all 4 corners  
    358                   ista = prodatqc%npvsta(jobs,1)  
    359                   iend = prodatqc%npvend(jobs,1)  
     329                  ista = prodatqc%npvsta(jobs,kvar)  
     330                  iend = prodatqc%npvend(jobs,kvar)  
    360331                  inum_obs = iend - ista + 1  
    361332                  ALLOCATE(interp_corner(2,2,inum_obs),iv_indic(inum_obs))  
     333                  IF ( ldclim ) THEN 
     334                     ALLOCATE( interp_corner_clim(2,2,inum_obs) ) 
     335                  ENDIF 
    362336 
    363337                  DO iin=1,2  
    … …  
    366340                        IF ( k1dint == 1 ) THEN  
    367341                           CALL obs_int_z1d_spl( kpk, &  
    368                               &     zinm1(iin,ijn,:,iobs), &  
     342                              &     zinm(iin,ijn,:,iobs), &  
    369343                              &     zobs2k, zgdept(iin,ijn,:,iobs), &  
    370                               &     zmask1(iin,ijn,:,iobs))  
     344                              &     zmask(iin,ijn,:,iobs))  
     345 
     346                           IF ( ldclim ) THEN 
     347                              CALL obs_int_z1d_spl( kpk, & 
     348                                 &     zclim(iin,ijn,:,iobs), & 
     349                                 &     zclm2k, zgdept(iin,ijn,:,iobs), & 
     350                                 &     zmask(iin,ijn,:,iobs)) 
     351                           ENDIF 
    371352                        ENDIF  
    372353        
    373354                        CALL obs_level_search(kpk, &  
    374355                           &    zgdept(iin,ijn,:,iobs), &  
    375                            &    inum_obs, prodatqc%var(1)%vdep(ista:iend), &  
     356                           &    inum_obs, prodatqc%var(kvar)%vdep(ista:iend), &  
    376357                           &    iv_indic)  
    377358 
    378359                        CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, &  
    379                            &    prodatqc%var(1)%vdep(ista:iend), &  
    380                            &    zinm1(iin,ijn,:,iobs), &  
     360                           &    prodatqc%var(kvar)%vdep(ista:iend), &  
     361                           &    zinm(iin,ijn,:,iobs), &  
    381362                           &    zobs2k, interp_corner(iin,ijn,:), &  
    382363                           &    zgdept(iin,ijn,:,iobs), &  
    383                            &    zmask1(iin,ijn,:,iobs))  
     364                           &    zmask(iin,ijn,:,iobs))  
     365 
     366                        IF ( ldclim ) THEN 
     367                           CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, & 
     368                              &    prodatqc%var(kvar)%vdep(ista:iend), & 
     369                              &    zclim(iin,ijn,:,iobs), & 
     370                              &    zclm2k, interp_corner_clim(iin,ijn,:), & 
     371                              &    zgdept(iin,ijn,:,iobs), & 
     372                              &    zmask(iin,ijn,:,iobs)) 
     373                        ENDIF 
    384374        
    385375                     ENDDO  
    … …  
    393383      
    394384               ! vertically interpolate all 4 corners  
    395                ista = prodatqc%npvsta(jobs,1)  
    396                iend = prodatqc%npvend(jobs,1)  
     385               ista = prodatqc%npvsta(jobs,kvar)  
     386               iend = prodatqc%npvend(jobs,kvar)  
    397387               inum_obs = iend - ista + 1  
    398388               ALLOCATE(interp_corner(2,2,inum_obs), iv_indic(inum_obs))  
     389               IF ( ldclim ) THEN 
     390                  ALLOCATE( interp_corner_clim(2,2,inum_obs) ) 
     391               ENDIF 
    399392               DO iin=1,2   
    400393                  DO ijn=1,2  
    … …  
    402395                     IF ( k1dint == 1 ) THEN  
    403396                        CALL obs_int_z1d_spl( kpk, &  
    404                            &    zint1(iin,ijn,:,iobs),&  
     397                           &    zint(iin,ijn,:,iobs),&  
    405398                           &    zobs2k, zgdept(iin,ijn,:,iobs), &  
    406                            &    zmask1(iin,ijn,:,iobs))  
    407    
     399                           &    zmask(iin,ijn,:,iobs))  
     400 
     401                        IF ( ldclim ) THEN 
     402                           CALL obs_int_z1d_spl( kpk, & 
     403                              &    zclim(iin,ijn,:,iobs),& 
     404                              &    zclm2k, zgdept(iin,ijn,:,iobs), & 
     405                              &    zmask(iin,ijn,:,iobs)) 
     406                        ENDIF 
    408407                     ENDIF  
    409408        
    410409                     CALL obs_level_search(kpk, &  
    411410                         &        zgdept(iin,ijn,:,iobs),&  
    412                          &        inum_obs, prodatqc%var(1)%vdep(ista:iend), &  
     411                         &        inum_obs, prodatqc%var(kvar)%vdep(ista:iend), &  
    413412                         &        iv_indic)  
    414413 
    415414                     CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs,     &  
    416                          &          prodatqc%var(1)%vdep(ista:iend),     &  
    417                          &          zint1(iin,ijn,:,iobs),            &  
     415                         &          prodatqc%var(kvar)%vdep(ista:iend),     &  
     416                         &          zint(iin,ijn,:,iobs),            &  
    418417                         &          zobs2k,interp_corner(iin,ijn,:), &  
    419418                         &          zgdept(iin,ijn,:,iobs),         &  
    420                          &          zmask1(iin,ijn,:,iobs) )       
     419                         &          zmask(iin,ijn,:,iobs) )       
     420 
     421                     IF ( ldclim ) THEN 
     422                        CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs,     & 
     423                            &          prodatqc%var(kvar)%vdep(ista:iend),     & 
     424                            &          zclim(iin,ijn,:,iobs),            & 
     425                            &          zclm2k,interp_corner_clim(iin,ijn,:), & 
     426                            &          zgdept(iin,ijn,:,iobs),         & 
     427                            &          zmask(iin,ijn,:,iobs) ) 
     428                     ENDIF 
    421429          
    422430                  ENDDO  
    … …  
    442450                  DO ijn=1,2  
    443451      
    444                      depth_loop1: DO ik=kpk,2,-1  
    445                         IF(zmask1(iin,ijn,ik-1,iobs ) > 0.9 )THEN    
     452                     depth_loop: DO ik=kpk,2,-1  
     453                        IF(zmask(iin,ijn,ik-1,iobs ) > 0.9 )THEN    
    446454                             
    447455                           zweig(iin,ijn,1) = &   
    448456                              & zweig1(iin,ijn,1) * &  
    449457                              & MAX( SIGN(1._wp,(zgdepw(iin,ijn,ik,iobs) ) &  
    450                               &  - prodatqc%var(1)%vdep(iend)),0._wp)  
     458                              &  - prodatqc%var(kvar)%vdep(iend)),0._wp)  
    451459                             
    452                            EXIT depth_loop1  
     460                           EXIT depth_loop  
    453461 
    454462                        ENDIF  
    455463 
    456                      ENDDO depth_loop1  
     464                     ENDDO depth_loop 
    457465      
    458466                  ENDDO  
    … …  
    460468    
    461469               CALL obs_int_h2d( 1, 1, zweig, interp_corner(:,:,ikn), &  
    462                   &              prodatqc%var(1)%vmod(iend:iend) )  
    463  
    464                   ! Set QC flag for any observations found below the bottom 
    465                   ! needed as the check here is more strict than that in obs_prep 
    466                IF (sum(zweig) == 0.0_wp) prodatqc%var(1)%nvqc(iend:iend)=4 
     470                  &              prodatqc%var(kvar)%vmod(iend:iend) )  
     471 
     472               IF ( ldclim ) THEN 
     473                  CALL obs_int_h2d( 1, 1, zweig, interp_corner_clim(:,:,ikn), & 
     474                     &              prodatqc%var(kvar)%vadd(iend:iend,kclim) ) 
     475               ENDIF 
     476 
     477               ! Set QC flag for any observations found below the bottom 
     478               ! needed as the check here is more strict than that in obs_prep 
     479               IF (sum(zweig) == 0.0_wp) prodatqc%var(kvar)%nvqc(iend:iend)=4 
    467480  
    468481            ENDDO  
    469482  
    470483            DEALLOCATE(interp_corner,iv_indic)  
     484            IF ( ldclim ) THEN 
     485               DEALLOCATE( interp_corner_clim ) 
     486            ENDIF 
    471487           
    472          ENDIF  
    473  
    474          ! For the second variable 
    475          IF ( prodatqc%npvend(jobs,2) > 0 ) THEN 
    476  
    477             zobsk(:) = obfillflt 
    478  
    479             IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN 
    480  
    481                IF ( idayend == 0 )  THEN 
    482                   ! Daily averaged data 
    483  
    484                   ! vertically interpolate all 4 corners  
    485                   ista = prodatqc%npvsta(jobs,2)  
    486                   iend = prodatqc%npvend(jobs,2)  
    487                   inum_obs = iend - ista + 1  
    488                   ALLOCATE(interp_corner(2,2,inum_obs),iv_indic(inum_obs))  
    489  
    490                   DO iin=1,2  
    491                      DO ijn=1,2  
    492  
    493                         IF ( k1dint == 1 ) THEN  
    494                            CALL obs_int_z1d_spl( kpk, &  
    495                               &     zinm2(iin,ijn,:,iobs), &  
    496                               &     zobs2k, zgdept(iin,ijn,:,iobs), &  
    497                               &     zmask2(iin,ijn,:,iobs))  
    498                         ENDIF  
    499         
    500                         CALL obs_level_search(kpk, &  
    501                            &    zgdept(iin,ijn,:,iobs), &  
    502                            &    inum_obs, prodatqc%var(2)%vdep(ista:iend), &  
    503                            &    iv_indic)  
    504  
    505                         CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, &  
    506                            &    prodatqc%var(2)%vdep(ista:iend), &  
    507                            &    zinm2(iin,ijn,:,iobs), &  
    508                            &    zobs2k, interp_corner(iin,ijn,:), &  
    509                            &    zgdept(iin,ijn,:,iobs), &  
    510                            &    zmask2(iin,ijn,:,iobs))  
    511         
    512                      ENDDO  
    513                   ENDDO  
    514  
    515                ENDIF !idayend 
    516  
    517             ELSE    
    518  
    519                ! Point data  
    520       
    521                ! vertically interpolate all 4 corners  
    522                ista = prodatqc%npvsta(jobs,2)  
    523                iend = prodatqc%npvend(jobs,2)  
    524                inum_obs = iend - ista + 1  
    525                ALLOCATE(interp_corner(2,2,inum_obs), iv_indic(inum_obs))  
    526                DO iin=1,2   
    527                   DO ijn=1,2  
    528                      
    529                      IF ( k1dint == 1 ) THEN  
    530                         CALL obs_int_z1d_spl( kpk, &  
    531                            &    zint2(iin,ijn,:,iobs),&  
    532                            &    zobs2k, zgdept(iin,ijn,:,iobs), &  
    533                            &    zmask2(iin,ijn,:,iobs))  
    534    
    535                      ENDIF  
    536         
    537                      CALL obs_level_search(kpk, &  
    538                          &        zgdept(iin,ijn,:,iobs),&  
    539                          &        inum_obs, prodatqc%var(2)%vdep(ista:iend), &  
    540                          &        iv_indic)  
    541  
    542                      CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs,     &  
    543                          &          prodatqc%var(2)%vdep(ista:iend),     &  
    544                          &          zint2(iin,ijn,:,iobs),            &  
    545                          &          zobs2k,interp_corner(iin,ijn,:), &  
    546                          &          zgdept(iin,ijn,:,iobs),         &  
    547                          &          zmask2(iin,ijn,:,iobs) )       
    548           
    549                   ENDDO  
    550                ENDDO  
    551               
    552             ENDIF  
    553  
    554             !-------------------------------------------------------------  
    555             ! Compute the horizontal interpolation for every profile level  
    556             !-------------------------------------------------------------  
    557               
    558             DO ikn=1,inum_obs  
    559                iend=ista+ikn-1 
    560                    
    561                zweig(:,:,1) = 0._wp  
    562     
    563                ! This code forces the horizontal weights to be   
    564                ! zero IF the observation is below the bottom of the   
    565                ! corners of the interpolation nodes, Or if it is in   
    566                ! the mask. This is important for observations near   
    567                ! steep bathymetry  
    568                DO iin=1,2  
    569                   DO ijn=1,2  
    570       
    571                      depth_loop2: DO ik=kpk,2,-1  
    572                         IF(zmask2(iin,ijn,ik-1,iobs ) > 0.9 )THEN    
    573                              
    574                            zweig(iin,ijn,1) = &   
    575                               & zweig2(iin,ijn,1) * &  
    576                               & MAX( SIGN(1._wp,(zgdepw(iin,ijn,ik,iobs) ) &  
    577                               &  - prodatqc%var(2)%vdep(iend)),0._wp)  
    578                              
    579                            EXIT depth_loop2  
    580  
    581                         ENDIF  
    582  
    583                      ENDDO depth_loop2  
    584       
    585                   ENDDO  
    586                ENDDO  
    587     
    588                CALL obs_int_h2d( 1, 1, zweig, interp_corner(:,:,ikn), &  
    589                   &              prodatqc%var(2)%vmod(iend:iend) )  
    590  
    591                   ! Set QC flag for any observations found below the bottom 
    592                   ! needed as the check here is more strict than that in obs_prep 
    593                IF (sum(zweig) == 0.0_wp) prodatqc%var(2)%nvqc(iend:iend)=4 
    594   
    595             ENDDO  
    596   
    597             DEALLOCATE(interp_corner,iv_indic)  
    598            
    599          ENDIF  
     488         ENDIF 
    600489 
    601490      ENDDO 
    602491 
    603492      ! Deallocate the data for interpolation 
    604       DEALLOCATE( & 
    605          & igrdi1, & 
    606          & igrdi2, & 
    607          & igrdj1, & 
    608          & igrdj2, & 
    609          & zglam1, & 
    610          & zglam2, & 
    611          & zgphi1, & 
    612          & zgphi2, & 
    613          & zmask1, & 
    614          & zmask2, & 
    615          & zint1,  & 
    616          & zint2,  & 
     493      DEALLOCATE(  & 
     494         & igrdi,  & 
     495         & igrdj,  & 
     496         & zglam,  & 
     497         & zgphi,  & 
     498         & zmask,  & 
     499         & zint,   & 
    617500         & zgdept, & 
    618501         & zgdepw  & 
    619502         & ) 
    620503 
     504      IF ( ldclim ) THEN 
     505         DEALLOCATE( zclim ) 
     506      ENDIF 
     507 
    621508      ! At the end of the day also get interpolated means 
    622509      IF ( ld_dailyav .AND. idayend == 0 ) THEN 
    623          DEALLOCATE( & 
    624             & zinm1,  & 
    625             & zinm2   & 
    626             & ) 
    627       ENDIF 
    628  
    629       prodatqc%nprofup = prodatqc%nprofup + ipro  
     510         DEALLOCATE( zinm ) 
     511      ENDIF 
     512 
     513      IF ( kvar == prodatqc%nvar ) THEN 
     514         prodatqc%nprofup = prodatqc%nprofup + ipro  
     515      ENDIF 
    630516 
    631517   END SUBROUTINE obs_prof_opt 
    632518 
    633    SUBROUTINE obs_surf_opt( surfdataqc, kt, kpi, kpj,            & 
    634       &                     kit000, kdaystp, psurf, psurfmask,   & 
    635       &                     k2dint, ldnightav, plamscl, pphiscl, & 
    636       &                     lindegrees ) 
     519   SUBROUTINE obs_surf_opt( surfdataqc, kt, kpi, kpj,                & 
     520      &                     kit000, kdaystp, kvar, psurf,            & 
     521      &                     ldclim, kclim, pclim, psurfmask,         & 
     522      &                     k2dint, ldnightav, plamscl, pphiscl,     & 
     523      &                     lindegrees, ldtime_mean, kmeanstp,       & 
     524      &                     kssh, kmdt, kfbd, ksnow ) 
    637525 
    638526      !!----------------------------------------------------------------------- 
    … …  
    680568                                       !   (kit000-1 = restart time) 
    681569      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day 
     570      INTEGER, INTENT(IN) :: kvar      ! Index of variable in surfdataqc   
     571      INTEGER, INTENT(IN) :: kclim     ! Index of climatology in surfdataqc 
    682572      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header) 
     573      LOGICAL, INTENT(IN) :: ldclim    ! Switch to interpolate climatology 
    683574      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
    684575         & psurf,  &                   ! Model surface field 
     576         & pclim,  &                   ! Climatology surface field 
    685577         & psurfmask                   ! Land-sea mask 
    686578      LOGICAL, INTENT(IN) :: ldnightav ! Logical for averaging night-time data 
    … …  
    690582      LOGICAL, INTENT(IN) :: & 
    691583         & lindegrees                  ! T=> plamscl and pphiscl are specified in degrees, F=> in metres 
     584      LOGICAL, INTENT(IN) :: & 
     585         & ldtime_mean                 ! Observations/background represent a time mean 
     586      INTEGER, INTENT(IN) :: kmeanstp  ! Number of time steps for meaning if ldtime_mean 
     587      INTEGER, OPTIONAL, INTENT(IN) :: & 
     588         & kssh                        ! Index of additional variable representing SSH 
     589      INTEGER, OPTIONAL, INTENT(IN) :: & 
     590         & kmdt                        ! Index of extra variable representing MDT 
     591      INTEGER, OPTIONAL, INTENT(IN) :: & 
     592         & kfbd                        ! Index of additional variable representing ice freeboard 
     593      INTEGER, OPTIONAL, INTENT(IN) :: & 
     594         & ksnow                       ! Index of extra variable representing ice snow thickness 
    692595 
    693596      !! * Local declarations 
    … …  
    701604      INTEGER :: imodi, imodj 
    702605      INTEGER :: idayend 
     606      INTEGER :: imeanend 
    703607      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
    704608         & igrdi,   & 
    … …  
    711615      REAL(wp) :: zlam 
    712616      REAL(wp) :: zphi 
    713       REAL(wp), DIMENSION(1) :: zext, zobsmask 
     617      REAL(wp), DIMENSION(1) :: zext, zobsmask, zclm 
    714618      REAL(wp) :: zdaystp 
     619      REAL(wp) :: zmeanstp 
    715620      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
    716621         & zweig,  & 
    … …  
    719624         & zsurfm, & 
    720625         & zsurftmp, & 
     626         & zclim,  & 
    721627         & zglam,  & 
    722628         & zgphi,  & 
    … …  
    741647      CALL obs_max_fpsize( k2dint, plamscl, pphiscl, lindegrees, psurfmask, imaxifp, imaxjfp ) 
    742648 
     649      IF ( ldtime_mean .AND. ldnightav ) THEN 
     650         CALL ctl_stop( 'obs_surf_opt: Can have ldtime_mean or ldnightav but not both' ) 
     651      ENDIF 
     652 
     653      IF ( ldtime_mean ) THEN 
     654         ! Initialize time mean for first timestep 
     655         imeanend = MOD( kt - kit000 + 1, kmeanstp ) 
     656         IF (lwp) WRITE(numout,*) 'Obs time mean ', kt, kit000, kmeanstp, imeanend 
     657 
     658         ! Added kt == 0 test to catch restart case 
     659         IF ( ( imeanend == 1 ) .OR. ( kt == 0 ) ) THEN 
     660            IF (lwp) WRITE(numout,*) 'Reset surfdataqc%vdmean on time-step: ', kt 
     661            DO jj = 1, jpj 
     662               DO ji = 1, jpi 
     663                  surfdataqc%vdmean(ji,jj,kvar) = 0.0 
     664               END DO 
     665            END DO 
     666         ENDIF 
     667 
     668         ! On each time-step, increment the field for computing time mean 
     669         IF (lwp) WRITE(numout,*)'Accumulating surfdataqc%vdmean on time-step: ', kt 
     670         DO jj = 1, jpj 
     671            DO ji = 1, jpi 
     672               surfdataqc%vdmean(ji,jj,kvar) = surfdataqc%vdmean(ji,jj,kvar) & 
     673                  &                            + psurf(ji,jj) 
     674            END DO 
     675         END DO 
     676 
     677         ! Compute the time mean at the end of time period 
     678         IF ( imeanend == 0 ) THEN 
     679            zmeanstp = 1.0 / REAL( kmeanstp ) 
     680            IF (lwp) WRITE(numout,*) 'Calculating surfdataqc%vdmean time mean on time-step: ', & 
     681               &                     kt, ' with weight: ', zmeanstp 
     682            DO jj = 1, jpj 
     683               DO ji = 1, jpi 
     684                  surfdataqc%vdmean(ji,jj,kvar) = surfdataqc%vdmean(ji,jj,kvar) & 
     685                     &                            * zmeanstp 
     686               END DO 
     687            END DO 
     688         ENDIF 
     689      ENDIF 
    743690 
    744691      IF ( ldnightav ) THEN 
    745692 
    746       ! Initialize array for night mean 
     693         ! Initialize array for night mean 
    747694         IF ( kt == 0 ) THEN 
    748695            ALLOCATE ( icount_night(kpi,kpj) ) 
    … …  
    762709            DO jj = 1, jpj 
    763710               DO ji = 1, jpi 
    764                   surfdataqc%vdmean(ji,jj) = 0.0 
     711                  surfdataqc%vdmean(ji,jj,:) = 0.0 
    765712                  zmeanday(ji,jj) = 0.0 
    766713                  icount_night(ji,jj) = 0 
    … …  
    775722         DO jj = 1, jpj 
    776723            DO ji = 1, jpi 
    777                ! Increment the temperature field for computing night mean and counter 
    778                surfdataqc%vdmean(ji,jj) = surfdataqc%vdmean(ji,jj)  & 
    779                       &                    + psurf(ji,jj) * REAL( imask_night(ji,jj) ) 
     724               ! Increment the model field for computing night mean and counter 
     725               surfdataqc%vdmean(ji,jj,kvar) = surfdataqc%vdmean(ji,jj,kvar)  & 
     726                      &                        + psurf(ji,jj) * REAL( imask_night(ji,jj) ) 
    780727               zmeanday(ji,jj)          = zmeanday(ji,jj) + psurf(ji,jj) 
    781728               icount_night(ji,jj)      = icount_night(ji,jj) + imask_night(ji,jj) 
    … …  
    786733         zdaystp = 1.0 / REAL( kdaystp ) 
    787734         IF ( idayend == 0 ) THEN 
    788             IF (lwp) WRITE(numout,*) 'Calculating surfdataqc%vdmean on time-step: ',kt 
     735            IF (lwp) WRITE(numout,*) 'Calculating surfdataqc%vdmean on time-step: ', kt 
    789736            DO jj = 1, jpj 
    790737               DO ji = 1, jpi 
    791738                  ! Test if "no night" point 
    792739                  IF ( icount_night(ji,jj) > 0 ) THEN 
    793                      surfdataqc%vdmean(ji,jj) = surfdataqc%vdmean(ji,jj) & 
    794                        &                        / REAL( icount_night(ji,jj) ) 
     740                     surfdataqc%vdmean(ji,jj,kvar) = surfdataqc%vdmean(ji,jj,kvar) & 
     741                       &                             / REAL( icount_night(ji,jj) ) 
    795742                  ELSE 
    796743                     !At locations where there is no night (e.g. poles), 
    797744                     ! calculate daily mean instead of night-time mean. 
    798                      surfdataqc%vdmean(ji,jj) = zmeanday(ji,jj) * zdaystp 
     745                     surfdataqc%vdmean(ji,jj,kvar) = zmeanday(ji,jj) * zdaystp 
    799746                  ENDIF 
    800747               END DO 
    … …  
    814761         & zmask(imaxifp,imaxjfp,isurf), & 
    815762         & zsurf(imaxifp,imaxjfp,isurf), & 
    816          & zsurftmp(imaxifp,imaxjfp,isurf),  & 
    817          & zglamf(imaxifp+1,imaxjfp+1,isurf), & 
    818          & zgphif(imaxifp+1,imaxjfp+1,isurf), & 
    819          & igrdip1(imaxifp+1,imaxjfp+1,isurf), & 
    820          & igrdjp1(imaxifp+1,imaxjfp+1,isurf) & 
     763         & zsurftmp(imaxifp,imaxjfp,isurf) & 
    821764         & ) 
     765 
     766      IF ( k2dint > 4 ) THEN 
     767         ALLOCATE( & 
     768            & zglamf(imaxifp+1,imaxjfp+1,isurf),  & 
     769            & zgphif(imaxifp+1,imaxjfp+1,isurf),  & 
     770            & igrdip1(imaxifp+1,imaxjfp+1,isurf), & 
     771            & igrdjp1(imaxifp+1,imaxjfp+1,isurf)  & 
     772            & ) 
     773      ENDIF 
     774 
     775      IF ( ldclim ) THEN 
     776         ALLOCATE( zclim(imaxifp,imaxjfp,isurf) ) 
     777      ENDIF 
    822778 
    823779      DO jobs = surfdataqc%nsurfup + 1, surfdataqc%nsurfup + isurf 
    824780         iobs = jobs - surfdataqc%nsurfup 
    825781         DO ji = 0, imaxifp 
    826             imodi = surfdataqc%mi(jobs) - int(imaxifp/2) + ji - 1 
     782            imodi = surfdataqc%mi(jobs,kvar) - int(imaxifp/2) + ji - 1 
    827783            ! 
    828784            !Deal with wrap around in longitude 
    … …  
    831787            ! 
    832788            DO jj = 0, imaxjfp 
    833                imodj = surfdataqc%mj(jobs) - int(imaxjfp/2) + jj - 1 
     789               imodj = surfdataqc%mj(jobs,kvar) - int(imaxjfp/2) + jj - 1 
    834790               !If model values are out of the domain to the north/south then 
    835791               !set them to be the edge of the domain 
    … …  
    837793               IF ( imodj > jpjglo ) imodj = jpjglo 
    838794               ! 
    839                igrdip1(ji+1,jj+1,iobs) = imodi 
    840                igrdjp1(ji+1,jj+1,iobs) = imodj 
     795               IF ( k2dint > 4 ) THEN 
     796                  igrdip1(ji+1,jj+1,iobs) = imodi 
     797                  igrdjp1(ji+1,jj+1,iobs) = imodj 
     798               ENDIF 
    841799               ! 
    842800               IF ( ji >= 1 .AND. jj >= 1 ) THEN 
    … …  
    855813      CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 
    856814         &                  igrdi, igrdj, psurfmask, zmask ) 
    857       CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 
    858          &                  igrdi, igrdj, psurf, zsurf ) 
    859       CALL obs_int_comm_2d( imaxifp+1, imaxjfp+1, isurf, kpi, kpj, & 
    860          &                  igrdip1, igrdjp1, glamf, zglamf ) 
    861       CALL obs_int_comm_2d( imaxifp+1, imaxjfp+1, isurf, kpi, kpj, & 
    862          &                  igrdip1, igrdjp1, gphif, zgphif ) 
     815 
     816      ! At the end of the averaging period get interpolated means 
     817      IF ( ldtime_mean ) THEN 
     818         IF ( imeanend == 0 ) THEN 
     819            ALLOCATE( zsurfm(imaxifp,imaxjfp,isurf) ) 
     820            IF (lwp) WRITE(numout,*)' Interpolating the time mean values on time step: ', kt 
     821            CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 
     822               &                  igrdi, igrdj, surfdataqc%vdmean(:,:,kvar), zsurfm ) 
     823         ENDIF 
     824      ELSE 
     825         CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 
     826            &                  igrdi, igrdj, psurf, zsurf ) 
     827      ENDIF 
     828 
     829      IF ( k2dint > 4 ) THEN  
     830         CALL obs_int_comm_2d( imaxifp+1, imaxjfp+1, isurf, kpi, kpj, & 
     831            &                  igrdip1, igrdjp1, glamf, zglamf ) 
     832         CALL obs_int_comm_2d( imaxifp+1, imaxjfp+1, isurf, kpi, kpj, & 
     833            &                  igrdip1, igrdjp1, gphif, zgphif ) 
     834      ENDIF 
     835       
     836      IF ( ldclim ) THEN 
     837         CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 
     838            &                  igrdi, igrdj, pclim, zclim ) 
     839      ENDIF 
    863840 
    864841      ! At the end of the day get interpolated means 
    … …  
    870847 
    871848         CALL obs_int_comm_2d( imaxifp,imaxjfp, isurf, kpi, kpj, igrdi, igrdj, & 
    872             &               surfdataqc%vdmean(:,:), zsurfm ) 
     849            &               surfdataqc%vdmean(:,:,kvar), zsurfm ) 
    873850 
    874851      ENDIF 
    … …  
    900877         zphi = surfdataqc%rphi(jobs) 
    901878 
    902          IF ( ldnightav .AND. idayend == 0 ) THEN 
    903             ! Night-time averaged data 
     879         IF ( ( ldnightav .AND. idayend == 0 ) .OR. (ldtime_mean .AND. imeanend == 0) ) THEN 
     880            ! Night-time or N=kmeanstp timestep averaged data 
    904881            zsurftmp(:,:,iobs) = zsurfm(:,:,iobs) 
    905882         ELSE 
    … …  
    907884         ENDIF 
    908885 
    909          IF ( k2dint <= 4 ) THEN 
    910  
    911             ! Get weights to interpolate the model value to the observation point 
    912             CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
    913                &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
    914                &                   zmask(:,:,iobs), zweig, zobsmask ) 
    915  
    916             ! Interpolate the model value to the observation point  
    917             CALL obs_int_h2d( 1, 1, zweig, zsurftmp(:,:,iobs), zext ) 
    918  
    919          ELSE 
    920  
    921             ! Get weights to average the model SLA to the observation footprint 
    922             CALL obs_avg_h2d_init( 1, 1, imaxifp, imaxjfp, k2dint, zlam,  zphi, & 
    923                &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
    924                &                   zglamf(:,:,iobs), zgphif(:,:,iobs), & 
    925                &                   zmask(:,:,iobs), plamscl, pphiscl, & 
    926                &                   lindegrees, zweig, zobsmask ) 
    927  
    928             ! Average the model SST to the observation footprint 
    929             CALL obs_avg_h2d( 1, 1, imaxifp, imaxjfp, & 
    930                &              zweig, zsurftmp(:,:,iobs),  zext ) 
    931  
    932          ENDIF 
    933  
    934          IF ( TRIM(surfdataqc%cvars(1)) == 'SLA' .AND. surfdataqc%nextra == 2 ) THEN 
    935             ! ... Remove the MDT from the SSH at the observation point to get the SLA 
    936             surfdataqc%rext(jobs,1) = zext(1) 
    937             surfdataqc%rmod(jobs,1) = surfdataqc%rext(jobs,1) - surfdataqc%rext(jobs,2) 
    938          ELSE 
    939             surfdataqc%rmod(jobs,1) = zext(1) 
    940          ENDIF 
    941           
    942          IF ( zext(1) == obfillflt ) THEN 
    943             ! If the observation value is a fill value, set QC flag to bad 
    944             surfdataqc%nqc(jobs) = 4 
     886         IF ( ( .NOT. ldtime_mean ) .OR. ( ldtime_mean .AND. imeanend == 0) ) THEN 
     887 
     888            IF ( k2dint <= 4 ) THEN 
     889 
     890               ! Get weights to interpolate the model value to the observation point 
     891               CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
     892                  &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
     893                  &                   zmask(:,:,iobs), zweig, zobsmask ) 
     894 
     895               ! Interpolate the model value to the observation point  
     896               CALL obs_int_h2d( 1, 1, zweig, zsurftmp(:,:,iobs), zext ) 
     897 
     898               IF ( ldclim ) THEN 
     899                  CALL obs_int_h2d( 1, 1, zweig, zclim(:,:,iobs), zclm ) 
     900               ENDIF 
     901 
     902            ELSE 
     903 
     904               ! Get weights to average the model field to the observation footprint 
     905               CALL obs_avg_h2d_init( 1, 1, imaxifp, imaxjfp, k2dint, zlam,  zphi, & 
     906                  &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
     907                  &                   zglamf(:,:,iobs), zgphif(:,:,iobs), & 
     908                  &                   zmask(:,:,iobs), plamscl, pphiscl, & 
     909                  &                   lindegrees, zweig, zobsmask ) 
     910 
     911               ! Average the model field to the observation footprint 
     912               CALL obs_avg_h2d( 1, 1, imaxifp, imaxjfp, & 
     913                  &              zweig, zsurftmp(:,:,iobs),  zext ) 
     914 
     915               IF ( ldclim ) THEN 
     916                  CALL obs_avg_h2d( 1, 1, imaxifp, imaxjfp, & 
     917                     &              zweig, zclim(:,:,iobs),  zclm ) 
     918               ENDIF 
     919 
     920            ENDIF 
     921 
     922            IF ( TRIM(surfdataqc%cvars(kvar)) == cobsname_sla .AND. PRESENT(kssh) .AND. PRESENT(kmdt) ) THEN 
     923               ! ... Remove the MDT from the SSH at the observation point to get the SLA 
     924               surfdataqc%radd(jobs,kssh,kvar) = zext(1) 
     925               surfdataqc%rmod(jobs,kvar) = surfdataqc%radd(jobs,kssh,kvar) - surfdataqc%rext(jobs,kmdt) 
     926#if defined key_si3 || defined key_cice 
     927            ELSE IF ( TRIM(surfdataqc%cvars(kvar)) == cobsname_fbd .AND. PRESENT(kfbd) .AND. PRESENT(ksnow) ) THEN 
     928               surfdataqc%rmod(jobs,kvar) = zext(1) 
     929               ! Convert radar freeboard to true freeboard 
     930               ! (add 1/4 snow depth; 1/4 based on ratio of speed of light in vacuum 
     931               !  compared to snow (3.0e8 vs 2.4e8 m/s)) 
     932               surfdataqc%radd(jobs,kfbd,kvar) = surfdataqc%robs(jobs,kvar) 
     933               surfdataqc%robs(jobs,kvar) = surfdataqc%radd(jobs,kfbd,kvar) + 0.25*surfdataqc%rext(jobs,ksnow) 
     934               ! If the corrected freeboard observation is outside -0.3 to 3.0 m (CPOM) then set the QC flag to bad 
     935               IF ((surfdataqc%robs(jobs,kvar) < -0.3) .OR. (surfdataqc%robs(jobs,kvar) > 3.0)) THEN 
     936                  surfdataqc%nqc(jobs) = 4 
     937               ENDIF            
     938               ! Convert corrected freeboard to ice thickness following Tilling et al. (2016) 
     939               surfdataqc%robs(jobs,kvar) = (surfdataqc%robs(jobs,kvar)*rhow + surfdataqc%rext(jobs,ksnow)*rhos)/ & 
     940                  &                         (rhow - rhoi) 
     941#endif 
     942            ELSE 
     943               surfdataqc%rmod(jobs,kvar) = zext(1) 
     944            ENDIF 
     945 
     946            IF ( ldclim ) THEN 
     947               surfdataqc%radd(jobs,kclim,kvar) = zclm(1) 
     948            ENDIF 
     949 
     950            IF ( zext(1) == obfillflt ) THEN 
     951               ! If the observation value is a fill value, set QC flag to bad 
     952               surfdataqc%nqc(jobs) = 4 
     953            ENDIF 
     954 
    945955         ENDIF 
    946956 
    … …  
    956966         & zmask, & 
    957967         & zsurf, & 
    958          & zsurftmp, & 
    959          & zglamf, & 
    960          & zgphif, & 
    961          & igrdip1,& 
    962          & igrdjp1 & 
     968         & zsurftmp & 
    963969         & ) 
    964970 
    965       ! At the end of the day also deallocate night-time mean array 
    966       IF ( idayend == 0 .AND. ldnightav ) THEN 
     971      IF ( k2dint > 4 ) THEN 
     972         DEALLOCATE( &      
     973            & zglamf, & 
     974            & zgphif, & 
     975            & igrdip1,& 
     976            & igrdjp1 & 
     977            & ) 
     978      ENDIF 
     979             
     980      IF ( ldclim ) THEN 
     981         DEALLOCATE( zclim ) 
     982      ENDIF 
     983 
     984      ! At the end of the day also deallocate time mean array 
     985      IF ( ( idayend == 0 .AND. ldnightav ) .OR. ( imeanend == 0 .AND. ldtime_mean ) ) THEN 
    967986         DEALLOCATE( & 
    968987            & zsurfm  & 
    … …  
    970989      ENDIF 
    971990      ! 
    972       surfdataqc%nsurfup = surfdataqc%nsurfup + isurf 
     991      IF ( kvar == surfdataqc%nvar ) THEN 
     992         surfdataqc%nsurfup = surfdataqc%nsurfup + isurf 
     993      ENDIF 
    973994      ! 
    974995   END SUBROUTINE obs_surf_opt 

  • NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS/obs_prep.F90

    r14075 r15799  
    2222   USE obs_inter_sup      ! Interpolation support 
    2323   USE obs_oper           ! Observation operators 
     24   USE obs_group_def, ONLY : &  ! Observation variable information 
     25      & cobsname_uvel, & 
     26      & cobsname_vvel, & 
     27      & imaxavtypes 
    2428   USE lib_mpp, ONLY :   ctl_warn, ctl_stop 
    2529   USE bdy_oce, ONLY : &        ! Boundary information 
    … …  
    4246CONTAINS 
    4347 
    44    SUBROUTINE obs_pre_surf( surfdata, surfdataqc, ld_nea, ld_bound_reject, & 
    45                             kqc_cutoff ) 
    46       !!---------------------------------------------------------------------- 
    47       !!                    ***  ROUTINE obs_pre_sla  *** 
     48   SUBROUTINE obs_pre_surf( surfdata, surfdataqc, & 
     49      &                     kpi, kpj, &    
     50      &                     zmask, pglam, pgphi, & 
     51      &                     ld_nea, ld_bound_reject, & 
     52      &                     kqc_cutoff ) 
     53      !!---------------------------------------------------------------------- 
     54      !!                    ***  ROUTINE obs_pre_surf  *** 
    4855      !! 
    4956      !! ** Purpose : First level check and screening of surface observations 
    … …  
    6572      !! * Arguments 
    6673      TYPE(obs_surf), INTENT(INOUT) :: surfdata    ! Full set of surface data 
    67       TYPE(obs_surf), INTENT(INOUT) :: surfdataqc   ! Subset of surface data not failing screening 
    68       LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land 
     74      TYPE(obs_surf), INTENT(INOUT) :: surfdataqc  ! Subset of surface data not failing screening 
     75      INTEGER, INTENT(IN) :: kpi, kpj              ! Local domain sizes       
     76      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj,surfdata%nvar) :: & 
     77         & zmask       
     78      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj,surfdata%nvar) :: & 
     79         & pglam, & 
     80         & pgphi 
     81      LOGICAL, INTENT(IN) :: ld_nea                ! Switch for rejecting observation near land 
    6982      LOGICAL, INTENT(IN) :: ld_bound_reject       ! Switch for rejecting obs near the boundary 
    70       INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff   ! cut off for QC value 
     83      INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff  ! cut off for QC value 
    7184      !! * Local declarations 
    7285      INTEGER :: iqc_cutoff = 255   ! cut off for QC value 
    … …  
    7790      INTEGER :: imin0 
    7891      INTEGER :: icycle       ! Current assimilation cycle 
    79                               ! Counters for observations that 
    80       INTEGER :: iotdobs      !  - outside time domain 
    81       INTEGER :: iosdsobs     !  - outside space domain 
    82       INTEGER :: ilansobs     !  - within a model land cell 
    83       INTEGER :: inlasobs     !  - close to land 
    84       INTEGER :: igrdobs      !  - fail the grid search 
    85       INTEGER :: ibdysobs     !  - close to open boundary 
    86                               ! Global counters for observations that 
    87       INTEGER :: iotdobsmpp     !  - outside time domain 
    88       INTEGER :: iosdsobsmpp    !  - outside space domain 
    89       INTEGER :: ilansobsmpp    !  - within a model land cell 
    90       INTEGER :: inlasobsmpp    !  - close to land 
    91       INTEGER :: igrdobsmpp     !  - fail the grid search 
    92       INTEGER :: ibdysobsmpp  !  - close to open boundary 
     92                                                        ! Counters for observations that are 
     93      INTEGER                           :: iotdobs      !  - outside time domain 
     94      INTEGER, DIMENSION(surfdata%nvar) :: iosdsobs     !  - outside space domain 
     95      INTEGER, DIMENSION(surfdata%nvar) :: ilansobs     !  - within a model land cell 
     96      INTEGER, DIMENSION(surfdata%nvar) :: inlasobs     !  - close to land 
     97      INTEGER, DIMENSION(surfdata%nvar) :: ibdysobs     !  - close to open boundary 
     98      INTEGER                           :: igrdobs      !  - fail the grid search       
     99                                                        ! Global counters for observations that 
     100      INTEGER                           :: iotdobsmpp   !  - outside time domain 
     101      INTEGER, DIMENSION(surfdata%nvar) :: iosdsobsmpp  !  - outside space domain 
     102      INTEGER, DIMENSION(surfdata%nvar) :: ilansobsmpp  !  - within a model land cell 
     103      INTEGER, DIMENSION(surfdata%nvar) :: inlasobsmpp  !  - close to land 
     104      INTEGER, DIMENSION(surfdata%nvar) :: ibdysobsmpp  !  - close to open boundary 
     105      INTEGER                           :: igrdobsmpp   !  - fail the grid search 
     106 
    93107      LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    94108         & llvalid            ! SLA data selection 
    95       INTEGER :: jobs         ! Obs. loop variable 
     109      INTEGER :: jobs         ! Obs. loop counter 
     110      INTEGER :: jvar         ! Variable loop counter 
    96111      INTEGER :: jstp         ! Time loop variable 
    97112      INTEGER :: inrc         ! Time index variable 
     113      CHARACTER(LEN=256) :: cout1  ! Diagnostic output line 
    98114      !!---------------------------------------------------------------------- 
    99115 
    … …  
    110126      icycle = nn_no     ! Assimilation cycle 
    111127 
    112       ! Diagnotics counters for various failures. 
     128      ! Diagnostic counters for various failures. 
    113129 
    114130      iotdobs  = 0 
    115131      igrdobs  = 0 
    116       iosdsobs = 0 
    117       ilansobs = 0 
    118       inlasobs = 0 
    119       ibdysobs = 0  
     132      iosdsobs(:) = 0 
     133      ilansobs(:) = 0 
     134      inlasobs(:) = 0 
     135      ibdysobs(:) = 0  
    120136 
    121137      ! Set QC cutoff to optional value if provided 
    122       IF ( PRESENT(kqc_cutoff) ) iqc_cutoff=kqc_cutoff 
     138      IF ( PRESENT(kqc_cutoff) ) iqc_cutoff = kqc_cutoff 
    123139 
    124140      ! ----------------------------------------------------------------------- 
    … …  
    138154      ! ----------------------------------------------------------------------- 
    139155 
    140       CALL obs_coo_grd( surfdata%nsurf,   surfdata%mi, surfdata%mj, & 
    141          &              surfdata%nqc,     igrdobs                         ) 
     156      DO jvar = 1, surfdata%nvar 
     157         CALL obs_coo_grd( surfdata%nsurf,      surfdata%mi(:,jvar),         & 
     158            &              surfdata%mj(:,jvar), surfdata%nqc,        igrdobs ) 
     159      END DO 
    142160 
    143161      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 
    … …  
    147165      ! ----------------------------------------------------------------------- 
    148166 
    149       CALL obs_coo_spc_2d( surfdata%nsurf,              & 
    150          &                 jpi,          jpj,          & 
    151          &                 surfdata%mi,   surfdata%mj,   &  
    152          &                 surfdata%rlam, surfdata%rphi, & 
    153          &                 glamt,        gphit,        & 
    154          &                 tmask(:,:,1), surfdata%nqc,  & 
    155          &                 iosdsobs,     ilansobs,     & 
    156          &                 inlasobs,     ld_nea,       & 
    157          &                 ibdysobs,     ld_bound_reject, & 
    158          &                 iqc_cutoff                     ) 
    159  
    160       CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    161       CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    162       CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
    163       CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 
     167      DO jvar = 1, surfdata%nvar 
     168         CALL obs_coo_spc_2d( surfdata%nsurf,                           & 
     169            &                 jpi,                 jpj,                 & 
     170            &                 surfdata%mi(:,jvar), surfdata%mj(:,jvar), &  
     171            &                 surfdata%rlam,       surfdata%rphi,       & 
     172            &                 pglam(:,:,jvar),     pgphi(:,:,jvar),     & 
     173            &                 zmask(:,:,jvar),     surfdata%nqc,        & 
     174            &                 iosdsobs(jvar),      ilansobs(jvar),      & 
     175            &                 inlasobs(jvar),      ld_nea,              & 
     176            &                 ibdysobs(jvar),      ld_bound_reject,     & 
     177            &                 iqc_cutoff                     ) 
     178         CALL obs_mpp_sum_integer( iosdsobs(jvar), iosdsobsmpp(jvar) ) 
     179         CALL obs_mpp_sum_integer( ilansobs(jvar), ilansobsmpp(jvar) ) 
     180         CALL obs_mpp_sum_integer( inlasobs(jvar), inlasobsmpp(jvar) ) 
     181         CALL obs_mpp_sum_integer( ibdysobs(jvar), ibdysobsmpp(jvar) ) 
     182      END DO 
    164183 
    165184      ! ----------------------------------------------------------------------- 
    … …  
    191210       
    192211      IF(lwp) THEN 
     212         DO jvar = 1, surfdataqc%nvar        
     213            IF ( jvar == 1 ) THEN 
     214               cout1 = TRIM(surfdataqc%cvars(1))                   
     215            ELSE 
     216               WRITE(cout1,'(A,A1,A)') TRIM(cout1), '/', TRIM(surfdataqc%cvars(jvar))             
     217            ENDIF 
     218         END DO 
     219                
    193220         WRITE(numout,*) 
    194          WRITE(numout,*) ' '//surfdataqc%cvars(1)//' data outside time domain                  = ', & 
     221         WRITE(numout,*) ' '//TRIM(cout1)//' data outside time domain                  = ', & 
    195222            &            iotdobsmpp 
    196          WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data that failed grid search    = ', & 
     223         WRITE(numout,*) ' Remaining '//TRIM(cout1)//' data that failed grid search    = ', & 
    197224            &            igrdobsmpp 
    198          WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data outside space domain       = ', & 
    199             &            iosdsobsmpp 
    200          WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data at land points             = ', & 
    201             &            ilansobsmpp 
    202          IF (ld_nea) THEN 
    203             WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data near land points (removed) = ', & 
    204                &            inlasobsmpp 
    205          ELSE 
    206             WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data near land points (kept)    = ', & 
    207                &            inlasobsmpp 
    208          ENDIF 
    209          WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data near open boundary (removed) = ', & 
    210             &            ibdysobsmpp   
    211          WRITE(numout,*) ' '//surfdataqc%cvars(1)//' data accepted                             = ', & 
    212             &            surfdataqc%nsurfmpp 
     225 
     226         DO jvar = 1, surfdataqc%nvar             
     227            WRITE(numout,*) ' Remaining '//surfdataqc%cvars(jvar)//' data outside space domain       = ', & 
     228                &            iosdsobsmpp(jvar) 
     229             WRITE(numout,*) ' Remaining '//surfdataqc%cvars(jvar)//' data at land points             = ', & 
     230                &            ilansobsmpp(jvar) 
     231             IF (ld_nea) THEN 
     232                WRITE(numout,*) ' Remaining '//surfdataqc%cvars(jvar)//' data near land points (removed) = ', & 
     233                   &            inlasobsmpp(jvar) 
     234             ELSE 
     235                WRITE(numout,*) ' Remaining '//surfdataqc%cvars(jvar)//' data near land points (kept)    = ', & 
     236                   &            inlasobsmpp(jvar) 
     237             ENDIF      
     238             WRITE(numout,*) ' Remaining '//surfdataqc%cvars(jvar)//' data near open boundary (removed) = ', & 
     239                &            ibdysobsmpp(jvar) 
     240          END DO 
     241          WRITE(numout,*) ' '//TRIM(cout1)//' data accepted                             = ', & 
     242             &            surfdataqc%nsurfmpp 
    213243 
    214244         WRITE(numout,*) 
    215245         WRITE(numout,*) ' Number of observations per time step :' 
    216246         WRITE(numout,*) 
    217          WRITE(numout,'(10X,A,10X,A)')'Time step',surfdataqc%cvars(1) 
    218          WRITE(numout,'(10X,A,5X,A)')'---------','-----------------' 
     247         WRITE(numout,'(10X,A,10X,A)') 'Time step', TRIM(cout1) 
     248         WRITE(numout,'(10X,A,5X,A)')  '---------', '-----------------' 
    219249         CALL FLUSH(numout) 
    220250      ENDIF 
    … …  
    241271 
    242272 
    243    SUBROUTINE obs_pre_prof( profdata, prodatqc, ld_var1, ld_var2, & 
     273   SUBROUTINE obs_pre_prof( profdata, prodatqc, ld_var, & 
    244274      &                     kpi, kpj, kpk, & 
    245       &                     zmask1, pglam1, pgphi1, zmask2, pglam2, pgphi2,  & 
     275      &                     zmask, pglam, pgphi,  & 
    246276      &                     ld_nea, ld_bound_reject, kdailyavtypes,  kqc_cutoff ) 
    247277 
    … …  
    269299      TYPE(obs_prof), INTENT(INOUT) :: profdata   ! Full set of profile data 
    270300      TYPE(obs_prof), INTENT(INOUT) :: prodatqc   ! Subset of profile data not failing screening 
    271       LOGICAL, INTENT(IN) :: ld_var1              ! Observed variables switches 
    272       LOGICAL, INTENT(IN) :: ld_var2 
     301      LOGICAL, DIMENSION(profdata%nvar), INTENT(IN) :: & 
     302         & ld_var                                 ! Observed variables switches 
    273303      LOGICAL, INTENT(IN) :: ld_nea               ! Switch for rejecting observation near land 
    274304      LOGICAL, INTENT(IN) :: ld_bound_reject      ! Switch for rejecting observations near the boundary 
    … …  
    276306      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    277307         & kdailyavtypes                          ! Types for daily averages 
    278       REAL(wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 
    279          & zmask1, & 
    280          & zmask2 
    281       REAL(wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
    282          & pglam1, & 
    283          & pglam2, & 
    284          & pgphi1, & 
    285          & pgphi2 
     308      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj,kpk,profdata%nvar) :: & 
     309         & zmask 
     310      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj,profdata%nvar) :: & 
     311         & pglam, & 
     312         & pgphi 
    286313      INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff   ! cut off for QC value 
    287314 
    … …  
    294321      INTEGER :: imin0 
    295322      INTEGER :: icycle       ! Current assimilation cycle 
    296                               ! Counters for observations that are 
    297       INTEGER :: iotdobs      !  - outside time domain 
    298       INTEGER :: iosdv1obs    !  - outside space domain (variable 1) 
    299       INTEGER :: iosdv2obs    !  - outside space domain (variable 2) 
    300       INTEGER :: ilanv1obs    !  - within a model land cell (variable 1) 
    301       INTEGER :: ilanv2obs    !  - within a model land cell (variable 2) 
    302       INTEGER :: inlav1obs    !  - close to land (variable 1) 
    303       INTEGER :: inlav2obs    !  - close to land (variable 2) 
    304       INTEGER :: ibdyv1obs    !  - boundary (variable 1)  
    305       INTEGER :: ibdyv2obs    !  - boundary (variable 2)       
    306       INTEGER :: igrdobs      !  - fail the grid search 
    307       INTEGER :: iuvchku      !  - reject u if v rejected and vice versa 
    308       INTEGER :: iuvchkv      ! 
    309                               ! Global counters for observations that are 
    310       INTEGER :: iotdobsmpp   !  - outside time domain 
    311       INTEGER :: iosdv1obsmpp !  - outside space domain (variable 1) 
    312       INTEGER :: iosdv2obsmpp !  - outside space domain (variable 2) 
    313       INTEGER :: ilanv1obsmpp !  - within a model land cell (variable 1) 
    314       INTEGER :: ilanv2obsmpp !  - within a model land cell (variable 2) 
    315       INTEGER :: inlav1obsmpp !  - close to land (variable 1) 
    316       INTEGER :: inlav2obsmpp !  - close to land (variable 2) 
    317       INTEGER :: ibdyv1obsmpp !  - boundary (variable 1)  
    318       INTEGER :: ibdyv2obsmpp !  - boundary (variable 2)       
    319       INTEGER :: igrdobsmpp   !  - fail the grid search 
    320       INTEGER :: iuvchkumpp   !  - reject var1 if var2 rejected and vice versa 
    321       INTEGER :: iuvchkvmpp   ! 
     323                                                       ! Counters for observations that are 
     324      INTEGER                           :: iotdobs     !  - outside time domain 
     325      INTEGER, DIMENSION(profdata%nvar) :: iosdvobs    !  - outside space domain 
     326      INTEGER, DIMENSION(profdata%nvar) :: ilanvobs    !  - within a model land cell 
     327      INTEGER, DIMENSION(profdata%nvar) :: inlavobs    !  - close to land 
     328      INTEGER, DIMENSION(profdata%nvar) :: ibdyvobs    !  - boundary    
     329      INTEGER                           :: igrdobs     !  - fail the grid search 
     330      INTEGER                           :: iuvchku     !  - reject UVEL if VVEL rejected 
     331      INTEGER                           :: iuvchkv     !  - reject VVEL if UVEL rejected 
     332                                                       ! Global counters for observations that are 
     333      INTEGER                           :: iotdobsmpp  !  - outside time domain 
     334      INTEGER, DIMENSION(profdata%nvar) :: iosdvobsmpp !  - outside space domain 
     335      INTEGER, DIMENSION(profdata%nvar) :: ilanvobsmpp !  - within a model land cell 
     336      INTEGER, DIMENSION(profdata%nvar) :: inlavobsmpp !  - close to land 
     337      INTEGER, DIMENSION(profdata%nvar) :: ibdyvobsmpp !  - boundary 
     338      INTEGER :: igrdobsmpp                            !  - fail the grid search 
     339      INTEGER :: iuvchkumpp                            !  - reject UVEL if VVEL rejected 
     340      INTEGER :: iuvchkvmpp                            !  - reject VVEL if UVEL rejected 
     341      INTEGER :: iuvar                                 !  - UVEL index 
     342      INTEGER :: ivvar                                 !  - VVEL index 
    322343      TYPE(obs_prof_valid) ::  llvalid      ! Profile selection  
    323344      TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: & 
    324          & llvvalid           ! var1,var2 selection  
     345         & llvvalid           ! var selection  
    325346      INTEGER :: jvar         ! Variable loop variable 
    326347      INTEGER :: jobs         ! Obs. loop variable 
    327348      INTEGER :: jstp         ! Time loop variable 
    328349      INTEGER :: inrc         ! Time index variable 
     350      CHARACTER(LEN=256) :: cout1  ! Diagnostic output line 
     351      CHARACTER(LEN=256) :: cout2  ! Diagnostic output line 
    329352      !!---------------------------------------------------------------------- 
    330353 
    … …  
    341364      icycle = nn_no     ! Assimilation cycle 
    342365 
    343       ! Diagnotics counters for various failures. 
    344  
    345       iotdobs   = 0 
    346       igrdobs   = 0 
    347       iosdv1obs = 0 
    348       iosdv2obs = 0 
    349       ilanv1obs = 0 
    350       ilanv2obs = 0 
    351       inlav1obs = 0 
    352       inlav2obs = 0 
    353       ibdyv1obs = 0 
    354       ibdyv2obs = 0 
    355       iuvchku   = 0 
    356       iuvchkv   = 0 
     366      ! Diagnostic counters for various failures. 
     367 
     368      iotdobs     = 0 
     369      igrdobs     = 0 
     370      iosdvobs(:) = 0 
     371      ilanvobs(:) = 0 
     372      inlavobs(:) = 0 
     373      ibdyvobs(:) = 0 
     374      iuvchku     = 0 
     375      iuvchkv     = 0 
    357376 
    358377 
    359378      ! Set QC cutoff to optional value if provided 
    360       IF ( PRESENT(kqc_cutoff) ) iqc_cutoff=kqc_cutoff 
     379      IF ( PRESENT(kqc_cutoff) ) iqc_cutoff = kqc_cutoff 
    361380 
    362381      ! ----------------------------------------------------------------------- 
    … …  
    387406      ! ----------------------------------------------------------------------- 
    388407 
    389       CALL obs_coo_grd( profdata%nprof,   profdata%mi(:,1), profdata%mj(:,1), & 
    390          &              profdata%nqc,     igrdobs                         ) 
    391       CALL obs_coo_grd( profdata%nprof,   profdata%mi(:,2), profdata%mj(:,2), & 
    392          &              profdata%nqc,     igrdobs                         ) 
     408      DO jvar = 1, profdata%nvar 
     409         CALL obs_coo_grd( profdata%nprof,   profdata%mi(:,jvar), profdata%mj(:,jvar), & 
     410            &              profdata%nqc,     igrdobs                         ) 
     411      END DO 
    393412 
    394413      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 
    … …  
    405424      ! ----------------------------------------------------------------------- 
    406425 
    407       ! Variable 1 
    408       CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(1),   & 
    409          &                 profdata%npvsta(:,1),  profdata%npvend(:,1), & 
    410          &                 jpi,                   jpj,                  & 
    411          &                 jpk,                                         & 
    412          &                 profdata%mi,           profdata%mj,          & 
    413          &                 profdata%var(1)%mvk,                         & 
    414          &                 profdata%rlam,         profdata%rphi,        & 
    415          &                 profdata%var(1)%vdep,                        & 
    416          &                 pglam1,                pgphi1,               & 
    417          &                 gdept_1d,              zmask1,               & 
    418          &                 profdata%nqc,          profdata%var(1)%nvqc, & 
    419          &                 iosdv1obs,             ilanv1obs,            & 
    420          &                 inlav1obs,             ld_nea,               & 
    421          &                 ibdyv1obs,             ld_bound_reject,      & 
    422          &                 iqc_cutoff       ) 
    423  
    424       CALL obs_mpp_sum_integer( iosdv1obs, iosdv1obsmpp ) 
    425       CALL obs_mpp_sum_integer( ilanv1obs, ilanv1obsmpp ) 
    426       CALL obs_mpp_sum_integer( inlav1obs, inlav1obsmpp ) 
    427       CALL obs_mpp_sum_integer( ibdyv1obs, ibdyv1obsmpp ) 
    428  
    429       ! Variable 2 
    430       CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(2),   & 
    431          &                 profdata%npvsta(:,2),  profdata%npvend(:,2), & 
    432          &                 jpi,                   jpj,                  & 
    433          &                 jpk,                                         & 
    434          &                 profdata%mi,           profdata%mj,          &  
    435          &                 profdata%var(2)%mvk,                         & 
    436          &                 profdata%rlam,         profdata%rphi,        & 
    437          &                 profdata%var(2)%vdep,                        & 
    438          &                 pglam2,                pgphi2,               & 
    439          &                 gdept_1d,              zmask2,               & 
    440          &                 profdata%nqc,          profdata%var(2)%nvqc, & 
    441          &                 iosdv2obs,             ilanv2obs,            & 
    442          &                 inlav2obs,             ld_nea,               & 
    443          &                 ibdyv2obs,             ld_bound_reject,      & 
    444          &                 iqc_cutoff       ) 
    445  
    446       CALL obs_mpp_sum_integer( iosdv2obs, iosdv2obsmpp ) 
    447       CALL obs_mpp_sum_integer( ilanv2obs, ilanv2obsmpp ) 
    448       CALL obs_mpp_sum_integer( inlav2obs, inlav2obsmpp ) 
    449       CALL obs_mpp_sum_integer( ibdyv2obs, ibdyv2obsmpp ) 
     426      DO jvar = 1, profdata%nvar 
     427         CALL obs_coo_spc_3d( profdata%nprof,          profdata%nvprot(jvar),   & 
     428            &                 profdata%npvsta(:,jvar), profdata%npvend(:,jvar), & 
     429            &                 jpi,                     jpj,                     & 
     430            &                 jpk,                                              & 
     431            &                 profdata%mi,             profdata%mj,             & 
     432            &                 profdata%var(jvar)%mvk,                           & 
     433            &                 profdata%rlam,           profdata%rphi,           & 
     434            &                 profdata%var(jvar)%vdep,                          & 
     435            &                 pglam(:,:,jvar),         pgphi(:,:,jvar),         & 
     436            &                 gdept_1d,                zmask(:,:,:,jvar),       & 
     437            &                 profdata%nqc,            profdata%var(jvar)%nvqc, & 
     438            &                 iosdvobs(jvar),          ilanvobs(jvar),          & 
     439            &                 inlavobs(jvar),          ld_nea,                  & 
     440            &                 ibdyvobs(jvar),          ld_bound_reject,         & 
     441            &                 iqc_cutoff       ) 
     442 
     443         CALL obs_mpp_sum_integer( iosdvobs(jvar), iosdvobsmpp(jvar) ) 
     444         CALL obs_mpp_sum_integer( ilanvobs(jvar), ilanvobsmpp(jvar) ) 
     445         CALL obs_mpp_sum_integer( inlavobs(jvar), inlavobsmpp(jvar) ) 
     446         CALL obs_mpp_sum_integer( ibdyvobs(jvar), ibdyvobsmpp(jvar) ) 
     447      END DO 
    450448 
    451449      ! ----------------------------------------------------------------------- 
    … …  
    453451      ! ----------------------------------------------------------------------- 
    454452 
    455       IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN 
    456          CALL obs_uv_rej( profdata, iuvchku, iuvchkv, iqc_cutoff ) 
     453      iuvar = 0 
     454      ivvar = 0 
     455      DO jvar = 1,profdata%nvar 
     456         IF ( TRIM(profdata%cvars(jvar)) == cobsname_uvel ) THEN 
     457            iuvar = jvar 
     458         ELSEIF ( TRIM(profdata%cvars(jvar)) == cobsname_vvel ) THEN 
     459            ivvar = jvar 
     460         ENDIF 
     461      END DO 
     462      IF ( (iuvar > 0) .AND. (ivvar > 0) ) THEN 
     463         CALL obs_uv_rej( profdata, iuvchku, iuvchkv, iqc_cutoff, iuvar, ivvar ) 
    457464         CALL obs_mpp_sum_integer( iuvchku, iuvchkumpp ) 
    458465         CALL obs_mpp_sum_integer( iuvchkv, iuvchkvmpp ) 
    … …  
    498505       
    499506         WRITE(numout,*) 
    500          WRITE(numout,*) ' Profiles outside time domain                     = ', & 
     507         WRITE(numout,*) ' Profiles outside time domain                       = ', & 
    501508            &            iotdobsmpp 
    502          WRITE(numout,*) ' Remaining profiles that failed grid search       = ', & 
     509         WRITE(numout,*) ' Remaining profiles that failed grid search         = ', & 
    503510            &            igrdobsmpp 
    504          WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data outside space domain       = ', & 
    505             &            iosdv1obsmpp 
    506          WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data at land points             = ', & 
    507             &            ilanv1obsmpp 
    508          IF (ld_nea) THEN 
    509             WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data near land points (removed) = ',& 
    510                &            inlav1obsmpp 
    511          ELSE 
    512             WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data near land points (kept)    = ',& 
    513                &            inlav1obsmpp 
    514          ENDIF 
    515          IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN 
    516             WRITE(numout,*) ' U observation rejected since V rejected     = ', & 
    517                &            iuvchku 
    518          ENDIF 
    519          WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data near open boundary (removed) = ',& 
    520                &            ibdyv1obsmpp 
    521          WRITE(numout,*) ' '//prodatqc%cvars(1)//' data accepted                             = ', & 
    522             &            prodatqc%nvprotmpp(1) 
    523          WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data outside space domain       = ', & 
    524             &            iosdv2obsmpp 
    525          WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data at land points             = ', & 
    526             &            ilanv2obsmpp 
    527          IF (ld_nea) THEN 
    528             WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near land points (removed) = ',& 
    529                &            inlav2obsmpp 
    530          ELSE 
    531             WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near land points (kept)    = ',& 
    532                &            inlav2obsmpp 
    533          ENDIF 
    534          IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN 
    535             WRITE(numout,*) ' V observation rejected since U rejected     = ', & 
    536                &            iuvchkv 
    537          ENDIF 
    538          WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near open boundary (removed) = ',& 
    539                &            ibdyv2obsmpp 
    540          WRITE(numout,*) ' '//prodatqc%cvars(2)//' data accepted                             = ', & 
    541             &            prodatqc%nvprotmpp(2) 
     511         DO jvar = 1, profdata%nvar 
     512            WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data outside space domain       = ', & 
     513               &            iosdvobsmpp(jvar) 
     514            WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data at land points             = ', & 
     515               &            ilanvobsmpp(jvar) 
     516            IF (ld_nea) THEN 
     517               WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data near land points (removed) = ', & 
     518                  &            inlavobsmpp(jvar) 
     519            ELSE 
     520               WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data near land points (kept)    = ', & 
     521                  &            inlavobsmpp(jvar) 
     522            ENDIF 
     523            IF ( (iuvar > 0) .AND. (ivvar > 0) ) THEN 
     524               IF ( TRIM(profdata%cvars(jvar)) == cobsname_uvel ) THEN 
     525                  WRITE(numout,*) ' U observation rejected since V rejected     = ', & 
     526                     &            iuvchku 
     527               ELSE IF ( TRIM(profdata%cvars(jvar)) == cobsname_vvel ) THEN 
     528                  WRITE(numout,*) ' V observation rejected since U rejected     = ', & 
     529                     &            iuvchkv 
     530               ENDIF 
     531            ENDIF 
     532            WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data near open boundary (removed) = ', & 
     533                  &            ibdyvobsmpp(jvar) 
     534            WRITE(numout,*) ' '//prodatqc%cvars(jvar)//' data accepted                             = ', & 
     535               &            prodatqc%nvprotmpp(jvar) 
     536         END DO 
    542537 
    543538         WRITE(numout,*) 
    544539         WRITE(numout,*) ' Number of observations per time step :' 
    545540         WRITE(numout,*) 
    546          WRITE(numout,'(10X,A,5X,A,5X,A,A)')'Time step','Profiles', & 
    547             &                               '     '//prodatqc%cvars(1)//'     ', & 
    548             &                               '     '//prodatqc%cvars(2)//'     ' 
    549          WRITE(numout,998) 
     541         WRITE(cout1,'(10X,A9,5X,A8)') 'Time step', 'Profiles' 
     542         WRITE(cout2,'(10X,A9,5X,A8)') '---------', '--------' 
     543         DO jvar = 1, prodatqc%nvar 
     544            WRITE(cout1,'(A,5X,A11)') TRIM(cout1), TRIM(prodatqc%cvars(jvar)) 
     545            WRITE(cout2,'(A,5X,A11)') TRIM(cout2), '-----------' 
     546         END DO 
     547         WRITE(numout,*) cout1 
     548         WRITE(numout,*) cout2 
    550549      ENDIF 
    551550       
    … …  
    574573         DO jstp = nit000 - 1, nitend 
    575574            inrc = jstp - nit000 + 2 
    576             WRITE(numout,999) jstp, prodatqc%npstpmpp(inrc), & 
    577                &                    prodatqc%nvstpmpp(inrc,1), & 
    578                &                    prodatqc%nvstpmpp(inrc,2) 
     575            WRITE(cout1,'(10X,I9,5X,I8)') jstp, prodatqc%npstpmpp(inrc) 
     576            DO jvar = 1, prodatqc%nvar 
     577               WRITE(cout1,'(A,5X,I11)') TRIM(cout1), prodatqc%nvstpmpp(inrc,jvar) 
     578            END DO 
     579            WRITE(numout,*) cout1 
    579580         END DO 
    580581      ENDIF 
    581  
    582 998   FORMAT(10X,'---------',5X,'--------',5X,'-----------',5X,'----------------') 
    583 999   FORMAT(10X,I9,5X,I8,5X,I11,5X,I8) 
    584582 
    585583   END SUBROUTINE obs_pre_prof 
    … …  
    834832      !! * Local declarations 
    835833      INTEGER :: jobs 
    836       INTEGER :: iqc_cutoff=255 
     834      INTEGER :: iqc_cutoff = 255 
    837835 
    838836      !----------------------------------------------------------------------- 
    … …  
    11221120         & gdept_n,       & 
    11231121         & ln_zco,        & 
    1124          & ln_zps              
     1122         & ln_zps,        & 
     1123         & mbkt 
    11251124 
    11261125      !! * Arguments 
    … …  
    11681167      REAL(KIND=wp), DIMENSION(jpi,jpj) :: zbdymask 
    11691168      REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: & 
     1169         & zgdept, & 
    11701170         & zgdepw 
    11711171      REAL(KIND=wp), DIMENSION(2,2,kprofno) :: & 
    11721172         & zglam, &           ! Model longitude at grid points 
    1173          & zgphi              ! Model latitude at grid points 
     1173         & zgphi, &           ! Model latitude at grid points 
     1174         & zbathy             ! Index of deepest wet level at grid points 
    11741175      INTEGER, DIMENSION(2,2,kprofno) :: & 
    11751176         & igrdi, &           ! Grid i,j 
    … …  
    11791180      INTEGER :: iig, ijg           ! i,j of observation on model grid point. 
    11801181      INTEGER :: jobs, jobsp, jk, ji, jj 
     1182      REAL(KIND=wp) :: maxdept, maxdepw 
    11811183      !!---------------------------------------------------------------------- 
    11821184 
    … …  
    12301232      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, plam, zglam ) 
    12311233      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, pphi, zgphi ) 
     1234      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, REAL(mbkt), zbathy ) 
     1235      ! Need to know the bathy depth for each observation for sco 
    12321236      CALL obs_int_comm_3d( 2, 2, kprofno, kpi, kpj, kpk, igrdi, igrdj, gdepw_n(:,:,:), & 
    1233         &                     zgdepw ) 
     1237        &                   zgdepw ) 
     1238      CALL obs_int_comm_3d( 2, 2, kprofno, kpi, kpj, kpk, igrdi, igrdj, gdept_n(:,:,:), & 
     1239         &                  zgdept ) 
    12341240 
    12351241      DO jobs = 1, kprofno 
    … …  
    12671273         DO jobsp = kpstart(jobs), kpend(jobs) 
    12681274 
     1275            ! Calculate max T and W depths of 2x2 grid 
     1276            maxdept = zgdept(1,1,NINT(zbathy(1,1,jobs)),jobs) 
     1277            maxdepw = zgdepw(1,1,NINT(zbathy(1,1,jobs))+1,jobs) 
     1278            DO jj = 1, 2 
     1279               DO ji = 1, 2 
     1280                  IF ( zgdept(ji,jj,NINT(zbathy(ji,jj,jobs)),jobs) > maxdept ) THEN 
     1281                     maxdept = zgdept(ji,jj,NINT(zbathy(ji,jj,jobs)),jobs) 
     1282                  END IF 
     1283                  IF ( zgdepw(ji,jj,NINT(zbathy(ji,jj,jobs))+1,jobs) > maxdepw ) THEN 
     1284                     maxdepw = zgdepw(ji,jj,NINT(zbathy(ji,jj,jobs))+1,jobs) 
     1285                  END IF 
     1286               END DO 
     1287            END DO 
     1288 
    12691289            ! Flag if the observation falls outside the model spatial domain 
    1270             IF (       ( pobslam(jobs) < -180.         )       & 
    1271                &  .OR. ( pobslam(jobs) >  180.         )       & 
    1272                &  .OR. ( pobsphi(jobs) <  -90.         )       & 
    1273                &  .OR. ( pobsphi(jobs) >   90.         )       & 
    1274                &  .OR. ( pobsdep(jobsp) < 0.0          )       & 
    1275                &  .OR. ( pobsdep(jobsp) > gdepw_1d(kpk)) ) THEN 
     1290            IF (       ( pobslam(jobs) < -180.    )       & 
     1291               &  .OR. ( pobslam(jobs) >  180.    )       & 
     1292               &  .OR. ( pobsphi(jobs) <  -90.    )       & 
     1293               &  .OR. ( pobsphi(jobs) >   90.    )       & 
     1294               &  .OR. ( pobsdep(jobsp) < 0.0     )       & 
     1295               &  .OR. ( pobsdep(jobsp) > gdepw_1d(kpk) ) ) THEN 
    12761296               kobsqc(jobsp) = IBSET(kobsqc(jobsp),11) 
    12771297               kosdobs = kosdobs + 1 
    … …  
    13201340            ! Set observation depth equal to that of the first model depth 
    13211341            IF ( pobsdep(jobsp) <= pdep(1) ) THEN 
    1322                pobsdep(jobsp) = pdep(1)   
    1323             ENDIF 
     1342               pobsdep(jobsp) = pdep(1)  
     1343            ENDIF 
     1344            !IF ( pobsdep(jobsp) < MINVAL(zgdept(1:2,1:2,1,jobs) ) ) THEN 
     1345            !   pobsdep(jobsp) = MINVAL(zgdept(1:2,1:2,1,jobs)) 
     1346            !ENDIF 
     1347 
     1348            ! Set observation depth equal to that of the last wet T-point 
     1349            !IF ( ( pobsdep(jobsp) > maxdept ) .AND. & 
     1350            !   & ( pobsdep(jobsp) < maxdepw ) ) THEN 
     1351            !   pobsdep(jobsp) = maxdept 
     1352            !END IF 
    13241353             
    13251354            IF (ln_bdy) THEN 
    … …  
    13951424 
    13961425 
    1397    SUBROUTINE obs_uv_rej( profdata, knumu, knumv, kqc_cutoff ) 
     1426   SUBROUTINE obs_uv_rej( profdata, knumu, knumv, kqc_cutoff, kuvar, kvvar ) 
    13981427      !!---------------------------------------------------------------------- 
    13991428      !!                    ***  ROUTINE obs_uv_rej *** 
    … …  
    14121441      INTEGER, INTENT(INOUT) :: knumu             ! Number of u rejected 
    14131442      INTEGER, INTENT(INOUT) :: knumv             ! Number of v rejected 
    1414       INTEGER, INTENT(IN) :: kqc_cutoff           ! QC cutoff value 
     1443      INTEGER, INTENT(IN)    :: kqc_cutoff        ! QC cutoff value 
     1444      INTEGER, INTENT(IN)    :: kuvar             ! Index of u 
     1445      INTEGER, INTENT(IN)    :: kvvar             ! Index of v 
    14151446      ! 
    14161447      INTEGER :: jprof 
    … …  
    14211452      DO jprof = 1, profdata%nprof      !==  Loop over profiles  ==! 
    14221453         ! 
    1423          IF ( ( profdata%npvsta(jprof,1) /= profdata%npvsta(jprof,2) ) .OR. & 
    1424             & ( profdata%npvend(jprof,1) /= profdata%npvend(jprof,2) ) ) THEN 
     1454         IF ( ( profdata%npvsta(jprof,kuvar) /= profdata%npvsta(jprof,kvvar) ) .OR. & 
     1455            & ( profdata%npvend(jprof,kuvar) /= profdata%npvend(jprof,kvvar) ) ) THEN 
    14251456            ! 
    14261457            CALL ctl_stop('U,V profiles inconsistent in obs_uv_rej') 
    … …  
    14291460         ENDIF 
    14301461         ! 
    1431          DO jobs = profdata%npvsta(jprof,1), profdata%npvend(jprof,1) 
     1462         DO jobs = profdata%npvsta(jprof,kuvar), profdata%npvend(jprof,kuvar) 
    14321463            !   
    1433             IF ( ( profdata%var(1)%nvqc(jobs) >  kqc_cutoff ) .AND. & 
    1434                & ( profdata%var(2)%nvqc(jobs) <=  kqc_cutoff) ) THEN 
    1435                profdata%var(2)%nvqc(jobs) = IBSET(profdata%var(1)%nvqc(jobs),15) 
     1464            IF ( ( profdata%var(kuvar)%nvqc(jobs) >  kqc_cutoff ) .AND. & 
     1465               & ( profdata%var(kvvar)%nvqc(jobs) <=  kqc_cutoff) ) THEN 
     1466               profdata%var(kvvar)%nvqc(jobs) = IBSET(profdata%var(kuvar)%nvqc(jobs),15) 
    14361467               knumv = knumv + 1 
    14371468            ENDIF 
    1438             IF ( ( profdata%var(2)%nvqc(jobs) >  kqc_cutoff ) .AND. & 
    1439                & ( profdata%var(1)%nvqc(jobs) <=  kqc_cutoff) ) THEN 
    1440                profdata%var(1)%nvqc(jobs) = IBSET(profdata%var(1)%nvqc(jobs),15) 
     1469            IF ( ( profdata%var(kvvar)%nvqc(jobs) >  kqc_cutoff ) .AND. & 
     1470               & ( profdata%var(kuvar)%nvqc(jobs) <=  kqc_cutoff) ) THEN 
     1471               profdata%var(kuvar)%nvqc(jobs) = IBSET(profdata%var(kuvar)%nvqc(jobs),15) 
    14411472               knumu = knumu + 1 
    14421473            ENDIF 

  • NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS/obs_profiles_def.F90

    r14075 r15799  
    4343      & obs_prof_alloc,     & 
    4444      & obs_prof_alloc_var, & 
     45      & obs_prof_alloc_ext, & 
    4546      & obs_prof_dealloc,   & 
    4647      & obs_prof_compress,  & 
    4748      & obs_prof_decompress,& 
    48       & obs_prof_staend 
     49      & obs_prof_staend,    & 
     50      & obs_prof_staend_ext 
    4951 
    5052   !! * Type definition for valid observations 
    … …  
    7577 
    7678      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: & 
    77          & vext           !: Extra variables 
     79         & vadd           !: Additional variables 
    7880 
    7981      INTEGER, POINTER, DIMENSION(:) :: & 
    … …  
    8789   END TYPE obs_prof_var 
    8890 
     91   !! * Type definition for extra variables 
     92 
     93   TYPE obs_prof_ext 
     94 
     95      ! Arrays with size equal to the number of observations 
     96 
     97      INTEGER, POINTER, DIMENSION(:) :: & 
     98         & nepidx,&       !: Profile number 
     99         & nelidx         !: Level number in profile 
     100 
     101      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: & 
     102         & eobs           !: Profile data 
     103 
     104      INTEGER, POINTER, DIMENSION(:) :: & 
     105         & neind          !: Source indices of temp. data in compressed data 
     106 
     107   END TYPE obs_prof_ext 
     108 
    89109   !! * Type definition for profile observation type 
    90110 
    … …  
    94114 
    95115      INTEGER :: nvar     !: Number of variables 
    96       INTEGER :: next     !: Number of extra fields 
     116      INTEGER :: next     !: Number of extra variables 
     117      INTEGER :: nadd     !: Number of additional variables 
    97118      INTEGER :: nprof    !: Total number of profiles within window. 
    98119      INTEGER :: nstp     !: Number of time steps 
    … …  
    104125      ! Bookkeeping arrays with sizes equal to number of variables 
    105126 
    106       CHARACTER(len=8), POINTER, DIMENSION(:) :: & 
    107          & cvars          !: Variable names 
     127      CHARACTER(len=ilenname), POINTER, DIMENSION(:) :: & 
     128         & cvars,    &    !: Variable names 
     129         & cextvars, &    !: Extra variable names 
     130         & caddvars       !: Additional variable names 
     131 
     132      CHARACTER(len=ilenlong), POINTER, DIMENSION(:) :: & 
     133         & clong,    &    !: Variable long names 
     134         & cextlong       !: Extra variable long names 
     135 
     136      CHARACTER(len=ilenlong), POINTER, DIMENSION(:,:) :: & 
     137         & caddlong       !: Additional variable long names 
     138 
     139      CHARACTER(len=ilenunit), POINTER, DIMENSION(:) :: & 
     140         & cunit,    &    !: Variable units 
     141         & cextunit       !: Extra variable units 
     142 
     143      CHARACTER(len=ilenunit), POINTER, DIMENSION(:,:) :: & 
     144         & caddunit       !: Additional variable units 
     145 
     146      CHARACTER(len=ilengrid), POINTER, DIMENSION(:) :: & 
     147         & cgrid          !: Variable grids 
    108148 
    109149      INTEGER, POINTER, DIMENSION(:) :: & 
    110          & nvprot,   &    !: Local total number of profile T data 
    111          & nvprotmpp      !: Global total number of profile T data 
     150         & nvprot,   &    !: Local total number of profile data 
     151         & nvprotmpp      !: Global total number of profile data 
    112152       
    113153      ! Arrays with size equal to the number of profiles 
    … …  
    131171         & rphi           !: Latitude coordinate of profile data 
    132172 
    133       CHARACTER(LEN=8), POINTER, DIMENSION(:) :: & 
     173      CHARACTER(LEN=ilenwmo), POINTER, DIMENSION(:) :: & 
    134174         & cwmo           !: Profile WMO indentifier 
    135175       
    … …  
    140180         & npvsta, &      !: Start of each variable profile in full arrays 
    141181         & npvend, &      !: End of each variable profile in full arrays 
    142          & mi,     &      !: i-th grid coord. for interpolating to profile T data 
    143          & mj,     &      !: j-th grid coord. for interpolating to profile T data 
     182         & mi,     &      !: i-th grid coord. for interpolating to profile data 
     183         & mj,     &      !: j-th grid coord. for interpolating to profile data 
    144184         & ivqc           !: QC flags for all levels for a variable 
    145185 
    … …  
    160200      TYPE(obs_prof_var), POINTER, DIMENSION(:) :: var 
    161201 
     202      ! Extra variables 
     203 
     204      TYPE(obs_prof_ext) :: vext 
     205 
     206      INTEGER :: nvprotext  !: Local total number of extra variable profile data 
     207 
     208      INTEGER, POINTER, DIMENSION(:) :: & 
     209         & npvstaext, &      !: Start of extra variable profiles in full arrays 
     210         & npvendext         !: End of extra variable profiles in full arrays 
     211 
    162212      ! Arrays with size equal to the number of time steps in the window 
    163213 
    … …  
    197247CONTAINS 
    198248    
    199    SUBROUTINE obs_prof_alloc( prof,  kvar, kext, kprof,  & 
    200       &                       ko3dt, kstp, kpi, kpj, kpk ) 
     249   SUBROUTINE obs_prof_alloc( prof,  kvar, kadd, kext, kprof,  & 
     250      &                       ko3dt, ke3dt, kstp, kpi, kpj, kpk ) 
    201251      !!---------------------------------------------------------------------- 
    202252      !!                     ***  ROUTINE obs_prof_alloc  *** 
    … …  
    214264      INTEGER, INTENT(IN) :: kprof  ! Number of profiles 
    215265      INTEGER, INTENT(IN) :: kvar   ! Number of variables 
    216       INTEGER, INTENT(IN) :: kext   ! Number of extra fields within each variable 
     266      INTEGER, INTENT(IN) :: kadd   ! Number of additional fields within each variable 
     267      INTEGER, INTENT(IN) :: kext   ! Number of extra fields 
    217268      INTEGER, INTENT(IN), DIMENSION(kvar) :: & 
    218269         & ko3dt     ! Number of observations per variables 
     270      INTEGER, INTENT(IN) :: ke3dt  ! Number of observations per extra variables 
    219271      INTEGER, INTENT(IN) :: kstp   ! Number of time steps 
    220272      INTEGER, INTENT(IN) :: kpi    ! Number of 3D grid points 
    … …  
    223275 
    224276      !!* Local variables 
    225       INTEGER :: jvar 
     277      INTEGER :: jvar, jadd, jext 
    226278      INTEGER :: ji 
    227279 
    … …  
    229281 
    230282      prof%nvar      = kvar 
     283      prof%nadd      = kadd 
    231284      prof%next      = kext 
    232285      prof%nprof     = kprof 
    … …  
    241294      ALLOCATE( & 
    242295         & prof%cvars(kvar),    & 
     296         & prof%clong(kvar),    & 
     297         & prof%cunit(kvar),    & 
     298         & prof%cgrid(kvar),    & 
    243299         & prof%nvprot(kvar),   & 
    244300         & prof%nvprotmpp(kvar) & 
    … …  
    247303      DO jvar = 1, kvar 
    248304         prof%cvars    (jvar) = "NotSet" 
     305         prof%clong    (jvar) = "NotSet" 
     306         prof%cunit    (jvar) = "NotSet" 
     307         prof%cgrid    (jvar) = "" 
    249308         prof%nvprot   (jvar) = ko3dt(jvar) 
    250309         prof%nvprotmpp(jvar) = 0 
     310      END DO 
     311 
     312      ! Allocate additional/extra variable metadata 
     313 
     314      ALLOCATE( & 
     315         & prof%caddvars(kadd),      & 
     316         & prof%caddlong(kadd,kvar), & 
     317         & prof%caddunit(kadd,kvar), & 
     318         & prof%cextvars(kext),      & 
     319         & prof%cextlong(kext),      & 
     320         & prof%cextunit(kext)       & 
     321         ) 
     322          
     323      DO jadd = 1, kadd 
     324         prof%caddvars(jadd) = "NotSet" 
     325         DO jvar = 1, kvar 
     326            prof%caddlong(jadd,jvar) = "NotSet" 
     327            prof%caddunit(jadd,jvar) = "NotSet" 
     328         END DO 
     329      END DO 
     330          
     331      DO jext = 1, kext 
     332         prof%cextvars(jext) = "NotSet" 
     333         prof%cextlong(jext) = "NotSet" 
     334         prof%cextunit(jext) = "NotSet" 
    251335      END DO 
    252336 
    … …  
    306390 
    307391      DO jvar = 1, kvar 
    308  
    309392         IF ( ko3dt(jvar) >= 0 ) THEN 
    310             CALL obs_prof_alloc_var( prof, jvar, kext, ko3dt(jvar) ) 
     393            CALL obs_prof_alloc_var( prof, jvar, kadd, ko3dt(jvar) ) 
    311394         ENDIF 
    312           
    313       END DO 
     395      END DO 
     396       
     397      ! Extra variables 
     398 
     399      IF ( kext > 0 ) THEN 
     400         prof%nvprotext = ke3dt 
     401         ALLOCATE( & 
     402            & prof%npvstaext(kprof), &   
     403            & prof%npvendext(kprof) ) 
     404         CALL obs_prof_alloc_ext( prof, kext, ke3dt ) 
     405      ELSE 
     406         prof%nvprotext = 0 
     407      ENDIF 
    314408 
    315409      ! Allocate arrays of size number of time step size 
    … …  
    346440         END DO 
    347441      END DO 
     442 
     443      IF ( kext > 0 ) THEN 
     444         DO ji = 1, ke3dt 
     445            prof%vext%neind(ji) = ji 
     446         END DO 
     447      ENDIF 
    348448 
    349449      ! Set defaults for number of observations per time step 
    … …  
    377477      !!* Local variables 
    378478      INTEGER :: & 
    379          & jvar 
     479         & jvar, & 
     480         & jext 
    380481 
    381482      ! Deallocate arrays of size number of profiles 
    … …  
    418519 
    419520      DO jvar = 1, prof%nvar 
    420  
    421521         IF ( prof%nvprot(jvar) >= 0 ) THEN 
    422  
    423522            CALL obs_prof_dealloc_var( prof, jvar ) 
    424  
    425523         ENDIF 
    426           
    427524      END DO 
    428525 
    … …  
    432529         & ) 
    433530 
     531      ! Deallocate extra variables 
     532      IF ( prof%next > 0 ) THEN 
     533         DEALLOCATE( & 
     534            & prof%npvstaext, &   
     535            & prof%npvendext  & 
     536            ) 
     537         CALL obs_prof_dealloc_ext( prof ) 
     538      ENDIF 
     539       
    434540      ! Deallocate arrays of size number of time step size 
    435541 
    … …  
    458564      DEALLOCATE( & 
    459565         & prof%cvars,    & 
     566         & prof%clong,    & 
     567         & prof%cunit,    & 
     568         & prof%cgrid,    & 
    460569         & prof%nvprot,   & 
    461570         & prof%nvprotmpp & 
    462571         ) 
    463572 
     573      ! Dellocate additional/extra variables metadata 
     574 
     575      DEALLOCATE( & 
     576         & prof%caddvars, & 
     577         & prof%caddlong, & 
     578         & prof%caddunit, & 
     579         & prof%cextvars, & 
     580         & prof%cextlong, & 
     581         & prof%cextunit  & 
     582         ) 
    464583 
    465584   END SUBROUTINE obs_prof_dealloc 
    466585 
    467586 
    468    SUBROUTINE obs_prof_alloc_var( prof, kvar, kext, kobs ) 
     587   SUBROUTINE obs_prof_alloc_var( prof, kvar, kadd, kobs ) 
    469588 
    470589      !!---------------------------------------------------------------------- 
    … …  
    480599      TYPE(obs_prof), INTENT(INOUT) :: prof   ! Profile data to be allocated 
    481600      INTEGER, INTENT(IN) :: kvar   ! Variable number 
    482       INTEGER, INTENT(IN) :: kext   ! Number of extra fields within each variable 
     601      INTEGER, INTENT(IN) :: kadd   ! Number of additional fields within each variable 
    483602      INTEGER, INTENT(IN) :: kobs   ! Number of observations 
    484603       
    … …  
    498617         & prof%var(kvar)%nvqcf(idefnqcf,kobs)  & 
    499618         & ) 
    500       IF (kext>0) THEN 
     619      IF (kadd>0) THEN 
    501620         ALLOCATE( &  
    502             & prof%var(kvar)%vext(kobs,kext) & 
     621            & prof%var(kvar)%vadd(kobs,kadd) & 
    503622            & ) 
    504623      ENDIF 
    … …  
    506625   END SUBROUTINE obs_prof_alloc_var 
    507626 
     627 
    508628   SUBROUTINE obs_prof_dealloc_var( prof, kvar ) 
    509629 
    510630      !!---------------------------------------------------------------------- 
    511       !!                     ***  ROUTINE obs_prof_alloc_var  *** 
     631      !!                     ***  ROUTINE obs_prof_dealloc_var  *** 
    512632      !!                       
    513       !! ** Purpose : - Allocate data for variable data in profile arrays 
     633      !! ** Purpose : - Deallocate data for variable data in profile arrays 
    514634      !!  
    515635      !! ** Method  : - Fortran-90 dynamic arrays 
    … …  
    518638      !!        !  07-03  (K. Mogensen) Original code 
    519639      !! * Arguments 
    520       TYPE(obs_prof), INTENT(INOUT) :: prof   ! Profile data to be allocated 
     640      TYPE(obs_prof), INTENT(INOUT) :: prof   ! Profile data to be deallocated 
    521641      INTEGER, INTENT(IN) :: kvar      ! Variable number 
    522642       
    … …  
    534654         & prof%var(kvar)%nvqcf   & 
    535655         & ) 
    536       IF (prof%next>0) THEN 
     656      IF (prof%nadd>0) THEN 
    537657         DEALLOCATE( &  
    538             & prof%var(kvar)%vext  & 
     658            & prof%var(kvar)%vadd  & 
    539659            & ) 
    540660      ENDIF 
    … …  
    542662   END SUBROUTINE obs_prof_dealloc_var 
    543663 
     664 
     665   SUBROUTINE obs_prof_alloc_ext( prof, kext, kobs ) 
     666 
     667      !!---------------------------------------------------------------------- 
     668      !!                     ***  ROUTINE obs_prof_alloc_ext  *** 
     669      !!                       
     670      !! ** Purpose : - Allocate data for extra variables in profile arrays 
     671      !!  
     672      !! ** Method  : - Fortran-90 dynamic arrays 
     673      !! 
     674      !! History : 
     675      !!        !  07-03  (K. Mogensen) Original code 
     676      !! * Arguments 
     677      TYPE(obs_prof), INTENT(INOUT) :: prof   ! Profile data to be allocated 
     678      INTEGER,        INTENT(IN)    :: kext   ! Number of extra variables 
     679      INTEGER,        INTENT(IN)    :: kobs   ! Number of observations 
     680 
     681      ALLOCATE( & 
     682         & prof%vext%nepidx(kobs),   & 
     683         & prof%vext%nelidx(kobs),   & 
     684         & prof%vext%neind(kobs),    & 
     685         & prof%vext%eobs(kobs,kext) & 
     686         & ) 
     687 
     688   END SUBROUTINE obs_prof_alloc_ext 
     689 
     690 
     691   SUBROUTINE obs_prof_dealloc_ext( prof ) 
     692 
     693      !!---------------------------------------------------------------------- 
     694      !!                     ***  ROUTINE obs_prof_dealloc_var  *** 
     695      !!                       
     696      !! ** Purpose : - Deallocate data for extra variables in profile arrays 
     697      !!  
     698      !! ** Method  : - Fortran-90 dynamic arrays 
     699      !! 
     700      !! History : 
     701      !!        !  07-03  (K. Mogensen) Original code 
     702      !! * Arguments 
     703      TYPE(obs_prof), INTENT(INOUT) :: prof   ! Profile data to be deallocated 
     704       
     705      DEALLOCATE( & 
     706         & prof%vext%nepidx, & 
     707         & prof%vext%nelidx, & 
     708         & prof%vext%eobs,   & 
     709         & prof%vext%neind   & 
     710         & ) 
     711 
     712   END SUBROUTINE obs_prof_dealloc_ext 
     713 
     714 
    544715   SUBROUTINE obs_prof_compress( prof,   newprof, lallocate, & 
    545       &                          kumout, lvalid,   lvvalid ) 
     716      &                          kumout, lvalid,  lvvalid ) 
    546717      !!---------------------------------------------------------------------- 
    547718      !!                     ***  ROUTINE obs_prof_compress  *** 
    … …  
    564735      TYPE(obs_prof), INTENT(IN)    :: prof      ! Original profile 
    565736      TYPE(obs_prof), INTENT(INOUT) :: newprof   ! New profile with the copy of the data 
    566       LOGICAL :: lallocate                ! Allocate newprof data 
    567       INTEGER,INTENT(IN) :: kumout        ! Fortran unit for messages 
     737      LOGICAL,        INTENT(IN)    :: lallocate ! Allocate newprof data 
     738      INTEGER,        INTENT(IN)    :: kumout    ! Fortran unit for messages 
    568739      TYPE(obs_prof_valid), OPTIONAL, INTENT(in) :: & 
    569740         & lvalid        ! Valid profiles 
    … …  
    575746      INTEGER, DIMENSION(prof%nvar) :: & 
    576747         & invpro 
     748      INTEGER :: invproext 
    577749      INTEGER :: jvar 
     750      INTEGER :: jadd 
    578751      INTEGER :: jext 
    579752      INTEGER :: ji 
    … …  
    587760      LOGICAL :: lnonepresent 
    588761 
    589       ! Check that either all or none of the masks are persent. 
     762      ! Check that either all or none of the masks are present. 
    590763 
    591764      lallpresent  = .FALSE. 
    … …  
    607780         inprof = 0 
    608781         invpro(:) = 0 
     782         invproext = 0 
    609783         DO ji = 1, prof%nprof 
    610784            IF ( lvalid%luse(ji) ) THEN 
    611                inprof=inprof+1 
     785               inprof = inprof + 1 
    612786               DO jvar = 1, prof%nvar 
    613787                  DO jj = prof%npvsta(ji,jvar), prof%npvend(ji,jvar) 
    … …  
    616790                  END DO 
    617791               END DO 
     792               IF ( prof%next > 0 ) THEN 
     793                  DO jj = prof%npvstaext(ji), prof%npvendext(ji) 
     794                     invproext = invproext + 1 
     795                  END DO 
     796               ENDIF 
    618797            ENDIF 
    619798         END DO 
    … …  
    621800         inprof    = prof%nprof 
    622801         invpro(:) = prof%nvprot(:) 
     802         invproext = prof%nvprotext 
    623803      ENDIF 
    624804 
    … …  
    627807      IF ( lallocate ) THEN 
    628808         CALL obs_prof_alloc( newprof,   prof%nvar, & 
    629             &                 prof%next,            & 
     809            &                 prof%nadd, prof%next, & 
    630810            &                 inprof,    invpro,    & 
     811            &                 invproext,            & 
    631812            &                 prof%nstp, prof%npi,  & 
    632813            &                 prof%npj,  prof%npk ) 
    … …  
    655836      inprof    = 0 
    656837      invpro(:) = 0 
    657  
    658       newprof%npvsta(:,:) =  0 
    659       newprof%npvend(:,:) = -1 
     838      invproext = 0 
     839 
     840      newprof%npvsta(:,:)  =  0 
     841      newprof%npvend(:,:)  = -1 
     842      newprof%npvstaext(:) =  0 
     843      newprof%npvendext(:) = -1 
    660844       
    661845      ! Loop over source profiles 
    … …  
    670854 
    671855            newprof%mi(inprof,:)  = prof%mi(ji,:) 
    672             newprof%mj(inprof,:) = prof%mj(ji,:) 
     856            newprof%mj(inprof,:)  = prof%mj(ji,:) 
    673857            newprof%npidx(inprof) = prof%npidx(ji) 
    674858            newprof%npfil(inprof) = prof%npfil(ji) 
    … …  
    741925                     newprof%var(jvar)%vmod(invpro(jvar))   = & 
    742926                        &                           prof%var(jvar)%vmod(jj) 
    743                      DO jext = 1, prof%next 
    744                         newprof%var(jvar)%vext(invpro(jvar),jext) = & 
    745                            &                      prof%var(jvar)%vext(jj,jext) 
     927                     DO jadd = 1, prof%nadd 
     928                        newprof%var(jvar)%vadd(invpro(jvar),jadd) = & 
     929                           &                      prof%var(jvar)%vadd(jj,jadd) 
    746930                     END DO 
    747931                   
    … …  
    756940            END DO 
    757941 
     942            IF ( prof%next > 0 ) THEN 
     943 
     944               ! Extra variables 
     945 
     946               lfirst = .TRUE. 
     947 
     948               DO jj = prof%npvstaext(ji), prof%npvendext(ji) 
     949 
     950                  invproext = invproext + 1 
     951 
     952                  ! Book keeping information 
     953 
     954                  IF ( lfirst ) THEN 
     955                     lfirst = .FALSE. 
     956                     newprof%npvstaext(inprof) = invproext 
     957                  ENDIF 
     958                  newprof%npvendext(inprof) = invproext 
     959 
     960                  ! Variable data 
     961 
     962                  newprof%vext%nepidx(invproext) = prof%vext%nepidx(jj) 
     963                  newprof%vext%nelidx(invproext) = prof%vext%nelidx(jj) 
     964                  DO jext = 1, prof%next 
     965                     newprof%vext%eobs(invproext,jext) = prof%vext%eobs(jj,jext) 
     966                  END DO 
     967 
     968                  ! nvind is the index of the original variable data 
     969 
     970                  newprof%vext%neind(invproext)  = jj 
     971 
     972               END DO 
     973 
     974            ENDIF 
     975 
    758976         ENDIF 
    759977 
    … …  
    767985      CALL obs_mpp_sum_integers ( newprof%nvprot, newprof%nvprotmpp,& 
    768986         &                        prof%nvar ) 
     987      newprof%nvprotext = invproext 
    769988       
    770989      ! Set book keeping variables which do not depend on number of obs. 
    771990 
    772991      newprof%nvar     = prof%nvar 
     992      newprof%nadd     = prof%nadd 
    773993      newprof%next     = prof%next 
    774994      newprof%nstp     = prof%nstp 
    … …  
    777997      newprof%npk      = prof%npk 
    778998      newprof%cvars(:) = prof%cvars(:) 
     999      newprof%clong(:) = prof%clong(:) 
     1000      newprof%cunit(:) = prof%cunit(:) 
     1001      newprof%cgrid(:) = prof%cgrid(:) 
     1002      newprof%caddvars(:)   = prof%caddvars(:) 
     1003      newprof%caddlong(:,:) = prof%caddlong(:,:) 
     1004      newprof%caddunit(:,:) = prof%caddunit(:,:) 
     1005      newprof%cextvars(:)   = prof%cextvars(:) 
     1006      newprof%cextlong(:)   = prof%cextlong(:) 
     1007      newprof%cextunit(:)   = prof%cextunit(:) 
    7791008  
    7801009      ! Deallocate temporary data 
    … …  
    8101039      !!* Local variables 
    8111040      INTEGER :: jvar 
     1041      INTEGER :: jadd 
    8121042      INTEGER :: jext 
    8131043      INTEGER :: ji 
    … …  
    8661096               oldprof%var(jvar)%idqcf(:,jl) = prof%var(jvar)%idqcf(:,jj) 
    8671097               oldprof%var(jvar)%nvqcf(:,jl) = prof%var(jvar)%nvqcf(:,jj) 
    868                DO jext = 1, prof%next 
    869                   oldprof%var(jvar)%vext(jl,jext) = & 
    870                      &                        prof%var(jvar)%vext(jj,jext) 
     1098               DO jadd = 1, prof%nadd 
     1099                  oldprof%var(jvar)%vadd(jl,jadd) = & 
     1100                     &                        prof%var(jvar)%vadd(jj,jadd) 
    8711101               END DO 
    8721102                
    … …  
    8741104 
    8751105         END DO 
     1106 
     1107         IF ( prof%next > 0 ) THEN 
     1108 
     1109            DO jj = prof%npvstaext(ji), prof%npvendext(ji) 
     1110 
     1111               jl = prof%vext%neind(jj) 
     1112 
     1113               oldprof%vext%nepidx(jl) = prof%vext%nepidx(jj) 
     1114               oldprof%vext%nelidx(jl) = prof%vext%nelidx(jj) 
     1115               DO jext = 1, prof%next 
     1116                  oldprof%vext%eobs(jl,jext) = prof%vext%eobs(jj,jext) 
     1117               END DO 
     1118 
     1119            END DO 
     1120 
     1121         ENDIF 
    8761122          
    8771123      END DO 
    … …  
    8831129   END SUBROUTINE obs_prof_decompress 
    8841130 
     1131 
    8851132   SUBROUTINE obs_prof_staend( prof, kvarno ) 
    8861133      !!---------------------------------------------------------------------- 
    887       !!                     ***  ROUTINE obs_prof_decompress  *** 
     1134      !!                     ***  ROUTINE obs_prof_staend  *** 
    8881135      !!                       
    8891136      !! ** Purpose : - Set npvsta and npvend of a variable within  
    … …  
    9241171 
    9251172   END SUBROUTINE obs_prof_staend 
     1173 
     1174 
     1175   SUBROUTINE obs_prof_staend_ext( prof ) 
     1176      !!---------------------------------------------------------------------- 
     1177      !!                     ***  ROUTINE obs_prof_staend_ext  *** 
     1178      !!                       
     1179      !! ** Purpose : - Set npvsta and npvend within  
     1180      !!                an obs_prof_ext type 
     1181      !! 
     1182      !! ** Method  : - Find the start and stop of a profile by searching  
     1183      !!                through the data 
     1184      !!  
     1185      !! History : 
     1186      !!        !  07-04  (K. Mogensen) Original code 
     1187      !!---------------------------------------------------------------------- 
     1188      !! * Arguments 
     1189      TYPE(obs_prof),INTENT(INOUT) :: prof     ! Profile data 
     1190 
     1191      !!* Local variables 
     1192      INTEGER :: ji 
     1193      INTEGER :: iprofno 
     1194 
     1195      !----------------------------------------------------------------------- 
     1196      ! Compute start and end bookkeeping arrays 
     1197      !----------------------------------------------------------------------- 
     1198 
     1199      prof%npvstaext(:) = prof%nvprotext + 1 
     1200      prof%npvendext(:) = -1 
     1201      DO ji = 1, prof%nvprotext 
     1202         iprofno = prof%vext%nepidx(ji) 
     1203         prof%npvstaext(iprofno) = & 
     1204            & MIN( ji, prof%npvstaext(iprofno) ) 
     1205         prof%npvendext(iprofno) = & 
     1206            & MAX( ji, prof%npvendext(iprofno) ) 
     1207      END DO 
     1208 
     1209      DO ji = 1, prof%nprof 
     1210         IF ( prof%npvstaext(ji) == ( prof%nvprotext + 1 ) ) & 
     1211            & prof%npvstaext(ji) = 0 
     1212      END DO 
     1213 
     1214   END SUBROUTINE obs_prof_staend_ext 
    9261215    
    9271216END MODULE obs_profiles_def 

  • NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS/obs_read_altbias.F90

    r14075 r15799  
    116116      numaltbias=0 
    117117 
    118       IF(lwp)WRITE(numout,*) 'Opening ',bias_file 
     118      IF (lwp) WRITE(numout,*) 'Opening ', bias_file 
    119119 
    120120      CALL iom_open( bias_file, numaltbias, ldstop=.FALSE. ) 

  • NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS/obs_read_prof.F90

    r14075 r15799  
    2727   USE lib_mpp                  ! For ctl_warn/stop 
    2828   USE obs_fbm                  ! Feedback routines 
     29   USE obs_group_def, ONLY : &  ! Observation variable information 
     30      & cobsname_uvel, & 
     31      & cobsname_vvel, & 
     32      & imaxavtypes 
    2933 
    3034   IMPLICIT NONE 
    … …  
    4448 
    4549   SUBROUTINE obs_rea_prof( profdata, knumfiles, cdfilenames, & 
    46       &                     kvars, kextr, kstp, ddobsini, ddobsend, & 
    47       &                     ldvar1, ldvar2, ldignmis, ldsatt, & 
    48       &                     ldmod, kdailyavtypes ) 
     50      &                     kvars, kadd, kextr, kstp, ddobsini, ddobsend, & 
     51      &                     ldvar, ldignmis, ldallatall, & 
     52      &                     ldmod, cdvars, kdailyavtypes ) 
    4953      !!--------------------------------------------------------------------- 
    5054      !! 
    … …  
    7276         & cdfilenames(knumfiles)        ! File names to read in 
    7377      INTEGER, INTENT(IN) :: kvars      ! Number of variables in profdata 
    74       INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var 
     78      INTEGER, INTENT(IN) :: kadd       ! Number of additional fields 
     79                                        !   in addition to those in the input file(s) 
     80      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields 
     81                                        !   in addition to those in the input file(s) 
    7582      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index 
    76       LOGICAL, INTENT(IN) :: ldvar1     ! Observed variables switches 
    77       LOGICAL, INTENT(IN) :: ldvar2 
     83      LOGICAL, DIMENSION(kvars), INTENT(IN) :: ldvar     ! Observed variables switches 
    7884      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files 
    79       LOGICAL, INTENT(IN) :: ldsatt     ! Compute salinity at all temperature points 
     85      LOGICAL, INTENT(IN) :: ldallatall     ! Compute salinity at all temperature points 
    8086      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data 
    8187      REAL(dp), INTENT(IN) :: ddobsini  ! Obs. ini time in YYYYMMDD.HHMMSS 
    8288      REAL(dp), INTENT(IN) :: ddobsend  ! Obs. end time in YYYYMMDD.HHMMSS 
     89      CHARACTER(len=8), DIMENSION(kvars), INTENT(IN) :: cdvars 
    8390      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    8491         & kdailyavtypes                ! Types of daily average observations 
    … …  
    8794      CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_prof' 
    8895      CHARACTER(len=8) :: clrefdate 
    89       CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: clvars 
    90       INTEGER :: jvar 
     96      CHARACTER(len=ilenname), DIMENSION(:),   ALLOCATABLE :: clvarsin 
     97      CHARACTER(len=ilenlong), DIMENSION(:),   ALLOCATABLE :: cllongin 
     98      CHARACTER(len=ilenunit), DIMENSION(:),   ALLOCATABLE :: clunitin 
     99      CHARACTER(len=ilengrid), DIMENSION(:),   ALLOCATABLE :: clgridin 
     100      CHARACTER(len=ilenname), DIMENSION(:),   ALLOCATABLE :: claddvarsin 
     101      CHARACTER(len=ilenlong), DIMENSION(:,:), ALLOCATABLE :: claddlongin 
     102      CHARACTER(len=ilenunit), DIMENSION(:,:), ALLOCATABLE :: claddunitin 
     103      CHARACTER(len=ilenname), DIMENSION(:),   ALLOCATABLE :: clextvarsin 
     104      CHARACTER(len=ilenlong), DIMENSION(:),   ALLOCATABLE :: clextlongin 
     105      CHARACTER(len=ilenunit), DIMENSION(:),   ALLOCATABLE :: clextunitin 
    91106      INTEGER :: ji 
    92107      INTEGER :: jj 
    93108      INTEGER :: jk 
    94109      INTEGER :: ij 
     110      INTEGER :: jind 
     111      INTEGER :: jext 
     112      INTEGER :: jvar 
     113      INTEGER :: jadd 
     114      INTEGER :: jadd2 
     115      INTEGER :: iadd 
     116      INTEGER :: iaddin 
     117      INTEGER :: iextr 
    95118      INTEGER :: iflag 
    96119      INTEGER :: inobf 
    … …  
    105128      INTEGER :: iprof 
    106129      INTEGER :: iproftot 
    107       INTEGER :: ivar1t0 
    108       INTEGER :: ivar2t0 
    109       INTEGER :: ivar1t 
    110       INTEGER :: ivar2t 
     130      INTEGER, DIMENSION(kvars) :: ivart0 
     131      INTEGER, DIMENSION(kvars) :: ivart 
    111132      INTEGER :: ip3dt 
    112133      INTEGER :: ios 
    113134      INTEGER :: ioserrcount 
    114       INTEGER :: ivar1tmpp 
    115       INTEGER :: ivar2tmpp 
     135      INTEGER, DIMENSION(kvars) :: ivartmpp 
    116136      INTEGER :: ip3dtmpp 
    117137      INTEGER :: itype 
    118138      INTEGER, DIMENSION(knumfiles) :: & 
    119139         & irefdate 
    120       INTEGER, DIMENSION(ntyp1770+1) :: & 
    121          & itypvar1,    & 
    122          & itypvar1mpp, & 
    123          & itypvar2,    & 
    124          & itypvar2mpp  
     140      INTEGER, DIMENSION(ntyp1770+1,kvars) :: & 
     141         & itypvar,    & 
     142         & itypvarmpp 
     143      INTEGER, DIMENSION(:,:), ALLOCATABLE :: & 
     144         & iobsi,    & 
     145         & iobsj,    & 
     146         & iproc 
    125147      INTEGER, DIMENSION(:), ALLOCATABLE :: & 
    126          & iobsi1,    & 
    127          & iobsj1,    & 
    128          & iproc1,    & 
    129          & iobsi2,    & 
    130          & iobsj2,    & 
    131          & iproc2,    & 
    132148         & iindx,    & 
    133149         & ifileidx, & 
    … …  
    147163      LOGICAL :: llvalprof 
    148164      LOGICAL :: lldavtimset 
     165      LOGICAL :: llcycle 
     166      LOGICAL :: llpotm 
    149167      TYPE(obfbdata), POINTER, DIMENSION(:) :: & 
    150168         & inpfiles 
    … …  
    152170      ! Local initialization 
    153171      iprof = 0 
    154       ivar1t0 = 0 
    155       ivar2t0 = 0 
     172      ivart0(:) = 0 
    156173      ip3dt = 0 
    157174 
    … …  
    172189 
    173190      ALLOCATE( inpfiles(inobf) ) 
     191 
     192      iadd  = 0 
     193      iextr = 0 
    174194 
    175195      prof_files : DO jj = 1, inobf 
    … …  
    219239               &                ldgrid = .TRUE. ) 
    220240 
    221             IF ( inpfiles(jj)%nvar < 2 ) THEN 
     241            IF ( inpfiles(jj)%nvar /= kvars ) THEN 
    222242               CALL ctl_stop( 'Feedback format error: ', & 
    223                   &           ' less than 2 vars in profile file' ) 
     243                  &           ' unexpected number of vars in feedback file', & 
     244                  &           TRIM(cdfilenames(jj)) ) 
    224245            ENDIF 
    225246 
    226247            IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN 
    227                CALL ctl_stop( 'Model not in input data' ) 
     248               CALL ctl_stop( 'Model not in input data in', & 
     249                  &           TRIM(cdfilenames(jj)) ) 
     250               RETURN 
     251            ENDIF 
     252 
     253            IF ( (iextr > 0) .AND. (inpfiles(jj)%next /= iextr) ) THEN 
     254               CALL ctl_stop( 'Number of extra variables not consistent', & 
     255                  &           ' with previous files for this type in', & 
     256                  &           TRIM(cdfilenames(jj)) ) 
     257            ELSE 
     258               iextr = inpfiles(jj)%next 
     259            ENDIF 
     260 
     261            ! Ignore model counterpart 
     262            iaddin = inpfiles(jj)%nadd 
     263            DO ji = 1, iaddin 
     264               IF ( TRIM(inpfiles(jj)%caddname(ji)) == 'Hx' ) THEN 
     265                  iaddin = iaddin - 1 
     266                  EXIT 
     267               ENDIF 
     268            END DO 
     269            IF ( ldmod .AND. ( inpfiles(jj)%nadd == iaddin ) ) THEN 
     270               CALL ctl_stop( 'Model not in input data', & 
     271                  &           TRIM(cdfilenames(jj)) ) 
     272            ENDIF 
     273 
     274            IF ( (iadd > 0) .AND. (iaddin /= iadd) ) THEN 
     275               CALL ctl_stop( 'Number of additional variables not consistent', & 
     276                  &           ' with previous files for this type in', & 
     277                  &           TRIM(cdfilenames(jj)) ) 
     278            ELSE 
     279               iadd = iaddin 
    228280            ENDIF 
    229281 
    230282            IF ( jj == 1 ) THEN 
    231                ALLOCATE( clvars( inpfiles(jj)%nvar ) ) 
     283               ALLOCATE( clvarsin( inpfiles(jj)%nvar ) ) 
     284               ALLOCATE( cllongin( inpfiles(jj)%nvar ) ) 
     285               ALLOCATE( clunitin( inpfiles(jj)%nvar ) ) 
     286               ALLOCATE( clgridin( inpfiles(jj)%nvar ) ) 
    232287               DO ji = 1, inpfiles(jj)%nvar 
    233                  clvars(ji) = inpfiles(jj)%cname(ji) 
     288                 clvarsin(ji) = inpfiles(jj)%cname(ji) 
     289                 cllongin(ji) = inpfiles(jj)%coblong(ji) 
     290                 clunitin(ji) = inpfiles(jj)%cobunit(ji) 
     291                 clgridin(ji) = inpfiles(jj)%cgrid(ji) 
     292                 IF ( clvarsin(ji) /= cdvars(ji) ) THEN 
     293                    CALL ctl_stop( 'Feedback file variables do not match', & 
     294                        &           ' expected variable names for this type' ) 
     295                 ENDIF 
    234296               END DO 
     297               IF ( iadd > 0 ) THEN 
     298                  ALLOCATE( claddvarsin( iadd ) ) 
     299                  ALLOCATE( claddlongin( iadd, inpfiles(jj)%nvar ) ) 
     300                  ALLOCATE( claddunitin( iadd, inpfiles(jj)%nvar ) ) 
     301                  jadd = 0 
     302                  DO ji = 1, inpfiles(jj)%nadd 
     303                    IF ( TRIM(inpfiles(jj)%caddname(ji)) /= 'Hx' ) THEN 
     304                       jadd = jadd + 1 
     305                       claddvarsin(jadd) = inpfiles(jj)%caddname(ji) 
     306                       DO jk = 1, inpfiles(jj)%nvar 
     307                          claddlongin(jadd,jk) = inpfiles(jj)%caddlong(ji,jk) 
     308                          claddunitin(jadd,jk) = inpfiles(jj)%caddunit(ji,jk) 
     309                       END DO 
     310                    ENDIF 
     311                  END DO 
     312               ENDIF 
     313               IF ( iextr > 0 ) THEN 
     314                  ALLOCATE( clextvarsin( iextr ) ) 
     315                  ALLOCATE( clextlongin( iextr ) ) 
     316                  ALLOCATE( clextunitin( iextr ) ) 
     317                  DO ji = 1, iextr 
     318                    clextvarsin(ji) = inpfiles(jj)%cextname(ji) 
     319                    clextlongin(ji) = inpfiles(jj)%cextlong(ji) 
     320                    clextunitin(ji) = inpfiles(jj)%cextunit(ji) 
     321                  END DO 
     322               ENDIF 
    235323            ELSE 
    236324               DO ji = 1, inpfiles(jj)%nvar 
    237                   IF ( inpfiles(jj)%cname(ji) /= clvars(ji) ) THEN 
     325                  IF ( inpfiles(jj)%cname(ji) /= clvarsin(ji) ) THEN 
    238326                     CALL ctl_stop( 'Feedback file variables not consistent', & 
    239                         &           ' with previous files for this type' ) 
     327                        &           ' with previous files for this type in', & 
     328                        &           TRIM(cdfilenames(jj)) ) 
    240329                  ENDIF 
    241330               END DO 
     331               IF ( iadd > 0 ) THEN 
     332                  jadd = 0 
     333                  DO ji = 1, inpfiles(jj)%nadd 
     334                     IF ( TRIM(inpfiles(jj)%caddname(ji)) /= 'Hx' ) THEN 
     335                        jadd = jadd + 1 
     336                        IF ( inpfiles(jj)%caddname(ji) /= claddvarsin(jadd) ) THEN 
     337                           CALL ctl_stop( 'Feedback file additional variables not consistent', & 
     338                              &           ' with previous files for this type in', & 
     339                              &           TRIM(cdfilenames(jj)) ) 
     340                        ENDIF 
     341                     ENDIF 
     342                  END DO 
     343               ENDIF 
     344               IF ( iextr > 0 ) THEN 
     345                  DO ji = 1, iextr 
     346                     IF ( inpfiles(jj)%cextname(ji) /= clextvarsin(ji) ) THEN 
     347                        CALL ctl_stop( 'Feedback file extra variables not consistent', & 
     348                           &           ' with previous files for this type in', & 
     349                           &           TRIM(cdfilenames(jj)) ) 
     350                     ENDIF 
     351                  END DO 
     352               ENDIF 
    242353            ENDIF 
    243354 
    … …  
    308419            DO ji = 1, inpfiles(jj)%nobs 
    309420               IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
    310                IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
    311                   & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
     421               llcycle = .TRUE. 
     422               DO jvar = 1, kvars 
     423                  IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     424                     llcycle = .FALSE. 
     425                     EXIT 
     426                  ENDIF 
     427               END DO 
     428               IF ( llcycle ) CYCLE 
    312429               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    313430                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    317434            ALLOCATE( zlam(inowin)  ) 
    318435            ALLOCATE( zphi(inowin)  ) 
    319             ALLOCATE( iobsi1(inowin) ) 
    320             ALLOCATE( iobsj1(inowin) ) 
    321             ALLOCATE( iproc1(inowin) ) 
    322             ALLOCATE( iobsi2(inowin) ) 
    323             ALLOCATE( iobsj2(inowin) ) 
    324             ALLOCATE( iproc2(inowin) ) 
     436            ALLOCATE( iobsi(inowin,kvars) ) 
     437            ALLOCATE( iobsj(inowin,kvars) ) 
     438            ALLOCATE( iproc(inowin,kvars) ) 
    325439            inowin = 0 
    326440            DO ji = 1, inpfiles(jj)%nobs 
    327441               IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
    328                IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
    329                   & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
     442               llcycle = .TRUE. 
     443               DO jvar = 1, kvars 
     444                  IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     445                     llcycle = .FALSE. 
     446                     EXIT 
     447                  ENDIF 
     448               END DO 
     449               IF ( llcycle ) CYCLE 
    330450               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    331451                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    336456            END DO 
    337457 
    338             IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN 
    339                CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, & 
    340                   &                  iproc1, 'T' ) 
    341                iobsi2(:) = iobsi1(:) 
    342                iobsj2(:) = iobsj1(:) 
    343                iproc2(:) = iproc1(:) 
    344             ELSEIF ( TRIM( inpfiles(jj)%cname(1) ) == 'UVEL' ) THEN 
    345                CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, & 
    346                   &                  iproc1, 'U' ) 
    347                CALL obs_grid_search( inowin, zlam, zphi, iobsi2, iobsj2, & 
    348                   &                  iproc2, 'V' ) 
    349             ENDIF 
     458            ! Do grid search 
     459            ! Assume anything other than velocity is on T grid 
     460            ! Save resource by not repeating for the same grid 
     461            jind = 0 
     462            DO jvar = 1, kvars 
     463               IF ( TRIM(inpfiles(jj)%cname(jvar)) == cobsname_uvel ) THEN 
     464                  CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,jvar), iobsj(:,jvar), & 
     465                     &                  iproc(:,jvar), 'U' ) 
     466               ELSE IF ( TRIM(inpfiles(jj)%cname(jvar)) == cobsname_vvel ) THEN 
     467                  CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,jvar), iobsj(:,jvar), & 
     468                     &                  iproc(:,jvar), 'V' ) 
     469               ELSE 
     470                  IF ( jind > 0 ) THEN 
     471                     iobsi(:,jvar) = iobsi(:,jind) 
     472                     iobsj(:,jvar) = iobsj(:,jind) 
     473                     iproc(:,jvar) = iproc(:,jind) 
     474                  ELSE 
     475                     jind = jvar 
     476                     CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,jvar), iobsj(:,jvar), & 
     477                        &                  iproc(:,jvar), 'T' ) 
     478                  ENDIF 
     479               ENDIF 
     480            END DO 
    350481 
    351482            inowin = 0 
    352483            DO ji = 1, inpfiles(jj)%nobs 
    353484               IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
    354                IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
    355                   & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
     485               llcycle = .TRUE. 
     486               DO jvar = 1, kvars 
     487                  IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     488                     llcycle = .FALSE. 
     489                     EXIT 
     490                  ENDIF 
     491               END DO 
     492               IF ( llcycle ) CYCLE 
    356493               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    357494                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    358495                  inowin = inowin + 1 
    359                   inpfiles(jj)%iproc(ji,1) = iproc1(inowin) 
    360                   inpfiles(jj)%iobsi(ji,1) = iobsi1(inowin) 
    361                   inpfiles(jj)%iobsj(ji,1) = iobsj1(inowin) 
    362                   inpfiles(jj)%iproc(ji,2) = iproc2(inowin) 
    363                   inpfiles(jj)%iobsi(ji,2) = iobsi2(inowin) 
    364                   inpfiles(jj)%iobsj(ji,2) = iobsj2(inowin) 
    365                   IF ( inpfiles(jj)%iproc(ji,1) /= & 
    366                      & inpfiles(jj)%iproc(ji,2) ) THEN 
    367                      CALL ctl_stop( 'Error in obs_read_prof:', & 
    368                         & 'var1 and var2 observation on different processors') 
     496                  DO jvar = 1, kvars 
     497                     inpfiles(jj)%iproc(ji,jvar) = iproc(inowin,jvar) 
     498                     inpfiles(jj)%iobsi(ji,jvar) = iobsi(inowin,jvar) 
     499                     inpfiles(jj)%iobsj(ji,jvar) = iobsj(inowin,jvar) 
     500                  END DO 
     501                  IF ( kvars > 1 ) THEN 
     502                     DO jvar = 2, kvars 
     503                        IF ( inpfiles(jj)%iproc(ji,jvar) /= & 
     504                           & inpfiles(jj)%iproc(ji,1) ) THEN 
     505                           CALL ctl_stop( 'Error in obs_read_prof:', & 
     506                              & 'observation on different processors for different vars') 
     507                        ENDIF 
     508                     END DO 
    369509                  ENDIF 
    370510               ENDIF 
    371511            END DO 
    372             DEALLOCATE( zlam, zphi, iobsi1, iobsj1, iproc1, iobsi2, iobsj2, iproc2 ) 
     512            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc ) 
    373513 
    374514            DO ji = 1, inpfiles(jj)%nobs 
    375515               IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
    376                IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
    377                   & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
     516               llcycle = .TRUE. 
     517               DO jvar = 1, kvars 
     518                  IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     519                     llcycle = .FALSE. 
     520                     EXIT 
     521                  ENDIF 
     522               END DO 
     523               IF ( llcycle ) CYCLE 
    378524               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    379525                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    384530                  ENDIF 
    385531                  llvalprof = .FALSE. 
    386                   IF ( ldvar1 ) THEN 
    387                      loop_t_count : DO ij = 1,inpfiles(jj)%nlev 
    388                         IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    389                            & CYCLE 
    390                         IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
    391                            & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    392                            ivar1t0 = ivar1t0 + 1 
    393                         ENDIF 
    394                      END DO loop_t_count 
    395                   ENDIF 
    396                   IF ( ldvar2 ) THEN 
    397                      loop_s_count : DO ij = 1,inpfiles(jj)%nlev 
    398                         IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    399                            & CYCLE 
    400                         IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
    401                            & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    402                            ivar2t0 = ivar2t0 + 1 
    403                         ENDIF 
    404                      END DO loop_s_count 
    405                   ENDIF 
    406                   loop_p_count : DO ij = 1,inpfiles(jj)%nlev 
     532                  DO jvar = 1, kvars 
     533                     IF ( ldvar(jvar) ) THEN 
     534                        DO ij = 1,inpfiles(jj)%nlev 
     535                           IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
     536                              & CYCLE 
     537                           IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
     538                              & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
     539                              ivart0(jvar) = ivart0(jvar) + 1 
     540                           ENDIF 
     541                        END DO 
     542                     ENDIF 
     543                  END DO 
     544                  DO ij = 1,inpfiles(jj)%nlev 
    407545                     IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    408546                        & CYCLE 
    409                      IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
    410                         &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
    411                         &    ldvar1 ) .OR. & 
    412                         & ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
    413                         &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
    414                         &     ldvar2 ) ) THEN 
    415                         ip3dt = ip3dt + 1 
    416                         llvalprof = .TRUE. 
    417                      ENDIF 
    418                   END DO loop_p_count 
     547                     DO jvar = 1, kvars 
     548                        IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
     549                           &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
     550                           &    ldvar(jvar) ) ) THEN 
     551                           ip3dt = ip3dt + 1 
     552                           llvalprof = .TRUE. 
     553                           EXIT 
     554                        ENDIF 
     555                     END DO 
     556                  END DO 
    419557 
    420558                  IF ( llvalprof ) iprof = iprof + 1 
    … …  
    438576         DO ji = 1, inpfiles(jj)%nobs 
    439577            IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
    440             IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
    441                & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
     578            llcycle = .TRUE. 
     579            DO jvar = 1, kvars 
     580               IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     581                  llcycle = .FALSE. 
     582                  EXIT 
     583               ENDIF 
     584            END DO 
     585            IF ( llcycle ) CYCLE 
    442586            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    443587               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    453597         DO ji = 1, inpfiles(jj)%nobs 
    454598            IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
    455             IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
    456                & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
     599            llcycle = .TRUE. 
     600            DO jvar = 1, kvars 
     601               IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     602                  llcycle = .FALSE. 
     603                  EXIT 
     604               ENDIF 
     605            END DO 
     606            IF ( llcycle ) CYCLE 
    457607            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    458608               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    469619 
    470620      iv3dt(:) = -1 
    471       IF (ldsatt) THEN 
    472          iv3dt(1) = ip3dt 
    473          iv3dt(2) = ip3dt 
     621      IF (ldallatall) THEN 
     622         iv3dt(:) = ip3dt 
    474623      ELSE 
    475          iv3dt(1) = ivar1t0 
    476          iv3dt(2) = ivar2t0 
     624         iv3dt(:) = ivart0(:) 
    477625      ENDIF 
    478       CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, & 
    479          &                 kstp, jpi, jpj, jpk ) 
     626      CALL obs_prof_alloc( profdata, kvars, kadd+iadd, kextr+iextr, iprof, iv3dt, & 
     627         &                 ip3dt, kstp, jpi, jpj, jpk ) 
    480628 
    481629      ! * Read obs/positions, QC, all variable and assign to profdata 
    … …  
    483631      profdata%nprof     = 0 
    484632      profdata%nvprot(:) = 0 
    485       profdata%cvars(:)  = clvars(:) 
     633      profdata%cvars(:)  = clvarsin(:) 
     634      profdata%clong(:)  = cllongin(:) 
     635      profdata%cunit(:)  = clunitin(:) 
     636      profdata%cgrid(:)  = clgridin(:) 
     637      IF ( iadd > 0 ) THEN 
     638         profdata%caddvars(kadd+1:)   = claddvarsin(:) 
     639         profdata%caddlong(kadd+1:,:) = claddlongin(:,:) 
     640         profdata%caddunit(kadd+1:,:) = claddunitin(:,:) 
     641      ENDIF 
     642      IF ( iextr > 0 ) THEN 
     643         profdata%cextvars(kextr+1:) = clextvarsin(:) 
     644         profdata%cextlong(kextr+1:) = clextlongin(:) 
     645         profdata%cextunit(kextr+1:) = clextunitin(:) 
     646      ENDIF 
    486647      iprof = 0 
    487648 
    488649      ip3dt = 0 
    489       ivar1t = 0 
    490       ivar2t = 0 
    491       itypvar1   (:) = 0 
    492       itypvar1mpp(:) = 0 
    493  
    494       itypvar2   (:) = 0 
    495       itypvar2mpp(:) = 0 
     650      ivart(:) = 0 
     651      itypvar   (:,:) = 0 
     652      itypvarmpp(:,:) = 0 
    496653 
    497654      ioserrcount = 0 
    … …  
    501658         ji = iprofidx(iindx(jk)) 
    502659 
    503             IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
    504             IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
    505                & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
     660         IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     661         llcycle = .TRUE. 
     662         DO jvar = 1, kvars 
     663            IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     664               llcycle = .FALSE. 
     665               EXIT 
     666            ENDIF 
     667         END DO 
     668         IF ( llcycle ) CYCLE 
    506669 
    507670         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  & 
    … …  
    519682 
    520683            IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
    521             IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
    522                & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
     684            llcycle = .TRUE. 
     685            DO jvar = 1, kvars 
     686               IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     687                  llcycle = .FALSE. 
     688                  EXIT 
     689               ENDIF 
     690            END DO 
     691            IF ( llcycle ) CYCLE 
    523692 
    524693            loop_prof : DO ij = 1, inpfiles(jj)%nlev 
    … …  
    527696                  & CYCLE 
    528697 
    529                IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
    530                   & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    531  
    532                   llvalprof = .TRUE.  
    533                   EXIT loop_prof 
    534  
    535                ENDIF 
    536  
    537                IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
    538                   & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    539  
    540                   llvalprof = .TRUE.  
    541                   EXIT loop_prof 
    542  
    543                ENDIF 
     698               DO jvar = 1, kvars 
     699                  IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
     700                     & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
     701 
     702                     llvalprof = .TRUE.  
     703                     EXIT loop_prof 
     704 
     705                  ENDIF 
     706               END DO 
    544707 
    545708            END DO loop_prof 
    … …  
    573736 
    574737               ! Coordinate search parameters 
    575                profdata%mi  (iprof,1) = inpfiles(jj)%iobsi(ji,1) 
    576                profdata%mj  (iprof,1) = inpfiles(jj)%iobsj(ji,1) 
    577                profdata%mi  (iprof,2) = inpfiles(jj)%iobsi(ji,2) 
    578                profdata%mj  (iprof,2) = inpfiles(jj)%iobsj(ji,2) 
     738               DO jvar = 1, kvars 
     739                  profdata%mi  (iprof,jvar) = inpfiles(jj)%iobsi(ji,jvar) 
     740                  profdata%mj  (iprof,jvar) = inpfiles(jj)%iobsj(ji,jvar) 
     741               END DO 
    579742 
    580743               ! Profile WMO number 
    … …  
    614777                     & CYCLE 
    615778 
    616                   IF (ldsatt) THEN 
    617  
    618                      IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
    619                         &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
    620                         &    ldvar1 ) .OR. & 
    621                         & ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
    622                         &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
    623                         &   ldvar2 ) ) THEN 
    624                         ip3dt = ip3dt + 1 
    625                      ELSE 
    626                         CYCLE 
     779                  IF ( ldallatall .OR. (iextr > 0) ) THEN 
     780 
     781                     DO jvar = 1, kvars 
     782                        IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
     783                           &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
     784                           &    ldvar(jvar) ) ) THEN 
     785                           ip3dt = ip3dt + 1 
     786                           EXIT 
     787                        ELSE IF ( jvar == kvars ) THEN 
     788                           CYCLE loop_p 
     789                        ENDIF 
     790                     END DO 
     791 
     792                  ENDIF 
     793 
     794                  DO jvar = 1, kvars 
     795                   
     796                     IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
     797                       &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
     798                       &    ldvar(jvar) ) .OR. ldallatall ) THEN 
     799 
     800                        IF (ldallatall) THEN 
     801 
     802                           ivart(jvar) = ip3dt 
     803 
     804                        ELSE 
     805 
     806                           ivart(jvar) = ivart(jvar) + 1 
     807 
     808                        ENDIF 
     809 
     810                        ! Depth of jvar observation 
     811                        profdata%var(jvar)%vdep(ivart(jvar)) = & 
     812                           &                inpfiles(jj)%pdep(ij,ji) 
     813 
     814                        ! Depth of jvar observation QC 
     815                        profdata%var(jvar)%idqc(ivart(jvar)) = & 
     816                           &                inpfiles(jj)%idqc(ij,ji) 
     817 
     818                        ! Depth of jvar observation QC flags 
     819                        profdata%var(jvar)%idqcf(:,ivart(jvar)) = & 
     820                           &                inpfiles(jj)%idqcf(:,ij,ji) 
     821 
     822                        ! Profile index 
     823                        profdata%var(jvar)%nvpidx(ivart(jvar)) = iprof 
     824 
     825                        ! Vertical index in original profile 
     826                        profdata%var(jvar)%nvlidx(ivart(jvar)) = ij 
     827 
     828                        ! Profile jvar value 
     829                        IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
     830                           & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
     831                           profdata%var(jvar)%vobs(ivart(jvar)) = & 
     832                              &                inpfiles(jj)%pob(ij,ji,jvar) 
     833                           ! Count number of profile var1 data as function of type 
     834                           itypvar( profdata%ntyp(iprof) + 1, jvar ) = & 
     835                              & itypvar( profdata%ntyp(iprof) + 1, jvar ) + 1 
     836                        ELSE 
     837                           profdata%var(jvar)%vobs(ivart(jvar)) = fbrmdi 
     838                        ENDIF 
     839 
     840                        ! Profile jvar qc 
     841                        profdata%var(jvar)%nvqc(ivart(jvar)) = & 
     842                           & inpfiles(jj)%ivlqc(ij,ji,jvar) 
     843 
     844                        ! Profile jvar qc flags 
     845                        profdata%var(jvar)%nvqcf(:,ivart(jvar)) = & 
     846                           & inpfiles(jj)%ivlqcf(:,ij,ji,jvar) 
     847 
     848                        ! Additional variables 
     849                        IF ( iadd > 0 ) THEN 
     850                           jadd2 = 0 
     851                           DO jadd = 1, inpfiles(jj)%nadd 
     852                              IF ( TRIM(inpfiles(jj)%caddname(jadd)) == 'Hx' ) THEN 
     853                                 IF ( ldmod ) THEN 
     854                                    profdata%var(jvar)%vmod(ivart(jvar)) = & 
     855                                       &                inpfiles(jj)%padd(ij,ji,jadd,jvar) 
     856                                 ENDIF 
     857                              ELSE 
     858                                 jadd2 = jadd2 + 1 
     859                                 profdata%var(jvar)%vadd(ivart(jvar),kadd+jadd2) = & 
     860                                    &                inpfiles(jj)%padd(ij,ji,jadd,jvar) 
     861                              ENDIF 
     862                           END DO 
     863                        ENDIF 
     864 
    627865                     ENDIF 
    628  
    629                   ENDIF 
    630  
    631                   IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
    632                     &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
    633                     &    ldvar1 ) .OR. ldsatt ) THEN 
    634  
    635                      IF (ldsatt) THEN 
    636  
    637                         ivar1t = ip3dt 
    638  
    639                      ELSE 
    640  
    641                         ivar1t = ivar1t + 1 
    642  
    643                      ENDIF 
    644  
    645                      ! Depth of var1 observation 
    646                      profdata%var(1)%vdep(ivar1t) = & 
    647                         &                inpfiles(jj)%pdep(ij,ji) 
    648  
    649                      ! Depth of var1 observation QC 
    650                      profdata%var(1)%idqc(ivar1t) = & 
    651                         &                inpfiles(jj)%idqc(ij,ji) 
    652  
    653                      ! Depth of var1 observation QC flags 
    654                      profdata%var(1)%idqcf(:,ivar1t) = & 
    655                         &                inpfiles(jj)%idqcf(:,ij,ji) 
    656  
    657                      ! Profile index 
    658                      profdata%var(1)%nvpidx(ivar1t) = iprof 
    659  
    660                      ! Vertical index in original profile 
    661                      profdata%var(1)%nvlidx(ivar1t) = ij 
    662  
    663                      ! Profile var1 value 
    664                      IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
    665                         & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    666                         profdata%var(1)%vobs(ivar1t) = & 
    667                            &                inpfiles(jj)%pob(ij,ji,1) 
    668                         IF ( ldmod ) THEN 
    669                            profdata%var(1)%vmod(ivar1t) = & 
    670                               &                inpfiles(jj)%padd(ij,ji,1,1) 
     866                   
     867                  END DO 
     868                   
     869                  ! Extra variables 
     870                  ! Special consideration for if the extra variable is called TEMP 
     871                  ! and there's a regular variable called POTM. These are in situ 
     872                  ! and potential temperature respectively, and need the same QC checks 
     873                  IF ( iextr > 0 ) THEN 
     874                     profdata%vext%nepidx(ip3dt) = iprof 
     875                     profdata%vext%nelidx(ip3dt) = ij 
     876                     DO jext = 1, iextr 
     877                        IF ( TRIM(inpfiles(jj)%cextname(jext)) == 'TEMP' ) THEN 
     878                           llpotm = .false. 
     879                           DO jvar = 1, kvars 
     880                              IF ( TRIM(inpfiles(jj)%cname(jvar)) == 'POTM' ) THEN 
     881                                 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
     882                                    &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
     883                                    &    ldvar(jvar) ) ) THEN 
     884                                    profdata%vext%eobs(ip3dt,kextr+jext) = inpfiles(jj)%pext(ij,ji,jext) 
     885                                 ELSE 
     886                                    profdata%vext%eobs(ip3dt,kextr+jext) = fbrmdi 
     887                                 ENDIF 
     888                                 llpotm = .true. 
     889                                 EXIT 
     890                              ENDIF 
     891                           END DO 
     892                           IF ( .NOT. llpotm ) THEN 
     893                              profdata%vext%eobs(ip3dt,kextr+jext) = inpfiles(jj)%pext(ij,ji,jext) 
     894                           ENDIF 
     895                        ELSE 
     896                           profdata%vext%eobs(ip3dt,kextr+jext) = inpfiles(jj)%pext(ij,ji,jext) 
    671897                        ENDIF 
    672                         ! Count number of profile var1 data as function of type 
    673                         itypvar1( profdata%ntyp(iprof) + 1 ) = & 
    674                            & itypvar1( profdata%ntyp(iprof) + 1 ) + 1 
    675                      ELSE 
    676                         profdata%var(1)%vobs(ivar1t) = fbrmdi 
    677                      ENDIF 
    678  
    679                      ! Profile var1 qc 
    680                      profdata%var(1)%nvqc(ivar1t) = & 
    681                         & inpfiles(jj)%ivlqc(ij,ji,1) 
    682  
    683                      ! Profile var1 qc flags 
    684                      profdata%var(1)%nvqcf(:,ivar1t) = & 
    685                         & inpfiles(jj)%ivlqcf(:,ij,ji,1) 
    686  
    687                      ! Profile insitu T value 
    688                      IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN 
    689                         profdata%var(1)%vext(ivar1t,1) = & 
    690                            &                inpfiles(jj)%pext(ij,ji,1) 
    691                      ENDIF 
    692  
    693                   ENDIF 
    694  
    695                   IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
    696                      &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2)    .AND. & 
    697                      &   ldvar2 ) .OR. ldsatt ) THEN 
    698  
    699                      IF (ldsatt) THEN 
    700  
    701                         ivar2t = ip3dt 
    702  
    703                      ELSE 
    704  
    705                         ivar2t = ivar2t + 1 
    706  
    707                      ENDIF 
    708  
    709                      ! Depth of var2 observation 
    710                      profdata%var(2)%vdep(ivar2t) = & 
    711                         &                inpfiles(jj)%pdep(ij,ji) 
    712  
    713                      ! Depth of var2 observation QC 
    714                      profdata%var(2)%idqc(ivar2t) = & 
    715                         &                inpfiles(jj)%idqc(ij,ji) 
    716  
    717                      ! Depth of var2 observation QC flags 
    718                      profdata%var(2)%idqcf(:,ivar2t) = & 
    719                         &                inpfiles(jj)%idqcf(:,ij,ji) 
    720  
    721                      ! Profile index 
    722                      profdata%var(2)%nvpidx(ivar2t) = iprof 
    723  
    724                      ! Vertical index in original profile 
    725                      profdata%var(2)%nvlidx(ivar2t) = ij 
    726  
    727                      ! Profile var2 value 
    728                   IF (  ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) ) .AND. & 
    729                     &   ( .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2)    )  ) THEN 
    730                         profdata%var(2)%vobs(ivar2t) = & 
    731                            &                inpfiles(jj)%pob(ij,ji,2) 
    732                         IF ( ldmod ) THEN 
    733                            profdata%var(2)%vmod(ivar2t) = & 
    734                               &                inpfiles(jj)%padd(ij,ji,1,2) 
    735                         ENDIF 
    736                         ! Count number of profile var2 data as function of type 
    737                         itypvar2( profdata%ntyp(iprof) + 1 ) = & 
    738                            & itypvar2( profdata%ntyp(iprof) + 1 ) + 1 
    739                      ELSE 
    740                         profdata%var(2)%vobs(ivar2t) = fbrmdi 
    741                      ENDIF 
    742  
    743                      ! Profile var2 qc 
    744                      profdata%var(2)%nvqc(ivar2t) = & 
    745                         & inpfiles(jj)%ivlqc(ij,ji,2) 
    746  
    747                      ! Profile var2 qc flags 
    748                      profdata%var(2)%nvqcf(:,ivar2t) = & 
    749                         & inpfiles(jj)%ivlqcf(:,ij,ji,2) 
    750  
     898                     END DO 
    751899                  ENDIF 
    752900 
    … …  
    763911      !----------------------------------------------------------------------- 
    764912 
    765       CALL obs_mpp_sum_integer ( ivar1t0, ivar1tmpp ) 
    766       CALL obs_mpp_sum_integer ( ivar2t0, ivar2tmpp ) 
     913      DO jvar = 1, kvars 
     914         CALL obs_mpp_sum_integer ( ivart0(jvar), ivartmpp(jvar) ) 
     915      END DO 
    767916      CALL obs_mpp_sum_integer ( ip3dt,   ip3dtmpp  ) 
    768917 
    769       CALL obs_mpp_sum_integers( itypvar1, itypvar1mpp, ntyp1770 + 1 ) 
    770       CALL obs_mpp_sum_integers( itypvar2, itypvar2mpp, ntyp1770 + 1 ) 
     918      DO jvar = 1, kvars 
     919         CALL obs_mpp_sum_integers( itypvar(:,jvar), itypvarmpp(:,jvar), ntyp1770 + 1 ) 
     920      END DO 
    771921 
    772922      !----------------------------------------------------------------------- 
    … …  
    778928         WRITE(numout,'(1X,A)') '------------' 
    779929         WRITE(numout,*)  
    780          WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(1) ) 
    781          WRITE(numout,'(1X,A)') '------------------------' 
    782          DO ji = 0, ntyp1770 
    783             IF ( itypvar1mpp(ji+1) > 0 ) THEN 
    784                WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 
    785                   & cwmonam1770(ji)(1:52),' = ', & 
    786                   & itypvar1mpp(ji+1) 
    787             ENDIF 
     930         DO jvar = 1, kvars 
     931            WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(jvar) ) 
     932            WRITE(numout,'(1X,A)') '------------------------' 
     933            DO ji = 0, ntyp1770 
     934               IF ( itypvarmpp(ji+1,jvar) > 0 ) THEN 
     935                  WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 
     936                     & cwmonam1770(ji)(1:52),' = ', & 
     937                     & itypvarmpp(ji+1,jvar) 
     938               ENDIF 
     939            END DO 
     940            WRITE(numout,'(1X,A)') & 
     941               & '---------------------------------------------------------------' 
     942            WRITE(numout,'(1X,A55,I8)') & 
     943               & 'Total profile data for variable '//TRIM( profdata%cvars(jvar) )// & 
     944               & '             = ', ivartmpp(jvar) 
     945            WRITE(numout,'(1X,A)') & 
     946               & '---------------------------------------------------------------' 
     947            WRITE(numout,*)  
    788948         END DO 
    789          WRITE(numout,'(1X,A)') & 
    790             & '---------------------------------------------------------------' 
    791          WRITE(numout,'(1X,A55,I8)') & 
    792             & 'Total profile data for variable '//TRIM( profdata%cvars(1) )// & 
    793             & '             = ', ivar1tmpp 
    794          WRITE(numout,'(1X,A)') & 
    795             & '---------------------------------------------------------------' 
    796          WRITE(numout,*)  
    797          WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(2) ) 
    798          WRITE(numout,'(1X,A)') '------------------------' 
    799          DO ji = 0, ntyp1770 
    800             IF ( itypvar2mpp(ji+1) > 0 ) THEN 
    801                WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 
    802                   & cwmonam1770(ji)(1:52),' = ', & 
    803                   & itypvar2mpp(ji+1) 
    804             ENDIF 
     949      ENDIF 
     950 
     951      IF (ldallatall) THEN 
     952         profdata%nvprot(:)    = ip3dt 
     953         profdata%nvprotmpp(:) = ip3dtmpp 
     954      ELSE 
     955         DO jvar = 1, kvars 
     956            profdata%nvprot(jvar)    = ivart(jvar) 
     957            profdata%nvprotmpp(jvar) = ivartmpp(jvar) 
    805958         END DO 
    806          WRITE(numout,'(1X,A)') & 
    807             & '---------------------------------------------------------------' 
    808          WRITE(numout,'(1X,A55,I8)') & 
    809             & 'Total profile data for variable '//TRIM( profdata%cvars(2) )// & 
    810             & '             = ', ivar2tmpp 
    811          WRITE(numout,'(1X,A)') & 
    812             & '---------------------------------------------------------------' 
    813          WRITE(numout,*)  
    814       ENDIF 
    815  
    816       IF (ldsatt) THEN 
    817          profdata%nvprot(1)    = ip3dt 
    818          profdata%nvprot(2)    = ip3dt 
    819          profdata%nvprotmpp(1) = ip3dtmpp 
    820          profdata%nvprotmpp(2) = ip3dtmpp 
    821       ELSE 
    822          profdata%nvprot(1)    = ivar1t 
    823          profdata%nvprot(2)    = ivar2t 
    824          profdata%nvprotmpp(1) = ivar1tmpp 
    825          profdata%nvprotmpp(2) = ivar2tmpp 
    826959      ENDIF 
    827960      profdata%nprof        = iprof 
    … …  
    830963      ! Model level search 
    831964      !----------------------------------------------------------------------- 
    832       IF ( ldvar1 ) THEN 
    833          CALL obs_level_search( jpk, gdept_1d, & 
    834             & profdata%nvprot(1), profdata%var(1)%vdep, & 
    835             & profdata%var(1)%mvk ) 
    836       ENDIF 
    837       IF ( ldvar2 ) THEN 
    838          CALL obs_level_search( jpk, gdept_1d, & 
    839             & profdata%nvprot(2), profdata%var(2)%vdep, & 
    840             & profdata%var(2)%mvk ) 
    841       ENDIF 
     965      DO jvar = 1, kvars 
     966         IF ( ldvar(jvar) ) THEN 
     967            CALL obs_level_search( jpk, gdept_1d, & 
     968               & profdata%nvprot(jvar), profdata%var(jvar)%vdep, & 
     969               & profdata%var(jvar)%mvk ) 
     970         ENDIF 
     971      END DO 
    842972 
    843973      !----------------------------------------------------------------------- 
    … …  
    852982      ! Deallocate temporary data 
    853983      !----------------------------------------------------------------------- 
    854       DEALLOCATE( ifileidx, iprofidx, zdat, clvars ) 
     984      DEALLOCATE( ifileidx, iprofidx, zdat, & 
     985         &        clvarsin, cllongin, clunitin, clgridin ) 
     986      IF ( iadd > 0 ) THEN 
     987         DEALLOCATE( claddvarsin, claddlongin, claddunitin) 
     988      ENDIF 
     989      IF ( iextr > 0 ) THEN 
     990         DEALLOCATE( clextvarsin, clextlongin, clextunitin ) 
     991      ENDIF 
    855992 
    856993      !----------------------------------------------------------------------- 

  • NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS/obs_read_surf.F90

    r14075 r15799  
    2222   USE obs_fbm                  ! Feedback routines 
    2323   USE netcdf                   ! NetCDF library 
     24   USE obs_group_def, ONLY : &  ! Observation variable information 
     25      & cobsname_uvel, & 
     26      & cobsname_vvel 
    2427 
    2528   IMPLICIT NONE 
    … …  
    3942 
    4043   SUBROUTINE obs_rea_surf( surfdata, knumfiles, cdfilenames, & 
    41       &                     kvars, kextr, kstp, ddobsini, ddobsend, & 
    42       &                     ldignmis, ldmod, ldnightav ) 
     44      &                     kvars, kadd, kextr, kstp, ddobsini, ddobsend, & 
     45      &                     ptime_mean_period, ld_time_mean_bkg, & 
     46      &                     ldignmis, ldmod, ldnightav, cdvars ) 
    4347      !!--------------------------------------------------------------------- 
    4448      !! 
    … …  
    6165      !! * Arguments 
    6266      TYPE(obs_surf), INTENT(INOUT) :: & 
    63          & surfdata                     ! Surface data to be read 
    64       INTEGER, INTENT(IN) :: knumfiles  ! Number of corio format files to read 
     67         & surfdata                             ! Surface data to be read 
     68      INTEGER,  INTENT(IN) :: knumfiles         ! Number of corio format files to read 
    6569      CHARACTER(LEN=128), INTENT(IN) :: & 
    66          & cdfilenames(knumfiles)       ! File names to read in 
    67       INTEGER, INTENT(IN) :: kvars      ! Number of variables in surfdata 
    68       INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var 
    69       INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index 
    70       LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files 
    71       LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data 
    72       LOGICAL, INTENT(IN) :: ldnightav  ! Observations represent a night-time average 
    73       REAL(dp), INTENT(IN) :: ddobsini   ! Obs. ini time in YYYYMMDD.HHMMSS 
    74       REAL(dp), INTENT(IN) :: ddobsend   ! Obs. end time in YYYYMMDD.HHMMSS 
     70         & cdfilenames(knumfiles)               ! File names to read in 
     71      INTEGER,  INTENT(IN) :: kvars             ! Number of variables in surfdata 
     72      INTEGER,  INTENT(IN) :: kadd              ! Number of additional fields 
     73                                                !   in addition to those in the input file(s) 
     74      INTEGER,  INTENT(IN) :: kextr             ! Number of extra fields 
     75                                                !   in addition to those in the input file(s) 
     76      INTEGER,  INTENT(IN) :: kstp              ! Ocean time-step index 
     77      REAL(dp), INTENT(IN) :: ddobsini          ! Obs. ini time in YYYYMMDD.HHMMSS 
     78      REAL(dp), INTENT(IN) :: ddobsend          ! Obs. end time in YYYYMMDD.HHMMSS 
     79      REAL(wp), INTENT(IN) :: ptime_mean_period ! Averaging period in hours 
     80      LOGICAL,  INTENT(IN) :: ld_time_mean_bkg  ! Will reset times to end of averaging period 
     81      LOGICAL,  INTENT(IN) :: ldignmis          ! Ignore missing files 
     82      LOGICAL,  INTENT(IN) :: ldmod             ! Initialize model from input data 
     83      LOGICAL,  INTENT(IN) :: ldnightav         ! Observations represent a night-time average 
     84      CHARACTER(len=8), DIMENSION(kvars), INTENT(IN) :: cdvars  ! Expected variable names 
    7585 
    7686      !! * Local declarations 
    7787      CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_surf' 
    7888      CHARACTER(len=8) :: clrefdate 
    79       CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: clvars 
     89      CHARACTER(len=ilenname), DIMENSION(:),   ALLOCATABLE :: clvarsin 
     90      CHARACTER(len=ilenlong), DIMENSION(:),   ALLOCATABLE :: cllongin 
     91      CHARACTER(len=ilenunit), DIMENSION(:),   ALLOCATABLE :: clunitin 
     92      CHARACTER(len=ilengrid), DIMENSION(:),   ALLOCATABLE :: clgridin 
     93      CHARACTER(len=ilenname), DIMENSION(:),   ALLOCATABLE :: claddvarsin 
     94      CHARACTER(len=ilenlong), DIMENSION(:,:), ALLOCATABLE :: claddlongin 
     95      CHARACTER(len=ilenunit), DIMENSION(:,:), ALLOCATABLE :: claddunitin 
     96      CHARACTER(len=ilenname), DIMENSION(:),   ALLOCATABLE :: clextvarsin 
     97      CHARACTER(len=ilenlong), DIMENSION(:),   ALLOCATABLE :: clextlongin 
     98      CHARACTER(len=ilenunit), DIMENSION(:),   ALLOCATABLE :: clextunitin 
    8099      INTEGER :: ji 
    81100      INTEGER :: jj 
    82101      INTEGER :: jk 
     102      INTEGER :: jind 
     103      INTEGER :: jvar 
     104      INTEGER :: jext 
     105      INTEGER :: jadd 
     106      INTEGER :: jadd2 
     107      INTEGER :: iadd 
     108      INTEGER :: iaddin 
     109      INTEGER :: iextr 
    83110      INTEGER :: iflag 
    84111      INTEGER :: inobf 
    … …  
    102129         & ityp, & 
    103130         & itypmpp 
    104       INTEGER, DIMENSION(:), ALLOCATABLE :: & 
     131      INTEGER, DIMENSION(:,:), ALLOCATABLE :: & 
    105132         & iobsi,    & 
    106133         & iobsj,    & 
    107          & iproc,    & 
     134         & iproc 
     135      INTEGER, DIMENSION(:), ALLOCATABLE :: & 
    108136         & iindx,    & 
    109137         & ifileidx, & 
    … …  
    120148      TYPE(obfbdata), POINTER, DIMENSION(:) :: & 
    121149         & inpfiles 
     150      CHARACTER(LEN=256) :: cout1  ! Diagnostic output line 
    122151 
    123152      ! Local initialization 
    … …  
    131160 
    132161      ALLOCATE( inpfiles(inobf) ) 
     162 
     163      iadd  = 0 
     164      iextr = 0 
    133165 
    134166      surf_files : DO jj = 1, inobf 
    … …  
    178210               &                ldgrid = .TRUE. ) 
    179211 
     212            IF ( inpfiles(jj)%nvar /= kvars ) THEN 
     213               CALL ctl_stop( 'Feedback format error: ', & 
     214                  &           ' unexpected number of vars in feedback file', & 
     215                  &           TRIM(cdfilenames(jj)) ) 
     216            ENDIF 
     217 
    180218            IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN 
    181                CALL ctl_stop( 'Model not in input data' ) 
     219               CALL ctl_stop( 'Model not in input data in', & 
     220                  &           TRIM(cdfilenames(jj)) ) 
    182221               RETURN 
    183222            ENDIF 
    184223 
     224            IF ( (iextr > 0) .AND. (inpfiles(jj)%next /= iextr) ) THEN 
     225               CALL ctl_stop( 'Number of extra variables not consistent', & 
     226                  &           ' with previous files for this type in', & 
     227                  &           TRIM(cdfilenames(jj)) ) 
     228            ELSE 
     229               iextr = inpfiles(jj)%next 
     230            ENDIF 
     231 
     232            ! Ignore model counterpart 
     233            iaddin = inpfiles(jj)%nadd 
     234            DO ji = 1, iaddin 
     235               IF ( TRIM(inpfiles(jj)%caddname(ji)) == 'Hx' ) THEN 
     236                  iaddin = iaddin - 1 
     237                  EXIT 
     238               ENDIF 
     239            END DO 
     240            IF ( ldmod .AND. ( inpfiles(jj)%nadd == iaddin ) ) THEN 
     241               CALL ctl_stop( 'Model not in input data', & 
     242                  &           TRIM(cdfilenames(jj)) ) 
     243            ENDIF 
     244 
     245            IF ( (iadd > 0) .AND. (iaddin /= iadd) ) THEN 
     246               CALL ctl_stop( 'Number of additional variables not consistent', & 
     247                  &           ' with previous files for this type in', & 
     248                  &           TRIM(cdfilenames(jj)) ) 
     249            ELSE 
     250               iadd = iaddin 
     251            ENDIF 
     252 
    185253            IF ( jj == 1 ) THEN 
    186                ALLOCATE( clvars( inpfiles(jj)%nvar ) ) 
     254               ALLOCATE( clvarsin( inpfiles(jj)%nvar ) ) 
     255               ALLOCATE( cllongin( inpfiles(jj)%nvar ) ) 
     256               ALLOCATE( clunitin( inpfiles(jj)%nvar ) ) 
     257               ALLOCATE( clgridin( inpfiles(jj)%nvar ) ) 
    187258               DO ji = 1, inpfiles(jj)%nvar 
    188                  clvars(ji) = inpfiles(jj)%cname(ji) 
     259                 clvarsin(ji) = inpfiles(jj)%cname(ji) 
     260                 cllongin(ji) = inpfiles(jj)%coblong(ji) 
     261                 clunitin(ji) = inpfiles(jj)%cobunit(ji) 
     262                 clgridin(ji) = inpfiles(jj)%cgrid(ji) 
     263                 IF ( clvarsin(ji) /= cdvars(ji) ) THEN 
     264                    CALL ctl_stop( 'Feedback file variables do not match', & 
     265                        &           ' expected variable names for this type' ) 
     266                 ENDIF 
    189267               END DO 
     268               IF ( iadd > 0 ) THEN 
     269                  ALLOCATE( claddvarsin( iadd ) ) 
     270                  ALLOCATE( claddlongin( iadd, inpfiles(jj)%nvar ) ) 
     271                  ALLOCATE( claddunitin( iadd, inpfiles(jj)%nvar ) ) 
     272                  jadd = 0 
     273                  DO ji = 1, inpfiles(jj)%nadd 
     274                    IF ( TRIM(inpfiles(jj)%caddname(ji)) /= 'Hx' ) THEN 
     275                       jadd = jadd + 1 
     276                       claddvarsin(jadd) = inpfiles(jj)%caddname(ji) 
     277                       DO jk = 1, inpfiles(jj)%nvar 
     278                          claddlongin(jadd,jk) = inpfiles(jj)%caddlong(ji,jk) 
     279                          claddunitin(jadd,jk) = inpfiles(jj)%caddunit(ji,jk) 
     280                       END DO 
     281                    ENDIF 
     282                  END DO 
     283               ENDIF 
     284               IF ( iextr > 0 ) THEN 
     285                  ALLOCATE( clextvarsin( iextr ) ) 
     286                  ALLOCATE( clextlongin( iextr ) ) 
     287                  ALLOCATE( clextunitin( iextr ) ) 
     288                  DO ji = 1, iextr 
     289                    clextvarsin(ji) = inpfiles(jj)%cextname(ji) 
     290                    clextlongin(ji) = inpfiles(jj)%cextlong(ji) 
     291                    clextunitin(ji) = inpfiles(jj)%cextunit(ji) 
     292                  END DO 
     293               ENDIF 
    190294            ELSE 
    191295               DO ji = 1, inpfiles(jj)%nvar 
    192                   IF ( inpfiles(jj)%cname(ji) /= clvars(ji) ) THEN 
     296                  IF ( inpfiles(jj)%cname(ji) /= clvarsin(ji) ) THEN 
    193297                     CALL ctl_stop( 'Feedback file variables not consistent', & 
    194                         &           ' with previous files for this type' ) 
     298                        &           ' with previous files for this type in', & 
     299                        &           TRIM(cdfilenames(jj)) ) 
    195300                  ENDIF 
    196301               END DO 
    197             ENDIF 
    198  
    199             IF (lwp) WRITE(numout,*)'Observation file contains ',inpfiles(jj)%nobs,' observations' 
     302               IF ( iadd > 0 ) THEN 
     303                  jadd = 0 
     304                  DO ji = 1, inpfiles(jj)%nadd 
     305                     IF ( TRIM(inpfiles(jj)%caddname(ji)) /= 'Hx' ) THEN 
     306                        jadd = jadd + 1 
     307                        IF ( inpfiles(jj)%caddname(ji) /= claddvarsin(jadd) ) THEN 
     308                           CALL ctl_stop( 'Feedback file additional variables not consistent', & 
     309                              &           ' with previous files for this type in', & 
     310                              &           TRIM(cdfilenames(jj)) ) 
     311                        ENDIF 
     312                     ENDIF 
     313                  END DO 
     314               ENDIF 
     315               IF ( iextr > 0 ) THEN 
     316                  DO ji = 1, iextr 
     317                     IF ( inpfiles(jj)%cextname(ji) /= clextvarsin(ji) ) THEN 
     318                        CALL ctl_stop( 'Feedback file extra variables not consistent', & 
     319                           &           ' with previous files for this type in', & 
     320                           &           TRIM(cdfilenames(jj)) ) 
     321                     ENDIF 
     322                  END DO 
     323               ENDIF 
     324 
     325            ENDIF 
     326 
     327            IF (lwp) WRITE(numout,*) 'Observation file contains ', inpfiles(jj)%nobs, ' observations' 
    200328 
    201329            !------------------------------------------------------------------ 
    … …  
    247375 
    248376            IF ( inpfiles(jj)%nobs > 0 ) THEN 
    249                inpfiles(jj)%iproc = -1 
    250                inpfiles(jj)%iobsi = -1 
    251                inpfiles(jj)%iobsj = -1 
    252             ENDIF 
     377               inpfiles(jj)%iproc(:,:) = -1 
     378               inpfiles(jj)%iobsi(:,:) = -1 
     379               inpfiles(jj)%iobsj(:,:) = -1 
     380            ENDIF 
     381 
     382            ! If observations are representing a time mean then set the time 
     383            ! of the obs to the end of that meaning period relative to the start of the run 
     384            IF ( ld_time_mean_bkg ) THEN 
     385               DO ji = 1, inpfiles(jj)%nobs 
     386                  ! Only do this for obs within time window 
     387                  IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
     388                     & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN 
     389                     inpfiles(jj)%ptim(ji) = djulini(jj) + (ptime_mean_period/24.0) 
     390                  ENDIF 
     391               END DO 
     392            ENDIF 
     393 
    253394            inowin = 0 
    254395            DO ji = 1, inpfiles(jj)%nobs 
    … …  
    258399               ENDIF 
    259400            END DO 
    260             ALLOCATE( zlam(inowin)  ) 
    261             ALLOCATE( zphi(inowin)  ) 
    262             ALLOCATE( iobsi(inowin) ) 
    263             ALLOCATE( iobsj(inowin) ) 
    264             ALLOCATE( iproc(inowin) ) 
     401            ALLOCATE( zlam (inowin)       ) 
     402            ALLOCATE( zphi (inowin)       ) 
     403            ALLOCATE( iobsi(inowin,kvars) ) 
     404            ALLOCATE( iobsj(inowin,kvars) ) 
     405            ALLOCATE( iproc(inowin,kvars) ) 
    265406            inowin = 0 
    266407            DO ji = 1, inpfiles(jj)%nobs 
    … …  
    273414            END DO 
    274415 
    275             CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' ) 
     416            ! Do grid search 
     417            ! Assume anything other than velocity is on T grid 
     418            ! Save resource by not repeating for the same grid 
     419            jind = 0 
     420            DO jvar = 1, kvars 
     421               IF ( TRIM(inpfiles(jj)%cname(jvar)) == cobsname_uvel ) THEN 
     422                  CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,jvar), iobsj(:,jvar), & 
     423                     &                  iproc(:,jvar), 'U' ) 
     424               ELSE IF ( TRIM(inpfiles(jj)%cname(jvar)) == cobsname_vvel ) THEN 
     425                  CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,jvar), iobsj(:,jvar), & 
     426                     &                  iproc(:,jvar), 'V' ) 
     427               ELSE 
     428                  IF ( jind > 0 ) THEN 
     429                     iobsi(:,jvar) = iobsi(:,jind) 
     430                     iobsj(:,jvar) = iobsj(:,jind) 
     431                     iproc(:,jvar) = iproc(:,jind) 
     432                  ELSE 
     433                     jind = jvar 
     434                     CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,jvar), iobsj(:,jvar), & 
     435                        &                  iproc(:,jvar), 'T' ) 
     436                  ENDIF 
     437               ENDIF 
     438            END DO 
    276439 
    277440            inowin = 0 
    … …  
    280443                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    281444                  inowin = inowin + 1 
    282                   inpfiles(jj)%iproc(ji,1) = iproc(inowin) 
    283                   inpfiles(jj)%iobsi(ji,1) = iobsi(inowin) 
    284                   inpfiles(jj)%iobsj(ji,1) = iobsj(inowin) 
     445                  DO jvar = 1, kvars 
     446                     inpfiles(jj)%iproc(ji,jvar) = iproc(inowin,jvar) 
     447                     inpfiles(jj)%iobsi(ji,jvar) = iobsi(inowin,jvar) 
     448                     inpfiles(jj)%iobsj(ji,jvar) = iobsj(inowin,jvar) 
     449                  END DO 
    285450               ENDIF 
    286451            END DO 
    … …  
    341506         &               iindx   ) 
    342507 
    343       CALL obs_surf_alloc( surfdata, iobs, kvars, kextr, kstp, jpi, jpj ) 
     508      CALL obs_surf_alloc( surfdata, iobs, kvars, kadd+iadd, kextr+iextr, kstp, jpi, jpj ) 
    344509 
    345510      ! Read obs/positions, QC, all variable and assign to surfdata 
    … …  
    347512      iobs = 0 
    348513 
    349       surfdata%cvars(:)  = clvars(:) 
     514      surfdata%cvars(:)  = clvarsin(:) 
     515      surfdata%clong(:)  = cllongin(:) 
     516      surfdata%cunit(:)  = clunitin(:) 
     517      surfdata%cgrid(:)  = clgridin(:) 
     518      IF ( iadd > 0 ) THEN 
     519         surfdata%caddvars(kadd+1:)   = claddvarsin(:) 
     520         surfdata%caddlong(kadd+1:,:) = claddlongin(:,:) 
     521         surfdata%caddunit(kadd+1:,:) = claddunitin(:,:) 
     522      ENDIF 
     523      IF ( iextr > 0 ) THEN 
     524         surfdata%cextvars(kextr+1:) = clextvarsin(:) 
     525         surfdata%cextlong(kextr+1:) = clextlongin(:) 
     526         surfdata%cextunit(kextr+1:) = clextunitin(:) 
     527      ENDIF 
    350528 
    351529      ityp   (:) = 0 
    … …  
    395573 
    396574               ! Coordinate search parameters 
    397                surfdata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1) 
    398                surfdata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1) 
     575               DO jvar = 1, kvars 
     576                  surfdata%mi(iobs,jvar) = inpfiles(jj)%iobsi(ji,jvar) 
     577                  surfdata%mj(iobs,jvar) = inpfiles(jj)%iobsj(ji,jvar) 
     578               END DO 
    399579 
    400580               ! WMO number 
    … …  
    415595                  ityp(itype+1) = ityp(itype+1) + 1 
    416596               ELSE 
    417                   IF(lwp)WRITE(numout,*)'WARNING:Increase jpsurfmaxtype in ',& 
    418                      &                  cpname 
     597                  IF(lwp)WRITE(numout,*) 'WARNING: Increase jpsurfmaxtype in ', & 
     598                     &                   cpname 
    419599               ENDIF 
    420600 
    … …  
    423603               surfdata%nsfil(iobs) = iindx(jk) 
    424604 
    425                ! QC flags 
    426                surfdata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1) 
    427  
    428                ! Observed value 
    429                surfdata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1) 
    430  
    431  
    432                ! Model and MDT is set to fbrmdi unless read from file 
    433                IF ( ldmod ) THEN 
    434                   surfdata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1) 
    435                   IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) THEN 
    436                      surfdata%rext(iobs,1) = inpfiles(jj)%padd(1,ji,2,1) 
    437                      surfdata%rext(iobs,2) = inpfiles(jj)%pext(1,ji,1) 
     605               DO jvar = 1, kvars 
     606 
     607                  ! QC flags 
     608                  surfdata%nqc(iobs) = inpfiles(jj)%ivqc(ji,jvar) 
     609 
     610                  ! Observed value 
     611                  surfdata%robs(iobs,jvar) = inpfiles(jj)%pob(1,ji,jvar) 
     612 
     613                  ! Additional variables 
     614                  surfdata%rmod(iobs,jvar) = fbrmdi 
     615                  IF ( iadd > 0 ) THEN 
     616                     jadd2 = 0 
     617                     DO jadd = 1, inpfiles(jj)%nadd 
     618                        IF ( TRIM(inpfiles(jj)%caddname(jadd)) == 'Hx' ) THEN 
     619                           IF ( ldmod ) THEN 
     620                              surfdata%rmod(iobs,jvar) = inpfiles(jj)%padd(1,ji,jadd,jvar) 
     621                           ENDIF 
     622                        ELSE 
     623                           jadd2 = jadd2 + 1 
     624                           surfdata%radd(iobs,kadd+jadd2,jvar) = & 
     625                              &                inpfiles(jj)%padd(1,ji,jadd,jvar) 
     626                        ENDIF 
     627                     END DO 
    438628                  ENDIF 
    439                 ELSE 
    440                   surfdata%rmod(iobs,1) = fbrmdi 
    441                   IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) surfdata%rext(iobs,:) = fbrmdi 
     629 
     630               END DO 
     631                   
     632               ! Extra variables 
     633               IF ( iextr > 0 ) THEN 
     634                  DO jext = 1, iextr 
     635                     surfdata%rext(iobs,kextr+jext) = inpfiles(jj)%pext(1,ji,jext) 
     636                  END DO 
    442637               ENDIF 
    443638            ENDIF 
    … …  
    457652      !----------------------------------------------------------------------- 
    458653      IF (lwp) THEN 
    459  
     654         DO jvar = 1, surfdata%nvar        
     655            IF ( jvar == 1 ) THEN 
     656               cout1=TRIM(surfdata%cvars(1))                   
     657            ELSE 
     658               WRITE(cout1,'(A,A1,A)') TRIM(cout1), '/', TRIM(surfdata%cvars(jvar))             
     659            ENDIF 
     660         END DO 
     661  
    460662         WRITE(numout,*) 
    461          WRITE(numout,'(1X,A)')TRIM( surfdata%cvars(1) )//' data' 
     663         WRITE(numout,'(1X,A)')TRIM( cout1 )//' data' 
    462664         WRITE(numout,'(1X,A)')'--------------' 
    463665         DO jj = 1,8 
    464666            IF ( itypmpp(jj) > 0 ) THEN 
    465                WRITE(numout,'(1X,A4,I4,A3,I10)')'Type ', jj,' = ',itypmpp(jj) 
     667               WRITE(numout,'(1X,A4,I4,A3,I10)') 'Type ', jj, ' = ', itypmpp(jj) 
    466668            ENDIF 
    467669         END DO 
    … …  
    469671            & '---------------------------------------------------------------' 
    470672         WRITE(numout,'(1X,A,I8)') & 
    471             & 'Total data for variable '//TRIM( surfdata%cvars(1) )// & 
     673            & 'Total data for variable '//TRIM( cout1 )// & 
    472674            & '           = ', iobsmpp 
    473675         WRITE(numout,'(1X,A)') & 
    … …  
    480682      ! Deallocate temporary data 
    481683      !----------------------------------------------------------------------- 
    482       DEALLOCATE( ifileidx, isurfidx, zdat, clvars ) 
     684      DEALLOCATE( ifileidx, isurfidx, zdat, clvarsin, & 
     685         &        cllongin, clunitin, clgridin ) 
     686      IF ( iadd > 0 ) THEN 
     687         DEALLOCATE( claddvarsin, claddlongin, claddunitin) 
     688      ENDIF 
     689      IF ( iextr > 0 ) THEN 
     690         DEALLOCATE( clextvarsin, clextlongin, clextunitin ) 
     691      ENDIF 
    483692 
    484693      !----------------------------------------------------------------------- 

  • NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS/obs_readmdt.F90

    r14075 r15799  
    3131    
    3232   PUBLIC   obs_rea_mdt     ! called by dia_obs_init 
    33    PUBLIC   obs_offset_mdt  ! called by obs_rea_mdt 
    34  
    35    INTEGER , PUBLIC :: nn_msshc    = 1         ! MDT correction scheme 
    36    REAL(wp), PUBLIC :: rn_mdtcorr   = 1.61_wp  ! User specified MDT correction 
    37    REAL(wp), PUBLIC :: rn_mdtcutoff = 65.0_wp  ! MDT cutoff for computed correction 
    3833 
    3934   !!---------------------------------------------------------------------- 
    … …  
    4439CONTAINS 
    4540 
    46    SUBROUTINE obs_rea_mdt( sladata, k2dint ) 
     41   SUBROUTINE obs_rea_mdt( sladata, k2dint, kmdt, nn_msshc, rn_mdtcorr, & 
     42                           rn_mdtcutoff ) 
    4743      !!--------------------------------------------------------------------- 
    4844      !! 
    … …  
    5753      USE iom 
    5854      ! 
    59       TYPE(obs_surf), INTENT(inout) ::   sladata   ! SLA data 
    60       INTEGER       , INTENT(in)    ::   k2dint    ! ? 
     55      TYPE(obs_surf), INTENT(inout) :: sladata      ! SLA data 
     56      INTEGER       , INTENT(in)    :: k2dint       ! Interpolation type 
     57      INTEGER       , INTENT(in)    :: kmdt         ! Index of MDT extra var 
     58      INTEGER       , INTENT(in)    :: nn_msshc     ! MDT correction scheme 
     59      REAL(wp)      , INTENT(in)    :: rn_mdtcorr   ! User specified MDT correction 
     60      REAL(wp)      , INTENT(in)    :: rn_mdtcutoff ! MDT cutoff for computed correction 
    6161      ! 
    6262      CHARACTER(LEN=12), PARAMETER ::   cpname  = 'obs_rea_mdt' 
    … …  
    105105 
    106106      ! Remove the offset between the MDT used with the sla and the model MDT 
    107       IF( nn_msshc == 1 .OR. nn_msshc == 2 ) & 
    108          & CALL obs_offset_mdt( jpi, jpj, z_mdt, zfill ) 
    109  
    110       ! Intepolate the MDT already on the model grid at the observation point 
    111    
     107      IF( nn_msshc == 1 .OR. nn_msshc == 2 ) THEN 
     108         CALL obs_offset_mdt( jpi, jpj, z_mdt, zfill, nn_msshc, & 
     109            &                 rn_mdtcorr, rn_mdtcutoff ) 
     110      ENDIF 
     111 
     112      ! Interpolate the MDT already on the model grid at the observation point 
     113 
    112114      ALLOCATE( & 
    113115         & igrdi(2,2,sladata%nsurf), & 
    … …  
    118120         & zmdtl(2,2,sladata%nsurf)  & 
    119121         & ) 
    120           
     122 
    121123      DO jobs = 1, sladata%nsurf 
    122124 
    … …  
    147149             
    148150         CALL obs_int_h2d( 1, 1, zweig, zmdtl(:,:,jobs),  zext ) 
    149   
    150          sladata%rext(jobs,2) = zext(1) 
     151 
     152         sladata%rext(jobs,kmdt) = zext(1) 
    151153 
    152154! mark any masked data with a QC flag 
    153155         IF( zobsmask(1) == 0 )   sladata%nqc(jobs) = IBSET(sladata%nqc(jobs),15) 
    154156 
    155          END DO 
    156           
     157      END DO 
     158 
    157159      DEALLOCATE( & 
    158160         & igrdi, & 
    … …  
    169171 
    170172 
    171    SUBROUTINE obs_offset_mdt( kpi, kpj, mdt, zfill ) 
     173   SUBROUTINE obs_offset_mdt( kpi, kpj, mdt, zfill, nn_msshc, rn_mdtcorr, & 
     174                              rn_mdtcutoff ) 
    172175      !!--------------------------------------------------------------------- 
    173176      !! 
    … …  
    183186      !!---------------------------------------------------------------------- 
    184187      INTEGER, INTENT(IN) ::  kpi, kpj 
    185       REAL(wp), DIMENSION(kpi,kpj), INTENT(INOUT) ::   mdt     ! MDT used on the model grid 
    186       REAL(wp)                    , INTENT(IN   ) ::   zfill  
     188      REAL(wp), DIMENSION(kpi,kpj), INTENT(INOUT) :: mdt          ! MDT used on the model grid 
     189      REAL(wp)                    , INTENT(IN   ) :: zfill        ! Fill value 
     190      INTEGER                     , INTENT(IN   ) :: nn_msshc     ! MDT correction scheme 
     191      REAL(wp)                    , INTENT(IN   ) :: rn_mdtcorr   ! User specified MDT correction 
     192      REAL(wp)                    , INTENT(IN   ) :: rn_mdtcutoff ! MDT cutoff for computed correction 
    187193      !  
    188194      INTEGER  :: ji, jj 
    … …  
    246252         WRITE(numout,*) '               zcorr         = ', zcorr 
    247253         WRITE(numout,*) '               nn_msshc        = ', nn_msshc 
     254 
     255         IF ( nn_msshc == 0 ) WRITE(numout,*) '           MSSH correction is not applied' 
     256         IF ( nn_msshc == 1 ) WRITE(numout,*) '           MSSH correction is applied' 
     257         IF ( nn_msshc == 2 ) WRITE(numout,*) '           User defined MSSH correction'  
    248258      ENDIF 
    249  
    250       IF ( nn_msshc == 0 ) WRITE(numout,*) '           MSSH correction is not applied' 
    251       IF ( nn_msshc == 1 ) WRITE(numout,*) '           MSSH correction is applied' 
    252       IF ( nn_msshc == 2 ) WRITE(numout,*) '           User defined MSSH correction'  
    253259 
    254260      ! 

  • NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS/obs_rot_vel.F90

    r14075 r15799  
    1616   USE obs_utils                ! For error handling 
    1717   USE obs_profiles_def         ! Profile definitions 
     18   USE obs_surf_def             ! Surface definitions 
    1819   USE obs_inter_h2d            ! Horizontal interpolation 
    1920   USE obs_inter_sup            ! MPP support routines for interpolation 
    … …  
    2627   PRIVATE 
    2728 
    28    PUBLIC obs_rotvel            ! Rotate the observations 
     29   PUBLIC obs_rotvel_pro        ! Rotate the profile velocity observations 
     30   PUBLIC obs_rotvel_surf       ! Rotate the surface velocity observations 
    2931 
    3032   !!---------------------------------------------------------------------- 
    … …  
    3638CONTAINS 
    3739 
    38    SUBROUTINE obs_rotvel( profdata, k2dint, pu, pv ) 
     40   SUBROUTINE obs_rotvel_pro( profdata, k2dint, kuvar, kvvar, pu, pv ) 
    3941      !!--------------------------------------------------------------------- 
    4042      !! 
    41       !!                   *** ROUTINE obs_rea_pro_dri *** 
     43      !!                   *** ROUTINE obs_rotvel_pro *** 
    4244      !! 
    4345      !! ** Purpose : Rotate velocity data into N-S,E-W directorions 
    … …  
    5759      !! * Arguments 
    5860      TYPE(obs_prof), INTENT(INOUT) :: profdata    ! Profile data to be read 
    59       INTEGER, INTENT(IN) :: k2dint     ! Horizontal interpolation methed 
     61      INTEGER, INTENT(IN) :: k2dint     ! Horizontal interpolation method 
     62      INTEGER, INTENT(IN) :: kuvar      ! Index of U velocity 
     63      INTEGER, INTENT(IN) :: kvvar      ! Index of V velocity 
    6064      REAL(wp), DIMENSION(*) :: & 
    6165         & pu, & 
    … …  
    185189         zsin = 0.5_wp * ( zsinu(1) + zsinv(1) ) 
    186190          
    187          IF ( ( profdata%npvsta(ji,1) /= profdata%npvsta(ji,2) ) .OR. & 
    188             & ( profdata%npvend(ji,1) /= profdata%npvend(ji,2) ) ) THEN 
     191         IF ( ( profdata%npvsta(ji,kuvar) /= profdata%npvsta(ji,kvvar) ) .OR. & 
     192            & ( profdata%npvend(ji,kuvar) /= profdata%npvend(ji,kvvar) ) ) THEN 
    189193            CALL fatal_error( 'Different number of U and V observations '// & 
    190194               'in a profile in obs_rotvel', __LINE__ ) 
    191195         ENDIF 
    192196 
    193          DO jk = profdata%npvsta(ji,1), profdata%npvend(ji,1) 
    194             IF ( ( profdata%var(1)%vmod(jk) /= fbrmdi ) .AND. & 
    195                & ( profdata%var(2)%vmod(jk) /= fbrmdi ) ) THEN 
    196                pu(jk) = profdata%var(1)%vmod(jk) * zcos - & 
    197                   &     profdata%var(2)%vmod(jk) * zsin 
    198                pv(jk) = profdata%var(2)%vmod(jk) * zcos + & 
    199                   &     profdata%var(1)%vmod(jk) * zsin 
     197         DO jk = profdata%npvsta(ji,kuvar), profdata%npvend(ji,kuvar) 
     198            IF ( ( profdata%var(kuvar)%vmod(jk) /= fbrmdi ) .AND. & 
     199               & ( profdata%var(kvvar)%vmod(jk) /= fbrmdi ) ) THEN 
     200               pu(jk) = profdata%var(kuvar)%vmod(jk) * zcos - & 
     201                  &     profdata%var(kvvar)%vmod(jk) * zsin 
     202               pv(jk) = profdata%var(kvvar)%vmod(jk) * zcos + & 
     203                  &     profdata%var(kuvar)%vmod(jk) * zsin 
    200204            ELSE 
    201205               pu(jk) = fbrmdi 
    … …  
    224228         & ) 
    225229 
    226    END SUBROUTINE obs_rotvel 
     230   END SUBROUTINE obs_rotvel_pro 
     231 
     232   SUBROUTINE obs_rotvel_surf( surfdata, k2dint, kuvar, kvvar, pu, pv ) 
     233      !!--------------------------------------------------------------------- 
     234      !! 
     235      !!                   *** ROUTINE obs_rotvel_surf *** 
     236      !! 
     237      !! ** Purpose : Rotate surface velocity data into N-S,E-W directorions 
     238      !! 
     239      !! ** Method  : Interpolation of geo2ocean coefficients on U,V grid 
     240      !!              to observation point followed by a similar computations 
     241      !!              as in geo2ocean. 
     242      !! 
     243      !! ** Action  : Review if there is a better way to do this. 
     244      !! 
     245      !! References :  
     246      !! 
     247      !! History :   
     248      !!      ! :  2009-02 (K. Mogensen) : New routine 
     249      !!---------------------------------------------------------------------- 
     250      !! * Modules used 
     251      !! * Arguments 
     252      TYPE(obs_surf), INTENT(INOUT) :: surfdata    ! Surface data to be read 
     253      INTEGER, INTENT(IN) :: k2dint     ! Horizontal interpolation method 
     254      INTEGER, INTENT(IN) :: kuvar      ! Index of U velocity 
     255      INTEGER, INTENT(IN) :: kvvar      ! Index of V velocity 
     256      REAL(wp), DIMENSION(*) :: & 
     257         & pu, & 
     258         & pv 
     259      !! * Local declarations 
     260      REAL(wp), DIMENSION(2,2,1) :: zweig 
     261      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
     262         & zmasku, & 
     263         & zmaskv, & 
     264         & zcoslu, & 
     265         & zsinlu, & 
     266         & zcoslv, & 
     267         & zsinlv, & 
     268         & zglamu, & 
     269         & zgphiu, & 
     270         & zglamv, & 
     271         & zgphiv 
     272      REAL(wp), DIMENSION(1) :: & 
     273         & zsinu, & 
     274         & zcosu, & 
     275         & zsinv, & 
     276         & zcosv 
     277      REAL(wp) :: zsin 
     278      REAL(wp) :: zcos 
     279      REAL(wp), DIMENSION(1) :: zobsmask 
     280      REAL(wp), DIMENSION(jpi,jpj) :: zsingu,zcosgu,zsingv,zcosgv 
     281      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
     282         & igrdiu, & 
     283         & igrdju, & 
     284         & igrdiv, & 
     285         & igrdjv 
     286      INTEGER :: ji 
     287      INTEGER :: jk 
     288 
     289      !----------------------------------------------------------------------- 
     290      ! Allocate data for message parsing and interpolation 
     291      !----------------------------------------------------------------------- 
     292 
     293      ALLOCATE( & 
     294         & igrdiu(2,2,surfdata%nsurf), & 
     295         & igrdju(2,2,surfdata%nsurf), & 
     296         & zglamu(2,2,surfdata%nsurf), & 
     297         & zgphiu(2,2,surfdata%nsurf), & 
     298         & zmasku(2,2,surfdata%nsurf), & 
     299         & zcoslu(2,2,surfdata%nsurf), & 
     300         & zsinlu(2,2,surfdata%nsurf), & 
     301         & igrdiv(2,2,surfdata%nsurf), & 
     302         & igrdjv(2,2,surfdata%nsurf), & 
     303         & zglamv(2,2,surfdata%nsurf), & 
     304         & zgphiv(2,2,surfdata%nsurf), & 
     305         & zmaskv(2,2,surfdata%nsurf), & 
     306         & zcoslv(2,2,surfdata%nsurf), & 
     307         & zsinlv(2,2,surfdata%nsurf)  & 
     308         & ) 
     309 
     310      !----------------------------------------------------------------------- 
     311      ! Receive the angles on the U and V grids. 
     312      !----------------------------------------------------------------------- 
     313 
     314      CALL obs_rot( zsingu, zcosgu, zsingv, zcosgv ) 
     315 
     316      DO ji = 1, surfdata%nsurf 
     317         igrdiu(1,1,ji) = surfdata%mi(ji,1)-1 
     318         igrdju(1,1,ji) = surfdata%mj(ji,1)-1 
     319         igrdiu(1,2,ji) = surfdata%mi(ji,1)-1 
     320         igrdju(1,2,ji) = surfdata%mj(ji,1) 
     321         igrdiu(2,1,ji) = surfdata%mi(ji,1) 
     322         igrdju(2,1,ji) = surfdata%mj(ji,1)-1 
     323         igrdiu(2,2,ji) = surfdata%mi(ji,1) 
     324         igrdju(2,2,ji) = surfdata%mj(ji,1) 
     325         igrdiv(1,1,ji) = surfdata%mi(ji,2)-1 
     326         igrdjv(1,1,ji) = surfdata%mj(ji,2)-1 
     327         igrdiv(1,2,ji) = surfdata%mi(ji,2)-1 
     328         igrdjv(1,2,ji) = surfdata%mj(ji,2) 
     329         igrdiv(2,1,ji) = surfdata%mi(ji,2) 
     330         igrdjv(2,1,ji) = surfdata%mj(ji,2)-1 
     331         igrdiv(2,2,ji) = surfdata%mi(ji,2) 
     332         igrdjv(2,2,ji) = surfdata%mj(ji,2) 
     333      END DO 
     334 
     335      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, & 
     336         &                  glamu, zglamu ) 
     337      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, & 
     338         &                  gphiu, zgphiu ) 
     339      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, & 
     340         &                  umask(:,:,1), zmasku ) 
     341      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, & 
     342         &                  zsingu, zsinlu ) 
     343      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiu, igrdju, & 
     344         &                  zcosgu, zcoslu ) 
     345      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, & 
     346         &                  glamv, zglamv ) 
     347      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, & 
     348         &                  gphiv, zgphiv ) 
     349      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, & 
     350         &                  vmask(:,:,1), zmaskv ) 
     351      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, & 
     352         &                  zsingv, zsinlv ) 
     353      CALL obs_int_comm_2d( 2, 2, surfdata%nsurf, jpi, jpj, igrdiv, igrdjv, & 
     354         &                  zcosgv, zcoslv ) 
     355 
     356      DO ji = 1, surfdata%nsurf 
     357             
     358         CALL obs_int_h2d_init( 1, 1, k2dint, & 
     359            &                   surfdata%rlam(ji), surfdata%rphi(ji), & 
     360            &                   zglamu(:,:,ji), zgphiu(:,:,ji), & 
     361            &                   zmasku(:,:,ji), zweig, zobsmask ) 
     362          
     363         CALL obs_int_h2d( 1, 1, zweig, zsinlu(:,:,ji),  zsinu ) 
     364 
     365         CALL obs_int_h2d( 1, 1, zweig, zcoslu(:,:,ji),  zcosu ) 
     366 
     367         CALL obs_int_h2d_init( 1, 1, k2dint, & 
     368            &                   surfdata%rlam(ji), surfdata%rphi(ji), & 
     369            &                   zglamv(:,:,ji), zgphiv(:,:,ji), & 
     370            &                   zmaskv(:,:,ji), zweig, zobsmask ) 
     371          
     372         CALL obs_int_h2d( 1, 1, zweig, zsinlv(:,:,ji),  zsinv ) 
     373 
     374         CALL obs_int_h2d( 1, 1, zweig, zcoslv(:,:,ji),  zcosv ) 
     375 
     376         ! Assume that the angle at observation point is the  
     377         ! mean of u and v cosines/sines 
     378 
     379         zcos = 0.5_wp * ( zcosu(1) + zcosv(1) ) 
     380         zsin = 0.5_wp * ( zsinu(1) + zsinv(1) ) 
     381 
     382         IF ( ( surfdata%rmod(ji,kuvar) /= fbrmdi ) .AND. & 
     383            & ( surfdata%rmod(ji,kvvar) /= fbrmdi ) ) THEN 
     384            pu(ji) = surfdata%rmod(ji,kuvar) * zcos - & 
     385               &     surfdata%rmod(ji,kvvar) * zsin 
     386            pv(ji) = surfdata%rmod(ji,kvvar) * zcos + & 
     387               &     surfdata%rmod(ji,kuvar) * zsin 
     388         ELSE 
     389            pu(ji) = fbrmdi 
     390            pv(ji) = fbrmdi 
     391         ENDIF 
     392 
     393 
     394      END DO 
     395       
     396      DEALLOCATE( & 
     397         & igrdiu, & 
     398         & igrdju, & 
     399         & zglamu, & 
     400         & zgphiu, & 
     401         & zmasku, & 
     402         & zcoslu, & 
     403         & zsinlu, & 
     404         & igrdiv, & 
     405         & igrdjv, & 
     406         & zglamv, & 
     407         & zgphiv, & 
     408         & zmaskv, & 
     409         & zcoslv, & 
     410         & zsinlv  & 
     411         & ) 
     412 
     413   END SUBROUTINE obs_rotvel_surf 
    227414 
    228415END MODULE obs_rot_vel 

  • NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS/obs_surf_def.F90

    r14075 r15799  
    2323   USE obs_mpp, ONLY : &  ! MPP tools  
    2424      obs_mpp_sum_integer 
     25   USE obs_fbm            ! Obs feedback format 
    2526 
    2627   IMPLICIT NONE 
    … …  
    4546      INTEGER :: nsurfmpp   !: Global number of surface data within window 
    4647      INTEGER :: nvar       !: Number of variables at observation points 
     48      INTEGER :: nadd       !: Number of additional fields at observation points 
    4749      INTEGER :: nextra     !: Number of extra fields at observation points 
    4850      INTEGER :: nstp       !: Number of time steps 
    … …  
    5557 
    5658      INTEGER, POINTER, DIMENSION(:) :: & 
    57          & mi,   &        !: i-th grid coord. for interpolating to surface observation 
    58          & mj,   &        !: j-th grid coord. for interpolating to surface observation 
    5959         & mt,   &        !: time record number for gridded data 
    6060         & nsidx,&        !: Surface observation number 
    … …  
    6969         & ntyp           !: Type of surface observation product 
    7070 
    71       CHARACTER(len=8), POINTER, DIMENSION(:) :: & 
    72          & cvars          !: Variable names 
    73  
    74       CHARACTER(LEN=8), POINTER, DIMENSION(:) :: & 
     71      INTEGER, POINTER, DIMENSION(:,:) :: & 
     72         & mi,   &        !: i-th grid coord. for interpolating to surface observation 
     73         & mj             !: j-th grid coord. for interpolating to surface observation 
     74 
     75      CHARACTER(len=ilenname), POINTER, DIMENSION(:) :: & 
     76         & cvars,    &    !: Variable names 
     77         & cextvars, &    !: Extra variable names 
     78         & caddvars       !: Additional variable names 
     79 
     80      CHARACTER(len=ilenlong), POINTER, DIMENSION(:) :: & 
     81         & clong,    &    !: Variable long names 
     82         & cextlong       !: Extra variable long names 
     83 
     84      CHARACTER(len=ilenlong), POINTER, DIMENSION(:,:) :: & 
     85         & caddlong       !: Additional variable long names 
     86 
     87      CHARACTER(len=ilenunit), POINTER, DIMENSION(:) :: & 
     88         & cunit,    &    !: Variable units 
     89         & cextunit       !: Extra variable units 
     90 
     91      CHARACTER(len=ilenunit), POINTER, DIMENSION(:,:) :: & 
     92         & caddunit       !: Additional variable units 
     93 
     94      CHARACTER(len=ilengrid), POINTER, DIMENSION(:) :: & 
     95         & cgrid          !: Variable grids 
     96 
     97      CHARACTER(LEN=ilenwmo), POINTER, DIMENSION(:) :: & 
    7598         & cwmo           !: WMO indentifier 
    7699          
    … …  
    86109         & rext           !: Extra fields interpolated to observation points 
    87110 
    88       REAL(KIND=wp), POINTER, DIMENSION(:,:) :: & 
     111      REAL(KIND=wp), POINTER, DIMENSION(:,:,:) :: & 
     112         & radd           !: Additional fields interpolated to observation points 
     113 
     114      REAL(KIND=wp), POINTER, DIMENSION(:,:,:) :: & 
    89115         & vdmean         !: Time averaged of model field 
    90116 
    … …  
    121147CONTAINS 
    122148    
    123    SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, kextra, kstp, kpi, kpj ) 
     149   SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, kadd, kextra, kstp, kpi, kpj ) 
    124150      !!---------------------------------------------------------------------- 
    125151      !!                     ***  ROUTINE obs_surf_alloc  *** 
    … …  
    136162      INTEGER, INTENT(IN) :: ksurf   ! Number of surface observations 
    137163      INTEGER, INTENT(IN) :: kvar    ! Number of surface variables 
     164      INTEGER, INTENT(IN) :: kadd    ! Number of additional fields at observation points 
    138165      INTEGER, INTENT(IN) :: kextra  ! Number of extra fields at observation points 
    139166      INTEGER, INTENT(IN) :: kstp    ! Number of time steps 
    … …  
    143170      !!* Local variables 
    144171      INTEGER :: ji 
    145       INTEGER :: jvar 
     172      INTEGER :: jvar, jadd, jext 
    146173 
    147174      ! Set bookkeeping variables 
    … …  
    149176      surf%nsurf    = ksurf 
    150177      surf%nsurfmpp = 0 
     178      surf%nadd     = kadd 
    151179      surf%nextra   = kextra 
    152180      surf%nvar     = kvar 
    … …  
    158186 
    159187      ALLOCATE( & 
    160          & surf%cvars(kvar)    & 
     188         & surf%cvars(kvar), & 
     189         & surf%clong(kvar), & 
     190         & surf%cunit(kvar), & 
     191         & surf%cgrid(kvar)  & 
    161192         & ) 
    162193 
    163194      DO jvar = 1, kvar 
    164195         surf%cvars(jvar) = "NotSet" 
     196         surf%clong(jvar) = "NotSet" 
     197         surf%cunit(jvar) = "NotSet" 
     198         surf%cgrid(jvar) = "" 
     199      END DO 
     200 
     201      ! Allocate additional/extra variable metadata 
     202 
     203      ALLOCATE( & 
     204         & surf%caddvars(kadd),      & 
     205         & surf%caddlong(kadd,kvar), & 
     206         & surf%caddunit(kadd,kvar), & 
     207         & surf%cextvars(kextra),    & 
     208         & surf%cextlong(kextra),    & 
     209         & surf%cextunit(kextra)     & 
     210         ) 
     211          
     212      DO jadd = 1, kadd 
     213         surf%caddvars(jadd) = "NotSet" 
     214         DO jvar = 1, kvar 
     215            surf%caddlong(jadd,jvar) = "NotSet" 
     216            surf%caddunit(jadd,jvar) = "NotSet" 
     217         END DO 
     218      END DO 
     219          
     220      DO jext = 1, kextra 
     221         surf%cextvars(jext) = "NotSet" 
     222         surf%cextlong(jext) = "NotSet" 
     223         surf%cextunit(jext) = "NotSet" 
    165224      END DO 
    166225       
    … …  
    168227 
    169228      ALLOCATE( & 
    170          & surf%mi(ksurf),      & 
    171          & surf%mj(ksurf),      & 
    172229         & surf%mt(ksurf),      & 
    173230         & surf%nsidx(ksurf),   & 
    … …  
    187244         & ) 
    188245 
     246      ALLOCATE( & 
     247         & surf%mi(ksurf,kvar), & 
     248         & surf%mj(ksurf,kvar)  & 
     249         & ) 
     250 
    189251      surf%mt(:) = -1 
    190252 
    … …  
    205267      surf%rext(:,:) = 0.0_wp  
    206268 
     269      ! Allocate arrays of number of additional fields at observation points 
     270 
     271      ALLOCATE( &  
     272         & surf%radd(ksurf,kadd,kvar) & 
     273         & ) 
     274 
     275      surf%radd(:,:,:) = 0.0_wp  
     276 
    207277      ! Allocate arrays of number of time step size 
    208278 
    … …  
    215285 
    216286      ALLOCATE( & 
    217          & surf%vdmean(kpi,kpj) & 
     287         & surf%vdmean(kpi,kpj,kvar) & 
    218288         & ) 
    219289 
    … …  
    291361         & ) 
    292362 
     363      ! Deallocate arrays of number of additional fields at observation points 
     364 
     365      DEALLOCATE( &  
     366         & surf%radd & 
     367         & ) 
     368 
    293369      ! Deallocate arrays of size number of grid points size times 
    294370      ! number of variables 
    … …  
    308384 
    309385      DEALLOCATE( & 
    310          & surf%cvars     & 
    311          & ) 
     386         & surf%cvars, & 
     387         & surf%clong, & 
     388         & surf%cunit, & 
     389         & surf%cgrid  & 
     390         & ) 
     391 
     392      ! Dellocate additional/extra variables metadata 
     393 
     394      DEALLOCATE( & 
     395         & surf%caddvars, & 
     396         & surf%caddlong, & 
     397         & surf%caddunit, & 
     398         & surf%cextvars, & 
     399         & surf%cextlong, & 
     400         & surf%cextunit  & 
     401         ) 
    312402 
    313403   END SUBROUTINE obs_surf_dealloc 
    … …  
    343433      INTEGER :: ji 
    344434      INTEGER :: jk 
     435      INTEGER :: jadd 
    345436      LOGICAL, DIMENSION(:), ALLOCATABLE :: llvalid 
    346437 
    … …  
    361452 
    362453      IF ( lallocate ) THEN 
    363          CALL obs_surf_alloc( newsurf,  insurf, surf%nvar, & 
     454         CALL obs_surf_alloc( newsurf,  insurf, surf%nvar, surf%nadd, & 
    364455            & surf%nextra, surf%nstp, surf%npi, surf%npj ) 
    365456      ENDIF 
    … …  
    388479            insurf = insurf + 1 
    389480 
    390             newsurf%mi(insurf)    = surf%mi(ji) 
    391             newsurf%mj(insurf)    = surf%mj(ji) 
     481            newsurf%mi(insurf,:)  = surf%mi(ji,:) 
     482            newsurf%mj(insurf,:)  = surf%mj(ji,:) 
    392483            newsurf%mt(insurf)    = surf%mt(ji) 
    393484            newsurf%nsidx(insurf) = surf%nsidx(ji) 
    … …  
    410501               newsurf%rmod(insurf,jk)  = surf%rmod(ji,jk) 
    411502                
     503               DO jadd = 1, surf%nadd 
     504                  newsurf%radd(insurf,jadd,jk) = surf%radd(ji,jadd,jk) 
     505               END DO 
     506                
    412507            END DO 
    413508 
    … …  
    433528      ! Set book keeping variables which do not depend on number of obs. 
    434529 
    435       newsurf%nstp     = surf%nstp 
    436       newsurf%cvars(:) = surf%cvars(:) 
     530      newsurf%nstp          = surf%nstp 
     531      newsurf%cvars(:)      = surf%cvars(:) 
     532      newsurf%clong(:)      = surf%clong(:) 
     533      newsurf%cunit(:)      = surf%cunit(:) 
     534      newsurf%cgrid(:)      = surf%cgrid(:) 
     535      newsurf%caddvars(:)   = surf%caddvars(:) 
     536      newsurf%caddlong(:,:) = surf%caddlong(:,:) 
     537      newsurf%caddunit(:,:) = surf%caddunit(:,:) 
     538      newsurf%cextvars(:)   = surf%cextvars(:) 
     539      newsurf%cextlong(:)   = surf%cextlong(:) 
     540      newsurf%cextunit(:)   = surf%cextunit(:) 
    437541       
    438542      ! Set gridded stuff 
    … …  
    470574      INTEGER :: jj 
    471575      INTEGER :: jk 
     576      INTEGER :: jadd 
    472577 
    473578      ! Copy data from surf to old surf 
    … …  
    475580      DO ji = 1, surf%nsurf 
    476581 
    477          jj=surf%nsind(ji) 
    478  
    479          oldsurf%mi(jj)    = surf%mi(ji) 
    480          oldsurf%mj(jj)    = surf%mj(ji) 
     582         jj = surf%nsind(ji) 
     583 
     584         oldsurf%mi(jj,:)  = surf%mi(ji,:) 
     585         oldsurf%mj(jj,:)  = surf%mj(ji,:) 
    481586         oldsurf%mt(jj)    = surf%mt(ji) 
    482587         oldsurf%nsidx(jj) = surf%nsidx(ji) 
    … …  
    500605         DO ji = 1, surf%nsurf 
    501606             
    502             jj=surf%nsind(ji) 
     607            jj = surf%nsind(ji) 
    503608 
    504609            oldsurf%robs(jj,jk)  = surf%robs(ji,jk) 
    505610            oldsurf%rmod(jj,jk)  = surf%rmod(ji,jk) 
     611                
     612            DO jadd = 1, surf%nadd 
     613               oldsurf%radd(jj,jadd,jk) = surf%radd(ji,jadd,jk) 
     614            END DO 
    506615 
    507616         END DO 
    … …  
    513622         DO ji = 1, surf%nsurf 
    514623             
    515             jj=surf%nsind(ji) 
     624            jj = surf%nsind(ji) 
    516625 
    517626            oldsurf%rext(jj,jk)  = surf%rext(ji,jk) 

  • NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/OBS/obs_write.F90

    r14075 r15799  
    5454CONTAINS 
    5555 
    56    SUBROUTINE obs_wri_prof( profdata, padd, pext ) 
     56   SUBROUTINE obs_wri_prof( profdata, clfiletype, padd, pext ) 
    5757      !!----------------------------------------------------------------------- 
    5858      !! 
    … …  
    7777      !! * Arguments 
    7878      TYPE(obs_prof), INTENT(INOUT) :: profdata      ! Full set of profile data 
    79       TYPE(obswriinfo), OPTIONAL :: padd             ! Additional info for each variable 
    80       TYPE(obswriinfo), OPTIONAL :: pext             ! Extra info 
     79      CHARACTER(LEN=25), INTENT(IN) :: clfiletype    ! Base name for file name 
     80      TYPE(obswriinfo), OPTIONAL    :: padd          ! Additional info for each variable 
     81      TYPE(obswriinfo), OPTIONAL    :: pext          ! Extra info 
    8182 
    8283      !! * Local declarations 
    8384      TYPE(obfbdata) :: fbdata 
    8485      CHARACTER(LEN=40) :: clfname 
    85       CHARACTER(LEN=10) :: clfiletype 
     86      CHARACTER(LEN=ilenlong) :: cllongname  ! Long name of variable 
     87      CHARACTER(LEN=ilenunit) :: clunits     ! Units of variable 
     88      CHARACTER(LEN=ilengrid) :: clgrid      ! Grid of variable 
     89      CHARACTER(LEN=12) :: clfmt            ! writing format 
     90      INTEGER :: idg                        ! number of digits 
    8691      INTEGER :: ilevel 
    8792      INTEGER :: jvar 
     93      INTEGER :: jvar2 
     94      INTEGER :: jsal 
    8895      INTEGER :: jo 
    8996      INTEGER :: jk 
    … …  
    111118      ! Find maximum level 
    112119      ilevel = 0 
    113       DO jvar = 1, 2 
     120      DO jvar = 1, profdata%nvar 
    114121         ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) ) 
    115122      END DO 
    116123 
    117       SELECT CASE ( TRIM(profdata%cvars(1)) ) 
    118       CASE('POTM') 
    119  
    120          clfiletype='profb' 
    121          CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, & 
    122             &                 1 + iadd, 1 + iext, .TRUE. ) 
    123          fbdata%cname(1)      = profdata%cvars(1) 
    124          fbdata%cname(2)      = profdata%cvars(2) 
    125          fbdata%coblong(1)    = 'Potential temperature' 
    126          fbdata%coblong(2)    = 'Practical salinity' 
    127          fbdata%cobunit(1)    = 'Degrees centigrade' 
    128          fbdata%cobunit(2)    = 'PSU' 
    129          fbdata%cextname(1)   = 'TEMP' 
    130          fbdata%cextlong(1)   = 'Insitu temperature' 
    131          fbdata%cextunit(1)   = 'Degrees centigrade' 
    132          fbdata%caddlong(1,1) = 'Model interpolated potential temperature' 
    133          fbdata%caddlong(1,2) = 'Model interpolated practical salinity' 
    134          fbdata%caddunit(1,1) = 'Degrees centigrade' 
    135          fbdata%caddunit(1,2) = 'PSU' 
    136          fbdata%cgrid(:)      = 'T' 
    137          DO je = 1, iext 
    138             fbdata%cextname(1+je) = pext%cdname(je) 
    139             fbdata%cextlong(1+je) = pext%cdlong(je,1) 
    140             fbdata%cextunit(1+je) = pext%cdunit(je,1) 
    141          END DO 
    142          DO ja = 1, iadd 
    143             fbdata%caddname(1+ja) = padd%cdname(ja) 
    144             DO jvar = 1, 2 
     124      CALL alloc_obfbdata( fbdata, profdata%nvar, profdata%nprof, ilevel, & 
     125            &                 1 + iadd, iext, .TRUE. ) 
     126      fbdata%caddname(1)   = 'Hx' 
     127      DO jvar = 1, profdata%nvar 
     128         fbdata%cname(jvar)      = profdata%cvars(jvar) 
     129         fbdata%coblong(jvar)    = profdata%clong(jvar) 
     130         fbdata%cobunit(jvar)    = profdata%cunit(jvar) 
     131         fbdata%cgrid(jvar)      = profdata%cgrid(jvar) 
     132         fbdata%caddlong(1,jvar) = 'Model interpolated ' // TRIM(profdata%clong(jvar)) 
     133         fbdata%caddunit(1,jvar) = profdata%cunit(jvar) 
     134         IF (iadd > 0) THEN 
     135            DO ja = 1, iadd 
     136               fbdata%caddname(1+ja) = padd%cdname(ja) 
    145137               fbdata%caddlong(1+ja,jvar) = padd%cdlong(ja,jvar) 
    146138               fbdata%caddunit(1+ja,jvar) = padd%cdunit(ja,jvar) 
    147139            END DO 
    148          END DO 
    149  
    150       CASE('UVEL') 
    151  
    152          clfiletype='velfb' 
    153          CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 1, 0, .TRUE. ) 
    154          fbdata%cname(1)      = profdata%cvars(1) 
    155          fbdata%cname(2)      = profdata%cvars(2) 
    156          fbdata%coblong(1)    = 'Zonal velocity' 
    157          fbdata%coblong(2)    = 'Meridional velocity' 
    158          fbdata%cobunit(1)    = 'm/s' 
    159          fbdata%cobunit(2)    = 'm/s' 
    160          DO je = 1, iext 
    161             fbdata%cextname(je) = pext%cdname(je) 
    162             fbdata%cextlong(je) = pext%cdlong(je,1) 
    163             fbdata%cextunit(je) = pext%cdunit(je,1) 
    164          END DO 
    165          fbdata%caddlong(1,1) = 'Model interpolated zonal velocity' 
    166          fbdata%caddlong(1,2) = 'Model interpolated meridional velocity' 
    167          fbdata%caddunit(1,1) = 'm/s' 
    168          fbdata%caddunit(1,2) = 'm/s' 
    169          fbdata%cgrid(1)      = 'U'  
    170          fbdata%cgrid(2)      = 'V' 
    171          DO ja = 1, iadd 
    172             fbdata%caddname(1+ja) = padd%cdname(ja) 
    173             fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
    174             fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
    175          END DO 
    176  
    177       END SELECT 
    178  
    179       fbdata%caddname(1)   = 'Hx' 
    180  
    181       WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 
     140         ENDIF 
     141         IF (iext > 0) THEN 
     142            DO je = 1, iext 
     143               fbdata%cextname(je) = pext%cdname(je) 
     144               fbdata%cextlong(je) = pext%cdlong(je,1) 
     145               fbdata%cextunit(je) = pext%cdunit(je,1) 
     146            END DO 
     147         ENDIF 
     148      END DO 
     149 
     150      WRITE(clfname, FMT="(A,'fb_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 
    182151 
    183152      IF(lwp) THEN 
    184153         WRITE(numout,*) 
    185          WRITE(numout,*)'obs_wri_prof :' 
    186          WRITE(numout,*)'~~~~~~~~~~~~~' 
    187          WRITE(numout,*)'Writing '//TRIM(clfiletype)//' feedback file : ',TRIM(clfname) 
     154         WRITE(numout,*) 'obs_wri_prof :' 
     155         WRITE(numout,*) '~~~~~~~~~~~~~' 
     156         WRITE(numout,*) 'Writing '//TRIM(clfiletype)//' feedback file : ', TRIM(clfname) 
    188157      ENDIF 
    189158 
    … …  
    228197            &           krefdate = 19500101 ) 
    229198         ! Reform the profiles arrays for output 
    230          DO jvar = 1, 2 
     199         DO jvar = 1, profdata%nvar 
    231200            DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar) 
    232201               ik = profdata%var(jvar)%nvlidx(jk) 
    … …  
    247216               ENDIF 
    248217               fbdata%iobsk(ik,jo,jvar)  = profdata%var(jvar)%mvk(jk) 
    249                DO ja = 1, iadd 
    250                   fbdata%padd(ik,jo,1+ja,jvar) = & 
    251                      & profdata%var(jvar)%vext(jk,padd%ipoint(ja)) 
     218               IF (iadd > 0) THEN 
     219                  DO ja = 1, iadd 
     220                     fbdata%padd(ik,jo,1+ja,jvar) = & 
     221                        & profdata%var(jvar)%vadd(jk,padd%ipoint(ja)) 
     222                  END DO 
     223               ENDIF 
     224            END DO 
     225         END DO 
     226         IF (iext > 0) THEN 
     227            DO jk = profdata%npvstaext(jo), profdata%npvendext(jo) 
     228               ik = profdata%vext%nelidx(jk) 
     229               DO je = 1, iext 
     230                  fbdata%pext(ik,jo,je) = & 
     231                     & profdata%vext%eobs(jk,pext%ipoint(je)) 
    252232               END DO 
    253                DO je = 1, iext 
    254                   fbdata%pext(ik,jo,1+je) = & 
    255                      & profdata%var(jvar)%vext(jk,pext%ipoint(je)) 
    256                END DO 
    257                IF ( ( jvar == 1 ) .AND. & 
    258                   & ( TRIM(profdata%cvars(1)) == 'POTM' ) ) THEN 
    259                   fbdata%pext(ik,jo,1) = profdata%var(jvar)%vext(jk,1) 
    260                ENDIF  
    261             END DO 
    262          END DO 
     233            END DO 
     234         ENDIF 
    263235      END DO 
    264236 
    265       IF ( TRIM(profdata%cvars(1)) == 'POTM' ) THEN 
    266          ! Convert insitu temperature to potential temperature using the model 
    267          ! salinity if no potential temperature 
    268          DO jo = 1, fbdata%nobs 
    269             IF ( fbdata%pphi(jo) < 9999.0 ) THEN 
    270                DO jk = 1, fbdata%nlev 
    271                   IF ( ( fbdata%pob(jk,jo,1) >= 9999.0 ) .AND. & 
    272                      & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. & 
    273                      & ( fbdata%padd(jk,jo,1,2) < 9999.0 ) .AND. & 
    274                      & ( fbdata%pext(jk,jo,1) < 9999.0 ) ) THEN 
    275                      zpres = dep_to_p( REAL(fbdata%pdep(jk,jo),wp), & 
    276                         &              REAL(fbdata%pphi(jo),wp) ) 
    277                      fbdata%pob(jk,jo,1) = potemp( & 
    278                         &                     REAL(fbdata%padd(jk,jo,1,2), wp),  & 
    279                         &                     REAL(fbdata%pext(jk,jo,1), wp), & 
    280                         &                     zpres, 0.0_wp ) 
     237      ! Convert insitu temperature to potential temperature using the model 
     238      ! salinity if no potential temperature 
     239      IF (iext > 0) THEN 
     240         DO jvar = 1, profdata%nvar 
     241            IF ( TRIM(profdata%cvars(jvar)) == 'POTM' ) THEN 
     242               jsal = 0 
     243               DO jvar2 = 1, profdata%nvar 
     244                  IF ( TRIM(profdata%cvars(jvar2)) == 'PSAL' ) THEN 
     245                     jsal = jvar2 
     246                     EXIT 
    281247                  ENDIF 
    282248               END DO 
     249               IF (jsal > 0) THEN 
     250                  DO je = 1, iext 
     251                     IF ( TRIM(fbdata%cextname(je)) == 'TEMP' ) THEN 
     252                        DO jo = 1, fbdata%nobs 
     253                           IF ( fbdata%pphi(jo) < 9999.0 ) THEN 
     254                              DO jk = 1, fbdata%nlev 
     255                                 IF ( ( fbdata%pob(jk,jo,jvar)   >= 9999.0 ) .AND. & 
     256                                    & ( fbdata%pdep(jk,jo)        < 9999.0 ) .AND. & 
     257                                    & ( fbdata%padd(jk,jo,1,jsal) < 9999.0 ) .AND. & 
     258                                    & ( fbdata%pext(jk,jo,je)     < 9999.0 ) ) THEN 
     259                                    zpres = dep_to_p( REAL(fbdata%pdep(jk,jo),wp), & 
     260                                       &              REAL(fbdata%pphi(jo),wp) ) 
     261                                    fbdata%pob(jk,jo,jvar) = potemp( & 
     262                                       &                     REAL(fbdata%padd(jk,jo,1,jsal), wp), & 
     263                                       &                     REAL(fbdata%pext(jk,jo,je), wp),     & 
     264                                       &                     zpres, 0.0_wp ) 
     265                                 ENDIF 
     266                              END DO 
     267                           ENDIF 
     268                        END DO 
     269                        EXIT 
     270                     ENDIF 
     271                  END DO 
     272               ENDIF 
     273               EXIT 
    283274            ENDIF 
    284275         END DO 
    … …  
    295286   END SUBROUTINE obs_wri_prof 
    296287 
    297    SUBROUTINE obs_wri_surf( surfdata, padd, pext ) 
     288   SUBROUTINE obs_wri_surf( surfdata, clfiletype, padd, pext ) 
    298289      !!----------------------------------------------------------------------- 
    299290      !! 
    … …  
    315306 
    316307      !! * Arguments 
    317       TYPE(obs_surf), INTENT(INOUT) :: surfdata         ! Full set of surface data 
    318       TYPE(obswriinfo), OPTIONAL :: padd               ! Additional info for each variable 
    319       TYPE(obswriinfo), OPTIONAL :: pext               ! Extra info 
     308      TYPE(obs_surf), INTENT(INOUT) :: surfdata      ! Full set of surface data 
     309      CHARACTER(LEN=25), INTENT(IN) :: clfiletype    ! Base name for file name 
     310      TYPE(obswriinfo), OPTIONAL    :: padd          ! Additional info for each variable 
     311      TYPE(obswriinfo), OPTIONAL    :: pext          ! Extra info 
    320312 
    321313      !! * Local declarations 
    322314      TYPE(obfbdata) :: fbdata 
    323315      CHARACTER(LEN=40) :: clfname         ! netCDF filename 
    324       CHARACTER(LEN=10) :: clfiletype 
     316      CHARACTER(LEN=ilenlong) :: cllongname  ! Long name of variable 
     317      CHARACTER(LEN=ilenunit) :: clunits     ! Units of variable 
     318      CHARACTER(LEN=ilengrid) :: clgrid      ! Grid of variable 
    325319      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_surf' 
    326320      INTEGER :: jo 
    327321      INTEGER :: ja 
    328322      INTEGER :: je 
     323      INTEGER :: jvar 
    329324      INTEGER :: iadd 
    330325      INTEGER :: iext 
    … …  
    344339      CALL init_obfbdata( fbdata ) 
    345340 
    346       SELECT CASE ( TRIM(surfdata%cvars(1)) ) 
    347       CASE('SLA') 
    348  
    349          CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
    350             &                 2 + iadd, 1 + iext, .TRUE. ) 
    351  
    352          clfiletype = 'slafb' 
    353          fbdata%cname(1)      = surfdata%cvars(1) 
    354          fbdata%coblong(1)    = 'Sea level anomaly' 
    355          fbdata%cobunit(1)    = 'Metres' 
    356          fbdata%cextname(1)   = 'MDT' 
    357          fbdata%cextlong(1)   = 'Mean dynamic topography' 
    358          fbdata%cextunit(1)   = 'Metres' 
    359          DO je = 1, iext 
    360             fbdata%cextname(je) = pext%cdname(je) 
    361             fbdata%cextlong(je) = pext%cdlong(je,1) 
    362             fbdata%cextunit(je) = pext%cdunit(je,1) 
    363          END DO 
    364          fbdata%caddlong(1,1) = 'Model interpolated SSH - MDT' 
    365          fbdata%caddunit(1,1) = 'Metres'  
    366          fbdata%caddname(2)   = 'SSH' 
    367          fbdata%caddlong(2,1) = 'Model Sea surface height' 
    368          fbdata%caddunit(2,1) = 'Metres' 
    369          fbdata%cgrid(1)      = 'T' 
    370          DO ja = 1, iadd 
    371             fbdata%caddname(2+ja) = padd%cdname(ja) 
    372             fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1) 
    373             fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1) 
    374          END DO 
    375  
    376       CASE('SST') 
    377  
    378          CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     341      CALL alloc_obfbdata( fbdata, surfdata%nvar, surfdata%nsurf, 1, & 
    379342            &                 1 + iadd, iext, .TRUE. ) 
    380  
    381          clfiletype = 'sstfb' 
    382          fbdata%cname(1)      = surfdata%cvars(1) 
    383          fbdata%coblong(1)    = 'Sea surface temperature' 
    384          fbdata%cobunit(1)    = 'Degree centigrade' 
    385          DO je = 1, iext 
    386             fbdata%cextname(je) = pext%cdname(je) 
    387             fbdata%cextlong(je) = pext%cdlong(je,1) 
    388             fbdata%cextunit(je) = pext%cdunit(je,1) 
    389          END DO 
    390          fbdata%caddlong(1,1) = 'Model interpolated SST' 
    391          fbdata%caddunit(1,1) = 'Degree centigrade' 
    392          fbdata%cgrid(1)      = 'T' 
    393          DO ja = 1, iadd 
    394             fbdata%caddname(1+ja) = padd%cdname(ja) 
    395             fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
    396             fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
    397          END DO 
    398  
    399       CASE('ICECONC') 
    400  
    401          CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
    402             &                 1 + iadd, iext, .TRUE. ) 
    403  
    404          clfiletype = 'sicfb' 
    405          fbdata%cname(1)      = surfdata%cvars(1) 
    406          fbdata%coblong(1)    = 'Sea ice' 
    407          fbdata%cobunit(1)    = 'Fraction' 
    408          DO je = 1, iext 
    409             fbdata%cextname(je) = pext%cdname(je) 
    410             fbdata%cextlong(je) = pext%cdlong(je,1) 
    411             fbdata%cextunit(je) = pext%cdunit(je,1) 
    412          END DO 
    413          fbdata%caddlong(1,1) = 'Model interpolated ICE' 
    414          fbdata%caddunit(1,1) = 'Fraction' 
    415          fbdata%cgrid(1)      = 'T' 
    416          DO ja = 1, iadd 
    417             fbdata%caddname(1+ja) = padd%cdname(ja) 
    418             fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
    419             fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
    420          END DO 
    421  
    422       CASE('SSS') 
    423  
    424          CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
    425             &                 1 + iadd, iext, .TRUE. ) 
    426  
    427          clfiletype = 'sssfb' 
    428          fbdata%cname(1)      = surfdata%cvars(1) 
    429          fbdata%coblong(1)    = 'Sea surface salinity' 
    430          fbdata%cobunit(1)    = 'psu' 
    431          DO je = 1, iext 
    432             fbdata%cextname(je) = pext%cdname(je) 
    433             fbdata%cextlong(je) = pext%cdlong(je,1) 
    434             fbdata%cextunit(je) = pext%cdunit(je,1) 
    435          END DO 
    436          fbdata%caddlong(1,1) = 'Model interpolated SSS' 
    437          fbdata%caddunit(1,1) = 'psu' 
    438          fbdata%cgrid(1)      = 'T' 
    439          DO ja = 1, iadd 
    440             fbdata%caddname(1+ja) = padd%cdname(ja) 
    441             fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
    442             fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
    443          END DO 
    444  
    445       CASE DEFAULT 
    446  
    447          CALL ctl_stop( 'Unknown observation type '//TRIM(surfdata%cvars(1))//' in obs_wri_surf' ) 
    448  
    449       END SELECT 
    450  
    451343      fbdata%caddname(1)   = 'Hx' 
    452  
    453       WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 
     344      DO jvar = 1, surfdata%nvar 
     345         fbdata%cname(jvar)      = surfdata%cvars(jvar) 
     346         fbdata%coblong(jvar)    = surfdata%clong(jvar) 
     347         fbdata%cobunit(jvar)    = surfdata%cunit(jvar) 
     348         fbdata%cgrid(jvar)      = surfdata%cgrid(jvar) 
     349         fbdata%caddlong(1,jvar) = 'Model interpolated ' // TRIM(surfdata%clong(jvar)) 
     350         fbdata%caddunit(1,jvar) = surfdata%cunit(jvar) 
     351         IF (iadd > 0) THEN 
     352            DO ja = 1, iadd 
     353               fbdata%caddname(1+ja) = padd%cdname(ja) 
     354               fbdata%caddlong(1+ja,jvar) = padd%cdlong(ja,jvar) 
     355               fbdata%caddunit(1+ja,jvar) = padd%cdunit(ja,jvar) 
     356            END DO 
     357         ENDIF 
     358         IF (iext > 0) THEN 
     359            DO je = 1, iext 
     360               fbdata%cextname(je) = pext%cdname(je) 
     361               fbdata%cextlong(je) = pext%cdlong(je,1) 
     362               fbdata%cextunit(je) = pext%cdunit(je,1) 
     363            END DO 
     364         ENDIF 
     365      END DO 
     366 
     367      WRITE(clfname, FMT="(A,'fb_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 
    454368 
    455369      IF(lwp) THEN 
    456370         WRITE(numout,*) 
    457          WRITE(numout,*)'obs_wri_surf :' 
    458          WRITE(numout,*)'~~~~~~~~~~~~~' 
    459          WRITE(numout,*)'Writing '//TRIM(surfdata%cvars(1))//' feedback file : ',TRIM(clfname) 
     371         WRITE(numout,*) 'obs_wri_surf :' 
     372         WRITE(numout,*) '~~~~~~~~~~~~~' 
     373         WRITE(numout,*) 'Writing '//TRIM(surfdata%cvars(1))//' feedback file : ', TRIM(clfname) 
    460374      ENDIF 
    461375 
    … …  
    484398         fbdata%cdwmo(jo)     = surfdata%cwmo(jo) 
    485399         fbdata%kindex(jo)    = surfdata%nsfil(jo) 
    486          IF (ln_grid_global) THEN 
    487             fbdata%iobsi(jo,1) = surfdata%mi(jo) 
    488             fbdata%iobsj(jo,1) = surfdata%mj(jo) 
    489          ELSE 
    490             fbdata%iobsi(jo,1) = mig(surfdata%mi(jo)) 
    491             fbdata%iobsj(jo,1) = mjg(surfdata%mj(jo)) 
    492          ENDIF 
     400         DO jvar = 1, surfdata%nvar 
     401            IF (ln_grid_global) THEN 
     402               fbdata%iobsi(jo,jvar) = surfdata%mi(jo,jvar) 
     403               fbdata%iobsj(jo,jvar) = surfdata%mj(jo,jvar) 
     404            ELSE 
     405               fbdata%iobsi(jo,jvar) = mig(surfdata%mi(jo,jvar)) 
     406               fbdata%iobsj(jo,jvar) = mjg(surfdata%mj(jo,jvar)) 
     407            ENDIF 
     408         END DO 
    493409         CALL greg2jul( 0, & 
    494410            &           surfdata%nmin(jo), & 
    … …  
    498414            &           surfdata%nyea(jo), & 
    499415            &           fbdata%ptim(jo),   & 
    500             &           krefdate = 19500101 ) 
    501          fbdata%padd(1,jo,1,1) = surfdata%rmod(jo,1) 
    502          IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) fbdata%padd(1,jo,2,1) = surfdata%rext(jo,1) 
    503          fbdata%pob(1,jo,1)    = surfdata%robs(jo,1)  
     416            &           krefdate = 19500101 )  
    504417         fbdata%pdep(1,jo)     = 0.0 
    505418         fbdata%idqc(1,jo)     = 0 
    506419         fbdata%idqcf(:,1,jo)  = 0 
    507          IF ( surfdata%nqc(jo) > 255 ) THEN 
    508             fbdata%ivqc(jo,1)       = 4 
    509             fbdata%ivlqc(1,jo,1)    = 4 
    510             fbdata%ivlqcf(1,1,jo,1) = 0 
     420         DO jvar = 1, surfdata%nvar 
     421            fbdata%padd(1,jo,1,jvar) = surfdata%rmod(jo,jvar) 
     422            fbdata%pob(1,jo,jvar)    = surfdata%robs(jo,jvar) 
     423            IF ( surfdata%nqc(jo) > 255 ) THEN 
     424               fbdata%ivqc(jo,jvar)       = 4 
     425               fbdata%ivlqc(1,jo,jvar)    = 4 
     426               fbdata%ivlqcf(1,1,jo,jvar) = 0 
    511427!$AGRIF_DO_NOT_TREAT 
    512             fbdata%ivlqcf(2,1,jo,1) = IAND(surfdata%nqc(jo),b'0000000011111111') 
     428               fbdata%ivlqcf(2,1,jo,jvar) = IAND(surfdata%nqc(jo),b'0000000011111111') 
    513429!$AGRIF_END_DO_NOT_TREAT 
    514          ELSE 
    515             fbdata%ivqc(jo,1)       = surfdata%nqc(jo) 
    516             fbdata%ivlqc(1,jo,1)    = surfdata%nqc(jo) 
    517             fbdata%ivlqcf(:,1,jo,1) = 0 
    518          ENDIF 
    519          fbdata%iobsk(1,jo,1)  = 0 
    520          IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) fbdata%pext(1,jo,1) = surfdata%rext(jo,2) 
    521          DO ja = 1, iadd 
    522             fbdata%padd(1,jo,2+ja,1) = & 
    523                & surfdata%rext(jo,padd%ipoint(ja)) 
     430            ELSE 
     431               fbdata%ivqc(jo,jvar)       = surfdata%nqc(jo) 
     432               fbdata%ivlqc(1,jo,jvar)    = surfdata%nqc(jo) 
     433               fbdata%ivlqcf(:,1,jo,jvar) = 0 
     434            ENDIF 
     435            fbdata%iobsk(1,jo,jvar)  = 0 
     436            IF (iadd > 0) THEN 
     437               DO ja = 1, iadd 
     438                  fbdata%padd(1,jo,1+ja,jvar) = & 
     439                     & surfdata%radd(jo,padd%ipoint(ja),jvar) 
     440               END DO 
     441            ENDIF 
    524442         END DO 
    525          DO je = 1, iext 
    526             fbdata%pext(1,jo,1+je) = & 
    527                & surfdata%rext(jo,pext%ipoint(je)) 
    528          END DO 
     443         IF (iext > 0) THEN 
     444            DO je = 1, iext 
     445               fbdata%pext(1,jo,je) = & 
     446                  & surfdata%rext(jo,pext%ipoint(je)) 
     447            END DO 
     448         ENDIF 
    529449      END DO 
    530450 
    … …  
    574494 
    575495      DO jvar = 1, fbdata%nvar 
    576          zsumx=0.0_wp 
    577          zsumx2=0.0_wp 
    578          inumgoodobs=0 
     496         zsumx = 0.0_wp 
     497         zsumx2 = 0.0_wp 
     498         inumgoodobs = 0 
    579499         DO jo = 1, fbdata%nobs 
    580500            DO jk = 1, fbdata%nlev 
    … …  
    583503                  & ( fbdata%padd(jk,jo,1,jvar) < 9999.0 ) ) THEN 
    584504 
    585                   zomb=fbdata%pob(jk, jo, jvar)-fbdata%padd(jk, jo, 1, jvar) 
    586                   zsumx=zsumx+zomb 
    587                   zsumx2=zsumx2+zomb**2 
    588                   inumgoodobs=inumgoodobs+1 
     505                  zomb = fbdata%pob(jk, jo, jvar)-fbdata%padd(jk, jo, 1, jvar) 
     506                  zsumx = zsumx + zomb 
     507                  zsumx2 = zsumx2 + zomb**2 
     508                  inumgoodobs = inumgoodobs + 1 
    589509               ENDIF 
    590510            ENDDO 
    … …  
    596516 
    597517         IF (lwp) THEN 
    598             WRITE(numout,*) 'Type: ',fbdata%cname(jvar),'  Total number of good observations: ',inumgoodobsmpp  
    599             WRITE(numout,*) 'Overall mean obs minus model of the good observations: ',zsumx/inumgoodobsmpp 
    600             WRITE(numout,*) 'Overall RMS obs minus model of the good observations: ',sqrt( zsumx2/inumgoodobsmpp ) 
     518            WRITE(numout,*) 'Type: ', fbdata%cname(jvar), '  Total number of good observations: ', inumgoodobsmpp 
     519            IF ( inumgoodobsmpp > 0 ) THEN 
     520               WRITE(numout,*) 'Overall mean obs minus model of the good observations: ', zsumx/inumgoodobsmpp 
     521               WRITE(numout,*) 'Overall RMS obs minus model of the good observations: ', sqrt( zsumx2/inumgoodobsmpp ) 
     522            ENDIF 
    601523            WRITE(numout,*) '' 
    602524         ENDIF 

  • NEMO/branches/UKMO/NEMO_4.0.4_FOAM_package/src/OCE/TRA/tradmp.F90

    r14075 r15799  
    5050   ! 
    5151   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   resto    !: restoring coeff. on T and S (s-1) 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tclim    !: temperature climatology on each time step(Celcius) 
     53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sclim    !: salinity climatology on each time step (psu) 
    5254 
    5355   !! * Substitutions 
    … …  
    6466      !!                ***  FUNCTION tra_dmp_alloc  *** 
    6567      !!---------------------------------------------------------------------- 
    66       ALLOCATE( resto(jpi,jpj,jpk), STAT= tra_dmp_alloc ) 
     68      ALLOCATE( resto(jpi,jpj,jpk), & 
     69         &      tclim(jpi,jpj,jpk), & 
     70         &      sclim(jpi,jpj,jpk), STAT= tra_dmp_alloc ) 
    6771      ! 
    6872      CALL mpp_sum ( 'tradmp', tra_dmp_alloc ) 
    … …  
    106110      CALL dta_tsd( kt, zts_dta )            ! read and interpolates T-S data at kt 
    107111      ! 
     112      tclim(:,:,:) = zts_dta(:,:,:,jp_tem) 
     113      sclim(:,:,:) = zts_dta(:,:,:,jp_sal) 
     114      ! 
    108115      SELECT CASE ( nn_zdmp )     !==  type of damping  ==! 
    109116      ! 
Note: See TracChangeset for help on using the changeset viewer.