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 10120 for branches/UKMO – NEMO

Changeset 10120 for branches/UKMO


Ignore:
Timestamp:
2018-09-12T19:12:15+02:00 (6 years ago)
Author:
charris
Message:

Added in obsoper updates (and commented out some lines in bias.F90 which don't work as intended currently).

Location:
branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM
Files:
19 deleted
18 edited
4 copied

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/CONFIG/SHARED/namelist_ref

    r10005 r10120  
    12241224&namobs       !  observation usage switch                               ('key_diaobs') 
    12251225!----------------------------------------------------------------------- 
    1226    ln_t3d     = .false.    ! Logical switch for T profile observations 
    1227    ln_s3d     = .false.    ! Logical switch for S profile observations 
    1228    ln_ena     = .false.    ! Logical switch for ENACT insitu data set 
    1229    !                       !     ln_cor                  Logical switch for Coriolis insitu data set 
    1230    ln_profb   = .false.    ! Logical switch for feedback insitu data set 
    1231    ln_sla     = .false.    ! Logical switch for SLA observations 
    1232  
    1233    ln_sladt   = .false.    ! Logical switch for AVISO SLA data 
    1234  
    1235    ln_slafb   = .false.    ! Logical switch for feedback SLA data 
    1236                            !     ln_ssh                  Logical switch for SSH observations 
    1237  
    1238    ln_sst     = .false.     ! Logical switch for SST observations 
    1239    ln_reysst  = .false.     !     ln_reysst               Logical switch for Reynolds observations 
    1240    ln_ghrsst  = .false.    !     ln_ghrsst               Logical switch for GHRSST observations 
    1241  
    1242    ln_sstfb   = .false.    ! Logical switch for feedback SST data 
    1243                            !     ln_sss                  Logical switch for SSS observations 
    1244    ln_seaice  = .false.    ! Logical switch for Sea Ice observations 
    1245                            !     ln_vel3d                Logical switch for velocity observations 
    1246                            !     ln_velavcur             Logical switch for velocity daily av. cur. 
    1247                            !     ln_velhrcur             Logical switch for velocity high freq. cur. 
    1248                            !     ln_velavadcp            Logical switch for velocity daily av. ADCP 
    1249                            !     ln_velhradcp            Logical switch for velocity high freq. ADCP 
    1250                            !     ln_velfb                Logical switch for feedback velocity data 
    1251                            !     ln_grid_global          Global distribtion of observations 
    1252                            !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table 
    1253                            !     grid_search_file        Grid search lookup file header 
    1254                            !     enactfiles              ENACT input observation file names 
    1255                            !     coriofiles              Coriolis input observation file name 
    1256    !                       ! profbfiles: Profile feedback input observation file name 
    1257    profbfiles = 'profiles_01.nc' 
    1258                            !     ln_profb_enatim         Enact feedback input time setting switch 
    1259                            !     slafilesact             Active SLA input observation file name 
    1260                            !     slafilespas             Passive SLA input observation file name 
    1261    !                       ! slafbfiles: Feedback SLA input observation file name 
    1262    slafbfiles = 'sla_01.nc' 
    1263                            !     sstfiles                GHRSST input observation file name 
    1264    !                       ! sstfbfiles: Feedback SST input observation file name 
    1265    sstfbfiles = 'sst_01.nc' 
    1266                            !     seaicefiles             Sea Ice input observation file names 
    1267    seaicefiles = 'seaice_01.nc' 
    1268                            !     velavcurfiles           Vel. cur. daily av. input file name 
    1269                            !     velhvcurfiles           Vel. cur. high freq. input file name 
    1270                            !     velavadcpfiles          Vel. ADCP daily av. input file name 
    1271                            !     velhvadcpfiles          Vel. ADCP high freq. input file name 
    1272                            !     velfbfiles              Vel. feedback input observation file name 
    1273                            !     dobsini                 Initial date in window YYYYMMDD.HHMMSS 
    1274                            !     dobsend                 Final date in window YYYYMMDD.HHMMSS 
    1275                            !     n1dint                  Type of vertical interpolation method 
    1276                            !     n2dint                  Type of horizontal interpolation method 
    1277                            !     ln_nea                  Rejection of observations near land switch 
    1278    nmsshc     = 0          ! MSSH correction scheme 
    1279                            !     mdtcorr                 MDT  correction 
    1280                            !     mdtcutoff               MDT cutoff for computed correction 
    1281    ln_altbias = .false.    ! Logical switch for alt bias 
    1282    ln_ignmis  = .true.     ! Logical switch for ignoring missing files 
    1283                            !     endailyavtypes   ENACT daily average types 
    1284    ln_grid_global = .true. 
    1285    ln_grid_search_lookup = .false. 
     1226   ln_diaobs  = .false.             ! Logical switch for the observation operator 
     1227   ln_t3d     = .false.             ! Logical switch for T profile observations 
     1228   ln_s3d     = .false.             ! Logical switch for S profile observations 
     1229   ln_sla     = .false.             ! Logical switch for SLA observations 
     1230   ln_sst     = .false.             ! Logical switch for SST observations 
     1231   ln_sic     = .false.             ! Logical switch for Sea Ice observations 
     1232   ln_vel3d   = .false.             ! Logical switch for velocity observations 
     1233   ln_sss     = .false.             ! Logical swithc for SSS observations 
     1234   ln_logchl  = .false.             ! Logical switch for log(Chl) obs 
     1235   ln_spm     = .false.             ! Logical switch for SPM obs 
     1236   ln_fco2    = .false.              
     1237   ln_pco2    = .false. 
     1238   ln_altbias = .false.             ! Logical switch for altimeter bias correction 
     1239   ln_sstbias = .false.             ! Logical switch for SST bias correction 
     1240   ln_nea     = .false.             ! Logical switch for rejection of observations near land 
     1241   ln_grid_global = .true.          ! Logical switch for global distribution of observations 
     1242   ln_grid_search_lookup = .false.  ! Logical switch for obs grid search w/lookup table 
     1243   ln_ignmis  = .true.              ! Logical switch for ignoring missing files 
     1244   ln_s_at_t  = .false.             ! Logical switch for computing model S at T obs if not there 
     1245   ln_sstnight = .false.            ! Logical switch for calculating night-time average for SST obs 
     1246   ln_sla_fp_indegs = .true.        ! Logical: T=> averaging footpring is in degrees, F=> in metres 
     1247   ln_sst_fp_indegs = .true. 
     1248   ln_sss_fp_indegs = .true. 
     1249   ln_sic_fp_indegs = .true. 
     1250! All of the *files* variables below are arrays. Use namelist_cfg to add more files 
     1251   cn_profbfiles = 'profiles_01.nc'    ! Profile feedback input observation file names 
     1252   cn_slafbfiles = 'sla_01.nc'         ! SLA feedback input observation file names 
     1253   cn_sstfbfiles = 'sst_01.nc'         ! SST feedback input observation file names 
     1254   cn_sicfbfiles = 'sic_01.nc'         ! SIC feedback input observation file names 
     1255   cn_velfbfiles = 'vel_01.nc'         ! Velocity feedback input observation file names 
     1256   cn_sssfbfiles = 'sss_01.nc'         ! SSS feedback input observation file names 
     1257   cn_altbiasfile = 'altbias.nc'       ! Altimeter bias input file name 
     1258   cn_sstbiasfiles = 'sstbias.nc'      ! SST bias input file names 
     1259   cn_gridsearchfile = 'gridsearch.nc' ! Grid search file name 
     1260   rn_gridsearchres = 0.5              ! Grid search resolution 
     1261   rn_sla_avglamscl = 0.               ! E/W diameter of SLA observation footprint (metres/degrees) 
     1262   rn_sla_avgphiscl = 0.               ! N/S diameter of SLA observation footprint (metres/degrees) 
     1263   rn_sst_avglamscl = 0. 
     1264   rn_sst_avgphiscl = 0. 
     1265   rn_sss_avglamscl = 0. 
     1266   rn_sss_avgphiscl = 0. 
     1267   rn_sic_avglamscl = 0. 
     1268   rn_sic_avgphiscl = 0. 
     1269   nn_1dint = 0                        ! Type of vertical interpolation method 
     1270   nn_2dint = 0                        ! Default horizontal interpolation method 
     1271   nn_2dint_sla = 0                    ! Horizontal interpolation method for SLA 
     1272   nn_2dint_sst = 0                    ! Horizontal interpolation method for SST 
     1273   nn_2dint_sss = 0                    ! Horizontal interpolation method for SSS 
     1274   nn_2dint_sic = 0                    ! Horizontal interpolation method for SIC 
     1275   nn_msshc = 0                        ! MSSH correction scheme 
     1276   rn_mdtcorr = 1.61                   ! MDT  correction 
     1277   rn_mdtcutoff = 65.0                 ! MDT cutoff for computed correction 
     1278   nn_profdavtypes = -1                ! Profile daily average types - array 
    12861279/ 
    12871280!----------------------------------------------------------------------- 

  • branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/ASM/bias.F90

    r8447 r10120  
    243243      ! Set additional default values (note that most values are set in the reference namelist) 
    244244       
     245      ! This doesn't work because nitiaufin hasn't been set yet 
    245246      IF ( ln_asmiau ) nn_bias_itwrt = nitiaufin 
    246247       
    … …  
    318319         IF ( (.NOT. ln_incpc) .AND. ln_incpc_only) &    
    319320            &   CALL ctl_stop (' if you set ln_incpc_only to .true. then you need to set ln_incpc to .true. as well' ) 
    320           
    321          WRITE(numout,*) '     time step is    = ',rdt,'you choose to write pcbias at nn_bias_itwrt  = ',nn_bias_itwrt,'and end of iau is rday/rdt=',rday/rdt  
     321 
     322         ! This doesn't work because nitiaufin hasn't been set yet (but the old code with rday/rdt was also wrong)         
     323!         WRITE(numout,*) '     time step is    = ',rdt,'you choose to write pcbias at nn_bias_itwrt  = ',nn_bias_itwrt,'and end of iau is nitiaufin=',nitiaufin  
    322324      ENDIF 
    323325      IF( .NOT. ln_bias ) RETURN 

  • branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r10005 r10120  
    66   !!====================================================================== 
    77 
    8    !!---------------------------------------------------------------------- 
    9    !!   'key_diaobs' : Switch on the observation diagnostic computation 
    108   !!---------------------------------------------------------------------- 
    119   !!   dia_obs_init : Reading and prepare observations 
    … …  
    1513   !!   fin_date     : Compute the final date YYYYMMDD.HHMMSS 
    1614   !!---------------------------------------------------------------------- 
    17    !! * Modules used    
     15   !! * Modules used 
    1816   USE wrk_nemo                 ! Memory Allocation 
    1917   USE par_kind                 ! Precision variables 
    … …  
    2119   USE par_oce 
    2220   USE dom_oce                  ! Ocean space and time domain variables 
    23    USE obs_fbm, ONLY: ln_cl4    ! Class 4 diagnostic switch 
    24    USE obs_read_prof            ! Reading and allocation of observations (Coriolis) 
    25    USE obs_read_sla             ! Reading and allocation of SLA observations   
    26    USE obs_read_sst             ! Reading and allocation of SST observations   
     21   USE obs_read_prof            ! Reading and allocation of profile obs 
     22   USE obs_read_surf            ! Reading and allocation of surface obs 
    2723   USE obs_readmdt              ! Reading and allocation of MDT for SLA. 
    28    USE obs_read_seaice          ! Reading and allocation of Sea Ice observations   
    29    USE obs_read_vel             ! Reading and allocation of velocity component observations 
    3024   USE obs_prep                 ! Preparation of obs. (grid search etc). 
    3125   USE obs_oper                 ! Observation operators 
    … …  
    3327   USE obs_grid                 ! Grid searching 
    3428   USE obs_read_altbias         ! Bias treatment for altimeter 
     29   USE obs_sstbias              ! Bias correction routine for SST 
    3530   USE obs_profiles_def         ! Profile data definitions 
    36    USE obs_profiles             ! Profile data storage 
    3731   USE obs_surf_def             ! Surface data definitions 
    38    USE obs_sla                  ! SLA data storage 
    39    USE obs_sst                  ! SST data storage 
    40    USE obs_seaice               ! Sea Ice data storage 
    4132   USE obs_types                ! Definitions for observation types 
    4233   USE mpp_map                  ! MPP mapping 
    … …  
    5344      &   calc_date           ! Compute the date of a timestep 
    5445 
    55    !! * Shared Module variables 
    56    LOGICAL, PUBLIC, PARAMETER :: & 
    57 #if defined key_diaobs 
    58       & lk_diaobs = .TRUE.   !: Logical switch for observation diangostics 
    59 #else 
    60       & lk_diaobs = .FALSE.  !: Logical switch for observation diangostics 
    61 #endif 
    62  
    6346   !! * Module variables 
    64    LOGICAL, PUBLIC :: ln_t3d         !: Logical switch for temperature profiles 
    65    LOGICAL, PUBLIC :: ln_s3d         !: Logical switch for salinity profiles 
    66    LOGICAL, PUBLIC :: ln_ena         !: Logical switch for the ENACT data set 
    67    LOGICAL, PUBLIC :: ln_cor         !: Logical switch for the Coriolis data set 
    68    LOGICAL, PUBLIC :: ln_profb       !: Logical switch for profile feedback datafiles 
    69    LOGICAL, PUBLIC :: ln_sla         !: Logical switch for sea level anomalies  
    70    LOGICAL, PUBLIC :: ln_sladt       !: Logical switch for SLA from AVISO files 
    71    LOGICAL, PUBLIC :: ln_slafb       !: Logical switch for SLA from feedback files 
    72    LOGICAL, PUBLIC :: ln_sst         !: Logical switch for sea surface temperature 
    73    LOGICAL, PUBLIC :: ln_reysst      !: Logical switch for Reynolds sea surface temperature 
    74    LOGICAL, PUBLIC :: ln_ghrsst      !: Logical switch for GHRSST data 
    75    LOGICAL, PUBLIC :: ln_sstfb       !: Logical switch for SST from feedback files 
    76    LOGICAL, PUBLIC :: ln_seaice      !: Logical switch for sea ice concentration 
    77    LOGICAL, PUBLIC :: ln_vel3d       !: Logical switch for velocity component (u,v) observations 
    78    LOGICAL, PUBLIC :: ln_velavcur    !: Logical switch for raw daily averaged netCDF current meter vel. data  
    79    LOGICAL, PUBLIC :: ln_velhrcur    !: Logical switch for raw high freq netCDF current meter vel. data  
    80    LOGICAL, PUBLIC :: ln_velavadcp   !: Logical switch for raw daily averaged netCDF ADCP vel. data  
    81    LOGICAL, PUBLIC :: ln_velhradcp   !: Logical switch for raw high freq netCDF ADCP vel. data  
    82    LOGICAL, PUBLIC :: ln_velfb       !: Logical switch for velocities from feedback files 
    83    LOGICAL, PUBLIC :: ln_ssh         !: Logical switch for sea surface height 
    84    LOGICAL, PUBLIC :: ln_sss         !: Logical switch for sea surface salinity 
    85    LOGICAL, PUBLIC :: ln_sstnight    !: Logical switch for night mean SST observations 
    86    LOGICAL, PUBLIC :: ln_nea         !: Remove observations near land 
    87    LOGICAL, PUBLIC :: ln_altbias     !: Logical switch for altimeter bias   
    88    LOGICAL, PUBLIC :: ln_ignmis      !: Logical switch for ignoring missing files 
    89    LOGICAL, PUBLIC :: ln_s_at_t      !: Logical switch to compute model S at T observations 
    90  
    91    REAL(KIND=dp), PUBLIC :: dobsini   !: Observation window start date YYYYMMDD.HHMMSS 
    92    REAL(KIND=dp), PUBLIC :: dobsend   !: Observation window end date YYYYMMDD.HHMMSS 
    93    
    94    INTEGER, PUBLIC :: n1dint       !: Vertical interpolation method 
    95    INTEGER, PUBLIC :: n2dint       !: Horizontal interpolation method  
    96  
     47   LOGICAL, PUBLIC :: & 
     48      &       lk_diaobs = .TRUE.  !: Include this for backwards compatibility at NEMO 3.6. 
     49   LOGICAL :: ln_diaobs           !: Logical switch for the obs operator 
     50   LOGICAL :: ln_sstnight         !: Logical switch for night mean SST obs 
     51   LOGICAL :: ln_sla_fp_indegs    !: T=> SLA obs footprint size specified in degrees, F=> in metres 
     52   LOGICAL :: ln_sst_fp_indegs    !: T=> SST obs footprint size specified in degrees, F=> in metres 
     53   LOGICAL :: ln_sss_fp_indegs    !: T=> SSS obs footprint size specified in degrees, F=> in metres 
     54   LOGICAL :: ln_sic_fp_indegs    !: T=> sea-ice obs footprint size specified in degrees, F=> in metres 
     55 
     56   REAL(wp) :: rn_sla_avglamscl !: E/W diameter of SLA observation footprint (metres) 
     57   REAL(wp) :: rn_sla_avgphiscl !: N/S diameter of SLA observation footprint (metres) 
     58   REAL(wp) :: rn_sst_avglamscl !: E/W diameter of SST observation footprint (metres) 
     59   REAL(wp) :: rn_sst_avgphiscl !: N/S diameter of SST observation footprint (metres) 
     60   REAL(wp) :: rn_sss_avglamscl !: E/W diameter of SSS observation footprint (metres) 
     61   REAL(wp) :: rn_sss_avgphiscl !: N/S diameter of SSS observation footprint (metres) 
     62   REAL(wp) :: rn_sic_avglamscl !: E/W diameter of sea-ice observation footprint (metres) 
     63   REAL(wp) :: rn_sic_avgphiscl !: N/S diameter of sea-ice observation footprint (metres) 
     64 
     65   INTEGER :: nn_1dint       !: Vertical interpolation method 
     66   INTEGER :: nn_2dint       !: Default horizontal interpolation method 
     67   INTEGER :: nn_2dint_sla   !: SLA horizontal interpolation method  
     68   INTEGER :: nn_2dint_sst   !: SST horizontal interpolation method  
     69   INTEGER :: nn_2dint_sss   !: SSS horizontal interpolation method  
     70   INTEGER :: nn_2dint_sic   !: Seaice horizontal interpolation method  
     71  
    9772   INTEGER, DIMENSION(imaxavtypes) :: & 
    98       & endailyavtypes !: ENACT data types which are daily average 
    99  
    100    INTEGER, PARAMETER :: MaxNumFiles = 1000 
    101    LOGICAL, DIMENSION(MaxNumFiles) :: & 
    102       & ln_profb_ena, & !: Is the feedback files from ENACT data ? 
    103    !                    !: If so use endailyavtypes 
    104       & ln_profb_enatim !: Change tim for 820 enact data set. 
    105     
    106    LOGICAL, DIMENSION(MaxNumFiles) :: & 
    107       & ln_velfb_av   !: Is the velocity feedback files daily average? 
     73      & nn_profdavtypes      !: Profile data types representing a daily average 
     74   INTEGER :: nproftypes     !: Number of profile obs types 
     75   INTEGER :: nsurftypes     !: Number of surface obs types 
     76   INTEGER, DIMENSION(:), ALLOCATABLE :: & 
     77      & nvarsprof, &         !: Number of profile variables 
     78      & nvarssurf            !: Number of surface variables 
     79   INTEGER, DIMENSION(:), ALLOCATABLE :: & 
     80      & nextrprof, &         !: Number of profile extra variables 
     81      & nextrsurf            !: Number of surface extra variables 
     82   INTEGER, DIMENSION(:), ALLOCATABLE :: & 
     83      & n2dintsurf           !: Interpolation option for surface variables 
     84   REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
     85      & ravglamscl, &        !: E/W diameter of averaging footprint for surface variables 
     86      & ravgphiscl           !: N/S diameter of averaging footprint for surface variables 
    10887   LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
    109       & ld_enact     !: Profile data is ENACT so use endailyavtypes 
    110    LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
    111       & ld_velav     !: Velocity data is daily averaged 
    112    LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
    113       & ld_sstnight  !: SST observation corresponds to night mean 
     88      & lfpindegs, &         !: T=> surface obs footprint size specified in degrees, F=> in metres 
     89      & llnightav            !: Logical for calculating night-time averages 
     90 
     91   TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) :: & 
     92      & surfdata, &          !: Initial surface data 
     93      & surfdataqc           !: Surface data after quality control 
     94   TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) :: & 
     95      & profdata, &          !: Initial profile data 
     96      & profdataqc           !: Profile data after quality control 
     97 
     98   CHARACTER(len=6), PUBLIC, DIMENSION(:), ALLOCATABLE :: & 
     99      & cobstypesprof, &     !: Profile obs types 
     100      & cobstypessurf        !: Surface obs types 
    114101 
    115102   !!---------------------------------------------------------------------- 
    … …  
    119106   !!---------------------------------------------------------------------- 
    120107 
     108   !! * Substitutions  
     109#  include "domzgr_substitute.h90" 
    121110CONTAINS 
    122111 
    … …  
    136125      !!        !  06-10  (A. Weaver) Cleaning and add controls 
    137126      !!        !  07-03  (K. Mogensen) General handling of profiles 
     127      !!        !  14-08  (J.While) Incorporated SST bias correction 
     128      !!        !  15-02  (M. Martin) Simplification of namelist and code 
    138129      !!---------------------------------------------------------------------- 
    139130 
    … …  
    141132 
    142133      !! * Local declarations 
    143       CHARACTER(len=128) :: enactfiles(MaxNumFiles) 
    144       CHARACTER(len=128) :: coriofiles(MaxNumFiles) 
    145       CHARACTER(len=128) :: profbfiles(MaxNumFiles) 
    146       CHARACTER(len=128) :: sstfiles(MaxNumFiles)       
    147       CHARACTER(len=128) :: sstfbfiles(MaxNumFiles)  
    148       CHARACTER(len=128) :: slafilesact(MaxNumFiles)       
    149       CHARACTER(len=128) :: slafilespas(MaxNumFiles)       
    150       CHARACTER(len=128) :: slafbfiles(MaxNumFiles) 
    151       CHARACTER(len=128) :: seaicefiles(MaxNumFiles)            
    152       CHARACTER(len=128) :: velcurfiles(MaxNumFiles)   
    153       CHARACTER(len=128) :: veladcpfiles(MaxNumFiles)     
    154       CHARACTER(len=128) :: velavcurfiles(MaxNumFiles) 
    155       CHARACTER(len=128) :: velhrcurfiles(MaxNumFiles) 
    156       CHARACTER(len=128) :: velavadcpfiles(MaxNumFiles) 
    157       CHARACTER(len=128) :: velhradcpfiles(MaxNumFiles) 
    158       CHARACTER(len=128) :: velfbfiles(MaxNumFiles) 
    159       CHARACTER(LEN=128) :: reysstname 
    160       CHARACTER(LEN=12)  :: reysstfmt 
    161       CHARACTER(LEN=128) :: bias_file 
    162       CHARACTER(LEN=20)  :: datestr=" ", timestr=" " 
    163       NAMELIST/namobs/ln_ena, ln_cor, ln_profb, ln_t3d, ln_s3d,       & 
    164          &            ln_sla, ln_sladt, ln_slafb,                     & 
    165          &            ln_ssh, ln_sst, ln_sstfb, ln_sss, ln_nea,       & 
    166          &            enactfiles, coriofiles, profbfiles,             & 
    167          &            slafilesact, slafilespas, slafbfiles,           & 
    168          &            sstfiles, sstfbfiles,                           & 
    169          &            ln_seaice, seaicefiles,                         & 
    170          &            dobsini, dobsend, n1dint, n2dint,               & 
    171          &            nmsshc, mdtcorr, mdtcutoff,                     & 
    172          &            ln_reysst, ln_ghrsst, reysstname, reysstfmt,    & 
     134      INTEGER, PARAMETER :: & 
     135         & jpmaxnfiles = 1000    ! Maximum number of files for each obs type 
     136      INTEGER, DIMENSION(:), ALLOCATABLE :: & 
     137         & ifilesprof, &         ! Number of profile files 
     138         & ifilessurf            ! Number of surface files 
     139      INTEGER :: ios             ! Local integer output status for namelist read 
     140      INTEGER :: jtype           ! Counter for obs types 
     141      INTEGER :: jvar            ! Counter for variables 
     142      INTEGER :: jfile           ! Counter for files 
     143      INTEGER :: jnumsstbias     ! Number of SST bias files to read and apply 
     144 
     145      CHARACTER(len=128), DIMENSION(jpmaxnfiles) :: & 
     146         & cn_profbfiles,    &   ! T/S profile input filenames 
     147         & cn_sstfbfiles,    &   ! Sea surface temperature input filenames 
     148         & cn_slafbfiles,    &   ! Sea level anomaly input filenames 
     149         & cn_sicfbfiles,    &   ! Seaice concentration input filenames 
     150         & cn_velfbfiles,    &   ! Velocity profile input filenames 
     151         & cn_sssfbfiles,    &   ! Sea surface salinity input filenames 
     152         & cn_logchlfbfiles, &   ! Log(Chl) input filenames 
     153         & cn_spmfbfiles,    &   ! Sediment input filenames 
     154         & cn_fco2fbfiles,   &   ! fco2 input filenames 
     155         & cn_pco2fbfiles,   &   ! pco2 input filenames 
     156         & cn_sstbiasfiles       ! SST bias input filenames 
     157 
     158      CHARACTER(LEN=128) :: & 
     159         & cn_altbiasfile        ! Altimeter bias input filename 
     160 
     161 
     162      LOGICAL :: ln_t3d          ! Logical switch for temperature profiles 
     163      LOGICAL :: ln_s3d          ! Logical switch for salinity profiles 
     164      LOGICAL :: ln_sla          ! Logical switch for sea level anomalies  
     165      LOGICAL :: ln_sst          ! Logical switch for sea surface temperature 
     166      LOGICAL :: ln_sic          ! Logical switch for sea ice concentration 
     167      LOGICAL :: ln_sss          ! Logical switch for sea surface salinity obs 
     168      LOGICAL :: ln_vel3d        ! Logical switch for velocity (u,v) obs 
     169      LOGICAL :: ln_logchl       ! Logical switch for log(Chl) obs 
     170      LOGICAL :: ln_spm          ! Logical switch for sediment obs 
     171      LOGICAL :: ln_fco2         ! Logical switch for fco2 obs 
     172      LOGICAL :: ln_pco2         ! Logical switch for pco2 obs 
     173      LOGICAL :: ln_nea          ! Logical switch to remove obs near land 
     174      LOGICAL :: ln_altbias      ! Logical switch for altimeter bias 
     175      LOGICAL :: ln_sstbias      ! Logical switch for bias correction of SST 
     176      LOGICAL :: ln_ignmis       ! Logical switch for ignoring missing files 
     177      LOGICAL :: ln_s_at_t       ! Logical switch to compute model S at T obs 
     178      LOGICAL :: ln_bound_reject ! Logical switch for rejecting obs near the boundary 
     179 
     180      REAL(dp) :: rn_dobsini     ! Obs window start date YYYYMMDD.HHMMSS 
     181      REAL(dp) :: rn_dobsend     ! Obs window end date   YYYYMMDD.HHMMSS 
     182 
     183      CHARACTER(len=128), DIMENSION(:,:), ALLOCATABLE :: & 
     184         & clproffiles, &        ! Profile filenames 
     185         & clsurffiles           ! Surface filenames 
     186 
     187      LOGICAL :: llvar1          ! Logical for profile variable 1 
     188      LOGICAL :: llvar2          ! Logical for profile variable 1 
     189 
     190      REAL(wp), POINTER, DIMENSION(:,:) :: & 
     191         & zglam1, &             ! Model longitudes for profile variable 1 
     192         & zglam2                ! Model longitudes for profile variable 2 
     193      REAL(wp), POINTER, DIMENSION(:,:) :: & 
     194         & zgphi1, &             ! Model latitudes for profile variable 1 
     195         & zgphi2                ! Model latitudes for profile variable 2 
     196      REAL(wp), POINTER, DIMENSION(:,:,:) :: & 
     197         & zmask1, &             ! Model land/sea mask associated with variable 1 
     198         & zmask2                ! Model land/sea mask associated with variable 2 
     199 
     200 
     201      NAMELIST/namobs/ln_diaobs, ln_t3d, ln_s3d, ln_sla,              & 
     202         &            ln_sst, ln_sic, ln_sss, ln_vel3d,               & 
     203         &            ln_logchl, ln_spm, ln_fco2, ln_pco2,            & 
     204         &            ln_altbias, ln_sstbias, ln_nea,                 & 
     205         &            ln_grid_global, ln_grid_search_lookup,          & 
     206         &            ln_ignmis, ln_s_at_t, ln_bound_reject,          & 
    173207         &            ln_sstnight,                                    & 
    174          &            ln_grid_search_lookup,                          & 
    175          &            grid_search_file, grid_search_res,              & 
    176          &            ln_grid_global, bias_file, ln_altbias,          & 
    177          &            endailyavtypes, ln_s_at_t, ln_profb_ena,        & 
    178          &            ln_vel3d, ln_velavcur, velavcurfiles,           & 
    179          &            ln_velhrcur, velhrcurfiles,                     & 
    180          &            ln_velavadcp, velavadcpfiles,                   & 
    181          &            ln_velhradcp, velhradcpfiles,                   & 
    182          &            ln_velfb, velfbfiles, ln_velfb_av,              & 
    183          &            ln_profb_enatim, ln_ignmis, ln_cl4 
    184  
    185       INTEGER :: jprofset 
    186       INTEGER :: jveloset 
    187       INTEGER :: jvar 
    188       INTEGER :: jnumenact 
    189       INTEGER :: jnumcorio 
    190       INTEGER :: jnumprofb 
    191       INTEGER :: jnumslaact 
    192       INTEGER :: jnumslapas 
    193       INTEGER :: jnumslafb 
    194       INTEGER :: jnumsst 
    195       INTEGER :: jnumsstfb 
    196       INTEGER :: jnumseaice 
    197       INTEGER :: jnumvelavcur 
    198       INTEGER :: jnumvelhrcur   
    199       INTEGER :: jnumvelavadcp 
    200       INTEGER :: jnumvelhradcp    
    201       INTEGER :: jnumvelfb 
    202       INTEGER :: ji 
    203       INTEGER :: jset 
    204       INTEGER :: ios                 ! Local integer output status for namelist read 
    205       LOGICAL :: lmask(MaxNumFiles), ll_u3d, ll_v3d 
     208         &            ln_sla_fp_indegs, ln_sst_fp_indegs,             & 
     209         &            ln_sss_fp_indegs, ln_sic_fp_indegs,             & 
     210         &            cn_profbfiles, cn_slafbfiles,                   & 
     211         &            cn_sstfbfiles, cn_sicfbfiles,                   & 
     212         &            cn_velfbfiles, cn_sssfbfiles,                   & 
     213         &            cn_logchlfbfiles, cn_spmfbfiles,                & 
     214         &            cn_fco2fbfiles, cn_pco2fbfiles,                 & 
     215         &            cn_sstbiasfiles, cn_altbiasfile,                & 
     216         &            cn_gridsearchfile, rn_gridsearchres,            & 
     217         &            rn_dobsini, rn_dobsend,                         & 
     218         &            rn_sla_avglamscl, rn_sla_avgphiscl,             & 
     219         &            rn_sst_avglamscl, rn_sst_avgphiscl,             & 
     220         &            rn_sss_avglamscl, rn_sss_avgphiscl,             & 
     221         &            rn_sic_avglamscl, rn_sic_avgphiscl,             & 
     222         &            nn_1dint, nn_2dint,                             & 
     223         &            nn_2dint_sla, nn_2dint_sst,                     & 
     224         &            nn_2dint_sss, nn_2dint_sic,                     & 
     225         &            nn_msshc, rn_mdtcorr, rn_mdtcutoff,             & 
     226         &            nn_profdavtypes 
     227 
     228      CALL wrk_alloc( jpi, jpj, zglam1 ) 
     229      CALL wrk_alloc( jpi, jpj, zglam2 ) 
     230      CALL wrk_alloc( jpi, jpj, zgphi1 ) 
     231      CALL wrk_alloc( jpi, jpj, zgphi2 ) 
     232      CALL wrk_alloc( jpi, jpj, jpk, zmask1 ) 
     233      CALL wrk_alloc( jpi, jpj, jpk, zmask2 ) 
    206234 
    207235      !----------------------------------------------------------------------- 
    … …  
    209237      !----------------------------------------------------------------------- 
    210238 
    211       enactfiles(:) = '' 
    212       coriofiles(:) = '' 
    213       profbfiles(:) = '' 
    214       slafilesact(:) = '' 
    215       slafilespas(:) = '' 
    216       slafbfiles(:) = '' 
    217       sstfiles(:)   = '' 
    218       sstfbfiles(:) = '' 
    219       seaicefiles(:) = '' 
    220       velcurfiles(:) = '' 
    221       veladcpfiles(:) = '' 
    222       velavcurfiles(:) = '' 
    223       velhrcurfiles(:) = '' 
    224       velavadcpfiles(:) = '' 
    225       velhradcpfiles(:) = '' 
    226       velfbfiles(:) = '' 
    227       velcurfiles(:) = '' 
    228       veladcpfiles(:) = '' 
    229       endailyavtypes(:) = -1 
    230       endailyavtypes(1) = 820 
    231       ln_profb_ena(:) = .FALSE. 
    232       ln_profb_enatim(:) = .TRUE. 
    233       ln_velfb_av(:) = .FALSE. 
    234       ln_ignmis = .FALSE. 
    235        
    236       CALL ini_date( dobsini ) 
    237       CALL fin_date( dobsend ) 
    238   
    239       ! Read Namelist namobs : control observation diagnostics 
    240       REWIND( numnam_ref )              ! Namelist namobs in reference namelist : Diagnostic: control observation 
     239      ! Some namelist arrays need initialising 
     240      cn_profbfiles(:)    = '' 
     241      cn_slafbfiles(:)    = '' 
     242      cn_sstfbfiles(:)    = '' 
     243      cn_sicfbfiles(:)    = '' 
     244      cn_velfbfiles(:)    = '' 
     245      cn_sssfbfiles(:)    = '' 
     246      cn_logchlfbfiles(:) = '' 
     247      cn_spmfbfiles(:)    = '' 
     248      cn_fco2fbfiles(:)   = '' 
     249      cn_pco2fbfiles(:)   = '' 
     250      cn_sstbiasfiles(:)  = '' 
     251      nn_profdavtypes(:)  = -1 
     252 
     253      CALL ini_date( rn_dobsini ) 
     254      CALL fin_date( rn_dobsend ) 
     255 
     256      ! Read namelist namobs : control observation diagnostics 
     257      REWIND( numnam_ref )   ! Namelist namobs in reference namelist 
    241258      READ  ( numnam_ref, namobs, IOSTAT = ios, ERR = 901) 
    242259901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namobs in reference namelist', lwp ) 
    243260 
    244       REWIND( numnam_cfg )              ! Namelist namobs in configuration namelist : Diagnostic: control observation 
     261      REWIND( numnam_cfg )   ! Namelist namobs in configuration namelist 
    245262      READ  ( numnam_cfg, namobs, IOSTAT = ios, ERR = 902 ) 
    246263902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namobs in configuration namelist', lwp ) 
    247264      IF(lwm) WRITE ( numond, namobs ) 
    248265 
    249       ! Count number of files for each type 
    250       IF (ln_ena) THEN 
    251          lmask(:) = .FALSE. 
    252          WHERE (enactfiles(:) /= '') lmask(:) = .TRUE. 
    253          jnumenact = COUNT(lmask) 
    254       ENDIF 
    255       IF (ln_cor) THEN 
    256          lmask(:) = .FALSE. 
    257          WHERE (coriofiles(:) /= '') lmask(:) = .TRUE. 
    258          jnumcorio = COUNT(lmask) 
    259       ENDIF 
    260       IF (ln_profb) THEN 
    261          lmask(:) = .FALSE. 
    262          WHERE (profbfiles(:) /= '') lmask(:) = .TRUE. 
    263          jnumprofb = COUNT(lmask) 
    264       ENDIF 
    265       IF (ln_sladt) THEN 
    266          lmask(:) = .FALSE. 
    267          WHERE (slafilesact(:) /= '') lmask(:) = .TRUE. 
    268          jnumslaact = COUNT(lmask) 
    269          lmask(:) = .FALSE. 
    270          WHERE (slafilespas(:) /= '') lmask(:) = .TRUE. 
    271          jnumslapas = COUNT(lmask) 
    272       ENDIF 
    273       IF (ln_slafb) THEN 
    274          lmask(:) = .FALSE. 
    275          WHERE (slafbfiles(:) /= '') lmask(:) = .TRUE. 
    276          jnumslafb = COUNT(lmask) 
    277          lmask(:) = .FALSE. 
    278       ENDIF 
    279       IF (ln_ghrsst) THEN 
    280          lmask(:) = .FALSE. 
    281          WHERE (sstfiles(:) /= '') lmask(:) = .TRUE. 
    282          jnumsst = COUNT(lmask) 
    283       ENDIF       
    284       IF (ln_sstfb) THEN 
    285          lmask(:) = .FALSE. 
    286          WHERE (sstfbfiles(:) /= '') lmask(:) = .TRUE. 
    287          jnumsstfb = COUNT(lmask) 
    288          lmask(:) = .FALSE. 
    289       ENDIF 
    290       IF (ln_seaice) THEN 
    291          lmask(:) = .FALSE. 
    292          WHERE (seaicefiles(:) /= '') lmask(:) = .TRUE. 
    293          jnumseaice = COUNT(lmask) 
    294       ENDIF 
    295       IF (ln_velavcur) THEN 
    296          lmask(:) = .FALSE. 
    297          WHERE (velavcurfiles(:) /= '') lmask(:) = .TRUE. 
    298          jnumvelavcur = COUNT(lmask) 
    299       ENDIF 
    300       IF (ln_velhrcur) THEN 
    301          lmask(:) = .FALSE. 
    302          WHERE (velhrcurfiles(:) /= '') lmask(:) = .TRUE. 
    303          jnumvelhrcur = COUNT(lmask) 
    304       ENDIF 
    305       IF (ln_velavadcp) THEN 
    306          lmask(:) = .FALSE. 
    307          WHERE (velavadcpfiles(:) /= '') lmask(:) = .TRUE. 
    308          jnumvelavadcp = COUNT(lmask) 
    309       ENDIF 
    310       IF (ln_velhradcp) THEN 
    311          lmask(:) = .FALSE. 
    312          WHERE (velhradcpfiles(:) /= '') lmask(:) = .TRUE. 
    313          jnumvelhradcp = COUNT(lmask) 
    314       ENDIF 
    315       IF (ln_velfb) THEN 
    316          lmask(:) = .FALSE. 
    317          WHERE (velfbfiles(:) /= '') lmask(:) = .TRUE. 
    318          jnumvelfb = COUNT(lmask) 
    319          lmask(:) = .FALSE. 
    320       ENDIF 
    321        
    322       ! Control print 
     266      lk_diaobs = .FALSE. 
     267#if defined key_diaobs 
     268      IF ( ln_diaobs ) lk_diaobs = .TRUE. 
     269#endif 
     270 
     271      IF ( .NOT. lk_diaobs ) THEN 
     272         IF(lwp) WRITE(numout,cform_war) 
     273         IF(lwp) WRITE(numout,*)' ln_diaobs is set to false or key_diaobs is not set, so not calling dia_obs' 
     274         RETURN 
     275      ENDIF 
     276 
    323277      IF(lwp) THEN 
    324278         WRITE(numout,*) 
    … …  
    326280         WRITE(numout,*) '~~~~~~~~~~~~' 
    327281         WRITE(numout,*) '          Namelist namobs : set observation diagnostic parameters'  
    328          WRITE(numout,*) '             Logical switch for T profile observations          ln_t3d = ', ln_t3d 
    329          WRITE(numout,*) '             Logical switch for S profile observations          ln_s3d = ', ln_s3d 
    330          WRITE(numout,*) '             Logical switch for ENACT insitu data set           ln_ena = ', ln_ena 
    331          WRITE(numout,*) '             Logical switch for Coriolis insitu data set        ln_cor = ', ln_cor 
    332          WRITE(numout,*) '             Logical switch for feedback insitu data set      ln_profb = ', ln_profb 
    333          WRITE(numout,*) '             Logical switch for SLA observations                ln_sla = ', ln_sla 
    334          WRITE(numout,*) '             Logical switch for AVISO SLA data                ln_sladt = ', ln_sladt 
    335          WRITE(numout,*) '             Logical switch for feedback SLA data             ln_slafb = ', ln_slafb 
    336          WRITE(numout,*) '             Logical switch for SSH observations                ln_ssh = ', ln_ssh 
    337          WRITE(numout,*) '             Logical switch for SST observations                ln_sst = ', ln_sst 
    338          WRITE(numout,*) '             Logical switch for Reynolds observations        ln_reysst = ', ln_reysst     
    339          WRITE(numout,*) '             Logical switch for GHRSST observations          ln_ghrsst = ', ln_ghrsst 
    340          WRITE(numout,*) '             Logical switch for feedback SST data             ln_sstfb = ', ln_sstfb 
    341          WRITE(numout,*) '             Logical switch for night-time SST obs         ln_sstnight = ', ln_sstnight 
    342          WRITE(numout,*) '             Logical switch for SSS observations                ln_sss = ', ln_sss 
    343          WRITE(numout,*) '             Logical switch for Sea Ice observations         ln_seaice = ', ln_seaice 
    344          WRITE(numout,*) '             Logical switch for velocity observations         ln_vel3d = ', ln_vel3d 
    345          WRITE(numout,*) '             Logical switch for velocity daily av. cur.    ln_velavcur = ', ln_velavcur 
    346          WRITE(numout,*) '             Logical switch for velocity high freq. cur.   ln_velhrcur = ', ln_velhrcur 
    347          WRITE(numout,*) '             Logical switch for velocity daily av. ADCP   ln_velavadcp = ', ln_velavadcp 
    348          WRITE(numout,*) '             Logical switch for velocity high freq. ADCP  ln_velhradcp = ', ln_velhradcp 
    349          WRITE(numout,*) '             Logical switch for feedback velocity data        ln_velfb = ', ln_velfb 
    350          WRITE(numout,*) '             Global distribtion of observations         ln_grid_global = ',ln_grid_global 
    351          WRITE(numout,*) & 
    352    '             Logical switch for obs grid search w/lookup table  ln_grid_search_lookup = ',ln_grid_search_lookup 
     282         WRITE(numout,*) '             Logical switch for T profile observations                ln_t3d = ', ln_t3d 
     283         WRITE(numout,*) '             Logical switch for S profile observations                ln_s3d = ', ln_s3d 
     284         WRITE(numout,*) '             Logical switch for SLA observations                      ln_sla = ', ln_sla 
     285         WRITE(numout,*) '             Logical switch for SST observations                      ln_sst = ', ln_sst 
     286         WRITE(numout,*) '             Logical switch for Sea Ice observations                  ln_sic = ', ln_sic 
     287         WRITE(numout,*) '             Logical switch for velocity observations               ln_vel3d = ', ln_vel3d 
     288         WRITE(numout,*) '             Logical switch for SSS observations                      ln_sss = ', ln_sss 
     289         WRITE(numout,*) '             Logical switch for log(Chl) observations              ln_logchl = ', ln_logchl 
     290         WRITE(numout,*) '             Logical switch for SPM observations                      ln_spm = ', ln_spm 
     291         WRITE(numout,*) '             Logical switch for FCO2 observations                    ln_fco2 = ', ln_fco2 
     292         WRITE(numout,*) '             Logical switch for PCO2 observations                    ln_pco2 = ', ln_pco2 
     293         WRITE(numout,*) '             Global distribution of observations              ln_grid_global = ', ln_grid_global 
     294         WRITE(numout,*) '             Logical switch for obs grid search lookup ln_grid_search_lookup = ', ln_grid_search_lookup 
    353295         IF (ln_grid_search_lookup) & 
    354             WRITE(numout,*) '             Grid search lookup file header       grid_search_file = ', grid_search_file 
    355          IF (ln_ena) THEN 
    356             DO ji = 1, jnumenact 
    357                WRITE(numout,'(1X,2A)') '             ENACT input observation file name          enactfiles = ', & 
    358                   TRIM(enactfiles(ji)) 
    359             END DO 
     296            WRITE(numout,*) '             Grid search lookup file header                cn_gridsearchfile = ', cn_gridsearchfile 
     297         WRITE(numout,*) '             Initial date in window YYYYMMDD.HHMMSS               rn_dobsini = ', rn_dobsini 
     298         WRITE(numout,*) '             Final date in window YYYYMMDD.HHMMSS                 rn_dobsend = ', rn_dobsend 
     299         WRITE(numout,*) '             Type of vertical interpolation method                  nn_1dint = ', nn_1dint 
     300         WRITE(numout,*) '             Type of horizontal interpolation method                nn_2dint = ', nn_2dint 
     301         WRITE(numout,*) '             Rejection of observations near land switch               ln_nea = ', ln_nea 
     302         WRITE(numout,*) '             Rejection of obs near open bdys                 ln_bound_reject = ', ln_bound_reject 
     303         WRITE(numout,*) '             MSSH correction scheme                                 nn_msshc = ', nn_msshc 
     304         WRITE(numout,*) '             MDT  correction                                      rn_mdtcorr = ', rn_mdtcorr 
     305         WRITE(numout,*) '             MDT cutoff for computed correction                 rn_mdtcutoff = ', rn_mdtcutoff 
     306         WRITE(numout,*) '             Logical switch for alt bias                          ln_altbias = ', ln_altbias 
     307         WRITE(numout,*) '             Logical switch for sst bias                          ln_sstbias = ', ln_sstbias 
     308         WRITE(numout,*) '             Logical switch for ignoring missing files             ln_ignmis = ', ln_ignmis 
     309         WRITE(numout,*) '             Daily average types                             nn_profdavtypes = ', nn_profdavtypes 
     310         WRITE(numout,*) '             Logical switch for night-time SST obs               ln_sstnight = ', ln_sstnight 
     311      ENDIF 
     312      !----------------------------------------------------------------------- 
     313      ! Set up list of observation types to be used 
     314      ! and the files associated with each type 
     315      !----------------------------------------------------------------------- 
     316 
     317      nproftypes = COUNT( (/ln_t3d .OR. ln_s3d, ln_vel3d /) ) 
     318      nsurftypes = COUNT( (/ln_sla, ln_sst, ln_sic, ln_sss, & 
     319         &                  ln_logchl, ln_spm, ln_fco2, ln_pco2 /) ) 
     320 
     321      IF ( nproftypes == 0 .AND. nsurftypes == 0 ) THEN 
     322         IF(lwp) WRITE(numout,cform_war) 
     323         IF(lwp) WRITE(numout,*) ' ln_diaobs is set to true, but all obs operator logical flags', & 
     324            &                    ' are set to .FALSE. so turning off calls to dia_obs' 
     325         nwarn = nwarn + 1 
     326         lk_diaobs = .FALSE. 
     327         RETURN 
     328      ENDIF 
     329 
     330      IF(lwp) WRITE(numout,*) '          Number of profile obs types: ',nproftypes 
     331      IF ( nproftypes > 0 ) THEN 
     332 
     333         ALLOCATE( cobstypesprof(nproftypes) ) 
     334         ALLOCATE( ifilesprof(nproftypes) ) 
     335         ALLOCATE( clproffiles(nproftypes,jpmaxnfiles) ) 
     336 
     337         jtype = 0 
     338         IF (ln_t3d .OR. ln_s3d) THEN 
     339            jtype = jtype + 1 
     340            CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'prof  ', & 
     341               &                   cn_profbfiles, ifilesprof, cobstypesprof, clproffiles ) 
    360342         ENDIF 
    361          IF (ln_cor) THEN 
    362             DO ji = 1, jnumcorio 
    363                WRITE(numout,'(1X,2A)') '             Coriolis input observation file name       coriofiles = ', & 
    364                   TRIM(coriofiles(ji)) 
    365             END DO 
     343         IF (ln_vel3d) THEN 
     344            jtype = jtype + 1 
     345            CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'vel   ', & 
     346               &                   cn_velfbfiles, ifilesprof, cobstypesprof, clproffiles ) 
    366347         ENDIF 
    367          IF (ln_profb) THEN 
    368             DO ji = 1, jnumprofb 
    369                IF (ln_profb_ena(ji)) THEN 
    370                   WRITE(numout,'(1X,2A)') '       Enact feedback input observation file name       profbfiles = ', & 
    371                      TRIM(profbfiles(ji)) 
    372                ELSE 
    373                   WRITE(numout,'(1X,2A)') '             Feedback input observation file name       profbfiles = ', & 
    374                      TRIM(profbfiles(ji)) 
    375                ENDIF 
    376                WRITE(numout,'(1X,2A)') '       Enact feedback input time setting switch    ln_profb_enatim = ', ln_profb_enatim(ji) 
    377             END DO 
     348 
     349      ENDIF 
     350 
     351      IF(lwp) WRITE(numout,*)'          Number of surface obs types: ',nsurftypes 
     352      IF ( nsurftypes > 0 ) THEN 
     353 
     354         ALLOCATE( cobstypessurf(nsurftypes) ) 
     355         ALLOCATE( ifilessurf(nsurftypes) ) 
     356         ALLOCATE( clsurffiles(nsurftypes, jpmaxnfiles) ) 
     357         ALLOCATE(n2dintsurf(nsurftypes)) 
     358         ALLOCATE(ravglamscl(nsurftypes)) 
     359         ALLOCATE(ravgphiscl(nsurftypes)) 
     360         ALLOCATE(lfpindegs(nsurftypes)) 
     361         ALLOCATE(llnightav(nsurftypes)) 
     362 
     363         jtype = 0 
     364         IF (ln_sla) THEN 
     365            jtype = jtype + 1 
     366            CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sla   ', & 
     367               &                   cn_slafbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
     368            CALL obs_setinterpopts( nsurftypes, jtype, 'sla   ',      & 
     369               &                  nn_2dint, nn_2dint_sla,             & 
     370               &                  rn_sla_avglamscl, rn_sla_avgphiscl, & 
     371               &                  ln_sla_fp_indegs, .FALSE.,          & 
     372               &                  n2dintsurf, ravglamscl, ravgphiscl, & 
     373               &                  lfpindegs, llnightav ) 
    378374         ENDIF 
    379          IF (ln_sladt) THEN 
    380             DO ji = 1, jnumslaact 
    381                WRITE(numout,'(1X,2A)') '             Active SLA input observation file name    slafilesact = ', & 
    382                   TRIM(slafilesact(ji)) 
    383             END DO 
    384             DO ji = 1, jnumslapas 
    385                WRITE(numout,'(1X,2A)') '             Passive SLA input observation file name   slafilespas = ', & 
    386                   TRIM(slafilespas(ji)) 
    387             END DO 
     375         IF (ln_sst) THEN 
     376            jtype = jtype + 1 
     377            CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sst   ', & 
     378               &                   cn_sstfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
     379            CALL obs_setinterpopts( nsurftypes, jtype, 'sst   ',      & 
     380               &                  nn_2dint, nn_2dint_sst,             & 
     381               &                  rn_sst_avglamscl, rn_sst_avgphiscl, & 
     382               &                  ln_sst_fp_indegs, ln_sstnight,      & 
     383               &                  n2dintsurf, ravglamscl, ravgphiscl, & 
     384               &                  lfpindegs, llnightav ) 
    388385         ENDIF 
    389          IF (ln_slafb) THEN 
    390             DO ji = 1, jnumslafb 
    391                WRITE(numout,'(1X,2A)') '             Feedback SLA input observation file name   slafbfiles = ', & 
    392                   TRIM(slafbfiles(ji)) 
    393             END DO 
     386#if defined key_lim2 || defined key_lim3 || defined key_cice 
     387         IF (ln_sic) THEN 
     388            jtype = jtype + 1 
     389            CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sic   ', & 
     390               &                   cn_sicfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
     391            CALL obs_setinterpopts( nsurftypes, jtype, 'sic   ',      & 
     392               &                  nn_2dint, nn_2dint_sic,             & 
     393               &                  rn_sic_avglamscl, rn_sic_avgphiscl, & 
     394               &                  ln_sic_fp_indegs, .FALSE.,          & 
     395               &                  n2dintsurf, ravglamscl, ravgphiscl, & 
     396               &                  lfpindegs, llnightav ) 
    394397         ENDIF 
    395          IF (ln_ghrsst) THEN 
    396             DO ji = 1, jnumsst 
    397                WRITE(numout,'(1X,2A)') '             GHRSST input observation file name           sstfiles = ', & 
    398                   TRIM(sstfiles(ji)) 
    399             END DO 
     398#endif 
     399         IF (ln_sss) THEN 
     400            jtype = jtype + 1 
     401            CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sss   ', & 
     402               &                   cn_sssfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
     403            CALL obs_setinterpopts( nsurftypes, jtype, 'sss   ',      & 
     404               &                  nn_2dint, nn_2dint_sss,             & 
     405               &                  rn_sss_avglamscl, rn_sss_avgphiscl, & 
     406               &                  ln_sss_fp_indegs, .FALSE.,          & 
     407               &                  n2dintsurf, ravglamscl, ravgphiscl, & 
     408               &                  lfpindegs, llnightav ) 
    400409         ENDIF 
    401          IF (ln_sstfb) THEN 
    402             DO ji = 1, jnumsstfb 
    403                WRITE(numout,'(1X,2A)') '             Feedback SST input observation file name   sstfbfiles = ', & 
    404                   TRIM(sstfbfiles(ji)) 
    405             END DO 
     410 
     411         IF (ln_logchl) THEN 
     412            jtype = jtype + 1 
     413            CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'logchl', & 
     414               &                   cn_logchlfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
     415            CALL obs_setinterpopts( nsurftypes, jtype, 'logchl',         & 
     416               &                    nn_2dint, -1, 0., 0., .TRUE., .FALSE., & 
     417               &                    n2dintsurf, ravglamscl, ravgphiscl,    & 
     418               &                    lfpindegs, llnightav ) 
    406419         ENDIF 
    407          IF (ln_seaice) THEN 
    408             DO ji = 1, jnumseaice 
    409                WRITE(numout,'(1X,2A)') '             Sea Ice input observation file name       seaicefiles = ', & 
    410                   TRIM(seaicefiles(ji)) 
    411             END DO 
     420 
     421         IF (ln_spm) THEN 
     422            jtype = jtype + 1 
     423            CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'spm   ', & 
     424               &                   cn_spmfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
     425            CALL obs_setinterpopts( nsurftypes, jtype, 'spm   ',         & 
     426               &                    nn_2dint, -1, 0., 0., .TRUE., .FALSE., & 
     427               &                    n2dintsurf, ravglamscl, ravgphiscl,    & 
     428               &                    lfpindegs, llnightav ) 
    412429         ENDIF 
    413          IF (ln_velavcur) THEN 
    414             DO ji = 1, jnumvelavcur 
    415                WRITE(numout,'(1X,2A)') '             Vel. cur. daily av. input file name     velavcurfiles = ', & 
    416                   TRIM(velavcurfiles(ji)) 
    417             END DO 
     430 
     431         IF (ln_fco2) THEN 
     432            jtype = jtype + 1 
     433            CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'fco2  ', & 
     434               &                   cn_fco2fbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
     435            CALL obs_setinterpopts( nsurftypes, jtype, 'fco2  ',         & 
     436               &                    nn_2dint, -1, 0., 0., .TRUE., .FALSE., & 
     437               &                    n2dintsurf, ravglamscl, ravgphiscl,    & 
     438               &                    lfpindegs, llnightav ) 
    418439         ENDIF 
    419          IF (ln_velhrcur) THEN 
    420             DO ji = 1, jnumvelhrcur 
    421                WRITE(numout,'(1X,2A)') '             Vel. cur. high freq. input file name    velhvcurfiles = ', & 
    422                   TRIM(velhrcurfiles(ji)) 
    423             END DO 
     440 
     441         IF (ln_pco2) THEN 
     442            jtype = jtype + 1 
     443            CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'pco2  ', & 
     444               &                   cn_pco2fbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
     445            CALL obs_setinterpopts( nsurftypes, jtype, 'pco2  ',         & 
     446               &                    nn_2dint, -1, 0., 0., .TRUE., .FALSE., & 
     447               &                    n2dintsurf, ravglamscl, ravgphiscl,    & 
     448               &                    lfpindegs, llnightav ) 
    424449         ENDIF 
    425          IF (ln_velavadcp) THEN 
    426             DO ji = 1, jnumvelavadcp 
    427                WRITE(numout,'(1X,2A)') '             Vel. ADCP daily av. input file name    velavadcpfiles = ', & 
    428                   TRIM(velavadcpfiles(ji)) 
    429             END DO 
    430          ENDIF 
    431          IF (ln_velhradcp) THEN 
    432             DO ji = 1, jnumvelhradcp 
    433                WRITE(numout,'(1X,2A)') '             Vel. ADCP high freq. input file name   velhvadcpfiles = ', & 
    434                   TRIM(velhradcpfiles(ji)) 
    435             END DO 
    436          ENDIF 
    437          IF (ln_velfb) THEN 
    438             DO ji = 1, jnumvelfb 
    439                IF (ln_velfb_av(ji)) THEN 
    440                   WRITE(numout,'(1X,2A)') '             Vel. feedback daily av. input file name    velfbfiles = ', & 
    441                      TRIM(velfbfiles(ji)) 
    442                ELSE 
    443                   WRITE(numout,'(1X,2A)') '             Vel. feedback input observation file name  velfbfiles = ', & 
    444                      TRIM(velfbfiles(ji)) 
    445                ENDIF 
    446             END DO 
    447          ENDIF 
    448          WRITE(numout,*) '             Initial date in window YYYYMMDD.HHMMSS        dobsini = ', dobsini 
    449          WRITE(numout,*) '             Final date in window YYYYMMDD.HHMMSS          dobsend = ', dobsend 
    450          WRITE(numout,*) '             Type of vertical interpolation method          n1dint = ', n1dint 
    451          WRITE(numout,*) '             Type of horizontal interpolation method        n2dint = ', n2dint 
    452          WRITE(numout,*) '             Rejection of observations near land swithch    ln_nea = ', ln_nea 
    453          WRITE(numout,*) '             MSSH correction scheme                         nmsshc = ', nmsshc 
    454          WRITE(numout,*) '             MDT  correction                               mdtcorr = ', mdtcorr 
    455          WRITE(numout,*) '             MDT cutoff for computed correction          mdtcutoff = ', mdtcutoff 
    456          WRITE(numout,*) '             Logical switch for alt bias                ln_altbias = ', ln_altbias 
    457          WRITE(numout,*) '             Logical switch for ignoring missing files   ln_ignmis = ', ln_ignmis 
    458          WRITE(numout,*) '             ENACT daily average types                             = ',endailyavtypes 
    459  
    460       ENDIF 
    461        
     450 
     451      ENDIF 
     452 
     453      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
     454 
     455 
     456      !----------------------------------------------------------------------- 
     457      ! Obs operator parameter checking and initialisations 
     458      !----------------------------------------------------------------------- 
     459 
    462460      IF ( ln_vel3d .AND. ( .NOT. ln_grid_global ) ) THEN 
    463461         CALL ctl_stop( 'Velocity data only works with ln_grid_global=.true.' ) 
    … …  
    465463      ENDIF 
    466464 
    467       CALL obs_typ_init 
    468        
    469       CALL mppmap_init 
    470        
    471       ! Parameter control 
    472 #if defined key_diaobs 
    473       IF ( ( .NOT. ln_t3d ).AND.( .NOT. ln_s3d ).AND.( .NOT. ln_sla ).AND. & 
    474          & ( .NOT. ln_vel3d ).AND.                                         & 
    475          & ( .NOT. ln_ssh ).AND.( .NOT. ln_sst ).AND.( .NOT. ln_sss ).AND. & 
    476          & ( .NOT. ln_seaice ).AND.( .NOT. ln_vel3d ) ) THEN 
    477          IF(lwp) WRITE(numout,cform_war) 
    478          IF(lwp) WRITE(numout,*) ' key_diaobs is activated but logical flags', & 
    479             &                    ' ln_t3d, ln_s3d, ln_sla, ln_ssh, ln_sst, ln_sss, ln_seaice, ln_vel3d are all set to .FALSE.' 
    480          nwarn = nwarn + 1 
    481       ENDIF 
    482 #endif 
    483  
    484       CALL obs_grid_setup( ) 
    485       IF ( ( n1dint < 0 ).OR.( n1dint > 1 ) ) THEN 
     465      IF ( ( nn_1dint < 0 ) .OR. ( nn_1dint > 1 ) ) THEN 
    486466         CALL ctl_stop(' Choice of vertical (1D) interpolation method', & 
    487467            &                    ' is not available') 
    488468      ENDIF 
    489       IF ( ( n2dint < 0 ).OR.( n2dint > 4 ) ) THEN 
     469 
     470      IF ( ( nn_2dint < 0 ) .OR. ( nn_2dint > 6 ) ) THEN 
    490471         CALL ctl_stop(' Choice of horizontal (2D) interpolation method', & 
    491472            &                    ' is not available') 
    492473      ENDIF 
     474 
     475      CALL obs_typ_init 
     476 
     477      CALL mppmap_init 
     478 
     479      CALL obs_grid_setup( ) 
    493480 
    494481      !----------------------------------------------------------------------- 
    495482      ! Depending on switches read the various observation types 
    496483      !----------------------------------------------------------------------- 
    497       !  - Temperature/salinity profiles 
    498  
    499       IF ( ln_t3d .OR. ln_s3d ) THEN 
    500  
    501          ! Set the number of variables for profiles to 2 (T and S) 
    502          nprofvars = 2 
    503          ! Set the number of extra variables for profiles to 1 (insitu temp). 
    504          nprofextr = 1 
    505  
    506          ! Count how may insitu data sets we have and allocate data. 
    507          jprofset = 0 
    508          IF ( ln_ena ) jprofset = jprofset + 1 
    509          IF ( ln_cor ) jprofset = jprofset + 1 
    510          IF ( ln_profb ) jprofset = jprofset + jnumprofb 
    511          nprofsets = jprofset 
    512          IF ( nprofsets > 0 ) THEN 
    513             ALLOCATE(ld_enact(nprofsets)) 
    514             ALLOCATE(profdata(nprofsets)) 
    515             ALLOCATE(prodatqc(nprofsets)) 
    516          ENDIF 
    517  
    518          jprofset = 0 
    519            
    520          ! ENACT insitu data 
    521  
    522          IF ( ln_ena ) THEN 
    523  
    524             jprofset = jprofset + 1 
    525              
    526             ld_enact(jprofset) = .TRUE. 
    527  
    528             CALL obs_rea_pro_dri( 1, profdata(jprofset),          & 
    529                &                  jnumenact, enactfiles(1:jnumenact), & 
    530                &                  nprofvars, nprofextr,        & 
    531                &                  nitend-nit000+2,             & 
    532                &                  dobsini, dobsend, ln_t3d, ln_s3d, & 
    533                &                  ln_ignmis, ln_s_at_t, .TRUE., .FALSE., & 
    534                &                  kdailyavtypes = endailyavtypes ) 
    535  
    536             DO jvar = 1, 2 
    537  
    538                CALL obs_prof_staend( profdata(jprofset), jvar ) 
    539  
     484 
     485      IF ( nproftypes > 0 ) THEN 
     486 
     487         ALLOCATE(profdata(nproftypes)) 
     488         ALLOCATE(profdataqc(nproftypes)) 
     489         ALLOCATE(nvarsprof(nproftypes)) 
     490         ALLOCATE(nextrprof(nproftypes)) 
     491 
     492         DO jtype = 1, nproftypes 
     493 
     494            nvarsprof(jtype) = 2 
     495            IF ( TRIM(cobstypesprof(jtype)) == 'prof' ) THEN 
     496               nextrprof(jtype) = 1 
     497               llvar1 = ln_t3d 
     498               llvar2 = ln_s3d 
     499               zglam1 = glamt 
     500               zgphi1 = gphit 
     501               zmask1 = tmask 
     502               zglam2 = glamt 
     503               zgphi2 = gphit 
     504               zmask2 = tmask 
     505            ENDIF 
     506            IF ( TRIM(cobstypesprof(jtype)) == 'vel' )  THEN 
     507               nextrprof(jtype) = 2 
     508               llvar1 = ln_vel3d 
     509               llvar2 = ln_vel3d 
     510               zglam1 = glamu 
     511               zgphi1 = gphiu 
     512               zmask1 = umask 
     513               zglam2 = glamv 
     514               zgphi2 = gphiv 
     515               zmask2 = vmask 
     516            ENDIF 
     517 
     518            !Read in profile or profile obs types 
     519            CALL obs_rea_prof( profdata(jtype), ifilesprof(jtype),       & 
     520               &               clproffiles(jtype,1:ifilesprof(jtype)), & 
     521               &               nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, & 
     522               &               rn_dobsini, rn_dobsend, llvar1, llvar2, & 
     523               &               ln_ignmis, ln_s_at_t, .FALSE., & 
     524               &               kdailyavtypes = nn_profdavtypes ) 
     525 
     526            DO jvar = 1, nvarsprof(jtype) 
     527               CALL obs_prof_staend( profdata(jtype), jvar ) 
    540528            END DO 
    541529 
    542             CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   & 
    543                &              ln_t3d, ln_s3d, ln_nea, & 
    544                &              kdailyavtypes=endailyavtypes ) 
    545              
    546          ENDIF 
    547  
    548          ! Coriolis insitu data 
    549  
    550          IF ( ln_cor ) THEN 
    551             
    552             jprofset = jprofset + 1 
    553  
    554             ld_enact(jprofset) = .FALSE. 
    555  
    556             CALL obs_rea_pro_dri( 2, profdata(jprofset),          & 
    557                &                  jnumcorio, coriofiles(1:jnumcorio), & 
    558                &                  nprofvars, nprofextr,        & 
    559                &                  nitend-nit000+2,             & 
    560                &                  dobsini, dobsend, ln_t3d, ln_s3d, & 
    561                &                  ln_ignmis, ln_s_at_t, .FALSE., .FALSE. ) 
    562  
    563             DO jvar = 1, 2 
    564  
    565                CALL obs_prof_staend( profdata(jprofset), jvar ) 
    566  
    567             END DO 
    568  
    569             CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   & 
    570                  &            ln_t3d, ln_s3d, ln_nea ) 
    571              
    572          ENDIF 
    573   
    574          ! Feedback insitu data 
    575  
    576          IF ( ln_profb ) THEN 
    577             
    578             DO jset = 1, jnumprofb 
    579                 
    580                jprofset = jprofset + 1 
    581                ld_enact (jprofset) = ln_profb_ena(jset) 
    582  
    583                CALL obs_rea_pro_dri( 0, profdata(jprofset),          & 
    584                   &                  1, profbfiles(jset:jset), & 
    585                   &                  nprofvars, nprofextr,        & 
    586                   &                  nitend-nit000+2,             & 
    587                   &                  dobsini, dobsend, ln_t3d, ln_s3d, & 
    588                   &                  ln_ignmis, ln_s_at_t, & 
    589                   &                  ld_enact(jprofset).AND.& 
    590                   &                  ln_profb_enatim(jset), & 
    591                   &                  .FALSE., kdailyavtypes = endailyavtypes ) 
    592                 
    593                DO jvar = 1, 2 
    594                    
    595                   CALL obs_prof_staend( profdata(jprofset), jvar ) 
    596                    
     530            CALL obs_pre_prof( profdata(jtype), profdataqc(jtype), & 
     531               &               llvar1, llvar2, & 
     532               &               jpi, jpj, jpk, & 
     533               &               zmask1, zglam1, zgphi1, zmask2, zglam2, zgphi2,  & 
     534               &               ln_nea, ln_bound_reject, & 
     535               &               kdailyavtypes = nn_profdavtypes ) 
     536 
     537         END DO 
     538 
     539         DEALLOCATE( ifilesprof, clproffiles ) 
     540 
     541      ENDIF 
     542 
     543      IF ( nsurftypes > 0 ) THEN 
     544 
     545         ALLOCATE(surfdata(nsurftypes)) 
     546         ALLOCATE(surfdataqc(nsurftypes)) 
     547         ALLOCATE(nvarssurf(nsurftypes)) 
     548         ALLOCATE(nextrsurf(nsurftypes)) 
     549 
     550         DO jtype = 1, nsurftypes 
     551 
     552            nvarssurf(jtype) = 1 
     553            nextrsurf(jtype) = 0 
     554            IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) nextrsurf(jtype) = 2 
     555 
     556            !Read in surface obs types 
     557            CALL obs_rea_surf( surfdata(jtype), ifilessurf(jtype), & 
     558               &               clsurffiles(jtype,1:ifilessurf(jtype)), & 
     559               &               nvarssurf(jtype), nextrsurf(jtype), nitend-nit000+2, & 
     560               &               rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav(jtype) ) 
     561 
     562            CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea, ln_bound_reject ) 
     563 
     564            IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN 
     565               CALL obs_rea_mdt( surfdataqc(jtype), n2dintsurf(jtype) ) 
     566               IF ( ln_altbias ) & 
     567                  & CALL obs_rea_altbias ( surfdataqc(jtype), n2dintsurf(jtype), cn_altbiasfile ) 
     568            ENDIF 
     569 
     570            IF ( TRIM(cobstypessurf(jtype)) == 'sst' .AND. ln_sstbias ) THEN 
     571               jnumsstbias = 0 
     572               DO jfile = 1, jpmaxnfiles 
     573                  IF ( TRIM(cn_sstbiasfiles(jfile)) /= '' ) & 
     574                     &  jnumsstbias = jnumsstbias + 1 
    597575               END DO 
    598                 
    599                IF ( ld_enact(jprofset) ) THEN 
    600                   CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   & 
    601                      &              ln_t3d, ln_s3d, ln_nea, & 
    602                      &              kdailyavtypes = endailyavtypes ) 
    603                ELSE 
    604                   CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   & 
    605                      &              ln_t3d, ln_s3d, ln_nea ) 
     576               IF ( jnumsstbias == 0 ) THEN 
     577                  CALL ctl_stop("ln_sstbias set but no bias files to read in")     
    606578               ENDIF 
    607                 
    608             END DO 
    609  
    610          ENDIF 
    611  
    612       ENDIF 
    613  
    614       !  - Sea level anomalies 
    615       IF ( ln_sla ) THEN 
    616         ! Set the number of variables for sla to 1 
    617          nslavars = 1 
    618  
    619          ! Set the number of extra variables for sla to 2 
    620          nslaextr = 2 
    621           
    622          ! Set the number of sla data sets to 2 
    623          nslasets = 0 
    624          IF ( ln_sladt ) THEN 
    625             nslasets = nslasets + 2 
    626          ENDIF 
    627          IF ( ln_slafb ) THEN 
    628             nslasets = nslasets + jnumslafb 
    629          ENDIF 
    630           
    631          ALLOCATE(sladata(nslasets)) 
    632          ALLOCATE(sladatqc(nslasets)) 
    633          sladata(:)%nsurf=0 
    634          sladatqc(:)%nsurf=0 
    635  
    636          nslasets = 0 
    637  
    638          ! AVISO SLA data 
    639  
    640          IF ( ln_sladt ) THEN 
    641  
    642             ! Active SLA observations 
    643              
    644             nslasets = nslasets + 1 
    645              
    646             CALL obs_rea_sla( 1, sladata(nslasets), jnumslaact, & 
    647                &              slafilesact(1:jnumslaact), & 
    648                &              nslavars, nslaextr, nitend-nit000+2, & 
    649                &              dobsini, dobsend, ln_ignmis, .FALSE. ) 
    650             CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), & 
    651                &              ln_sla, ln_nea ) 
    652              
    653             ! Passive SLA observations 
    654              
    655             nslasets = nslasets + 1 
    656              
    657             CALL obs_rea_sla( 1, sladata(nslasets), jnumslapas, & 
    658                &              slafilespas(1:jnumslapas), & 
    659                &              nslavars, nslaextr, nitend-nit000+2, & 
    660                &              dobsini, dobsend, ln_ignmis, .FALSE. ) 
    661              
    662             CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), & 
    663                &              ln_sla, ln_nea ) 
    664  
    665          ENDIF 
    666           
    667          ! Feedback SLA data 
    668  
    669          IF ( ln_slafb ) THEN 
    670  
    671             DO jset = 1, jnumslafb 
    672              
    673                nslasets = nslasets + 1 
    674              
    675                CALL obs_rea_sla( 0, sladata(nslasets), 1, & 
    676                   &              slafbfiles(jset:jset), & 
    677                   &              nslavars, nslaextr, nitend-nit000+2, & 
    678                   &              dobsini, dobsend, ln_ignmis, .FALSE. ) 
    679                CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), & 
    680                   &              ln_sla, ln_nea ) 
    681  
    682             END DO                
    683  
    684          ENDIF 
    685           
    686          CALL obs_rea_mdt( nslasets, sladatqc, n2dint ) 
    687              
    688          ! read in altimeter bias 
    689           
    690          IF ( ln_altbias ) THEN      
    691             CALL obs_rea_altbias ( nslasets, sladatqc, n2dint, bias_file ) 
    692          ENDIF 
    693       
    694       ENDIF 
    695  
    696       !  - Sea surface height 
    697       IF ( ln_ssh ) THEN 
    698          IF(lwp) WRITE(numout,*) ' SSH currently not available' 
    699       ENDIF 
    700  
    701       !  - Sea surface temperature 
    702       IF ( ln_sst ) THEN 
    703  
    704          ! Set the number of variables for sst to 1 
    705          nsstvars = 1 
    706  
    707          ! Set the number of extra variables for sst to 0 
    708          nsstextr = 0 
    709  
    710          nsstsets = 0 
    711  
    712          IF (ln_reysst) nsstsets = nsstsets + 1 
    713          IF (ln_ghrsst) nsstsets = nsstsets + 1 
    714          IF ( ln_sstfb ) THEN 
    715             nsstsets = nsstsets + jnumsstfb 
    716          ENDIF 
    717  
    718          ALLOCATE(sstdata(nsstsets)) 
    719          ALLOCATE(sstdatqc(nsstsets)) 
    720          ALLOCATE(ld_sstnight(nsstsets)) 
    721          sstdata(:)%nsurf=0 
    722          sstdatqc(:)%nsurf=0     
    723          ld_sstnight(:)=.false. 
    724  
    725          nsstsets = 0 
    726  
    727          IF (ln_reysst) THEN 
    728  
    729             nsstsets = nsstsets + 1 
    730  
    731             ld_sstnight(nsstsets) = ln_sstnight 
    732  
    733             CALL obs_rea_sst_rey( reysstname, reysstfmt, sstdata(nsstsets), & 
    734                &                  nsstvars, nsstextr, & 
    735                &                  nitend-nit000+2, dobsini, dobsend ) 
    736             CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), ln_sst, & 
    737                &              ln_nea ) 
    738  
    739         ENDIF 
    740          
    741         IF (ln_ghrsst) THEN 
    742          
    743             nsstsets = nsstsets + 1 
    744  
    745             ld_sstnight(nsstsets) = ln_sstnight 
    746            
    747             CALL obs_rea_sst( 1, sstdata(nsstsets), jnumsst, & 
    748                &              sstfiles(1:jnumsst), & 
    749                &              nsstvars, nsstextr, nitend-nit000+2, & 
    750                &              dobsini, dobsend, ln_ignmis, .FALSE. ) 
    751             CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), ln_sst, & 
    752                &              ln_nea ) 
    753  
    754         ENDIF 
    755                 
    756          ! Feedback SST data 
    757  
    758          IF ( ln_sstfb ) THEN 
    759  
    760             DO jset = 1, jnumsstfb 
    761              
    762                nsstsets = nsstsets + 1 
    763  
    764                ld_sstnight(nsstsets) = ln_sstnight 
    765              
    766                CALL obs_rea_sst( 0, sstdata(nsstsets), 1, & 
    767                   &              sstfbfiles(jset:jset), & 
    768                   &              nsstvars, nsstextr, nitend-nit000+2, & 
    769                   &              dobsini, dobsend, ln_ignmis, .FALSE. ) 
    770                CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), & 
    771                   &              ln_sst, ln_nea ) 
    772  
    773             END DO                
    774  
    775          ENDIF 
    776  
    777       ENDIF 
    778  
    779       !  - Sea surface salinity 
    780       IF ( ln_sss ) THEN 
    781          IF(lwp) WRITE(numout,*) ' SSS currently not available' 
    782       ENDIF 
    783  
    784       !  - Sea Ice Concentration 
    785        
    786       IF ( ln_seaice ) THEN 
    787  
    788          ! Set the number of variables for seaice to 1 
    789          nseaicevars = 1 
    790  
    791          ! Set the number of extra variables for seaice to 0 
    792          nseaiceextr = 0 
    793           
    794          ! Set the number of data sets to 1 
    795          nseaicesets = 1 
    796  
    797          ALLOCATE(seaicedata(nseaicesets)) 
    798          ALLOCATE(seaicedatqc(nseaicesets)) 
    799          seaicedata(:)%nsurf=0 
    800          seaicedatqc(:)%nsurf=0 
    801  
    802          CALL obs_rea_seaice( 1, seaicedata(nseaicesets), jnumseaice, & 
    803             &                 seaicefiles(1:jnumseaice), & 
    804             &                 nseaicevars, nseaiceextr, nitend-nit000+2, & 
    805             &                 dobsini, dobsend, ln_ignmis, .FALSE. ) 
    806  
    807          CALL obs_pre_seaice( seaicedata(nseaicesets), seaicedatqc(nseaicesets), & 
    808             &                 ln_seaice, ln_nea ) 
    809   
    810       ENDIF 
    811  
    812       IF (ln_vel3d) THEN 
    813  
    814          ! Set the number of variables for profiles to 2 (U and V) 
    815          nvelovars = 2 
    816  
    817          ! Set the number of extra variables for profiles to 2 to store  
    818          ! rotation parameters 
    819          nveloextr = 2 
    820  
    821          jveloset = 0 
    822           
    823          IF ( ln_velavcur ) jveloset = jveloset + 1 
    824          IF ( ln_velhrcur ) jveloset = jveloset + 1 
    825          IF ( ln_velavadcp ) jveloset = jveloset + 1 
    826          IF ( ln_velhradcp ) jveloset = jveloset + 1 
    827          IF (ln_velfb) jveloset = jveloset + jnumvelfb 
    828  
    829          nvelosets = jveloset 
    830          IF ( nvelosets > 0 ) THEN 
    831             ALLOCATE( velodata(nvelosets) ) 
    832             ALLOCATE( veldatqc(nvelosets) ) 
    833             ALLOCATE( ld_velav(nvelosets) ) 
    834          ENDIF 
    835           
    836          jveloset = 0 
    837           
    838          ! Daily averaged data 
    839  
    840          IF ( ln_velavcur ) THEN 
    841              
    842             jveloset = jveloset + 1 
    843              
    844             ld_velav(jveloset) = .TRUE. 
    845              
    846             CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelavcur, & 
    847                &                  velavcurfiles(1:jnumvelavcur), & 
    848                &                  nvelovars, nveloextr, & 
    849                &                  nitend-nit000+2,              & 
    850                &                  dobsini, dobsend, ln_ignmis, & 
    851                &                  ld_velav(jveloset), & 
    852                &                  .FALSE. ) 
    853              
    854             DO jvar = 1, 2 
    855                CALL obs_prof_staend( velodata(jveloset), jvar ) 
    856             END DO 
    857              
    858             CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), & 
    859                &              ln_vel3d, ln_nea, ld_velav(jveloset) ) 
    860              
    861          ENDIF 
    862  
    863          ! High frequency data 
    864  
    865          IF ( ln_velhrcur ) THEN 
    866              
    867             jveloset = jveloset + 1 
    868              
    869             ld_velav(jveloset) = .FALSE. 
    870                 
    871             CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelhrcur, & 
    872                &                  velhrcurfiles(1:jnumvelhrcur), & 
    873                &                  nvelovars, nveloextr, & 
    874                &                  nitend-nit000+2,              & 
    875                &                  dobsini, dobsend, ln_ignmis, & 
    876                &                  ld_velav(jveloset), & 
    877                &                  .FALSE. ) 
    878              
    879             DO jvar = 1, 2 
    880                CALL obs_prof_staend( velodata(jveloset), jvar ) 
    881             END DO 
    882              
    883             CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), & 
    884                &              ln_vel3d, ln_nea, ld_velav(jveloset) ) 
    885              
    886          ENDIF 
    887  
    888          ! Daily averaged data 
    889  
    890          IF ( ln_velavadcp ) THEN 
    891              
    892             jveloset = jveloset + 1 
    893              
    894             ld_velav(jveloset) = .TRUE. 
    895              
    896             CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelavadcp, & 
    897                &                  velavadcpfiles(1:jnumvelavadcp), & 
    898                &                  nvelovars, nveloextr, & 
    899                &                  nitend-nit000+2,              & 
    900                &                  dobsini, dobsend, ln_ignmis, & 
    901                &                  ld_velav(jveloset), & 
    902                &                  .FALSE. ) 
    903              
    904             DO jvar = 1, 2 
    905                CALL obs_prof_staend( velodata(jveloset), jvar ) 
    906             END DO 
    907              
    908             CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), & 
    909                &              ln_vel3d, ln_nea, ld_velav(jveloset) ) 
    910              
    911          ENDIF 
    912  
    913          ! High frequency data 
    914  
    915          IF ( ln_velhradcp ) THEN 
    916              
    917             jveloset = jveloset + 1 
    918              
    919             ld_velav(jveloset) = .FALSE. 
    920                 
    921             CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelhradcp, & 
    922                &                  velhradcpfiles(1:jnumvelhradcp), & 
    923                &                  nvelovars, nveloextr, & 
    924                &                  nitend-nit000+2,              & 
    925                &                  dobsini, dobsend, ln_ignmis, & 
    926                &                  ld_velav(jveloset), & 
    927                &                  .FALSE. ) 
    928              
    929             DO jvar = 1, 2 
    930                CALL obs_prof_staend( velodata(jveloset), jvar ) 
    931             END DO 
    932              
    933             CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), & 
    934                &              ln_vel3d, ln_nea, ld_velav(jveloset) ) 
    935              
    936          ENDIF 
    937  
    938          IF ( ln_velfb ) THEN 
    939  
    940             DO jset = 1, jnumvelfb 
    941              
    942                jveloset = jveloset + 1 
    943  
    944                ld_velav(jveloset) = ln_velfb_av(jset) 
    945                 
    946                CALL obs_rea_vel_dri( 0, velodata(jveloset), 1, & 
    947                   &                  velfbfiles(jset:jset), & 
    948                   &                  nvelovars, nveloextr, & 
    949                   &                  nitend-nit000+2,              & 
    950                   &                  dobsini, dobsend, ln_ignmis, & 
    951                   &                  ld_velav(jveloset), & 
    952                   &                  .FALSE. ) 
    953                 
    954                DO jvar = 1, 2 
    955                   CALL obs_prof_staend( velodata(jveloset), jvar ) 
    956                END DO 
    957                 
    958                CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), & 
    959                   &              ln_vel3d, ln_nea, ld_velav(jveloset) ) 
    960  
    961  
    962             END DO 
    963              
    964          ENDIF 
    965  
    966       ENDIF 
    967       
     579 
     580               CALL obs_app_sstbias( surfdataqc(jtype), n2dintsurf(jtype), &  
     581                  &                  jnumsstbias, cn_sstbiasfiles(1:jnumsstbias) )  
     582 
     583            ENDIF 
     584 
     585         END DO 
     586 
     587         DEALLOCATE( ifilessurf, clsurffiles ) 
     588 
     589      ENDIF 
     590 
     591      CALL wrk_dealloc( jpi, jpj, zglam1 ) 
     592      CALL wrk_dealloc( jpi, jpj, zglam2 ) 
     593      CALL wrk_dealloc( jpi, jpj, zgphi1 ) 
     594      CALL wrk_dealloc( jpi, jpj, zgphi2 ) 
     595      CALL wrk_dealloc( jpi, jpj, jpk, zmask1 ) 
     596      CALL wrk_dealloc( jpi, jpj, jpk, zmask2 ) 
     597 
    968598   END SUBROUTINE dia_obs_init 
    969599 
    … …  
    975605      !! 
    976606      !! ** Method  : Call the observation operators on each time step to 
    977       !!              compute the model equivalent of the following date: 
    978       !!               - T profiles 
    979       !!               - S profiles 
    980       !!               - Sea surface height (referenced to a mean) 
    981       !!               - Sea surface temperature 
    982       !!               - Sea surface salinity 
    983       !!               - Velocity component (U,V) profiles 
    984       !! 
    985       !! ** Action  :  
     607      !!              compute the model equivalent of the following data: 
     608      !!               - Profile data, currently T/S or U/V 
     609      !!               - Surface data, currently SST, SLA or sea-ice concentration. 
     610      !! 
     611      !! ** Action  : 
    986612      !! 
    987613      !! History : 
    … …  
    992618      !!        !  07-04  (G. Smith) Generalized surface operators 
    993619      !!        !  08-10  (M. Valdivieso) obs operator for velocity profiles 
     620      !!        !  15-08  (M. Martin) Combined surface/profile routines. 
    994621      !!---------------------------------------------------------------------- 
    995622      !! * Modules used 
    996       USE dom_oce, ONLY : &             ! Ocean space and time domain variables 
    997          & rdt,           &                        
    998          & gdept_1d,       &              
    999          & tmask, umask, vmask                             
    1000       USE phycst, ONLY : &              ! Physical constants 
    1001          & rday                          
    1002       USE oce, ONLY : &                 ! Ocean dynamics and tracers variables 
    1003          & tsn,  &              
    1004          & un, vn,  & 
     623      USE phycst, ONLY : &         ! Physical constants 
     624         & rday 
     625      USE oce, ONLY : &            ! Ocean dynamics and tracers variables 
     626         & tsn,       & 
     627         & un,        & 
     628         & vn,        & 
    1005629         & sshn 
    1006630#if defined  key_lim3 
    1007       USE ice, ONLY : &                     ! LIM Ice model variables 
     631      USE ice, ONLY : &            ! LIM3 Ice model variables 
    1008632         & frld 
    1009633#endif 
    1010634#if defined key_lim2 
    1011       USE ice_2, ONLY : &                     ! LIM Ice model variables 
     635      USE ice_2, ONLY : &          ! LIM2 Ice model variables 
    1012636         & frld 
    1013637#endif 
     638#if defined key_cice 
     639      USE sbc_oce, ONLY : fr_i     ! ice fraction 
     640#endif 
     641#if defined key_hadocc 
     642      USE trc, ONLY :  &           ! HadOCC chlorophyll, fCO2 and pCO2 
     643         & HADOCC_CHL, & 
     644         & HADOCC_FCO2, & 
     645         & HADOCC_PCO2, & 
     646         & HADOCC_FILL_FLT 
     647#elif defined key_medusa && defined key_foam_medusa 
     648      USE trc, ONLY :  &           ! MEDUSA chlorophyll, fCO2 and pCO2 
     649         & trn 
     650      USE par_medusa, ONLY: & 
     651         & jpchn, & 
     652         & jpchd 
     653#if defined key_roam 
     654      USE sms_medusa, ONLY: & 
     655         & f2_pco2w, & 
     656         & f2_fco2w 
     657#endif 
     658#elif defined key_fabm 
     659      USE fabm 
     660      USE par_fabm 
     661#endif 
     662#if defined key_spm 
     663      USE par_spm, ONLY: &         ! ERSEM/SPM sediments 
     664         & jp_spm 
     665      USE trc, ONLY :  & 
     666         & trn 
     667#endif 
     668 
    1014669      IMPLICIT NONE 
    1015670 
    1016671      !! * Arguments 
    1017       INTEGER, INTENT(IN) :: kstp                         ! Current timestep 
     672      INTEGER, INTENT(IN) :: kstp  ! Current timestep 
    1018673      !! * Local declarations 
    1019       INTEGER :: idaystp                ! Number of timesteps per day 
    1020       INTEGER :: jprofset               ! Profile data set loop variable 
    1021       INTEGER :: jslaset                ! SLA data set loop variable 
    1022       INTEGER :: jsstset                ! SST data set loop variable 
    1023       INTEGER :: jseaiceset             ! sea ice data set loop variable 
    1024       INTEGER :: jveloset               ! velocity profile data loop variable 
    1025       INTEGER :: jvar                   ! Variable number     
    1026 #if ! defined key_lim2 && ! defined key_lim3 
    1027       REAL(wp), POINTER, DIMENSION(:,:) :: frld    
    1028 #endif 
    1029       CHARACTER(LEN=20) :: datestr=" ",timestr=" " 
    1030   
    1031 #if ! defined key_lim2 && ! defined key_lim3 
    1032       CALL wrk_alloc(jpi,jpj,frld)  
    1033 #endif 
     674      INTEGER :: idaystp           ! Number of timesteps per day 
     675      INTEGER :: jtype             ! Data loop variable 
     676      INTEGER :: jvar              ! Variable number 
     677      INTEGER :: ji, jj            ! Loop counters 
     678      REAL(wp) :: tiny                  ! small number 
     679      REAL(wp), POINTER, DIMENSION(:,:,:) :: & 
     680         & zprofvar1, &            ! Model values for 1st variable in a prof ob 
     681         & zprofvar2               ! Model values for 2nd variable in a prof ob 
     682      REAL(wp), POINTER, DIMENSION(:,:,:) :: & 
     683         & zprofmask1, &           ! Mask associated with zprofvar1 
     684         & zprofmask2              ! Mask associated with zprofvar2 
     685      REAL(wp), POINTER, DIMENSION(:,:) :: & 
     686         & zsurfvar, &             ! Model values equivalent to surface ob. 
     687         & zsurfmask               ! Mask associated with surface variable 
     688      REAL(wp), POINTER, DIMENSION(:,:) :: & 
     689         & zglam1,    &            ! Model longitudes for prof variable 1 
     690         & zglam2,    &            ! Model longitudes for prof variable 2 
     691         & zgphi1,    &            ! Model latitudes for prof variable 1 
     692         & zgphi2                  ! Model latitudes for prof variable 2 
     693 
     694 
     695      !Allocate local work arrays 
     696      CALL wrk_alloc( jpi, jpj, jpk, zprofvar1 ) 
     697      CALL wrk_alloc( jpi, jpj, jpk, zprofvar2 ) 
     698      CALL wrk_alloc( jpi, jpj, jpk, zprofmask1 ) 
     699      CALL wrk_alloc( jpi, jpj, jpk, zprofmask2 ) 
     700      CALL wrk_alloc( jpi, jpj, zsurfvar ) 
     701      CALL wrk_alloc( jpi, jpj, zsurfmask ) 
     702      CALL wrk_alloc( jpi, jpj, zglam1 ) 
     703      CALL wrk_alloc( jpi, jpj, zglam2 ) 
     704      CALL wrk_alloc( jpi, jpj, zgphi1 ) 
     705      CALL wrk_alloc( jpi, jpj, zgphi2 ) 
    1034706 
    1035707      IF(lwp) THEN 
    … …  
    1037709         WRITE(numout,*) 'dia_obs : Call the observation operators', kstp 
    1038710         WRITE(numout,*) '~~~~~~~' 
     711         CALL FLUSH(numout) 
    1039712      ENDIF 
    1040713 
    … …  
    1042715 
    1043716      !----------------------------------------------------------------------- 
    1044       ! No LIM => frld == 0.0_wp 
     717      ! Call the profile and surface observation operators 
    1045718      !----------------------------------------------------------------------- 
    1046 #if ! defined key_lim2 && ! defined key_lim3 
    1047       frld(:,:) = 0.0_wp 
     719 
     720      IF ( nproftypes > 0 ) THEN 
     721 
     722         DO jtype = 1, nproftypes 
     723 
     724            SELECT CASE ( TRIM(cobstypesprof(jtype)) ) 
     725            CASE('prof') 
     726               zprofvar1(:,:,:) = tsn(:,:,:,jp_tem) 
     727               zprofvar2(:,:,:) = tsn(:,:,:,jp_sal) 
     728               zprofmask1(:,:,:) = tmask(:,:,:) 
     729               zprofmask2(:,:,:) = tmask(:,:,:) 
     730               zglam1(:,:) = glamt(:,:) 
     731               zglam2(:,:) = glamt(:,:) 
     732               zgphi1(:,:) = gphit(:,:) 
     733               zgphi2(:,:) = gphit(:,:) 
     734            CASE('vel') 
     735               zprofvar1(:,:,:) = un(:,:,:) 
     736               zprofvar2(:,:,:) = vn(:,:,:) 
     737               zprofmask1(:,:,:) = umask(:,:,:) 
     738               zprofmask2(:,:,:) = vmask(:,:,:) 
     739               zglam1(:,:) = glamu(:,:) 
     740               zglam2(:,:) = glamv(:,:) 
     741               zgphi1(:,:) = gphiu(:,:) 
     742               zgphi2(:,:) = gphiv(:,:) 
     743            CASE DEFAULT 
     744               CALL ctl_stop( 'Unknown profile observation type '//TRIM(cobstypesprof(jtype))//' in dia_obs' ) 
     745            END SELECT 
     746 
     747            CALL obs_prof_opt( profdataqc(jtype), kstp, jpi, jpj, jpk,  & 
     748               &               nit000, idaystp,                         & 
     749               &               zprofvar1, zprofvar2,                    & 
     750               &               fsdept(:,:,:), fsdepw(:,:,:),            &  
     751               &               zprofmask1, zprofmask2,                  & 
     752               &               zglam1, zglam2, zgphi1, zgphi2,          & 
     753               &               nn_1dint, nn_2dint,                      & 
     754               &               kdailyavtypes = nn_profdavtypes ) 
     755 
     756         END DO 
     757 
     758      ENDIF 
     759 
     760      IF ( nsurftypes > 0 ) THEN 
     761 
     762         DO jtype = 1, nsurftypes 
     763 
     764            !Defaults which might be changed 
     765            zsurfmask(:,:) = tmask(:,:,1) 
     766 
     767            SELECT CASE ( TRIM(cobstypessurf(jtype)) ) 
     768            CASE('sst') 
     769               zsurfvar(:,:) = tsn(:,:,1,jp_tem) 
     770            CASE('sla') 
     771               zsurfvar(:,:) = sshn(:,:) 
     772            CASE('sss') 
     773               zsurfvar(:,:) = tsn(:,:,1,jp_sal) 
     774            CASE('sic') 
     775               IF ( kstp == 0 ) THEN 
     776                  IF ( lwp .AND. surfdataqc(jtype)%nsstpmpp(1) > 0 ) THEN 
     777                     CALL ctl_warn( 'Sea-ice not initialised on zeroth '// & 
     778                        &           'time-step but some obs are valid then.' ) 
     779                     WRITE(numout,*)surfdataqc(jtype)%nsstpmpp(1), & 
     780                        &           ' sea-ice obs will be missed' 
     781                  ENDIF 
     782                  surfdataqc(jtype)%nsurfup = surfdataqc(jtype)%nsurfup + & 
     783                     &                        surfdataqc(jtype)%nsstp(1) 
     784                  CYCLE 
     785               ELSE 
     786#if defined key_cice 
     787                  zsurfvar(:,:) = fr_i(:,:) 
     788#elif defined key_lim2 || defined key_lim3 
     789                  zsurfvar(:,:) = 1._wp - frld(:,:) 
     790#else 
     791               CALL ctl_stop( ' Trying to run sea-ice observation operator', & 
     792                  &           ' but no sea-ice model appears to have been defined' ) 
    1048793#endif 
    1049       !----------------------------------------------------------------------- 
    1050       ! Depending on switches call various observation operators 
    1051       !----------------------------------------------------------------------- 
    1052  
    1053       !  - Temperature/salinity profiles 
    1054       IF ( ln_t3d .OR. ln_s3d ) THEN 
    1055          DO jprofset = 1, nprofsets 
    1056             IF ( ld_enact(jprofset) ) THEN 
    1057                CALL obs_pro_opt( prodatqc(jprofset),                     & 
    1058                   &              kstp, jpi, jpj, jpk, nit000, idaystp,   & 
    1059                   &              tsn(:,:,:,jp_tem), tsn(:,:,:,jp_sal),   & 
    1060                   &              gdept_1d, tmask, n1dint, n2dint,        & 
    1061                   &              kdailyavtypes = endailyavtypes ) 
    1062             ELSE 
    1063                CALL obs_pro_opt( prodatqc(jprofset),                     & 
    1064                   &              kstp, jpi, jpj, jpk, nit000, idaystp,   & 
    1065                   &              tsn(:,:,:,jp_tem), tsn(:,:,:,jp_sal),   & 
    1066                   &              gdept_1d, tmask, n1dint, n2dint              ) 
    1067             ENDIF 
     794               ENDIF 
     795 
     796            CASE('logchl') 
     797#if defined key_hadocc 
     798               zsurfvar(:,:) = HADOCC_CHL(:,:,1)    ! (not log) chlorophyll from HadOCC 
     799#elif defined key_medusa && defined key_foam_medusa 
     800               ! Add non-diatom and diatom surface chlorophyll from MEDUSA 
     801               zsurfvar(:,:) = trn(:,:,1,jpchn) + trn(:,:,1,jpchd) 
     802#elif defined key_fabm 
     803               chl_3d(:,:,:) = fabm_get_bulk_diagnostic_data(model, jp_fabmdia_chltot) 
     804               zsurfvar(:,:) = chl_3d(:,:,1) 
     805#else 
     806               CALL ctl_stop( ' Trying to run logchl observation operator', & 
     807                  &           ' but no biogeochemical model appears to have been defined' ) 
     808#endif 
     809               zsurfmask(:,:) = tmask(:,:,1)         ! create a special mask to exclude certain things 
     810               ! Take the log10 where we can, otherwise exclude 
     811               tiny = 1.0e-20 
     812               WHERE(zsurfvar(:,:) > tiny .AND. zsurfvar(:,:) /= obfillflt ) 
     813                  zsurfvar(:,:)  = LOG10(zsurfvar(:,:)) 
     814               ELSEWHERE 
     815                  zsurfvar(:,:)  = obfillflt 
     816                  zsurfmask(:,:) = 0 
     817               END WHERE 
     818            CASE('spm') 
     819#if defined key_spm 
     820               zsurfvar(:,:) = 0.0 
     821               DO jn = 1, jp_spm 
     822                  zsurfvar(:,:) = zsurfvar(:,:) + trn(:,:,1,jn)   ! sum SPM sizes 
     823               END DO 
     824#else 
     825               CALL ctl_stop( ' Trying to run spm observation operator', & 
     826                  &           ' but no spm model appears to have been defined' ) 
     827#endif 
     828            CASE('fco2') 
     829#if defined key_hadocc 
     830               zsurfvar(:,:) = HADOCC_FCO2(:,:)    ! fCO2 from HadOCC 
     831               IF ( ( MINVAL( HADOCC_FCO2 ) == HADOCC_FILL_FLT ) .AND. & 
     832                  & ( MAXVAL( HADOCC_FCO2 ) == HADOCC_FILL_FLT ) ) THEN 
     833                  zsurfvar(:,:) = obfillflt 
     834                  zsurfmask(:,:) = 0 
     835                  CALL ctl_warn( ' HadOCC fCO2 values masked out for observation operator', & 
     836                     &           ' as HADOCC_FCO2(:,:) == HADOCC_FILL_FLT' ) 
     837               ENDIF 
     838#elif defined key_medusa && defined key_foam_medusa && defined key_roam 
     839               zsurfvar(:,:) = f2_fco2w(:,:) 
     840#elif defined key_fabm 
     841               ! First, get pCO2 from FABM 
     842               pco2_3d(:,:,:) = fabm_get_bulk_diagnostic_data(model, jp_fabm_o3pc) 
     843               zsurfvar(:,:) = pco2_3d(:,:,1) 
     844               ! Now, convert pCO2 to fCO2, based on SST in K. This follows the standard methodology of: 
     845               ! Pierrot et al. (2009), Recommendations for autonomous underway pCO2 measuring systems 
     846               ! and data reduction routines, Deep-Sea Research II, 56: 512-522. 
     847               ! and 
     848               ! Weiss (1974), Carbon dioxide in water and seawater: the solubility of a non-ideal gas, 
     849               ! Marine Chemistry, 2: 203-215. 
     850               ! In the implementation below, atmospheric pressure has been assumed to be 1 atm and so 
     851               ! not explicitly included - atmospheric pressure is not necessarily available so this is 
     852               ! the best assumption. 
     853               ! Further, the (1-xCO2)^2 term has been neglected. This is common practice 
     854               ! (see e.g. Zeebe and Wolf-Gladrow (2001), CO2 in Seawater: Equilibrium, Kinetics, Isotopes) 
     855               ! because xCO2 in atm is ~0, and so this term will only affect the result to the 3rd decimal 
     856               ! place for typical values, and xCO2 would need to be approximated from pCO2 anyway. 
     857               zsurfvar(:,:) = zsurfvar(:,:) * EXP((-1636.75                                                          + & 
     858                  &            12.0408      * (tsn(:,:,1,jp_tem)+rt0)                                                 - & 
     859                  &            0.0327957    * (tsn(:,:,1,jp_tem)+rt0)*(tsn(:,:,1,jp_tem)+rt0)                         + & 
     860                  &            0.0000316528 * (tsn(:,:,1,jp_tem)+rt0)*(tsn(:,:,1,jp_tem)+rt0)*(tsn(:,:,1,jp_tem)+rt0) + & 
     861                  &            2.0 * (57.7 - 0.118 * (tsn(:,:,1,jp_tem)+rt0)))                                        / & 
     862                  &            (82.0578 * (tsn(:,:,1,jp_tem)+rt0))) 
     863#else 
     864               CALL ctl_stop( ' Trying to run fco2 observation operator', & 
     865                  &           ' but no biogeochemical model appears to have been defined' ) 
     866#endif 
     867            CASE('pco2') 
     868#if defined key_hadocc 
     869               zsurfvar(:,:) = HADOCC_PCO2(:,:)    ! pCO2 from HadOCC 
     870               IF ( ( MINVAL( HADOCC_PCO2 ) == HADOCC_FILL_FLT ) .AND. & 
     871                  & ( MAXVAL( HADOCC_PCO2 ) == HADOCC_FILL_FLT ) ) THEN 
     872                  zsurfvar(:,:) = obfillflt 
     873                  zsurfmask(:,:) = 0 
     874                  CALL ctl_warn( ' HadOCC pCO2 values masked out for observation operator', & 
     875                     &           ' as HADOCC_PCO2(:,:) == HADOCC_FILL_FLT' ) 
     876               ENDIF 
     877#elif defined key_medusa && defined key_foam_medusa && defined key_roam 
     878               zsurfvar(:,:) = f2_pco2w(:,:) 
     879#elif defined key_fabm 
     880               pco2_3d(:,:,:) = fabm_get_bulk_diagnostic_data(model, jp_fabm_o3pc) 
     881               zsurfvar(:,:) = pco2_3d(:,:,1) 
     882#else 
     883               CALL ctl_stop( ' Trying to run pCO2 observation operator', & 
     884                  &           ' but no biogeochemical model appears to have been defined' ) 
     885#endif 
     886 
     887            CASE DEFAULT 
     888 
     889               CALL ctl_stop( 'Unknown surface observation type '//TRIM(cobstypessurf(jtype))//' in dia_obs' ) 
     890 
     891            END SELECT 
     892 
     893            CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj,       & 
     894               &               nit000, idaystp, zsurfvar, zsurfmask,    & 
     895               &               n2dintsurf(jtype), llnightav(jtype),     & 
     896               &               ravglamscl(jtype), ravgphiscl(jtype),     & 
     897               &               lfpindegs(jtype) ) 
     898 
    1068899         END DO 
    1069       ENDIF 
    1070  
    1071       !  - Sea surface anomaly 
    1072       IF ( ln_sla ) THEN 
    1073          DO jslaset = 1, nslasets 
    1074             CALL obs_sla_opt( sladatqc(jslaset),            & 
    1075                &              kstp, jpi, jpj, nit000, sshn, & 
    1076                &              tmask(:,:,1), n2dint ) 
    1077          END DO          
    1078       ENDIF 
    1079  
    1080       !  - Sea surface temperature 
    1081       IF ( ln_sst ) THEN 
    1082          DO jsstset = 1, nsstsets 
    1083             CALL obs_sst_opt( sstdatqc(jsstset),                & 
    1084                &              kstp, jpi, jpj, nit000, idaystp,  & 
    1085                &              tsn(:,:,1,jp_tem), tmask(:,:,1),  & 
    1086                &              n2dint, ld_sstnight(jsstset) ) 
    1087          END DO 
    1088       ENDIF 
    1089  
    1090       !  - Sea surface salinity 
    1091       IF ( ln_sss ) THEN 
    1092          IF(lwp) WRITE(numout,*) ' SSS currently not available' 
    1093       ENDIF 
    1094  
    1095 #if defined key_lim2 || defined key_lim3 
    1096       IF ( ln_seaice ) THEN 
    1097          DO jseaiceset = 1, nseaicesets 
    1098             CALL obs_seaice_opt( seaicedatqc(jseaiceset),      & 
    1099                &              kstp, jpi, jpj, nit000, 1.-frld, & 
    1100                &              tmask(:,:,1), n2dint ) 
    1101          END DO 
    1102       ENDIF       
    1103 #endif 
    1104  
    1105       !  - Velocity profiles 
    1106       IF ( ln_vel3d ) THEN 
    1107          DO jveloset = 1, nvelosets 
    1108            ! zonal component of velocity 
    1109            CALL obs_vel_opt( veldatqc(jveloset), kstp, jpi, jpj, jpk, & 
    1110               &              nit000, idaystp, un, vn, gdept_1d, umask, vmask, & 
    1111                              n1dint, n2dint, ld_velav(jveloset) ) 
    1112          END DO 
    1113       ENDIF 
    1114  
    1115 #if ! defined key_lim2 && ! defined key_lim3 
    1116       CALL wrk_dealloc(jpi,jpj,frld)  
    1117 #endif 
     900 
     901      ENDIF 
     902 
     903      CALL wrk_dealloc( jpi, jpj, jpk, zprofvar1 ) 
     904      CALL wrk_dealloc( jpi, jpj, jpk, zprofvar2 ) 
     905      CALL wrk_dealloc( jpi, jpj, jpk, zprofmask1 ) 
     906      CALL wrk_dealloc( jpi, jpj, jpk, zprofmask2 ) 
     907      CALL wrk_dealloc( jpi, jpj, zsurfvar ) 
     908      CALL wrk_dealloc( jpi, jpj, zsurfmask ) 
     909      CALL wrk_dealloc( jpi, jpj, zglam1 ) 
     910      CALL wrk_dealloc( jpi, jpj, zglam2 ) 
     911      CALL wrk_dealloc( jpi, jpj, zgphi1 ) 
     912      CALL wrk_dealloc( jpi, jpj, zgphi2 ) 
    1118913 
    1119914   END SUBROUTINE dia_obs 
    1120    
    1121    SUBROUTINE dia_obs_wri  
     915 
     916   SUBROUTINE dia_obs_wri 
    1122917      !!---------------------------------------------------------------------- 
    1123918      !!                    ***  ROUTINE dia_obs_wri  *** 
    … …  
    1127922      !! ** Method  : Call observation diagnostic output routines 
    1128923      !! 
    1129       !! ** Action  :  
     924      !! ** Action  : 
    1130925      !! 
    1131926      !! History : 
    … …  
    1135930      !!        !  07-03  (K. Mogensen) General handling of profiles 
    1136931      !!        !  08-09  (M. Valdivieso) Velocity component (U,V) profiles 
    1137       !!---------------------------------------------------------------------- 
     932      !!        !  15-08  (M. Martin) Combined writing for prof and surf types 
     933      !!---------------------------------------------------------------------- 
     934      !! * Modules used 
     935      USE obs_rot_vel          ! Rotation of velocities 
     936 
    1138937      IMPLICIT NONE 
    1139938 
    1140939      !! * Local declarations 
    1141  
    1142       INTEGER :: jprofset                 ! Profile data set loop variable 
    1143       INTEGER :: jveloset                 ! Velocity data set loop variable 
    1144       INTEGER :: jslaset                  ! SLA data set loop variable 
    1145       INTEGER :: jsstset                  ! SST data set loop variable 
    1146       INTEGER :: jseaiceset               ! Sea Ice data set loop variable 
    1147       INTEGER :: jset 
    1148       INTEGER :: jfbini 
    1149       CHARACTER(LEN=20) :: datestr=" ",timestr=" " 
    1150       CHARACTER(LEN=10) :: cdtmp 
     940      INTEGER :: jtype                    ! Data set loop variable 
     941      INTEGER :: jo, jvar, jk 
     942      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
     943         & zu, & 
     944         & zv 
     945 
    1151946      !----------------------------------------------------------------------- 
    1152947      ! Depending on switches call various observation output routines 
    1153948      !----------------------------------------------------------------------- 
    1154949 
    1155       !  - Temperature/salinity profiles 
    1156  
    1157       IF( ln_t3d .OR. ln_s3d ) THEN 
    1158  
    1159          ! Copy data from prodatqc to profdata structures 
    1160          DO jprofset = 1, nprofsets 
    1161  
    1162             CALL obs_prof_decompress( prodatqc(jprofset), & 
    1163                  &                    profdata(jprofset), .TRUE., numout ) 
     950      IF ( nproftypes > 0 ) THEN 
     951 
     952         DO jtype = 1, nproftypes 
     953 
     954            IF ( TRIM(cobstypesprof(jtype)) == 'vel' ) THEN 
     955 
     956               ! For velocity data, rotate the model velocities to N/S, E/W 
     957               ! using the compressed data structure. 
     958               ALLOCATE( & 
     959                  & zu(profdataqc(jtype)%nvprot(1)), & 
     960                  & zv(profdataqc(jtype)%nvprot(2))  & 
     961                  & ) 
     962 
     963               CALL obs_rotvel( profdataqc(jtype), nn_2dint, zu, zv ) 
     964 
     965               DO jo = 1, profdataqc(jtype)%nprof 
     966                  DO jvar = 1, 2 
     967                     DO jk = profdataqc(jtype)%npvsta(jo,jvar), profdataqc(jtype)%npvend(jo,jvar) 
     968 
     969                        IF ( jvar == 1 ) THEN 
     970                           profdataqc(jtype)%var(jvar)%vmod(jk) = zu(jk) 
     971                        ELSE 
     972                           profdataqc(jtype)%var(jvar)%vmod(jk) = zv(jk) 
     973                        ENDIF 
     974 
     975                     END DO 
     976                  END DO 
     977               END DO 
     978 
     979               DEALLOCATE( zu ) 
     980               DEALLOCATE( zv ) 
     981 
     982            END IF 
     983 
     984            CALL obs_prof_decompress( profdataqc(jtype), & 
     985               &                      profdata(jtype), .TRUE., numout ) 
     986 
     987            CALL obs_wri_prof( profdata(jtype) ) 
    1164988 
    1165989         END DO 
    1166990 
    1167          ! Write the profiles. 
    1168  
    1169          jprofset = 0 
    1170  
    1171          ! ENACT insitu data 
    1172  
    1173          IF ( ln_ena ) THEN 
    1174             
    1175             jprofset = jprofset + 1 
    1176  
    1177             CALL obs_wri_p3d( 'enact', profdata(jprofset) ) 
    1178  
    1179          ENDIF 
    1180  
    1181          ! Coriolis insitu data 
    1182  
    1183          IF ( ln_cor ) THEN 
    1184              
    1185             jprofset = jprofset + 1 
    1186  
    1187             CALL obs_wri_p3d( 'corio', profdata(jprofset) ) 
    1188              
    1189          ENDIF 
    1190           
    1191          ! Feedback insitu data 
    1192  
    1193          IF ( ln_profb ) THEN 
    1194  
    1195             jfbini = jprofset + 1 
    1196  
    1197             DO jprofset = jfbini, nprofsets 
    1198                 
    1199                jset = jprofset - jfbini + 1 
    1200                WRITE(cdtmp,'(A,I2.2)')'profb_',jset 
    1201                CALL obs_wri_p3d( cdtmp, profdata(jprofset) ) 
    1202  
    1203             END DO 
    1204  
    1205          ENDIF 
    1206  
    1207       ENDIF 
    1208  
    1209       !  - Sea surface anomaly 
    1210       IF ( ln_sla ) THEN 
    1211  
    1212          ! Copy data from sladatqc to sladata structures 
    1213          DO jslaset = 1, nslasets 
    1214  
    1215               CALL obs_surf_decompress( sladatqc(jslaset), & 
    1216                  &                    sladata(jslaset), .TRUE., numout ) 
     991      ENDIF 
     992 
     993      IF ( nsurftypes > 0 ) THEN 
     994 
     995         DO jtype = 1, nsurftypes 
     996 
     997            CALL obs_surf_decompress( surfdataqc(jtype), & 
     998               &                      surfdata(jtype), .TRUE., numout ) 
     999 
     1000            CALL obs_wri_surf( surfdata(jtype) ) 
    12171001 
    12181002         END DO 
    12191003 
    1220          jslaset = 0  
    1221  
    1222          ! Write the AVISO SLA data 
    1223  
    1224          IF ( ln_sladt ) THEN 
    1225              
    1226             jslaset = 1 
    1227             CALL obs_wri_sla( 'aviso_act', sladata(jslaset) ) 
    1228             jslaset = 2 
    1229             CALL obs_wri_sla( 'aviso_pas', sladata(jslaset) ) 
    1230  
    1231          ENDIF 
    1232  
    1233          IF ( ln_slafb ) THEN 
    1234              
    1235             jfbini = jslaset + 1 
    1236  
    1237             DO jslaset = jfbini, nslasets 
    1238                 
    1239                jset = jslaset - jfbini + 1 
    1240                WRITE(cdtmp,'(A,I2.2)')'slafb_',jset 
    1241                CALL obs_wri_sla( cdtmp, sladata(jslaset) ) 
    1242  
    1243             END DO 
    1244  
    1245          ENDIF 
    1246  
    1247       ENDIF 
    1248  
    1249       !  - Sea surface temperature 
    1250       IF ( ln_sst ) THEN 
    1251  
    1252          ! Copy data from sstdatqc to sstdata structures 
    1253          DO jsstset = 1, nsstsets 
    1254       
    1255               CALL obs_surf_decompress( sstdatqc(jsstset), & 
    1256                  &                    sstdata(jsstset), .TRUE., numout ) 
    1257  
    1258          END DO 
    1259  
    1260          jsstset = 0  
    1261  
    1262          ! Write the AVISO SST data 
    1263  
    1264          IF ( ln_reysst ) THEN 
    1265              
    1266             jsstset = jsstset + 1 
    1267             CALL obs_wri_sst( 'reynolds', sstdata(jsstset) ) 
    1268  
    1269          ENDIF 
    1270  
    1271          IF ( ln_ghrsst ) THEN 
    1272              
    1273             jsstset = jsstset + 1 
    1274             CALL obs_wri_sst( 'ghr', sstdata(jsstset) ) 
    1275  
    1276          ENDIF 
    1277  
    1278          IF ( ln_sstfb ) THEN 
    1279              
    1280             jfbini = jsstset + 1 
    1281  
    1282             DO jsstset = jfbini, nsstsets 
    1283                 
    1284                jset = jsstset - jfbini + 1 
    1285                WRITE(cdtmp,'(A,I2.2)')'sstfb_',jset 
    1286                CALL obs_wri_sst( cdtmp, sstdata(jsstset) ) 
    1287  
    1288             END DO 
    1289  
    1290          ENDIF 
    1291  
    1292       ENDIF 
    1293  
    1294       !  - Sea surface salinity 
    1295       IF ( ln_sss ) THEN 
    1296          IF(lwp) WRITE(numout,*) ' SSS currently not available' 
    1297       ENDIF 
    1298  
    1299       !  - Sea Ice Concentration 
    1300       IF ( ln_seaice ) THEN 
    1301  
    1302          ! Copy data from seaicedatqc to seaicedata structures 
    1303          DO jseaiceset = 1, nseaicesets 
    1304  
    1305               CALL obs_surf_decompress( seaicedatqc(jseaiceset), & 
    1306                  &                    seaicedata(jseaiceset), .TRUE., numout ) 
    1307  
    1308          END DO 
    1309  
    1310          ! Write the Sea Ice data 
    1311          DO jseaiceset = 1, nseaicesets 
    1312        
    1313             WRITE(cdtmp,'(A,I2.2)')'seaicefb_',jseaiceset 
    1314             CALL obs_wri_seaice( cdtmp, seaicedata(jseaiceset) ) 
    1315  
    1316          END DO 
    1317  
    1318       ENDIF 
    1319        
    1320       ! Velocity data 
    1321       IF( ln_vel3d ) THEN 
    1322  
    1323          ! Copy data from veldatqc to velodata structures 
    1324          DO jveloset = 1, nvelosets 
    1325  
    1326             CALL obs_prof_decompress( veldatqc(jveloset), & 
    1327                  &                    velodata(jveloset), .TRUE., numout ) 
    1328  
    1329          END DO 
    1330  
    1331          ! Write the profiles. 
    1332  
    1333          jveloset = 0 
    1334  
    1335          ! Daily averaged data 
    1336  
    1337          IF ( ln_velavcur ) THEN 
    1338              
    1339             jveloset = jveloset + 1 
    1340  
    1341             CALL obs_wri_vel( 'velavcurr', velodata(jveloset), n2dint ) 
    1342  
    1343          ENDIF 
    1344  
    1345          ! High frequency data 
    1346  
    1347          IF ( ln_velhrcur ) THEN 
    1348              
    1349             jveloset = jveloset + 1 
    1350  
    1351             CALL obs_wri_vel( 'velhrcurr', velodata(jveloset), n2dint ) 
    1352  
    1353          ENDIF 
    1354  
    1355          ! Daily averaged data 
    1356  
    1357          IF ( ln_velavadcp ) THEN 
    1358              
    1359             jveloset = jveloset + 1 
    1360  
    1361             CALL obs_wri_vel( 'velavadcp', velodata(jveloset), n2dint ) 
    1362  
    1363          ENDIF 
    1364  
    1365          ! High frequency data 
    1366  
    1367          IF ( ln_velhradcp ) THEN 
    1368              
    1369             jveloset = jveloset + 1 
    1370              
    1371             CALL obs_wri_vel( 'velhradcp', velodata(jveloset), n2dint ) 
    1372                 
    1373          ENDIF 
    1374  
    1375          ! Feedback velocity data 
    1376  
    1377          IF ( ln_velfb ) THEN 
    1378  
    1379             jfbini = jveloset + 1 
    1380  
    1381             DO jveloset = jfbini, nvelosets 
    1382                 
    1383                jset = jveloset - jfbini + 1 
    1384                WRITE(cdtmp,'(A,I2.2)')'velfb_',jset 
    1385                CALL obs_wri_vel( cdtmp, velodata(jveloset), n2dint ) 
    1386  
    1387             END DO 
    1388  
    1389          ENDIF 
    1390           
    13911004      ENDIF 
    13921005 
    … …  
    14061019      !! 
    14071020      !!---------------------------------------------------------------------- 
    1408       !! obs_grid deallocation 
     1021      ! obs_grid deallocation 
    14091022      CALL obs_grid_deallocate 
    14101023 
    1411       !! diaobs deallocation 
    1412       IF ( nprofsets > 0 ) THEN 
    1413           DEALLOCATE(ld_enact, & 
    1414                   &  profdata, & 
    1415                   &  prodatqc) 
    1416       END IF 
    1417       IF ( ln_sla ) THEN 
    1418           DEALLOCATE(sladata, & 
    1419                   &  sladatqc) 
    1420       END IF 
    1421       IF ( ln_seaice ) THEN 
    1422           DEALLOCATE(sladata, & 
    1423                   &  sladatqc) 
    1424       END IF 
    1425       IF ( ln_sst ) THEN 
    1426           DEALLOCATE(sstdata, & 
    1427                   &  sstdatqc) 
    1428       END IF 
    1429       IF ( ln_vel3d ) THEN 
    1430           DEALLOCATE(ld_velav, & 
    1431                   &  velodata, & 
    1432                   &  veldatqc) 
    1433       END IF 
     1024      ! diaobs deallocation 
     1025      IF ( nproftypes > 0 ) & 
     1026         &   DEALLOCATE( cobstypesprof, profdata, profdataqc, nvarsprof, nextrprof ) 
     1027 
     1028      IF ( nsurftypes > 0 ) & 
     1029         &   DEALLOCATE( cobstypessurf, surfdata, surfdataqc, nvarssurf, nextrsurf, & 
     1030         &               n2dintsurf, ravglamscl, ravgphiscl, lfpindegs, llnightav ) 
     1031 
    14341032   END SUBROUTINE dia_obs_dealloc 
    14351033 
    … …  
    14541052      USE phycst, ONLY : &            ! Physical constants 
    14551053         & rday 
    1456 !      USE daymod, ONLY : &            ! Time variables 
    1457 !         & nmonth_len            
    14581054      USE dom_oce, ONLY : &           ! Ocean space and time domain variables 
    14591055         & rdt 
    … …  
    14721068      INTEGER :: imin 
    14731069      INTEGER :: imday         ! Number of days in month. 
    1474       REAL(KIND=wp) :: zdayfrc ! Fraction of day 
     1070      REAL(wp) :: zdayfrc ! Fraction of day 
    14751071 
    14761072      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year 
    14771073 
    1478       !!---------------------------------------------------------------------- 
    1479       !! Initial date initialization (year, month, day, hour, minute) 
    1480       !!---------------------------------------------------------------------- 
     1074      !---------------------------------------------------------------------- 
     1075      ! Initial date initialization (year, month, day, hour, minute) 
     1076      !---------------------------------------------------------------------- 
    14811077      iyea =   ndate0 / 10000 
    14821078      imon = ( ndate0 - iyea * 10000 ) / 100 
    … …  
    14851081      imin = ( nn_time0 - ihou * 100 )  
    14861082 
    1487       !!---------------------------------------------------------------------- 
    1488       !! Compute number of days + number of hours + min since initial time 
    1489       !!---------------------------------------------------------------------- 
     1083      !---------------------------------------------------------------------- 
     1084      ! Compute number of days + number of hours + min since initial time 
     1085      !---------------------------------------------------------------------- 
    14901086      zdayfrc = kstp * rdt / rday 
    14911087      zdayfrc = zdayfrc - aint(zdayfrc) 
    … …  
    15011097      iday = iday + kstp * rdt / rday  
    15021098 
    1503       !!----------------------------------------------------------------------- 
    1504       !! Convert number of days (iday) into a real date 
    1505       !!---------------------------------------------------------------------- 
     1099      !----------------------------------------------------------------------- 
     1100      ! Convert number of days (iday) into a real date 
     1101      !---------------------------------------------------------------------- 
    15061102 
    15071103      CALL calc_month_len( iyea, imonth_len ) 
    … …  
    15171113      END DO 
    15181114 
    1519       !!---------------------------------------------------------------------- 
    1520       !! Convert it into YYYYMMDD.HHMMSS format. 
    1521       !!---------------------------------------------------------------------- 
     1115      !---------------------------------------------------------------------- 
     1116      ! Convert it into YYYYMMDD.HHMMSS format. 
     1117      !---------------------------------------------------------------------- 
    15221118      ddobs = iyea * 10000_dp + imon * 100_dp + & 
    15231119         &    iday + ihou * 0.01_dp + imin * 0.0001_dp 
    … …  
    15281124      !!---------------------------------------------------------------------- 
    15291125      !!                    ***  ROUTINE ini_date  *** 
    1530       !!           
    1531       !! ** Purpose : Get initial data in double precision YYYYMMDD.HHMMSS format 
    1532       !! 
    1533       !! ** Method  : Get initial data in double precision YYYYMMDD.HHMMSS format 
    1534       !! 
    1535       !! ** Action  : Get initial data in double precision YYYYMMDD.HHMMSS format 
     1126      !! 
     1127      !! ** Purpose : Get initial date in double precision YYYYMMDD.HHMMSS format 
     1128      !! 
     1129      !! ** Method  : Get initial date in double precision YYYYMMDD.HHMMSS format 
     1130      !! 
     1131      !! ** Action  : Get initial date in double precision YYYYMMDD.HHMMSS format 
    15361132      !! 
    15371133      !! History : 
    … …  
    15461142 
    15471143      !! * Arguments 
    1548       REAL(KIND=dp), INTENT(OUT) :: ddobsini                   ! Initial date in YYYYMMDD.HHMMSS 
     1144      REAL(dp), INTENT(OUT) :: ddobsini  ! Initial date in YYYYMMDD.HHMMSS 
    15491145 
    15501146      CALL calc_date( nit000 - 1, ddobsini ) 
    … …  
    15551151      !!---------------------------------------------------------------------- 
    15561152      !!                    ***  ROUTINE fin_date  *** 
    1557       !!           
    1558       !! ** Purpose : Get final data in double precision YYYYMMDD.HHMMSS format 
    1559       !! 
    1560       !! ** Method  : Get final data in double precision YYYYMMDD.HHMMSS format 
    1561       !! 
    1562       !! ** Action  : Get final data in double precision YYYYMMDD.HHMMSS format 
     1153      !! 
     1154      !! ** Purpose : Get final date in double precision YYYYMMDD.HHMMSS format 
     1155      !! 
     1156      !! ** Method  : Get final date in double precision YYYYMMDD.HHMMSS format 
     1157      !! 
     1158      !! ** Action  : Get final date in double precision YYYYMMDD.HHMMSS format 
    15631159      !! 
    15641160      !! History : 
    … …  
    15721168 
    15731169      !! * Arguments 
    1574       REAL(KIND=dp), INTENT(OUT) :: ddobsfin                  ! Final date in YYYYMMDD.HHMMSS 
     1170      REAL(dp), INTENT(OUT) :: ddobsfin ! Final date in YYYYMMDD.HHMMSS 
    15751171 
    15761172      CALL calc_date( nitend, ddobsfin ) 
    15771173 
    1578    END SUBROUTINE fin_date 
    1579     
     1174    END SUBROUTINE fin_date 
     1175 
     1176    SUBROUTINE obs_settypefiles( ntypes, jpmaxnfiles, jtype, ctypein, & 
     1177       &                         cfilestype, ifiles, cobstypes, cfiles ) 
     1178 
     1179    INTEGER, INTENT(IN) :: ntypes      ! Total number of obs types 
     1180    INTEGER, INTENT(IN) :: jpmaxnfiles ! Maximum number of files allowed for each type 
     1181    INTEGER, INTENT(IN) :: jtype       ! Index of the current type of obs 
     1182    INTEGER, DIMENSION(ntypes), INTENT(INOUT) :: & 
     1183       &                   ifiles      ! Out appended number of files for this type 
     1184 
     1185    CHARACTER(len=6), INTENT(IN) :: ctypein  
     1186    CHARACTER(len=128), DIMENSION(jpmaxnfiles), INTENT(IN) :: & 
     1187       &                   cfilestype  ! In list of files for this obs type 
     1188    CHARACTER(len=6), DIMENSION(ntypes), INTENT(INOUT) :: & 
     1189       &                   cobstypes   ! Out appended list of obs types 
     1190    CHARACTER(len=128), DIMENSION(ntypes, jpmaxnfiles), INTENT(INOUT) :: & 
     1191       &                   cfiles      ! Out appended list of files for all types 
     1192 
     1193    !Local variables 
     1194    INTEGER :: jfile 
     1195 
     1196    cfiles(jtype,:) = cfilestype(:) 
     1197    cobstypes(jtype) = ctypein 
     1198    ifiles(jtype) = 0 
     1199    DO jfile = 1, jpmaxnfiles 
     1200       IF ( trim(cfiles(jtype,jfile)) /= '' ) & 
     1201                 ifiles(jtype) = ifiles(jtype) + 1 
     1202    END DO 
     1203 
     1204    IF ( ifiles(jtype) == 0 ) THEN 
     1205         CALL ctl_stop( 'Logical for observation type '//TRIM(ctypein)//   & 
     1206            &           ' set to true but no files available to read' ) 
     1207    ENDIF 
     1208 
     1209    IF(lwp) THEN     
     1210       WRITE(numout,*) '             '//cobstypes(jtype)//' input observation file names:' 
     1211       DO jfile = 1, ifiles(jtype) 
     1212          WRITE(numout,*) '                '//TRIM(cfiles(jtype,jfile)) 
     1213       END DO 
     1214    ENDIF 
     1215 
     1216    END SUBROUTINE obs_settypefiles 
     1217 
     1218    SUBROUTINE obs_setinterpopts( ntypes, jtype, ctypein,             & 
     1219               &                  n2dint_default, n2dint_type,        & 
     1220               &                  ravglamscl_type, ravgphiscl_type,   & 
     1221               &                  lfp_indegs_type, lavnight_type,     & 
     1222               &                  n2dint, ravglamscl, ravgphiscl,     & 
     1223               &                  lfpindegs, lavnight ) 
     1224 
     1225    INTEGER, INTENT(IN)  :: ntypes             ! Total number of obs types 
     1226    INTEGER, INTENT(IN)  :: jtype              ! Index of the current type of obs 
     1227    INTEGER, INTENT(IN)  :: n2dint_default     ! Default option for interpolation type 
     1228    INTEGER, INTENT(IN)  :: n2dint_type        ! Option for interpolation type 
     1229    REAL(wp), INTENT(IN) :: & 
     1230       &                    ravglamscl_type, & !E/W diameter of obs footprint for this type 
     1231       &                    ravgphiscl_type    !N/S diameter of obs footprint for this type 
     1232    LOGICAL, INTENT(IN)  :: lfp_indegs_type    !T=> footprint in degrees, F=> in metres 
     1233    LOGICAL, INTENT(IN)  :: lavnight_type      !T=> obs represent night time average 
     1234    CHARACTER(len=6), INTENT(IN) :: ctypein  
     1235 
     1236    INTEGER, DIMENSION(ntypes), INTENT(INOUT) :: & 
     1237       &                    n2dint  
     1238    REAL(wp), DIMENSION(ntypes), INTENT(INOUT) :: & 
     1239       &                    ravglamscl, ravgphiscl 
     1240    LOGICAL, DIMENSION(ntypes), INTENT(INOUT) :: & 
     1241       &                    lfpindegs, lavnight 
     1242 
     1243    lavnight(jtype) = lavnight_type 
     1244 
     1245    IF ( (n2dint_type >= 1) .AND. (n2dint_type <= 6) ) THEN 
     1246       n2dint(jtype) = n2dint_type 
     1247    ELSE 
     1248       n2dint(jtype) = n2dint_default 
     1249    ENDIF 
     1250 
     1251    ! For averaging observation footprints set options for size of footprint  
     1252    IF ( (n2dint(jtype) > 4) .AND. (n2dint(jtype) <= 6) ) THEN 
     1253       IF ( ravglamscl_type > 0._wp ) THEN 
     1254          ravglamscl(jtype) = ravglamscl_type 
     1255       ELSE 
     1256          CALL ctl_stop( 'Incorrect value set for averaging footprint '// & 
     1257                         'scale (ravglamscl) for observation type '//TRIM(ctypein) )       
     1258       ENDIF 
     1259 
     1260       IF ( ravgphiscl_type > 0._wp ) THEN 
     1261          ravgphiscl(jtype) = ravgphiscl_type 
     1262       ELSE 
     1263          CALL ctl_stop( 'Incorrect value set for averaging footprint '// & 
     1264                         'scale (ravgphiscl) for observation type '//TRIM(ctypein) )       
     1265       ENDIF 
     1266 
     1267       lfpindegs(jtype) = lfp_indegs_type  
     1268 
     1269    ENDIF 
     1270 
     1271    ! Write out info  
     1272    IF(lwp) THEN 
     1273       IF ( n2dint(jtype) <= 4 ) THEN 
     1274          WRITE(numout,*) '             '//TRIM(ctypein)// & 
     1275             &            ' model counterparts will be interpolated horizontally' 
     1276       ELSE IF ( n2dint(jtype) <= 6 ) THEN 
     1277          WRITE(numout,*) '             '//TRIM(ctypein)// & 
     1278             &            ' model counterparts will be averaged horizontally' 
     1279          WRITE(numout,*) '             '//'    with E/W scale: ',ravglamscl(jtype) 
     1280          WRITE(numout,*) '             '//'    with N/S scale: ',ravgphiscl(jtype) 
     1281          IF ( lfpindegs(jtype) ) THEN 
     1282              WRITE(numout,*) '             '//'    (in degrees)' 
     1283          ELSE 
     1284              WRITE(numout,*) '             '//'    (in metres)' 
     1285          ENDIF 
     1286       ENDIF 
     1287    ENDIF 
     1288 
     1289    END SUBROUTINE obs_setinterpopts 
     1290 
    15801291END MODULE diaobs 

  • branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grd_bruteforce.h90

    r2358 r10120  
    325325         CALL obs_mpp_max_integer( kobsj, kobs ) 
    326326      ELSE 
    327          CALL obs_mpp_find_obs_proc( kproc, kobsi, kobsj, kobs ) 
     327         CALL obs_mpp_find_obs_proc( kproc,kobs ) 
    328328      ENDIF 
    329329 

  • branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90

    r6486 r10120  
    5252 
    5353   !! Default values 
    54    REAL, PUBLIC :: grid_search_res = 0.5    ! Resolution of grid 
     54   REAL, PUBLIC :: rn_gridsearchres = 0.5   ! Resolution of grid 
    5555   INTEGER, PRIVATE :: gsearch_nlons_def    ! Num of longitudes 
    5656   INTEGER, PRIVATE :: gsearch_nlats_def    ! Num of latitudes 
    … …  
    8383   LOGICAL, PUBLIC :: ln_grid_global         ! Use global distribution of observations 
    8484   CHARACTER(LEN=44), PUBLIC :: & 
    85       & grid_search_file    ! file name head for grid search lookup  
     85      & cn_gridsearchfile    ! file name head for grid search lookup  
    8686 
    8787   !!---------------------------------------------------------------------- 
    … …  
    613613         CALL obs_mpp_max_integer( kobsj, kobs ) 
    614614      ELSE 
    615          CALL obs_mpp_find_obs_proc( kproc, kobsi, kobsj, kobs ) 
     615         CALL obs_mpp_find_obs_proc( kproc, kobs ) 
    616616      ENDIF 
    617617 
    … …  
    690690          
    691691         IF(lwp) WRITE(numout,*) 
    692          IF(lwp) WRITE(numout,*)'Grid search resolution : ', grid_search_res 
    693           
    694          gsearch_nlons_def  = NINT( 360.0_wp / grid_search_res )  
    695          gsearch_nlats_def  = NINT( 180.0_wp / grid_search_res ) 
    696          gsearch_lonmin_def = -180.0_wp + 0.5_wp * grid_search_res 
    697          gsearch_latmin_def =  -90.0_wp + 0.5_wp * grid_search_res 
    698          gsearch_dlon_def   = grid_search_res 
    699          gsearch_dlat_def   = grid_search_res 
     692         IF(lwp) WRITE(numout,*)'Grid search resolution : ', rn_gridsearchres 
     693          
     694         gsearch_nlons_def  = NINT( 360.0_wp / rn_gridsearchres )  
     695         gsearch_nlats_def  = NINT( 180.0_wp / rn_gridsearchres ) 
     696         gsearch_lonmin_def = -180.0_wp + 0.5_wp * rn_gridsearchres 
     697         gsearch_latmin_def =  -90.0_wp + 0.5_wp * rn_gridsearchres 
     698         gsearch_dlon_def   = rn_gridsearchres 
     699         gsearch_dlat_def   = rn_gridsearchres 
    700700          
    701701         IF (lwp) THEN 
    … …  
    710710         IF ( ln_grid_global ) THEN 
    711711            WRITE(cfname, FMT="(A,'_',A)") & 
    712                &          TRIM(grid_search_file), 'global.nc' 
     712               &          TRIM(cn_gridsearchfile), 'global.nc' 
    713713         ELSE 
    714714            WRITE(cfname, FMT="(A,'_',I4.4,'of',I4.4,'by',I4.4,'.nc')") & 
    715                &          TRIM(grid_search_file), nproc, jpni, jpnj 
     715               &          TRIM(cn_gridsearchfile), nproc, jpni, jpnj 
    716716         ENDIF 
    717717 

  • branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90

    r6486 r10120  
    3535CONTAINS 
    3636 
    37    SUBROUTINE obs_int_comm_3d( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, & 
     37   SUBROUTINE obs_int_comm_3d( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, & 
    3838      &                        pval, pgval, kproc ) 
    3939      !!---------------------------------------------------------------------- 
    … …  
    5757      INTEGER, INTENT(IN) :: kptsj     ! Number of j horizontal points per stencil 
    5858      INTEGER, INTENT(IN) :: kobs      ! Local number of observations 
     59      INTEGER, INTENT(IN) :: kpi       ! Number of points in i direction 
     60      INTEGER, INTENT(IN) :: kpj       ! Number of points in j direction 
    5961      INTEGER, INTENT(IN) :: kpk       ! Number of levels 
    6062      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    … …  
    6365      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    6466         & kproc            ! Precomputed processor for each i,j,iobs points 
    65       REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::& 
     67      REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) ::& 
    6668         & pval             ! Local 3D array to extract data from 
    6769      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::& 
    … …  
    7375         IF (PRESENT(kproc)) THEN 
    7476 
    75             CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, & 
     77            CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, & 
    7678               &                         kgrdj, pval, pgval, kproc=kproc ) 
    7779 
    7880         ELSE 
    7981 
    80             CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, & 
     82            CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, & 
    8183               &                         kgrdj, pval, pgval ) 
    8284 
    … …  
    8587      ELSE 
    8688 
    87          CALL obs_int_comm_3d_local( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, & 
     89         CALL obs_int_comm_3d_local( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, & 
    8890            &                        pval, pgval ) 
    8991 
    … …  
    9294   END SUBROUTINE obs_int_comm_3d 
    9395 
    94    SUBROUTINE obs_int_comm_2d( kptsi, kptsj, kobs, kgrdi, kgrdj, pval, pgval, & 
     96   SUBROUTINE obs_int_comm_2d( kptsi, kptsj, kobs, kpi, kpj, kgrdi, kgrdj, pval, pgval, & 
    9597      &                        kproc ) 
    9698      !!---------------------------------------------------------------------- 
    … …  
    111113      INTEGER, INTENT(IN) :: kptsj        ! Number of j horizontal points per stencil 
    112114      INTEGER, INTENT(IN) :: kobs          ! Local number of observations 
     115      INTEGER, INTENT(IN) :: kpi          ! Number of model grid points in i direction 
     116      INTEGER, INTENT(IN) :: kpj          ! Number of model grid points in j direction 
    113117      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    114118         & kgrdi, &         ! i,j indicies for each stencil 
    … …  
    116120      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    117121         & kproc            ! Precomputed processor for each i,j,iobs points 
    118       REAL(KIND=wp), DIMENSION(jpi,jpj), INTENT(IN) ::& 
     122      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) ::& 
    119123         & pval             ! Local 3D array to extra data from 
    120124      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kobs), INTENT(OUT) ::& 
    … …  
    136140      IF (PRESENT(kproc)) THEN 
    137141 
    138          CALL obs_int_comm_3d( kptsi, kptsj, kobs, 1, kgrdi, kgrdj, zval, & 
     142         CALL obs_int_comm_3d( kptsi, kptsj, kobs, kpi, kpj, 1, kgrdi, kgrdj, zval, & 
    139143            &                  zgval, kproc=kproc ) 
    140144      ELSE 
    141145 
    142          CALL obs_int_comm_3d( kptsi, kptsj, kobs, 1, kgrdi, kgrdj, zval, & 
     146         CALL obs_int_comm_3d( kptsi, kptsj, kobs, kpi, kpj, 1, kgrdi, kgrdj, zval, & 
    143147            &                  zgval ) 
    144148 
    … …  
    154158   END SUBROUTINE obs_int_comm_2d 
    155159 
    156    SUBROUTINE obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, & 
     160   SUBROUTINE obs_int_comm_3d_global( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, & 
    157161      &                               pval, pgval, kproc ) 
    158162      !!---------------------------------------------------------------------- 
    … …  
    174178      INTEGER, INTENT(IN) :: kptsj     ! Number of j horizontal points per stencil 
    175179      INTEGER, INTENT(IN) :: kobs      ! Local number of observations 
     180      INTEGER, INTENT(IN) :: kpi       ! Number of model points in i direction 
     181      INTEGER, INTENT(IN) :: kpj       ! Number of model points in j direction 
    176182      INTEGER, INTENT(IN) :: kpk       ! Number of levels 
    177183      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    … …  
    180186      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    181187         & kproc            ! Precomputed processor for each i,j,iobs points 
    182       REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::& 
     188      REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) ::& 
    183189         & pval             ! Local 3D array to extract data from 
    184190      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::& 
    … …  
    207213 
    208214      ! Check valid points 
    209        
     215 
    210216      IF ( ( MAXVAL(kgrdi) > jpiglo ) .OR. ( MINVAL(kgrdi) < 1 ) .OR. & 
    211217         & ( MAXVAL(kgrdj) > jpjglo ) .OR. ( MINVAL(kgrdj) < 1 ) ) THEN 
    212           
     218 
    213219         CALL ctl_stop( 'Error in obs_int_comm_3d_global', & 
    214220            &           'Point outside global domain' ) 
    215           
     221 
    216222      ENDIF 
    217223 
    … …  
    323329   END SUBROUTINE obs_int_comm_3d_global 
    324330    
    325    SUBROUTINE obs_int_comm_3d_local( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, & 
     331   SUBROUTINE obs_int_comm_3d_local( kptsi, kptsj, kobs, kpi, kpj, kpk, kgrdi, kgrdj, & 
    326332      &                              pval, pgval ) 
    327333      !!---------------------------------------------------------------------- 
    … …  
    343349      INTEGER, INTENT(IN) :: kptsj        ! Number of j horizontal points per stencil 
    344350      INTEGER, INTENT(IN) :: kobs         ! Local number of observations 
     351      INTEGER, INTENT(IN) :: kpi          ! Number of model points in i direction 
     352      INTEGER, INTENT(IN) :: kpj          ! Number of model points in j direction 
    345353      INTEGER, INTENT(IN) :: kpk          ! Number of levels 
    346354      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: & 
    347355         & kgrdi, &         ! i,j indicies for each stencil 
    348356         & kgrdj 
    349       REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::& 
     357      REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) ::& 
    350358         & pval             ! Local 3D array to extract data from 
    351359      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::& 

  • branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90

    r6486 r10120  
    77   !!             -   ! 2006-05  (K. Mogensen)  Reformatted 
    88   !!             -   ! 2008-01  (K. Mogensen)  add mpp_global_max 
     9   !!            3.6  ! 2015-01  (J. Waters) obs_mpp_find_obs_proc  
     10   !!                            rewritten to avoid global arrays 
    911   !!---------------------------------------------------------------------- 
    1012#  define mpivar mpi_double_precision 
    … …  
    1214   !! obs_mpp_bcast_integer : Broadcast an integer array from a processor to all processors 
    1315   !! obs_mpp_max_integer   : Find maximum on all processors of each value in an integer on all processors 
    14    !! obs_mpp_find_obs_proc : Find processors which should hold the observations 
     16   !! obs_mpp_find_obs_proc : Find processors which should hold the observations, avoiding global arrays 
    1517   !! obs_mpp_sum_integers  : Sum an integer array from all processors 
    1618   !! obs_mpp_sum_integer   : Sum an integer from all processors 
    … …  
    9698      ! 
    9799      INTEGER :: ierr  
    98       INTEGER, DIMENSION(kno) ::   ivals 
    99       ! 
    100 INCLUDE 'mpif.h' 
    101       !!---------------------------------------------------------------------- 
     100      INTEGER, DIMENSION(:), ALLOCATABLE ::   ivals 
     101      ! 
     102INCLUDE 'mpif.h' 
     103      !!---------------------------------------------------------------------- 
     104 
     105      ALLOCATE( ivals(kno) ) 
    102106 
    103107      ! Call the MPI library to find the maximum across processors 
    … …  
    105109         &                mpi_max, mpi_comm_opa, ierr ) 
    106110      kvals(:) = ivals(:) 
     111 
     112      DEALLOCATE( ivals ) 
    107113#else 
    108114      ! no MPI: empty routine 
    … …  
    111117 
    112118 
    113    SUBROUTINE obs_mpp_find_obs_proc( kobsp, kobsi, kobsj, kno ) 
    114       !!---------------------------------------------------------------------- 
    115       !!               ***  ROUTINE obs_mpp_find_obs_proc *** 
    116       !!           
    117       !! ** Purpose : From the array kobsp containing the results of the grid 
     119   SUBROUTINE obs_mpp_find_obs_proc( kobsp,kno ) 
     120      !!---------------------------------------------------------------------- 
     121      !!               ***  ROUTINE obs_mpp_find_obs_proc  *** 
     122      !!          
     123      !! ** Purpose : From the array kobsp containing the results of the 
    118124      !!              grid search on each processor the processor return a 
    119125      !!              decision of which processors should hold the observation. 
    120126      !! 
    121       !! ** Method  : A temporary 2D array holding all the decisions is 
    122       !!              constructed using mpi_allgather on each processor. 
    123       !!              If more than one processor has found the observation 
    124       !!              with the observation in the inner domain gets it 
    125       !! 
    126       !! ** Action  : This does only work for MPI.  
     127      !! ** Method  : Synchronize the processor number for each obs using 
     128      !!              obs_mpp_max_integer. If an observation exists on two  
     129      !!              processors it will be allocated to the lower numbered 
     130      !!              processor. 
     131      !! 
     132      !! ** Action  : This does only work for MPI. 
    127133      !!              It does not work for SHMEM. 
    128134      !! 
    … …  
    130136      !!---------------------------------------------------------------------- 
    131137      INTEGER                , INTENT(in   ) ::   kno 
    132       INTEGER, DIMENSION(kno), INTENT(in   ) ::   kobsi, kobsj 
    133138      INTEGER, DIMENSION(kno), INTENT(inout) ::   kobsp 
    134139      ! 
    135140#if defined key_mpp_mpi 
    136141      ! 
    137       INTEGER :: ji 
    138       INTEGER :: jj 
    139       INTEGER :: size 
    140       INTEGER :: ierr 
    141       INTEGER :: iobsip 
    142       INTEGER :: iobsjp 
    143       INTEGER :: num_sus_obs 
    144       INTEGER, DIMENSION(kno) ::   iobsig, iobsjg 
    145       INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iobsp, iobsi, iobsj 
    146       !! 
    147 INCLUDE 'mpif.h' 
    148       !!---------------------------------------------------------------------- 
    149  
    150       !----------------------------------------------------------------------- 
    151       ! Call the MPI library to find the maximum accross processors 
    152       !----------------------------------------------------------------------- 
    153       CALL mpi_comm_size( mpi_comm_opa, size, ierr ) 
    154       !----------------------------------------------------------------------- 
    155       ! Convert local grids points to global grid points 
    156       !----------------------------------------------------------------------- 
     142      ! 
     143      INTEGER :: ji, isum 
     144      INTEGER, DIMENSION(:), ALLOCATABLE ::   iobsp 
     145      !! 
     146      !! 
     147 
     148      ALLOCATE( iobsp(kno) ) 
     149 
     150      iobsp(:)=kobsp(:) 
     151 
     152      WHERE( iobsp(:) == -1 ) 
     153         iobsp(:) = 9999999 
     154      END WHERE 
     155 
     156      iobsp(:)=-1*iobsp(:) 
     157 
     158      CALL obs_mpp_max_integer( iobsp, kno ) 
     159 
     160      kobsp(:)=-1*iobsp(:) 
     161 
     162      isum=0 
    157163      DO ji = 1, kno 
    158          IF ( ( kobsi(ji) >= 1 ) .AND. ( kobsi(ji) <= jpi ) .AND. & 
    159             & ( kobsj(ji) >= 1 ) .AND. ( kobsj(ji) <= jpj ) ) THEN 
    160             iobsig(ji) = mig( kobsi(ji) ) 
    161             iobsjg(ji) = mjg( kobsj(ji) ) 
    162          ELSE 
    163             iobsig(ji) = -1 
    164             iobsjg(ji) = -1 
     164         IF ( kobsp(ji) == 9999999 ) THEN 
     165            isum=isum+1 
     166            kobsp(ji)=-1 
    165167         ENDIF 
    166       END DO 
    167       !----------------------------------------------------------------------- 
    168       ! Get the decisions from all processors 
    169       !----------------------------------------------------------------------- 
    170       ALLOCATE( iobsp(kno,size) ) 
    171       ALLOCATE( iobsi(kno,size) ) 
    172       ALLOCATE( iobsj(kno,size) ) 
    173       CALL mpi_allgather( kobsp, kno, mpi_integer, & 
    174          &                iobsp, kno, mpi_integer, & 
    175          &                mpi_comm_opa, ierr ) 
    176       CALL mpi_allgather( iobsig, kno, mpi_integer, & 
    177          &                iobsi, kno, mpi_integer, & 
    178          &                mpi_comm_opa, ierr ) 
    179       CALL mpi_allgather( iobsjg, kno, mpi_integer, & 
    180          &                iobsj, kno, mpi_integer, & 
    181          &                mpi_comm_opa, ierr ) 
    182  
    183       !----------------------------------------------------------------------- 
    184       ! Find the processor with observations from the lowest processor  
    185       ! number among processors holding the observation. 
    186       !----------------------------------------------------------------------- 
    187       kobsp(:) = -1 
    188       num_sus_obs = 0 
    189       DO ji = 1, kno 
    190          DO jj = 1, size 
    191             IF ( ( kobsp(ji) == -1 ) .AND. ( iobsp(ji,jj) /= -1 ) ) THEN 
    192                kobsp(ji) = iobsp(ji,jj) 
    193                iobsip = iobsi(ji,jj) 
    194                iobsjp = iobsj(ji,jj) 
    195             ENDIF 
    196             IF ( ( kobsp(ji) /= -1 ) .AND. ( iobsp(ji,jj) /= -1 ) ) THEN 
    197                IF ( ( iobsip /= iobsi(ji,jj) ) .OR. & 
    198                   & ( iobsjp /= iobsj(ji,jj) ) ) THEN 
    199                   IF ( ( kobsp(ji) < 1000000 ) .AND. & 
    200                      & ( iobsp(ji,jj) < 1000000 ) ) THEN 
    201                      num_sus_obs=num_sus_obs+1 
    202                   ENDIF 
    203                ENDIF 
    204                IF ( mppmap(iobsip,iobsjp) /= ( kobsp(ji)+1 ) ) THEN 
    205                   IF ( ( iobsi(ji,jj) /= -1 ) .AND. & 
    206                      & ( iobsj(ji,jj) /= -1 ) ) THEN 
    207                      IF ((mppmap(iobsi(ji,jj),iobsj(ji,jj)) == (iobsp(ji,jj)+1))& 
    208                         & .OR. ( iobsp(ji,jj) < kobsp(ji) ) ) THEN 
    209                         kobsp(ji) = iobsp(ji,jj) 
    210                         iobsip = iobsi(ji,jj) 
    211                         iobsjp = iobsj(ji,jj) 
    212                      ENDIF 
    213                   ENDIF 
    214                ENDIF 
    215             ENDIF 
    216          END DO 
    217       END DO 
    218       IF (lwp) WRITE(numout,*) 'Number of suspicious observations: ',num_sus_obs 
    219  
    220       DEALLOCATE( iobsj ) 
    221       DEALLOCATE( iobsi ) 
     168      ENDDO 
     169 
     170 
     171      IF ( isum > 0 ) THEN 
     172         IF (lwp) WRITE(numout,*) isum, ' observations failed the grid search.' 
     173         IF (lwp) WRITE(numout,*)'If ln_grid_search_lookup=.TRUE., try reducing grid_search_res' 
     174      ENDIF 
     175 
    222176      DEALLOCATE( iobsp ) 
     177 
    223178#else 
    224179      ! no MPI: empty routine 
    225 #endif 
    226       ! 
     180#endif      
     181       
    227182   END SUBROUTINE obs_mpp_find_obs_proc 
    228183 

  • branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90

    r6486 r10120  
    77 
    88   !!---------------------------------------------------------------------- 
    9    !!   obs_pro_opt :    Compute the model counterpart of temperature and 
    10    !!                    salinity observations from profiles 
    11    !!   obs_sla_opt :    Compute the model counterpart of sea level anomaly 
    12    !!                    observations 
    13    !!   obs_sst_opt :    Compute the model counterpart of sea surface temperature 
    14    !!                    observations 
    15    !!   obs_sss_opt :    Compute the model counterpart of sea surface salinity 
    16    !!                    observations 
    17    !!   obs_seaice_opt : Compute the model counterpart of sea ice concentration 
    18    !!                    observations 
    19    !! 
    20    !!   obs_vel_opt :    Compute the model counterpart of zonal and meridional 
    21    !!                    components of velocity from observations. 
     9   !!   obs_prof_opt :    Compute the model counterpart of profile data 
     10   !!   obs_surf_opt :    Compute the model counterpart of surface data 
    2211   !!---------------------------------------------------------------------- 
    2312 
    24    !! * Modules used    
     13   !! * Modules used 
    2514   USE par_kind, ONLY : &         ! Precision variables 
    2615      & wp 
    2716   USE in_out_manager             ! I/O manager 
    2817   USE obs_inter_sup              ! Interpolation support 
    29    USE obs_inter_h2d, ONLY : &    ! Horizontal interpolation to the observation pt 
     18   USE obs_inter_h2d, ONLY : &    ! Horizontal interpolation to the obs pt 
    3019      & obs_int_h2d, & 
    3120      & obs_int_h2d_init 
    32    USE obs_inter_z1d, ONLY : &    ! Vertical interpolation to the observation pt 
     21   USE obs_averg_h2d, ONLY : &    ! Horizontal averaging to the obs footprint 
     22      & obs_avg_h2d, & 
     23      & obs_avg_h2d_init, & 
     24      & obs_max_fpsize 
     25   USE obs_inter_z1d, ONLY : &    ! Vertical interpolation to the obs pt 
    3326      & obs_int_z1d,    & 
    3427      & obs_int_z1d_spl 
    35    USE obs_const,  ONLY :     & 
    36       & obfillflt      ! Fillvalue    
     28   USE obs_const,  ONLY :    &    ! Obs fill value 
     29      & obfillflt 
    3730   USE dom_oce,       ONLY : & 
    38       & glamt, glamu, glamv, & 
    39       & gphit, gphiu, gphiv 
    40    USE lib_mpp,       ONLY : & 
     31      & glamt, glamf, & 
     32      & gphit, gphif 
     33   USE lib_mpp,       ONLY : &    ! Warning and stopping routines 
    4134      & ctl_warn, ctl_stop 
     35   USE sbcdcy,        ONLY : &    ! For calculation of where it is night-time 
     36      & sbc_dcy, nday_qsr 
     37   USE obs_grid,      ONLY : &  
     38      & obs_level_search      
    4239 
    4340   IMPLICIT NONE 
    … …  
    4643   PRIVATE 
    4744 
    48    PUBLIC obs_pro_opt, &  ! Compute the model counterpart of profile observations 
    49       &   obs_sla_opt, &  ! Compute the model counterpart of SLA observations 
    50       &   obs_sst_opt, &  ! Compute the model counterpart of SST observations 
    51       &   obs_sss_opt, &  ! Compute the model counterpart of SSS observations 
    52       &   obs_seaice_opt, & 
    53       &   obs_vel_opt     ! Compute the model counterpart of velocity profile data 
    54  
    55    INTEGER, PARAMETER, PUBLIC :: imaxavtypes = 20 ! Max number of daily avgd obs types 
     45   PUBLIC obs_prof_opt, &  ! Compute the model counterpart of profile obs 
     46      &   obs_surf_opt     ! Compute the model counterpart of surface obs 
     47 
     48   INTEGER, PARAMETER, PUBLIC :: & 
     49      & imaxavtypes = 20   ! Max number of daily avgd obs types 
    5650 
    5751   !!---------------------------------------------------------------------- 
    … …  
    6155   !!---------------------------------------------------------------------- 
    6256 
     57   !! * Substitutions  
     58#  include "domzgr_substitute.h90"  
    6359CONTAINS 
    6460 
    65    SUBROUTINE obs_pro_opt( prodatqc, kt, kpi, kpj, kpk, kit000, kdaystp, & 
    66       &                    ptn, psn, pgdept, ptmask, k1dint, k2dint, & 
    67       &                    kdailyavtypes ) 
     61 
     62   SUBROUTINE obs_prof_opt( prodatqc, kt, kpi, kpj, kpk,          & 
     63      &                     kit000, kdaystp,                      & 
     64      &                     pvar1, pvar2, pgdept, pgdepw,         & 
     65      &                     pmask1, pmask2,                       &   
     66      &                     plam1, plam2, pphi1, pphi2,           & 
     67      &                     k1dint, k2dint, kdailyavtypes ) 
     68 
    6869      !!----------------------------------------------------------------------- 
    6970      !! 
    … …  
    7879      !! 
    7980      !!    First, a vertical profile of horizontally interpolated model 
    80       !!    now temperatures is computed at the obs (lon, lat) point. 
     81      !!    now values is computed at the obs (lon, lat) point. 
    8182      !!    Several horizontal interpolation schemes are available: 
    8283      !!        - distance-weighted (great circle) (k2dint = 0) 
    … …  
    8687      !!        - polynomial (quadrilateral grid)  (k2dint = 4) 
    8788      !! 
    88       !!    Next, the vertical temperature profile is interpolated to the 
     89      !!    Next, the vertical profile is interpolated to the 
    8990      !!    data depth points. Two vertical interpolation schemes are 
    9091      !!    available: 
    … …  
    9697      !!    routine. 
    9798      !! 
    98       !!    For ENACT moored buoy data (e.g., TAO), the model equivalent is 
     99      !!    If the logical is switched on, the model equivalent is 
    99100      !!    a daily mean model temperature field. So, we first compute 
    100101      !!    the mean, then interpolate only at the end of the day. 
    101102      !! 
    102       !!    Note: the in situ temperature observations must be converted 
     103      !!    Note: in situ temperature observations must be converted 
    103104      !!    to potential temperature (the model variable) prior to 
    104105      !!    assimilation.  
    105       !!?????????????????????????????????????????????????????????????? 
    106       !!    INCLUDE POTENTIAL TEMP -> IN SITU TEMP IN OBS OPERATOR??? 
    107       !!?????????????????????????????????????????????????????????????? 
    108106      !! 
    109107      !! ** Action  : 
    … …  
    115113      !!      ! 07-01 (K. Mogensen) Merge of temperature and salinity 
    116114      !!      ! 07-03 (K. Mogensen) General handling of profiles 
     115      !!      ! 15-02 (M. Martin) Combined routine for all profile types 
     116      !!      ! 17-02 (M. Martin) Include generalised vertical coordinate changes 
    117117      !!----------------------------------------------------------------------- 
    118    
     118 
    119119      !! * Modules used 
    120120      USE obs_profiles_def ! Definition of storage space for profile obs. 
    … …  
    123123 
    124124      !! * Arguments 
    125       TYPE(obs_prof), INTENT(INOUT) :: prodatqc  ! Subset of profile data not failing screening 
    126       INTEGER, INTENT(IN) :: kt        ! Time step 
    127       INTEGER, INTENT(IN) :: kpi       ! Model grid parameters 
     125      TYPE(obs_prof), INTENT(INOUT) :: & 
     126         & prodatqc                  ! Subset of profile data passing QC 
     127      INTEGER, INTENT(IN) :: kt      ! Time step 
     128      INTEGER, INTENT(IN) :: kpi     ! Model grid parameters 
    128129      INTEGER, INTENT(IN) :: kpj 
    129130      INTEGER, INTENT(IN) :: kpk 
    130       INTEGER, INTENT(IN) :: kit000    ! Number of the first time step  
    131                                        !   (kit000-1 = restart time) 
    132       INTEGER, INTENT(IN) :: k1dint    ! Vertical interpolation type (see header) 
    133       INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header) 
    134       INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day                     
     131      INTEGER, INTENT(IN) :: kit000  ! Number of the first time step 
     132                                     !   (kit000-1 = restart time) 
     133      INTEGER, INTENT(IN) :: k1dint  ! Vertical interpolation type (see header) 
     134      INTEGER, INTENT(IN) :: k2dint  ! Horizontal interpolation type (see header) 
     135      INTEGER, INTENT(IN) :: kdaystp ! Number of time steps per day 
    135136      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 
    136          & ptn,    &    ! Model temperature field 
    137          & psn,    &    ! Model salinity field 
    138          & ptmask       ! Land-sea mask 
    139       REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: & 
    140          & pgdept       ! Model array of depth levels 
     137         & pvar1,    &               ! Model field 1 
     138         & pvar2,    &               ! Model field 2 
     139         & pmask1,   &               ! Land-sea mask 1 
     140         & pmask2                    ! Land-sea mask 2 
     141      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
     142         & plam1,    &               ! Model longitudes for variable 1 
     143         & plam2,    &               ! Model longitudes for variable 2 
     144         & pphi1,    &               ! Model latitudes for variable 1 
     145         & pphi2                     ! Model latitudes for variable 2 
     146      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &  
     147         & pgdept, &                 ! Model array of depth T levels  
     148         & pgdepw                    ! Model array of depth W levels  
    141149      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    142          & kdailyavtypes! Types for daily averages 
     150         & kdailyavtypes             ! Types for daily averages 
     151 
    143152      !! * Local declarations 
    144153      INTEGER ::   ji 
    … …  
    152161      INTEGER ::   iend 
    153162      INTEGER ::   iobs 
     163      INTEGER ::   iin, ijn, ikn, ik   ! looping indices over interpolation nodes  
     164      INTEGER ::   inum_obs 
    154165      INTEGER, DIMENSION(imaxavtypes) :: & 
    155166         & idailyavtypes 
     167      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
     168         & igrdi1, & 
     169         & igrdi2, & 
     170         & igrdj1, & 
     171         & igrdj2 
     172      INTEGER, ALLOCATABLE, DIMENSION(:) :: iv_indic 
     173 
    156174      REAL(KIND=wp) :: zlam 
    157175      REAL(KIND=wp) :: zphi 
    158176      REAL(KIND=wp) :: zdaystp 
    159177      REAL(KIND=wp), DIMENSION(kpk) :: & 
    160          & zobsmask, & 
     178         & zobsmask1, & 
     179         & zobsmask2, & 
    161180         & zobsk,    & 
    162181         & zobs2k 
    163       REAL(KIND=wp), DIMENSION(2,2,kpk) :: & 
     182      REAL(KIND=wp), DIMENSION(2,2,1) :: & 
     183         & zweig1, & 
     184         & zweig2, & 
    164185         & zweig 
    165186      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: & 
    166          & zmask, & 
    167          & zintt, & 
    168          & zints, & 
    169          & zinmt, & 
    170          & zinms 
     187         & zmask1, & 
     188         & zmask2, & 
     189         & zint1,  & 
     190         & zint2,  & 
     191         & zinm1,  & 
     192         & zinm2,  & 
     193         & zgdept, &  
     194         & zgdepw 
    171195      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
    172          & zglam, & 
    173          & zgphi 
    174       INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
    175          & igrdi, & 
    176          & igrdj 
     196         & zglam1, & 
     197         & zglam2, & 
     198         & zgphi1, & 
     199         & zgphi2 
     200      REAL(KIND=wp), DIMENSION(1) :: zmsk_1, zmsk_2    
     201      REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: interp_corner 
     202 
     203      LOGICAL :: ld_dailyav 
    177204 
    178205      !------------------------------------------------------------------------ 
    179206      ! Local initialization  
    180207      !------------------------------------------------------------------------ 
    181       ! ... Record and data counters 
     208      ! Record and data counters 
    182209      inrc = kt - kit000 + 2 
    183210      ipro = prodatqc%npstp(inrc) 
    184   
     211 
    185212      ! Daily average types 
     213      ld_dailyav = .FALSE. 
    186214      IF ( PRESENT(kdailyavtypes) ) THEN 
    187215         idailyavtypes(:) = kdailyavtypes(:) 
     216         IF ( ANY (idailyavtypes(:) /= -1) ) ld_dailyav = .TRUE. 
    188217      ELSE 
    189218         idailyavtypes(:) = -1 
    190219      ENDIF 
    191220 
    192       ! Initialize daily mean for first timestep 
     221      ! Daily means are calculated for values over timesteps: 
     222      !  [1 <= kt <= kdaystp], [kdaystp+1 <= kt <= 2*kdaystp], ... 
    193223      idayend = MOD( kt - kit000 + 1, kdaystp ) 
    194224 
    195       ! Added kt == 0 test to catch restart case  
    196       IF ( idayend == 1 .OR. kt == 0) THEN 
    197          IF (lwp) WRITE(numout,*) 'Reset prodatqc%vdmean on time-step: ',kt 
     225      IF ( ld_dailyav ) THEN 
     226 
     227         ! Initialize daily mean for first timestep of the day 
     228         IF ( idayend == 1 .OR. kt == 0 ) THEN 
     229            DO jk = 1, jpk 
     230               DO jj = 1, jpj 
     231                  DO ji = 1, jpi 
     232                     prodatqc%vdmean(ji,jj,jk,1) = 0.0 
     233                     prodatqc%vdmean(ji,jj,jk,2) = 0.0 
     234                  END DO 
     235               END DO 
     236            END DO 
     237         ENDIF 
     238 
    198239         DO jk = 1, jpk 
    199240            DO jj = 1, jpj 
    200241               DO ji = 1, jpi 
    201                   prodatqc%vdmean(ji,jj,jk,1) = 0.0 
    202                   prodatqc%vdmean(ji,jj,jk,2) = 0.0 
     242                  ! Increment field 1 for computing daily mean 
     243                  prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) & 
     244                     &                        + pvar1(ji,jj,jk) 
     245                  ! Increment field 2 for computing daily mean 
     246                  prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) & 
     247                     &                        + pvar2(ji,jj,jk) 
    203248               END DO 
    204249            END DO 
    205250         END DO 
    206       ENDIF 
    207  
    208       DO jk = 1, jpk 
    209          DO jj = 1, jpj 
    210             DO ji = 1, jpi 
    211                ! Increment the temperature field for computing daily mean 
    212                prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) & 
    213                   &                        + ptn(ji,jj,jk) 
    214                ! Increment the salinity field for computing daily mean 
    215                prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) & 
    216                   &                        + psn(ji,jj,jk) 
    217             END DO 
    218          END DO 
    219       END DO 
    220     
    221       ! Compute the daily mean at the end of day 
    222       zdaystp = 1.0 / REAL( kdaystp ) 
    223       IF ( idayend == 0 ) THEN 
    224          DO jk = 1, jpk 
    225             DO jj = 1, jpj 
    226                DO ji = 1, jpi 
    227                   prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) & 
    228                      &                        * zdaystp 
    229                   prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) & 
    230                   &                           * zdaystp 
     251 
     252         ! Compute the daily mean at the end of day 
     253         zdaystp = 1.0 / REAL( kdaystp ) 
     254         IF ( idayend == 0 ) THEN 
     255            IF (lwp) WRITE(numout,*) 'Calculating prodatqc%vdmean on time-step: ',kt 
     256            CALL FLUSH(numout) 
     257            DO jk = 1, jpk 
     258               DO jj = 1, jpj 
     259                  DO ji = 1, jpi 
     260                     prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) & 
     261                        &                        * zdaystp 
     262                     prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) & 
     263                        &                        * zdaystp 
     264                  END DO 
    231265               END DO 
    232266            END DO 
    233          END DO 
     267         ENDIF 
     268 
    234269      ENDIF 
    235270 
    236271      ! Get the data for interpolation 
    237272      ALLOCATE( & 
    238          & igrdi(2,2,ipro),      & 
    239          & igrdj(2,2,ipro),      & 
    240          & zglam(2,2,ipro),      & 
    241          & zgphi(2,2,ipro),      & 
    242          & zmask(2,2,kpk,ipro),  & 
    243          & zintt(2,2,kpk,ipro),  & 
    244          & zints(2,2,kpk,ipro)   & 
     273         & igrdi1(2,2,ipro),      & 
     274         & igrdi2(2,2,ipro),      & 
     275         & igrdj1(2,2,ipro),      & 
     276         & igrdj2(2,2,ipro),      & 
     277         & zglam1(2,2,ipro),      & 
     278         & zglam2(2,2,ipro),      & 
     279         & zgphi1(2,2,ipro),      & 
     280         & zgphi2(2,2,ipro),      & 
     281         & zmask1(2,2,kpk,ipro),  & 
     282         & zmask2(2,2,kpk,ipro),  & 
     283         & zint1(2,2,kpk,ipro),   & 
     284         & zint2(2,2,kpk,ipro),   & 
     285         & zgdept(2,2,kpk,ipro),  &  
     286         & zgdepw(2,2,kpk,ipro)   &  
    245287         & ) 
    246288 
    247289      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 
    248290         iobs = jobs - prodatqc%nprofup 
    249          igrdi(1,1,iobs) = prodatqc%mi(jobs,1)-1 
    250          igrdj(1,1,iobs) = prodatqc%mj(jobs,1)-1 
    251          igrdi(1,2,iobs) = prodatqc%mi(jobs,1)-1 
    252          igrdj(1,2,iobs) = prodatqc%mj(jobs,1) 
    253          igrdi(2,1,iobs) = prodatqc%mi(jobs,1) 
    254          igrdj(2,1,iobs) = prodatqc%mj(jobs,1)-1 
    255          igrdi(2,2,iobs) = prodatqc%mi(jobs,1) 
    256          igrdj(2,2,iobs) = prodatqc%mj(jobs,1) 
     291         igrdi1(1,1,iobs) = prodatqc%mi(jobs,1)-1 
     292         igrdj1(1,1,iobs) = prodatqc%mj(jobs,1)-1 
     293         igrdi1(1,2,iobs) = prodatqc%mi(jobs,1)-1 
     294         igrdj1(1,2,iobs) = prodatqc%mj(jobs,1) 
     295         igrdi1(2,1,iobs) = prodatqc%mi(jobs,1) 
     296         igrdj1(2,1,iobs) = prodatqc%mj(jobs,1)-1 
     297         igrdi1(2,2,iobs) = prodatqc%mi(jobs,1) 
     298         igrdj1(2,2,iobs) = prodatqc%mj(jobs,1) 
     299         igrdi2(1,1,iobs) = prodatqc%mi(jobs,2)-1 
     300         igrdj2(1,1,iobs) = prodatqc%mj(jobs,2)-1 
     301         igrdi2(1,2,iobs) = prodatqc%mi(jobs,2)-1 
     302         igrdj2(1,2,iobs) = prodatqc%mj(jobs,2) 
     303         igrdi2(2,1,iobs) = prodatqc%mi(jobs,2) 
     304         igrdj2(2,1,iobs) = prodatqc%mj(jobs,2)-1 
     305         igrdi2(2,2,iobs) = prodatqc%mi(jobs,2) 
     306         igrdj2(2,2,iobs) = prodatqc%mj(jobs,2) 
    257307      END DO 
    258308 
    259       CALL obs_int_comm_2d( 2, 2, ipro, igrdi, igrdj, glamt, zglam ) 
    260       CALL obs_int_comm_2d( 2, 2, ipro, igrdi, igrdj, gphit, zgphi ) 
    261       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, ptmask,zmask ) 
    262       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, ptn,   zintt ) 
    263       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, psn,   zints ) 
     309      ! Initialise depth arrays 
     310      zgdept(:,:,:,:) = 0.0 
     311      zgdepw(:,:,:,:) = 0.0 
     312 
     313      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi1, igrdj1, plam1, zglam1 ) 
     314      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi1, igrdj1, pphi1, zgphi1 ) 
     315      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pmask1, zmask1 ) 
     316      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pvar1,   zint1 ) 
     317       
     318      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi2, igrdj2, plam2, zglam2 ) 
     319      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi2, igrdj2, pphi2, zgphi2 ) 
     320      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, pmask2, zmask2 ) 
     321      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, pvar2,   zint2 ) 
     322 
     323      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pgdept, zgdept )  
     324      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, pgdepw, zgdepw )  
    264325 
    265326      ! At the end of the day also get interpolated means 
    266       IF ( idayend == 0 ) THEN 
     327      IF ( ld_dailyav .AND. idayend == 0 ) THEN 
    267328 
    268329         ALLOCATE( & 
    269             & zinmt(2,2,kpk,ipro),  & 
    270             & zinms(2,2,kpk,ipro)   & 
     330            & zinm1(2,2,kpk,ipro),  & 
     331            & zinm2(2,2,kpk,ipro)   & 
    271332            & ) 
    272333 
    273          CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, & 
    274             &                  prodatqc%vdmean(:,:,:,1), zinmt ) 
    275          CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, & 
    276             &                  prodatqc%vdmean(:,:,:,2), zinms ) 
     334         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi1, igrdj1, & 
     335            &                  prodatqc%vdmean(:,:,:,1), zinm1 ) 
     336         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi2, igrdj2, & 
     337            &                  prodatqc%vdmean(:,:,:,2), zinm2 ) 
    277338 
    278339      ENDIF 
    279340 
     341      ! Return if no observations to process  
     342      ! Has to be done after comm commands to ensure processors  
     343      ! stay in sync  
     344      IF ( ipro == 0 ) RETURN  
     345 
    280346      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 
    281347 
    … …  
    283349 
    284350         IF ( kt /= prodatqc%mstp(jobs) ) THEN 
    285              
     351 
    286352            IF(lwp) THEN 
    287353               WRITE(numout,*) 
    … …  
    298364            CALL ctl_stop( 'obs_pro_opt', 'Inconsistent time' ) 
    299365         ENDIF 
    300           
     366 
    301367         zlam = prodatqc%rlam(jobs) 
    302368         zphi = prodatqc%rphi(jobs) 
     369 
     370         ! Horizontal weights  
     371         ! Masked values are calculated later.   
     372         IF ( prodatqc%npvend(jobs,1) > 0 ) THEN 
     373 
     374            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,     & 
     375               &                   zglam1(:,:,iobs), zgphi1(:,:,iobs), & 
     376               &                   zmask1(:,:,1,iobs), zweig1, zmsk_1 ) 
     377 
     378         ENDIF 
     379 
     380         IF ( prodatqc%npvend(jobs,2) > 0 ) THEN 
     381 
     382            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,     & 
     383               &                   zglam2(:,:,iobs), zgphi2(:,:,iobs), & 
     384               &                   zmask2(:,:,1,iobs), zweig2, zmsk_2 ) 
     385  
     386         ENDIF 
     387 
     388         IF ( prodatqc%npvend(jobs,1) > 0 ) THEN 
     389 
     390            zobsk(:) = obfillflt 
     391 
     392            IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN 
     393 
     394               IF ( idayend == 0 )  THEN 
     395                  ! Daily averaged data 
     396 
     397                  ! vertically interpolate all 4 corners  
     398                  ista = prodatqc%npvsta(jobs,1)  
     399                  iend = prodatqc%npvend(jobs,1)  
     400                  inum_obs = iend - ista + 1  
     401                  ALLOCATE(interp_corner(2,2,inum_obs),iv_indic(inum_obs))  
     402 
     403                  DO iin=1,2  
     404                     DO ijn=1,2  
     405 
     406                        IF ( k1dint == 1 ) THEN  
     407                           CALL obs_int_z1d_spl( kpk, &  
     408                              &     zinm1(iin,ijn,:,iobs), &  
     409                              &     zobs2k, zgdept(iin,ijn,:,iobs), &  
     410                              &     zmask1(iin,ijn,:,iobs))  
     411                        ENDIF  
     412        
     413                        CALL obs_level_search(kpk, &  
     414                           &    zgdept(iin,ijn,:,iobs), &  
     415                           &    inum_obs, prodatqc%var(1)%vdep(ista:iend), &  
     416                           &    iv_indic)  
     417 
     418                        CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, &  
     419                           &    prodatqc%var(1)%vdep(ista:iend), &  
     420                           &    zinm1(iin,ijn,:,iobs), &  
     421                           &    zobs2k, interp_corner(iin,ijn,:), &  
     422                           &    zgdept(iin,ijn,:,iobs), &  
     423                           &    zmask1(iin,ijn,:,iobs))  
     424        
     425                     ENDDO  
     426                  ENDDO  
     427 
     428               ENDIF !idayend 
     429 
     430            ELSE    
     431 
     432               ! Point data  
     433      
     434               ! vertically interpolate all 4 corners  
     435               ista = prodatqc%npvsta(jobs,1)  
     436               iend = prodatqc%npvend(jobs,1)  
     437               inum_obs = iend - ista + 1  
     438               ALLOCATE(interp_corner(2,2,inum_obs), iv_indic(inum_obs))  
     439               DO iin=1,2   
     440                  DO ijn=1,2  
     441                     
     442                     IF ( k1dint == 1 ) THEN  
     443                        CALL obs_int_z1d_spl( kpk, &  
     444                           &    zint1(iin,ijn,:,iobs),&  
     445                           &    zobs2k, zgdept(iin,ijn,:,iobs), &  
     446                           &    zmask1(iin,ijn,:,iobs))  
     447   
     448                     ENDIF  
     449        
     450                     CALL obs_level_search(kpk, &  
     451                         &        zgdept(iin,ijn,:,iobs),&  
     452                         &        inum_obs, prodatqc%var(1)%vdep(ista:iend), &  
     453                         &        iv_indic)  
     454 
     455                     CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs,     &  
     456                         &          prodatqc%var(1)%vdep(ista:iend),     &  
     457                         &          zint1(iin,ijn,:,iobs),            &  
     458                         &          zobs2k,interp_corner(iin,ijn,:), &  
     459                         &          zgdept(iin,ijn,:,iobs),         &  
     460                         &          zmask1(iin,ijn,:,iobs) )       
    303461          
    304          ! Horizontal weights and vertical mask 
    305  
    306          IF ( ( prodatqc%npvend(jobs,1) > 0 ) .OR. & 
    307             & ( prodatqc%npvend(jobs,2) > 0 ) ) THEN 
    308  
    309             CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     & 
    310                &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
    311                &                   zmask(:,:,:,iobs), zweig, zobsmask ) 
    312  
    313          ENDIF 
    314  
    315          IF ( prodatqc%npvend(jobs,1) > 0 ) THEN 
     462                  ENDDO  
     463               ENDDO  
     464              
     465            ENDIF  
     466 
     467            !-------------------------------------------------------------  
     468            ! Compute the horizontal interpolation for every profile level  
     469            !-------------------------------------------------------------  
     470              
     471            DO ikn=1,inum_obs  
     472               iend=ista+ikn-1 
     473                   
     474               zweig(:,:,1) = 0._wp  
     475    
     476               ! This code forces the horizontal weights to be   
     477               ! zero IF the observation is below the bottom of the   
     478               ! corners of the interpolation nodes, Or if it is in   
     479               ! the mask. This is important for observations near   
     480               ! steep bathymetry  
     481               DO iin=1,2  
     482                  DO ijn=1,2  
     483      
     484                     depth_loop1: DO ik=kpk,2,-1  
     485                        IF(zmask1(iin,ijn,ik-1,iobs ) > 0.9 )THEN    
     486                             
     487                           zweig(iin,ijn,1) = &   
     488                              & zweig1(iin,ijn,1) * &  
     489                              & MAX( SIGN(1._wp,(zgdepw(iin,ijn,ik,iobs) ) &  
     490                              &  - prodatqc%var(1)%vdep(iend)),0._wp)  
     491                             
     492                           EXIT depth_loop1  
     493 
     494                        ENDIF  
     495 
     496                     ENDDO depth_loop1  
     497      
     498                  ENDDO  
     499               ENDDO  
     500    
     501               CALL obs_int_h2d( 1, 1, zweig, interp_corner(:,:,ikn), &  
     502                  &              prodatqc%var(1)%vmod(iend:iend) )  
     503 
     504                  ! Set QC flag for any observations found below the bottom 
     505                  ! needed as the check here is more strict than that in obs_prep 
     506               IF (sum(zweig) == 0.0_wp) prodatqc%var(1)%nvqc(iend:iend)=4 
     507  
     508            ENDDO  
     509  
     510            DEALLOCATE(interp_corner,iv_indic)  
     511           
     512         ENDIF  
     513 
     514         ! For the second variable 
     515         IF ( prodatqc%npvend(jobs,2) > 0 ) THEN 
    316516 
    317517            zobsk(:) = obfillflt 
    318518 
    319        IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN 
     519            IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN 
    320520 
    321521               IF ( idayend == 0 )  THEN 
     522                  ! Daily averaged data 
     523 
     524                  ! vertically interpolate all 4 corners  
     525                  ista = prodatqc%npvsta(jobs,2)  
     526                  iend = prodatqc%npvend(jobs,2)  
     527                  inum_obs = iend - ista + 1  
     528                  ALLOCATE(interp_corner(2,2,inum_obs),iv_indic(inum_obs))  
     529 
     530                  DO iin=1,2  
     531                     DO ijn=1,2  
     532 
     533                        IF ( k1dint == 1 ) THEN  
     534                           CALL obs_int_z1d_spl( kpk, &  
     535                              &     zinm2(iin,ijn,:,iobs), &  
     536                              &     zobs2k, zgdept(iin,ijn,:,iobs), &  
     537                              &     zmask2(iin,ijn,:,iobs))  
     538                        ENDIF  
     539        
     540                        CALL obs_level_search(kpk, &  
     541                           &    zgdept(iin,ijn,:,iobs), &  
     542                           &    inum_obs, prodatqc%var(2)%vdep(ista:iend), &  
     543                           &    iv_indic)  
     544 
     545                        CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, &  
     546                           &    prodatqc%var(2)%vdep(ista:iend), &  
     547                           &    zinm2(iin,ijn,:,iobs), &  
     548                           &    zobs2k, interp_corner(iin,ijn,:), &  
     549                           &    zgdept(iin,ijn,:,iobs), &  
     550                           &    zmask2(iin,ijn,:,iobs))  
     551        
     552                     ENDDO  
     553                  ENDDO  
     554 
     555               ENDIF !idayend 
     556 
     557            ELSE    
     558 
     559               ! Point data  
     560      
     561               ! vertically interpolate all 4 corners  
     562               ista = prodatqc%npvsta(jobs,2)  
     563               iend = prodatqc%npvend(jobs,2)  
     564               inum_obs = iend - ista + 1  
     565               ALLOCATE(interp_corner(2,2,inum_obs), iv_indic(inum_obs))  
     566               DO iin=1,2   
     567                  DO ijn=1,2  
     568                     
     569                     IF ( k1dint == 1 ) THEN  
     570                        CALL obs_int_z1d_spl( kpk, &  
     571                           &    zint2(iin,ijn,:,iobs),&  
     572                           &    zobs2k, zgdept(iin,ijn,:,iobs), &  
     573                           &    zmask2(iin,ijn,:,iobs))  
     574   
     575                     ENDIF  
     576        
     577                     CALL obs_level_search(kpk, &  
     578                         &        zgdept(iin,ijn,:,iobs),&  
     579                         &        inum_obs, prodatqc%var(2)%vdep(ista:iend), &  
     580                         &        iv_indic)  
     581 
     582                     CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs,     &  
     583                         &          prodatqc%var(2)%vdep(ista:iend),     &  
     584                         &          zint2(iin,ijn,:,iobs),            &  
     585                         &          zobs2k,interp_corner(iin,ijn,:), &  
     586                         &          zgdept(iin,ijn,:,iobs),         &  
     587                         &          zmask2(iin,ijn,:,iobs) )       
     588          
     589                  ENDDO  
     590               ENDDO  
     591              
     592            ENDIF  
     593 
     594            !-------------------------------------------------------------  
     595            ! Compute the horizontal interpolation for every profile level  
     596            !-------------------------------------------------------------  
     597              
     598            DO ikn=1,inum_obs  
     599               iend=ista+ikn-1 
    322600                   
    323                   ! Daily averaged moored buoy (MRB) data 
    324                    
    325                   CALL obs_int_h2d( kpk, kpk,      & 
    326                      &              zweig, zinmt(:,:,:,iobs), zobsk ) 
    327                    
    328                    
    329                ELSE 
    330                 
    331                   CALL ctl_stop( ' A nonzero' //     & 
    332                      &           ' number of profile T BUOY data should' // & 
    333                      &           ' only occur at the end of a given day' ) 
    334  
    335                ENDIF 
    336            
    337             ELSE  
    338                 
    339                ! Point data 
    340  
    341                CALL obs_int_h2d( kpk, kpk,      & 
    342                   &              zweig, zintt(:,:,:,iobs), zobsk ) 
    343  
    344             ENDIF 
    345  
    346             !------------------------------------------------------------- 
    347             ! Compute vertical second-derivative of the interpolating  
    348             ! polynomial at obs points 
    349             !------------------------------------------------------------- 
    350              
    351             IF ( k1dint == 1 ) THEN 
    352                CALL obs_int_z1d_spl( kpk, zobsk, zobs2k,   & 
    353                   &                  pgdept, zobsmask ) 
    354             ENDIF 
    355              
    356             !----------------------------------------------------------------- 
    357             !  Vertical interpolation to the observation point 
    358             !----------------------------------------------------------------- 
    359             ista = prodatqc%npvsta(jobs,1) 
    360             iend = prodatqc%npvend(jobs,1) 
    361             CALL obs_int_z1d( kpk,                & 
    362                & prodatqc%var(1)%mvk(ista:iend),  & 
    363                & k1dint, iend - ista + 1,         & 
    364                & prodatqc%var(1)%vdep(ista:iend), & 
    365                & zobsk, zobs2k,                   & 
    366                & prodatqc%var(1)%vmod(ista:iend), & 
    367                & pgdept, zobsmask ) 
    368  
    369          ENDIF 
    370  
    371          IF ( prodatqc%npvend(jobs,2) > 0 ) THEN 
    372  
    373             zobsk(:) = obfillflt 
    374  
    375             IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN 
    376  
    377                IF ( idayend == 0 )  THEN 
    378  
    379                   ! Daily averaged moored buoy (MRB) data 
    380                    
    381                   CALL obs_int_h2d( kpk, kpk,      & 
    382                      &              zweig, zinms(:,:,:,iobs), zobsk ) 
    383                    
    384                ELSE 
    385  
    386                   CALL ctl_stop( ' A nonzero' //     & 
    387                      &           ' number of profile S BUOY data should' // & 
    388                      &           ' only occur at the end of a given day' ) 
    389  
    390                ENDIF 
    391  
    392             ELSE 
    393                 
    394                ! Point data 
    395  
    396                CALL obs_int_h2d( kpk, kpk,      & 
    397                   &              zweig, zints(:,:,:,iobs), zobsk ) 
    398  
    399             ENDIF 
    400  
    401  
    402             !------------------------------------------------------------- 
    403             ! Compute vertical second-derivative of the interpolating  
    404             ! polynomial at obs points 
    405             !------------------------------------------------------------- 
    406              
    407             IF ( k1dint == 1 ) THEN 
    408                CALL obs_int_z1d_spl( kpk, zobsk, zobs2k, & 
    409                   &                  pgdept, zobsmask ) 
    410             ENDIF 
    411              
    412             !---------------------------------------------------------------- 
    413             !  Vertical interpolation to the observation point 
    414             !---------------------------------------------------------------- 
    415             ista = prodatqc%npvsta(jobs,2) 
    416             iend = prodatqc%npvend(jobs,2) 
    417             CALL obs_int_z1d( kpk, & 
    418                & prodatqc%var(2)%mvk(ista:iend),& 
    419                & k1dint, iend - ista + 1, & 
    420                & prodatqc%var(2)%vdep(ista:iend),& 
    421                & zobsk, zobs2k, & 
    422                & prodatqc%var(2)%vmod(ista:iend),& 
    423                & pgdept, zobsmask ) 
    424  
    425          ENDIF 
    426  
    427       END DO 
     601               zweig(:,:,1) = 0._wp  
     602    
     603               ! This code forces the horizontal weights to be   
     604               ! zero IF the observation is below the bottom of the   
     605               ! corners of the interpolation nodes, Or if it is in   
     606               ! the mask. This is important for observations near   
     607               ! steep bathymetry  
     608               DO iin=1,2  
     609                  DO ijn=1,2  
     610      
     611                     depth_loop2: DO ik=kpk,2,-1  
     612                        IF(zmask2(iin,ijn,ik-1,iobs ) > 0.9 )THEN    
     613                             
     614                           zweig(iin,ijn,1) = &   
     615                              & zweig2(iin,ijn,1) * &  
     616                              & MAX( SIGN(1._wp,(zgdepw(iin,ijn,ik,iobs) ) &  
     617                              &  - prodatqc%var(2)%vdep(iend)),0._wp)  
     618                             
     619                           EXIT depth_loop2  
     620 
     621                        ENDIF  
     622 
     623                     ENDDO depth_loop2  
     624      
     625                  ENDDO  
     626               ENDDO  
     627    
     628               CALL obs_int_h2d( 1, 1, zweig, interp_corner(:,:,ikn), &  
     629                  &              prodatqc%var(2)%vmod(iend:iend) )  
     630 
     631                  ! Set QC flag for any observations found below the bottom 
     632                  ! needed as the check here is more strict than that in obs_prep 
     633               IF (sum(zweig) == 0.0_wp) prodatqc%var(2)%nvqc(iend:iend)=4 
    428634  
     635            ENDDO  
     636  
     637            DEALLOCATE(interp_corner,iv_indic)  
     638           
     639         ENDIF  
     640 
     641      ENDDO 
     642 
    429643      ! Deallocate the data for interpolation 
    430644      DEALLOCATE( & 
    431          & igrdi, & 
    432          & igrdj, & 
    433          & zglam, & 
    434          & zgphi, & 
    435          & zmask, & 
    436          & zintt, & 
    437          & zints  & 
     645         & igrdi1, & 
     646         & igrdi2, & 
     647         & igrdj1, & 
     648         & igrdj2, & 
     649         & zglam1, & 
     650         & zglam2, & 
     651         & zgphi1, & 
     652         & zgphi2, & 
     653         & zmask1, & 
     654         & zmask2, & 
     655         & zint1,  & 
     656         & zint2,  & 
     657         & zgdept, & 
     658         & zgdepw  & 
    438659         & ) 
     660 
    439661      ! At the end of the day also get interpolated means 
    440       IF ( idayend == 0 ) THEN 
     662      IF ( ld_dailyav .AND. idayend == 0 ) THEN 
    441663         DEALLOCATE( & 
    442             & zinmt,  & 
    443             & zinms   & 
     664            & zinm1,  & 
     665            & zinm2   & 
    444666            & ) 
    445667      ENDIF 
    446668 
    447669      prodatqc%nprofup = prodatqc%nprofup + ipro  
    448        
    449    END SUBROUTINE obs_pro_opt 
    450  
    451    SUBROUTINE obs_sla_opt( sladatqc, kt, kpi, kpj, kit000, & 
    452       &                    psshn, psshmask, k2dint ) 
     670 
     671   END SUBROUTINE obs_prof_opt 
     672 
     673   SUBROUTINE obs_surf_opt( surfdataqc, kt, kpi, kpj,            & 
     674      &                     kit000, kdaystp, psurf, psurfmask,   & 
     675      &                     k2dint, ldnightav, plamscl, pphiscl, & 
     676      &                     lindegrees ) 
     677 
    453678      !!----------------------------------------------------------------------- 
    454679      !! 
    455       !!                     ***  ROUTINE obs_sla_opt  *** 
    456       !! 
    457       !! ** Purpose : Compute the model counterpart of sea level anomaly 
     680      !!                     ***  ROUTINE obs_surf_opt  *** 
     681      !! 
     682      !! ** Purpose : Compute the model counterpart of surface 
    458683      !!              data by interpolating from the model grid to the  
    459684      !!              observation point. 
    … …  
    462687      !!              the model values at the corners of the surrounding grid box. 
    463688      !! 
    464       !!    The now model SSH is first computed at the obs (lon, lat) point. 
     689      !!    The new model value is first computed at the obs (lon, lat) point. 
    465690      !! 
    466691      !!    Several horizontal interpolation schemes are available: 
    … …  
    470695      !!        - bilinear (quadrilateral grid)    (k2dint = 3) 
    471696      !!        - polynomial (quadrilateral grid)  (k2dint = 4) 
    472       !!   
    473       !!    The sea level anomaly at the observation points is then computed  
    474       !!    by removing a mean dynamic topography (defined at the obs. point). 
     697      !! 
     698      !!    Two horizontal averaging schemes are also available: 
     699      !!        - weighted radial footprint        (k2dint = 5) 
     700      !!        - weighted rectangular footprint   (k2dint = 6) 
     701      !! 
    475702      !! 
    476703      !! ** Action  : 
    … …  
    478705      !! History : 
    479706      !!      ! 07-03 (A. Weaver) 
     707      !!      ! 15-02 (M. Martin) Combined routine for surface types 
     708      !!      ! 17-03 (M. Martin) Added horizontal averaging options 
    480709      !!----------------------------------------------------------------------- 
    481    
     710 
    482711      !! * Modules used 
    483712      USE obs_surf_def  ! Definition of storage space for surface observations 
    … …  
    486715 
    487716      !! * Arguments 
    488       TYPE(obs_surf), INTENT(INOUT) :: sladatqc     ! Subset of surface data not failing screening 
    489       INTEGER, INTENT(IN) :: kt      ! Time step 
    490       INTEGER, INTENT(IN) :: kpi     ! Model grid parameters 
     717      TYPE(obs_surf), INTENT(INOUT) :: & 
     718         & surfdataqc                  ! Subset of surface data passing QC 
     719      INTEGER, INTENT(IN) :: kt        ! Time step 
     720      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters 
    491721      INTEGER, INTENT(IN) :: kpj 
    492       INTEGER, INTENT(IN) :: kit000   ! Number of the first time step  
    493                                       !   (kit000-1 = restart time) 
    494       INTEGER, INTENT(IN) :: k2dint   ! Horizontal interpolation type (see header) 
    495       REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
    496          & psshn,  &    ! Model SSH field 
    497          & psshmask     ! Land-sea mask 
    498           
     722      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step  
     723                                       !   (kit000-1 = restart time) 
     724      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day 
     725      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header) 
     726      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
     727         & psurf,  &                   ! Model surface field 
     728         & psurfmask                   ! Land-sea mask 
     729      LOGICAL, INTENT(IN) :: ldnightav ! Logical for averaging night-time data 
     730      REAL(KIND=wp), INTENT(IN) :: & 
     731         & plamscl, &                  ! Diameter in metres of obs footprint in E/W, N/S directions 
     732         & pphiscl                     ! This is the full width (rather than half-width) 
     733      LOGICAL, INTENT(IN) :: & 
     734         & lindegrees                  ! T=> plamscl and pphiscl are specified in degrees, F=> in metres 
     735 
    499736      !! * Local declarations 
    500737      INTEGER :: ji 
    … …  
    502739      INTEGER :: jobs 
    503740      INTEGER :: inrc 
    504       INTEGER :: isla 
     741      INTEGER :: isurf 
    505742      INTEGER :: iobs 
    506       REAL(KIND=wp) :: zlam 
    507       REAL(KIND=wp) :: zphi 
    508       REAL(KIND=wp) :: zext(1), zobsmask(1) 
    509       REAL(kind=wp), DIMENSION(2,2,1) :: & 
    510          & zweig 
     743      INTEGER :: imaxifp, imaxjfp 
     744      INTEGER :: imodi, imodj 
     745      INTEGER :: idayend 
     746      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
     747         & igrdi,   & 
     748         & igrdj,   & 
     749         & igrdip1, & 
     750         & igrdjp1 
     751      INTEGER, DIMENSION(:,:), SAVE, ALLOCATABLE :: & 
     752         & icount_night,      & 
     753         & imask_night 
     754      REAL(wp) :: zlam 
     755      REAL(wp) :: zphi 
     756      REAL(wp), DIMENSION(1) :: zext, zobsmask 
     757      REAL(wp) :: zdaystp 
    511758      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
    512          & zmask, & 
    513          & zsshl, & 
    514          & zglam, & 
    515          & zgphi 
    516       INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
    517          & igrdi, & 
    518          & igrdj 
     759         & zweig,  & 
     760         & zmask,  & 
     761         & zsurf,  & 
     762         & zsurfm, & 
     763         & zsurftmp, & 
     764         & zglam,  & 
     765         & zgphi,  & 
     766         & zglamf, & 
     767         & zgphif 
     768 
     769      REAL(wp), DIMENSION(:,:), SAVE, ALLOCATABLE :: & 
     770         & zintmp,  & 
     771         & zouttmp, & 
     772         & zmeanday    ! to compute model sst in region of 24h daylight (pole) 
    519773 
    520774      !------------------------------------------------------------------------ 
    521775      ! Local initialization  
    522776      !------------------------------------------------------------------------ 
    523       ! ... Record and data counters 
     777      ! Record and data counters 
    524778      inrc = kt - kit000 + 2 
    525       isla = sladatqc%nsstp(inrc) 
     779      isurf = surfdataqc%nsstp(inrc) 
     780 
     781      ! Work out the maximum footprint size for the  
     782      ! interpolation/averaging in model grid-points - has to be even. 
     783 
     784      CALL obs_max_fpsize( k2dint, plamscl, pphiscl, lindegrees, psurfmask, imaxifp, imaxjfp ) 
     785 
     786 
     787      IF ( ldnightav ) THEN 
     788 
     789      ! Initialize array for night mean 
     790         IF ( kt == 0 ) THEN 
     791            ALLOCATE ( icount_night(kpi,kpj) ) 
     792            ALLOCATE ( imask_night(kpi,kpj) ) 
     793            ALLOCATE ( zintmp(kpi,kpj) ) 
     794            ALLOCATE ( zouttmp(kpi,kpj) ) 
     795            ALLOCATE ( zmeanday(kpi,kpj) ) 
     796            nday_qsr = -1   ! initialisation flag for nbc_dcy 
     797         ENDIF 
     798 
     799         ! Night-time means are calculated for night-time values over timesteps: 
     800         !  [1 <= kt <= kdaystp], [kdaystp+1 <= kt <= 2*kdaystp], ..... 
     801         idayend = MOD( kt - kit000 + 1, kdaystp ) 
     802 
     803         ! Initialize night-time mean for first timestep of the day 
     804         IF ( idayend == 1 .OR. kt == 0 ) THEN 
     805            DO jj = 1, jpj 
     806               DO ji = 1, jpi 
     807                  surfdataqc%vdmean(ji,jj) = 0.0 
     808                  zmeanday(ji,jj) = 0.0 
     809                  icount_night(ji,jj) = 0 
     810               END DO 
     811            END DO 
     812         ENDIF 
     813 
     814         zintmp(:,:) = 0.0 
     815         zouttmp(:,:) = sbc_dcy( zintmp(:,:), .TRUE. ) 
     816         imask_night(:,:) = INT( zouttmp(:,:) ) 
     817 
     818         DO jj = 1, jpj 
     819            DO ji = 1, jpi 
     820               ! Increment the temperature field for computing night mean and counter 
     821               surfdataqc%vdmean(ji,jj) = surfdataqc%vdmean(ji,jj)  & 
     822                      &                    + psurf(ji,jj) * REAL( imask_night(ji,jj) ) 
     823               zmeanday(ji,jj)          = zmeanday(ji,jj) + psurf(ji,jj) 
     824               icount_night(ji,jj)      = icount_night(ji,jj) + imask_night(ji,jj) 
     825            END DO 
     826         END DO 
     827 
     828         ! Compute the night-time mean at the end of the day 
     829         zdaystp = 1.0 / REAL( kdaystp ) 
     830         IF ( idayend == 0 ) THEN 
     831            IF (lwp) WRITE(numout,*) 'Calculating surfdataqc%vdmean on time-step: ',kt 
     832            DO jj = 1, jpj 
     833               DO ji = 1, jpi 
     834                  ! Test if "no night" point 
     835                  IF ( icount_night(ji,jj) > 0 ) THEN 
     836                     surfdataqc%vdmean(ji,jj) = surfdataqc%vdmean(ji,jj) & 
     837                       &                        / REAL( icount_night(ji,jj) ) 
     838                  ELSE 
     839                     !At locations where there is no night (e.g. poles), 
     840                     ! calculate daily mean instead of night-time mean. 
     841                     surfdataqc%vdmean(ji,jj) = zmeanday(ji,jj) * zdaystp 
     842                  ENDIF 
     843               END DO 
     844            END DO 
     845         ENDIF 
     846 
     847      ENDIF 
    526848 
    527849      ! Get the data for interpolation 
    528850 
    529851      ALLOCATE( & 
    530          & igrdi(2,2,isla), & 
    531          & igrdj(2,2,isla), & 
    532          & zglam(2,2,isla), & 
    533          & zgphi(2,2,isla), & 
    534          & zmask(2,2,isla), & 
    535          & zsshl(2,2,isla)  & 
     852         & zweig(imaxifp,imaxjfp,1),      & 
     853         & igrdi(imaxifp,imaxjfp,isurf), & 
     854         & igrdj(imaxifp,imaxjfp,isurf), & 
     855         & zglam(imaxifp,imaxjfp,isurf), & 
     856         & zgphi(imaxifp,imaxjfp,isurf), & 
     857         & zmask(imaxifp,imaxjfp,isurf), & 
     858         & zsurf(imaxifp,imaxjfp,isurf), & 
     859         & zsurftmp(imaxifp,imaxjfp,isurf),  & 
     860         & zglamf(imaxifp+1,imaxjfp+1,isurf), & 
     861         & zgphif(imaxifp+1,imaxjfp+1,isurf), & 
     862         & igrdip1(imaxifp+1,imaxjfp+1,isurf), & 
     863         & igrdjp1(imaxifp+1,imaxjfp+1,isurf) & 
    536864         & ) 
    537        
    538       DO jobs = sladatqc%nsurfup + 1, sladatqc%nsurfup + isla 
    539          iobs = jobs - sladatqc%nsurfup 
    540          igrdi(1,1,iobs) = sladatqc%mi(jobs)-1 
    541          igrdj(1,1,iobs) = sladatqc%mj(jobs)-1 
    542          igrdi(1,2,iobs) = sladatqc%mi(jobs)-1 
    543          igrdj(1,2,iobs) = sladatqc%mj(jobs) 
    544          igrdi(2,1,iobs) = sladatqc%mi(jobs) 
    545          igrdj(2,1,iobs) = sladatqc%mj(jobs)-1 
    546          igrdi(2,2,iobs) = sladatqc%mi(jobs) 
    547          igrdj(2,2,iobs) = sladatqc%mj(jobs) 
     865 
     866      DO jobs = surfdataqc%nsurfup + 1, surfdataqc%nsurfup + isurf 
     867         iobs = jobs - surfdataqc%nsurfup 
     868         DO ji = 0, imaxifp 
     869            imodi = surfdataqc%mi(jobs) - int(imaxifp/2) + ji - 1 
     870             
     871            !Deal with wrap around in longitude 
     872            IF ( imodi < 1      ) imodi = imodi + jpiglo 
     873            IF ( imodi > jpiglo ) imodi = imodi - jpiglo 
     874             
     875            DO jj = 0, imaxjfp 
     876               imodj = surfdataqc%mj(jobs) - int(imaxjfp/2) + jj - 1 
     877               !If model values are out of the domain to the north/south then 
     878               !set them to be the edge of the domain 
     879               IF ( imodj < 1      ) imodj = 1 
     880               IF ( imodj > jpjglo ) imodj = jpjglo 
     881 
     882               igrdip1(ji+1,jj+1,iobs) = imodi 
     883               igrdjp1(ji+1,jj+1,iobs) = imodj 
     884                
     885               IF ( ji >= 1 .AND. jj >= 1 ) THEN 
     886                  igrdi(ji,jj,iobs) = imodi 
     887                  igrdj(ji,jj,iobs) = imodj 
     888               ENDIF 
     889                
     890            END DO 
     891         END DO 
    548892      END DO 
    549893 
    550       CALL obs_int_comm_2d( 2, 2, isla, & 
     894      CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 
    551895         &                  igrdi, igrdj, glamt, zglam ) 
    552       CALL obs_int_comm_2d( 2, 2, isla, & 
     896      CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 
    553897         &                  igrdi, igrdj, gphit, zgphi ) 
    554       CALL obs_int_comm_2d( 2, 2, isla, & 
    555          &                  igrdi, igrdj, psshmask, zmask ) 
    556       CALL obs_int_comm_2d( 2, 2, isla, & 
    557          &                  igrdi, igrdj, psshn, zsshl ) 
     898      CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 
     899         &                  igrdi, igrdj, psurfmask, zmask ) 
     900      CALL obs_int_comm_2d( imaxifp, imaxjfp, isurf, kpi, kpj, & 
     901         &                  igrdi, igrdj, psurf, zsurf ) 
     902      CALL obs_int_comm_2d( imaxifp+1, imaxjfp+1, isurf, kpi, kpj, & 
     903         &                  igrdip1, igrdjp1, glamf, zglamf ) 
     904      CALL obs_int_comm_2d( imaxifp+1, imaxjfp+1, isurf, kpi, kpj, & 
     905         &                  igrdip1, igrdjp1, gphif, zgphif ) 
     906 
     907      ! At the end of the day get interpolated means 
     908      IF ( idayend == 0 .AND. ldnightav ) THEN 
     909 
     910         ALLOCATE( & 
     911            & zsurfm(imaxifp,imaxjfp,isurf)  & 
     912            & ) 
     913 
     914         CALL obs_int_comm_2d( imaxifp,imaxjfp, isurf, kpi, kpj, igrdi, igrdj, & 
     915            &               surfdataqc%vdmean(:,:), zsurfm ) 
     916 
     917      ENDIF 
    558918 
    559919      ! Loop over observations 
    560  
    561       DO jobs = sladatqc%nsurfup + 1, sladatqc%nsurfup + isla 
    562  
    563          iobs = jobs - sladatqc%nsurfup 
    564  
    565          IF ( kt /= sladatqc%mstp(jobs) ) THEN 
    566              
     920      DO jobs = surfdataqc%nsurfup + 1, surfdataqc%nsurfup + isurf 
     921 
     922         iobs = jobs - surfdataqc%nsurfup 
     923 
     924         IF ( kt /= surfdataqc%mstp(jobs) ) THEN 
     925 
    567926            IF(lwp) THEN 
    568927               WRITE(numout,*) 
    … …  
    574933               WRITE(numout,*) ' Record  = ', jobs,                & 
    575934                  &            ' kt      = ', kt,                  & 
    576                   &            ' mstp    = ', sladatqc%mstp(jobs), & 
    577                   &            ' ntyp    = ', sladatqc%ntyp(jobs) 
     935                  &            ' mstp    = ', surfdataqc%mstp(jobs), & 
     936                  &            ' ntyp    = ', surfdataqc%ntyp(jobs) 
    578937            ENDIF 
    579             CALL ctl_stop( 'obs_sla_opt', 'Inconsistent time' ) 
    580              
     938            CALL ctl_stop( 'obs_surf_opt', 'Inconsistent time' ) 
     939 
     940         ENDIF 
     941 
     942         zlam = surfdataqc%rlam(jobs) 
     943         zphi = surfdataqc%rphi(jobs) 
     944 
     945         IF ( ldnightav .AND. idayend == 0 ) THEN 
     946            ! Night-time averaged data 
     947            zsurftmp(:,:,iobs) = zsurfm(:,:,iobs) 
     948         ELSE 
     949            zsurftmp(:,:,iobs) = zsurf(:,:,iobs) 
     950         ENDIF 
     951 
     952         IF ( k2dint <= 4 ) THEN 
     953 
     954            ! Get weights to interpolate the model value to the observation point 
     955            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
     956               &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
     957               &                   zmask(:,:,iobs), zweig, zobsmask ) 
     958 
     959            ! Interpolate the model value to the observation point  
     960            CALL obs_int_h2d( 1, 1, zweig, zsurftmp(:,:,iobs), zext ) 
     961 
     962         ELSE 
     963 
     964            ! Get weights to average the model SLA to the observation footprint 
     965            CALL obs_avg_h2d_init( 1, 1, imaxifp, imaxjfp, k2dint, zlam,  zphi, & 
     966               &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
     967               &                   zglamf(:,:,iobs), zgphif(:,:,iobs), & 
     968               &                   zmask(:,:,iobs), plamscl, pphiscl, & 
     969               &                   lindegrees, zweig, zobsmask ) 
     970 
     971            ! Average the model SST to the observation footprint 
     972            CALL obs_avg_h2d( 1, 1, imaxifp, imaxjfp, & 
     973               &              zweig, zsurftmp(:,:,iobs),  zext ) 
     974 
     975         ENDIF 
     976 
     977         IF ( TRIM(surfdataqc%cvars(1)) == 'SLA' .AND. surfdataqc%nextra == 2 ) THEN 
     978            ! ... Remove the MDT from the SSH at the observation point to get the SLA 
     979            surfdataqc%rext(jobs,1) = zext(1) 
     980            surfdataqc%rmod(jobs,1) = surfdataqc%rext(jobs,1) - surfdataqc%rext(jobs,2) 
     981         ELSE 
     982            surfdataqc%rmod(jobs,1) = zext(1) 
    581983         ENDIF 
    582984          
    583          zlam = sladatqc%rlam(jobs) 
    584          zphi = sladatqc%rphi(jobs) 
    585  
    586          ! Get weights to interpolate the model SSH to the observation point 
    587          CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
    588             &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
    589             &                   zmask(:,:,iobs), zweig, zobsmask ) 
    590           
    591  
    592          ! Interpolate the model SSH to the observation point 
    593          CALL obs_int_h2d( 1, 1,      & 
    594             &              zweig, zsshl(:,:,iobs),  zext ) 
    595           
    596          sladatqc%rext(jobs,1) = zext(1) 
    597          ! ... Remove the MDT at the observation point 
    598          sladatqc%rmod(jobs,1) = sladatqc%rext(jobs,1) - sladatqc%rext(jobs,2) 
     985         IF ( zext(1) == obfillflt ) THEN 
     986            ! If the observation value is a fill value, set QC flag to bad 
     987            surfdataqc%nqc(jobs) = 4 
     988         ENDIF 
    599989 
    600990      END DO 
    … …  
    602992      ! Deallocate the data for interpolation 
    603993      DEALLOCATE( & 
     994         & zweig, & 
    604995         & igrdi, & 
    605996         & igrdj, & 
    … …  
    607998         & zgphi, & 
    608999         & zmask, & 
    609          & zsshl  & 
     1000         & zsurf, & 
     1001         & zsurftmp, & 
     1002         & zglamf, & 
     1003         & zgphif, & 
     1004         & igrdip1,& 
     1005         & igrdjp1 & 
    6101006         & ) 
    6111007 
    612       sladatqc%nsurfup = sladatqc%nsurfup + isla 
    613  
    614    END SUBROUTINE obs_sla_opt 
    615  
    616    SUBROUTINE obs_sst_opt( sstdatqc, kt, kpi, kpj, kit000, kdaystp, & 
    617       &                    psstn, psstmask, k2dint, ld_nightav ) 
    618       !!----------------------------------------------------------------------- 
    619       !! 
    620       !!                     ***  ROUTINE obs_sst_opt  *** 
    621       !! 
    622       !! ** Purpose : Compute the model counterpart of surface temperature 
    623       !!              data by interpolating from the model grid to the  
    624       !!              observation point. 
    625       !! 
    626       !! ** Method  : Linearly interpolate to each observation point using  
    627       !!              the model values at the corners of the surrounding grid box. 
    628       !! 
    629       !!    The now model SST is first computed at the obs (lon, lat) point. 
    630       !! 
    631       !!    Several horizontal interpolation schemes are available: 
    632       !!        - distance-weighted (great circle) (k2dint = 0) 
    633       !!        - distance-weighted (small angle)  (k2dint = 1) 
    634       !!        - bilinear (geographical grid)     (k2dint = 2) 
    635       !!        - bilinear (quadrilateral grid)    (k2dint = 3) 
    636       !!        - polynomial (quadrilateral grid)  (k2dint = 4) 
    637       !! 
    638       !! 
    639       !! ** Action  : 
    640       !! 
    641       !! History : 
    642       !!        !  07-07  (S. Ricci ) : Original 
    643       !!       
    644       !!----------------------------------------------------------------------- 
    645  
    646       !! * Modules used 
    647       USE obs_surf_def  ! Definition of storage space for surface observations 
    648       USE sbcdcy 
    649  
    650       IMPLICIT NONE 
    651  
    652       !! * Arguments 
    653       TYPE(obs_surf), INTENT(INOUT) :: & 
    654          & sstdatqc     ! Subset of surface data not failing screening 
    655       INTEGER, INTENT(IN) :: kt        ! Time step 
    656       INTEGER, INTENT(IN) :: kpi       ! Model grid parameters 
    657       INTEGER, INTENT(IN) :: kpj 
    658       INTEGER, INTENT(IN) :: kit000    ! Number of the first time step  
    659                                        !   (kit000-1 = restart time) 
    660       INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header) 
    661       INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day   
    662       REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
    663          & psstn,  &    ! Model SST field 
    664          & psstmask     ! Land-sea mask 
    665  
    666       !! * Local declarations 
    667       INTEGER :: ji 
    668       INTEGER :: jj 
    669       INTEGER :: jobs 
    670       INTEGER :: inrc 
    671       INTEGER :: isst 
    672       INTEGER :: iobs 
    673       INTEGER :: idayend 
    674       REAL(KIND=wp) :: zlam 
    675       REAL(KIND=wp) :: zphi 
    676       REAL(KIND=wp) :: zext(1), zobsmask(1) 
    677       REAL(KIND=wp) :: zdaystp 
    678       INTEGER, DIMENSION(:,:), SAVE, ALLOCATABLE :: & 
    679          & icount_sstnight,      & 
    680          & imask_night 
    681       REAL(kind=wp), DIMENSION(:,:), SAVE, ALLOCATABLE :: & 
    682          & zintmp, & 
    683          & zouttmp, &  
    684          & zmeanday    ! to compute model sst in region of 24h daylight (pole) 
    685       REAL(kind=wp), DIMENSION(2,2,1) :: & 
    686          & zweig 
    687       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
    688          & zmask, & 
    689          & zsstl, & 
    690          & zsstm, & 
    691          & zglam, & 
    692          & zgphi 
    693       INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
    694          & igrdi, & 
    695          & igrdj 
    696       LOGICAL, INTENT(IN) :: ld_nightav 
    697  
    698       !----------------------------------------------------------------------- 
    699       ! Local initialization  
    700       !----------------------------------------------------------------------- 
    701       ! ... Record and data counters 
    702       inrc = kt - kit000 + 2 
    703       isst = sstdatqc%nsstp(inrc) 
    704  
    705       IF ( ld_nightav ) THEN 
    706  
    707       ! Initialize array for night mean 
    708  
    709       IF ( kt .EQ. 0 ) THEN 
    710          ALLOCATE ( icount_sstnight(kpi,kpj) ) 
    711          ALLOCATE ( imask_night(kpi,kpj) ) 
    712          ALLOCATE ( zintmp(kpi,kpj) ) 
    713          ALLOCATE ( zouttmp(kpi,kpj) ) 
    714          ALLOCATE ( zmeanday(kpi,kpj) ) 
    715          nday_qsr = -1   ! initialisation flag for nbc_dcy 
    716       ENDIF 
    717  
    718       ! Initialize daily mean for first timestep 
    719       idayend = MOD( kt - kit000 + 1, kdaystp ) 
    720  
    721       ! Added kt == 0 test to catch restart case  
    722       IF ( idayend == 1 .OR. kt == 0) THEN 
    723          IF (lwp) WRITE(numout,*) 'Reset sstdatqc%vdmean on time-step: ',kt 
    724          DO jj = 1, jpj 
    725             DO ji = 1, jpi 
    726                sstdatqc%vdmean(ji,jj) = 0.0 
    727                zmeanday(ji,jj) = 0.0 
    728                icount_sstnight(ji,jj) = 0 
    729             END DO 
    730          END DO 
    731       ENDIF 
    732  
    733       zintmp(:,:) = 0.0 
    734       zouttmp(:,:) = sbc_dcy( zintmp(:,:), .TRUE. ) 
    735       imask_night(:,:) = INT( zouttmp(:,:) ) 
    736  
    737       DO jj = 1, jpj 
    738          DO ji = 1, jpi 
    739             ! Increment the temperature field for computing night mean and counter 
    740             sstdatqc%vdmean(ji,jj) = sstdatqc%vdmean(ji,jj)  & 
    741                    &                        + psstn(ji,jj)*imask_night(ji,jj) 
    742             zmeanday(ji,jj)        = zmeanday(ji,jj) + psstn(ji,jj) 
    743             icount_sstnight(ji,jj) = icount_sstnight(ji,jj) + imask_night(ji,jj) 
    744          END DO 
    745       END DO 
    746     
    747       ! Compute the daily mean at the end of day 
    748  
    749       zdaystp = 1.0 / REAL( kdaystp ) 
    750  
    751       IF ( idayend == 0 ) THEN  
    752          DO jj = 1, jpj 
    753             DO ji = 1, jpi 
    754                ! Test if "no night" point 
    755                IF ( icount_sstnight(ji,jj) .NE. 0 ) THEN 
    756                   sstdatqc%vdmean(ji,jj) = sstdatqc%vdmean(ji,jj) & 
    757                     &                        / icount_sstnight(ji,jj)  
    758                ELSE 
    759                   sstdatqc%vdmean(ji,jj) = zmeanday(ji,jj) * zdaystp 
    760                ENDIF 
    761             END DO 
    762          END DO 
    763       ENDIF 
    764  
    765       ENDIF 
    766  
    767       ! Get the data for interpolation 
    768        
    769       ALLOCATE( & 
    770          & igrdi(2,2,isst), & 
    771          & igrdj(2,2,isst), & 
    772          & zglam(2,2,isst), & 
    773          & zgphi(2,2,isst), & 
    774          & zmask(2,2,isst), & 
    775          & zsstl(2,2,isst)  & 
    776          & ) 
    777        
    778       DO jobs = sstdatqc%nsurfup + 1, sstdatqc%nsurfup + isst 
    779          iobs = jobs - sstdatqc%nsurfup 
    780          igrdi(1,1,iobs) = sstdatqc%mi(jobs)-1 
    781          igrdj(1,1,iobs) = sstdatqc%mj(jobs)-1 
    782          igrdi(1,2,iobs) = sstdatqc%mi(jobs)-1 
    783          igrdj(1,2,iobs) = sstdatqc%mj(jobs) 
    784          igrdi(2,1,iobs) = sstdatqc%mi(jobs) 
    785          igrdj(2,1,iobs) = sstdatqc%mj(jobs)-1 
    786          igrdi(2,2,iobs) = sstdatqc%mi(jobs) 
    787          igrdj(2,2,iobs) = sstdatqc%mj(jobs) 
    788       END DO 
    789        
    790       CALL obs_int_comm_2d( 2, 2, isst, & 
    791          &                  igrdi, igrdj, glamt, zglam ) 
    792       CALL obs_int_comm_2d( 2, 2, isst, & 
    793          &                  igrdi, igrdj, gphit, zgphi ) 
    794       CALL obs_int_comm_2d( 2, 2, isst, & 
    795          &                  igrdi, igrdj, psstmask, zmask ) 
    796       CALL obs_int_comm_2d( 2, 2, isst, & 
    797          &                  igrdi, igrdj, psstn, zsstl ) 
    798  
    799       ! At the end of the day get interpolated means 
    800       IF ( idayend == 0 .AND. ld_nightav ) THEN 
    801  
    802          ALLOCATE( & 
    803             & zsstm(2,2,isst)  & 
    804             & ) 
    805  
    806          CALL obs_int_comm_2d( 2, 2, isst, igrdi, igrdj, & 
    807             &               sstdatqc%vdmean(:,:), zsstm ) 
    808  
    809       ENDIF 
    810  
    811       ! Loop over observations 
    812  
    813       DO jobs = sstdatqc%nsurfup + 1, sstdatqc%nsurfup + isst 
    814           
    815          iobs = jobs - sstdatqc%nsurfup 
    816           
    817          IF ( kt /= sstdatqc%mstp(jobs) ) THEN 
    818              
    819             IF(lwp) THEN 
    820                WRITE(numout,*) 
    821                WRITE(numout,*) ' E R R O R : Observation',              & 
    822                   &            ' time step is not consistent with the', & 
    823                   &            ' model time step' 
    824                WRITE(numout,*) ' =========' 
    825                WRITE(numout,*) 
    826                WRITE(numout,*) ' Record  = ', jobs,                & 
    827                   &            ' kt      = ', kt,                  & 
    828                   &            ' mstp    = ', sstdatqc%mstp(jobs), & 
    829                   &            ' ntyp    = ', sstdatqc%ntyp(jobs) 
    830             ENDIF 
    831             CALL ctl_stop( 'obs_sst_opt', 'Inconsistent time' ) 
    832              
    833          ENDIF 
    834           
    835          zlam = sstdatqc%rlam(jobs) 
    836          zphi = sstdatqc%rphi(jobs) 
    837           
    838          ! Get weights to interpolate the model SST to the observation point 
    839          CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
    840             &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
    841             &                   zmask(:,:,iobs), zweig, zobsmask ) 
    842              
    843          ! Interpolate the model SST to the observation point  
    844  
    845          IF ( ld_nightav ) THEN 
    846  
    847            IF ( idayend == 0 )  THEN 
    848                ! Daily averaged/diurnal cycle of SST  data 
    849                CALL obs_int_h2d( 1, 1,      &  
    850                      &              zweig, zsstm(:,:,iobs), zext ) 
    851             ELSE  
    852                CALL ctl_stop( ' ld_nightav is set to true: a nonzero' //     & 
    853                      &           ' number of night SST data should' // & 
    854                      &           ' only occur at the end of a given day' ) 
    855             ENDIF 
    856  
    857          ELSE 
    858  
    859             CALL obs_int_h2d( 1, 1,      & 
    860             &              zweig, zsstl(:,:,iobs),  zext ) 
    861  
    862          ENDIF 
    863          sstdatqc%rmod(jobs,1) = zext(1) 
    864           
    865       END DO 
    866        
    867       ! Deallocate the data for interpolation 
    868       DEALLOCATE( & 
    869          & igrdi, & 
    870          & igrdj, & 
    871          & zglam, & 
    872          & zgphi, & 
    873          & zmask, & 
    874          & zsstl  & 
    875          & ) 
    876  
    877       ! At the end of the day also get interpolated means 
    878       IF ( idayend == 0 .AND. ld_nightav ) THEN 
     1008      ! At the end of the day also deallocate night-time mean array 
     1009      IF ( idayend == 0 .AND. ldnightav ) THEN 
    8791010         DEALLOCATE( & 
    880             & zsstm  & 
     1011            & zsurfm  & 
    8811012            & ) 
    8821013      ENDIF 
    883        
    884       sstdatqc%nsurfup = sstdatqc%nsurfup + isst 
    885  
    886    END SUBROUTINE obs_sst_opt 
    887  
    888    SUBROUTINE obs_sss_opt 
    889       !!----------------------------------------------------------------------- 
    890       !! 
    891       !!                     ***  ROUTINE obs_sss_opt  *** 
    892       !! 
    893       !! ** Purpose : Compute the model counterpart of sea surface salinity 
    894       !!              data by interpolating from the model grid to the  
    895       !!              observation point. 
    896       !! 
    897       !! ** Method  :  
    898       !! 
    899       !! ** Action  : 
    900       !! 
    901       !! History : 
    902       !!      ! ??-??  
    903       !!----------------------------------------------------------------------- 
    904  
    905       IMPLICIT NONE 
    906  
    907    END SUBROUTINE obs_sss_opt 
    908  
    909    SUBROUTINE obs_seaice_opt( seaicedatqc, kt, kpi, kpj, kit000, & 
    910       &                    pseaicen, pseaicemask, k2dint ) 
    911  
    912       !!----------------------------------------------------------------------- 
    913       !! 
    914       !!                     ***  ROUTINE obs_seaice_opt  *** 
    915       !! 
    916       !! ** Purpose : Compute the model counterpart of surface temperature 
    917       !!              data by interpolating from the model grid to the  
    918       !!              observation point. 
    919       !! 
    920       !! ** Method  : Linearly interpolate to each observation point using  
    921       !!              the model values at the corners of the surrounding grid box. 
    922       !! 
    923       !!    The now model sea ice is first computed at the obs (lon, lat) point. 
    924       !! 
    925       !!    Several horizontal interpolation schemes are available: 
    926       !!        - distance-weighted (great circle) (k2dint = 0) 
    927       !!        - distance-weighted (small angle)  (k2dint = 1) 
    928       !!        - bilinear (geographical grid)     (k2dint = 2) 
    929       !!        - bilinear (quadrilateral grid)    (k2dint = 3) 
    930       !!        - polynomial (quadrilateral grid)  (k2dint = 4) 
    931       !! 
    932       !! 
    933       !! ** Action  : 
    934       !! 
    935       !! History : 
    936       !!        !  07-07  (S. Ricci ) : Original 
    937       !!       
    938       !!----------------------------------------------------------------------- 
    939  
    940       !! * Modules used 
    941       USE obs_surf_def  ! Definition of storage space for surface observations 
    942  
    943       IMPLICIT NONE 
    944  
    945       !! * Arguments 
    946       TYPE(obs_surf), INTENT(INOUT) :: seaicedatqc     ! Subset of surface data not failing screening 
    947       INTEGER, INTENT(IN) :: kt       ! Time step 
    948       INTEGER, INTENT(IN) :: kpi      ! Model grid parameters 
    949       INTEGER, INTENT(IN) :: kpj 
    950       INTEGER, INTENT(IN) :: kit000   ! Number of the first time step  
    951                                       !   (kit000-1 = restart time) 
    952       INTEGER, INTENT(IN) :: k2dint   ! Horizontal interpolation type (see header) 
    953       REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
    954          & pseaicen,  &    ! Model sea ice field 
    955          & pseaicemask     ! Land-sea mask 
    956           
    957       !! * Local declarations 
    958       INTEGER :: ji 
    959       INTEGER :: jj 
    960       INTEGER :: jobs 
    961       INTEGER :: inrc 
    962       INTEGER :: iseaice 
    963       INTEGER :: iobs 
    964         
    965       REAL(KIND=wp) :: zlam 
    966       REAL(KIND=wp) :: zphi 
    967       REAL(KIND=wp) :: zext(1), zobsmask(1) 
    968       REAL(kind=wp), DIMENSION(2,2,1) :: & 
    969          & zweig 
    970       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
    971          & zmask, & 
    972          & zseaicel, & 
    973          & zglam, & 
    974          & zgphi 
    975       INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
    976          & igrdi, & 
    977          & igrdj 
    978  
    979       !------------------------------------------------------------------------ 
    980       ! Local initialization  
    981       !------------------------------------------------------------------------ 
    982       ! ... Record and data counters 
    983       inrc = kt - kit000 + 2 
    984       iseaice = seaicedatqc%nsstp(inrc) 
    985  
    986       ! Get the data for interpolation 
    987        
    988       ALLOCATE( & 
    989          & igrdi(2,2,iseaice), & 
    990          & igrdj(2,2,iseaice), & 
    991          & zglam(2,2,iseaice), & 
    992          & zgphi(2,2,iseaice), & 
    993          & zmask(2,2,iseaice), & 
    994          & zseaicel(2,2,iseaice)  & 
    995          & ) 
    996        
    997       DO jobs = seaicedatqc%nsurfup + 1, seaicedatqc%nsurfup + iseaice 
    998          iobs = jobs - seaicedatqc%nsurfup 
    999          igrdi(1,1,iobs) = seaicedatqc%mi(jobs)-1 
    1000          igrdj(1,1,iobs) = seaicedatqc%mj(jobs)-1 
    1001          igrdi(1,2,iobs) = seaicedatqc%mi(jobs)-1 
    1002          igrdj(1,2,iobs) = seaicedatqc%mj(jobs) 
    1003          igrdi(2,1,iobs) = seaicedatqc%mi(jobs) 
    1004          igrdj(2,1,iobs) = seaicedatqc%mj(jobs)-1 
    1005          igrdi(2,2,iobs) = seaicedatqc%mi(jobs) 
    1006          igrdj(2,2,iobs) = seaicedatqc%mj(jobs) 
    1007       END DO 
    1008        
    1009       CALL obs_int_comm_2d( 2, 2, iseaice, & 
    1010          &                  igrdi, igrdj, glamt, zglam ) 
    1011       CALL obs_int_comm_2d( 2, 2, iseaice, & 
    1012          &                  igrdi, igrdj, gphit, zgphi ) 
    1013       CALL obs_int_comm_2d( 2, 2, iseaice, & 
    1014          &                  igrdi, igrdj, pseaicemask, zmask ) 
    1015       CALL obs_int_comm_2d( 2, 2, iseaice, & 
    1016          &                  igrdi, igrdj, pseaicen, zseaicel ) 
    1017        
    1018       DO jobs = seaicedatqc%nsurfup + 1, seaicedatqc%nsurfup + iseaice 
    1019           
    1020          iobs = jobs - seaicedatqc%nsurfup 
    1021           
    1022          IF ( kt /= seaicedatqc%mstp(jobs) ) THEN 
    1023              
    1024             IF(lwp) THEN 
    1025                WRITE(numout,*) 
    1026                WRITE(numout,*) ' E R R O R : Observation',              & 
    1027                   &            ' time step is not consistent with the', & 
    1028                   &            ' model time step' 
    1029                WRITE(numout,*) ' =========' 
    1030                WRITE(numout,*) 
    1031                WRITE(numout,*) ' Record  = ', jobs,                & 
    1032                   &            ' kt      = ', kt,                  & 
    1033                   &            ' mstp    = ', seaicedatqc%mstp(jobs), & 
    1034                   &            ' ntyp    = ', seaicedatqc%ntyp(jobs) 
    1035             ENDIF 
    1036             CALL ctl_stop( 'obs_seaice_opt', 'Inconsistent time' ) 
    1037              
    1038          ENDIF 
    1039           
    1040          zlam = seaicedatqc%rlam(jobs) 
    1041          zphi = seaicedatqc%rphi(jobs) 
    1042           
    1043          ! Get weights to interpolate the model sea ice to the observation point 
    1044          CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
    1045             &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
    1046             &                   zmask(:,:,iobs), zweig, zobsmask ) 
    1047           
    1048          ! ... Interpolate the model sea ice to the observation point 
    1049          CALL obs_int_h2d( 1, 1,      & 
    1050             &              zweig, zseaicel(:,:,iobs),  zext ) 
    1051           
    1052          seaicedatqc%rmod(jobs,1) = zext(1) 
    1053           
    1054       END DO 
    1055        
    1056       ! Deallocate the data for interpolation 
    1057       DEALLOCATE( & 
    1058          & igrdi,    & 
    1059          & igrdj,    & 
    1060          & zglam,    & 
    1061          & zgphi,    & 
    1062          & zmask,    & 
    1063          & zseaicel  & 
    1064          & ) 
    1065        
    1066       seaicedatqc%nsurfup = seaicedatqc%nsurfup + iseaice 
    1067  
    1068    END SUBROUTINE obs_seaice_opt 
    1069  
    1070    SUBROUTINE obs_vel_opt( prodatqc, kt, kpi, kpj, kpk, kit000, kdaystp, & 
    1071       &                    pun, pvn, pgdept, pumask, pvmask, k1dint, k2dint, & 
    1072       &                    ld_dailyav ) 
    1073       !!----------------------------------------------------------------------- 
    1074       !! 
    1075       !!                     ***  ROUTINE obs_vel_opt  *** 
    1076       !! 
    1077       !! ** Purpose : Compute the model counterpart of velocity profile 
    1078       !!              data by interpolating from the model grid to the  
    1079       !!              observation point. 
    1080       !! 
    1081       !! ** Method  : Linearly interpolate zonal and meridional components of velocity  
    1082       !!              to each observation point using the model values at the corners of  
    1083       !!              the surrounding grid box. The model velocity components are on a  
    1084       !!              staggered C- grid. 
    1085       !! 
    1086       !!    For velocity data from the TAO array, the model equivalent is 
    1087       !!    a daily mean velocity field. So, we first compute 
    1088       !!    the mean, then interpolate only at the end of the day. 
    1089       !! 
    1090       !! ** Action  : 
    1091       !! 
    1092       !! History : 
    1093       !!    ! 07-03 (K. Mogensen)      : Temperature and Salinity profiles 
    1094       !!    ! 08-10 (Maria Valdivieso) : Velocity component (U,V) profiles 
    1095       !!----------------------------------------------------------------------- 
    1096      
    1097       !! * Modules used 
    1098       USE obs_profiles_def ! Definition of storage space for profile obs. 
    1099  
    1100       IMPLICIT NONE 
    1101  
    1102       !! * Arguments 
    1103       TYPE(obs_prof), INTENT(INOUT) :: & 
    1104          & prodatqc        ! Subset of profile data not failing screening 
    1105       INTEGER, INTENT(IN) :: kt        ! Time step 
    1106       INTEGER, INTENT(IN) :: kpi       ! Model grid parameters 
    1107       INTEGER, INTENT(IN) :: kpj 
    1108       INTEGER, INTENT(IN) :: kpk  
    1109       INTEGER, INTENT(IN) :: kit000    ! Number of the first time step  
    1110                                        !   (kit000-1 = restart time) 
    1111       INTEGER, INTENT(IN) :: k1dint    ! Vertical interpolation type (see header) 
    1112       INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header) 
    1113       INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day                     
    1114       REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 
    1115          & pun,    &    ! Model zonal component of velocity 
    1116          & pvn,    &    ! Model meridional component of velocity 
    1117          & pumask, &    ! Land-sea mask 
    1118          & pvmask       ! Land-sea mask 
    1119       REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: & 
    1120          & pgdept       ! Model array of depth levels 
    1121       LOGICAL, INTENT(IN) :: ld_dailyav 
    1122           
    1123       !! * Local declarations 
    1124       INTEGER :: ji 
    1125       INTEGER :: jj 
    1126       INTEGER :: jk 
    1127       INTEGER :: jobs 
    1128       INTEGER :: inrc 
    1129       INTEGER :: ipro 
    1130       INTEGER :: idayend 
    1131       INTEGER :: ista 
    1132       INTEGER :: iend 
    1133       INTEGER :: iobs 
    1134       INTEGER, DIMENSION(imaxavtypes) :: & 
    1135          & idailyavtypes 
    1136       REAL(KIND=wp) :: zlam 
    1137       REAL(KIND=wp) :: zphi 
    1138       REAL(KIND=wp) :: zdaystp 
    1139       REAL(KIND=wp), DIMENSION(kpk) :: & 
    1140          & zobsmasku, & 
    1141          & zobsmaskv, & 
    1142          & zobsmask,  & 
    1143          & zobsk,     & 
    1144          & zobs2k 
    1145       REAL(KIND=wp), DIMENSION(2,2,kpk) :: & 
    1146          & zweigu,zweigv 
    1147       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: & 
    1148          & zumask, zvmask, & 
    1149          & zintu, & 
    1150          & zintv, & 
    1151          & zinmu, & 
    1152          & zinmv 
    1153       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
    1154          & zglamu, zglamv, & 
    1155          & zgphiu, zgphiv 
    1156       INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
    1157          & igrdiu, & 
    1158          & igrdju, & 
    1159          & igrdiv, & 
    1160          & igrdjv 
    1161  
    1162       !------------------------------------------------------------------------ 
    1163       ! Local initialization  
    1164       !------------------------------------------------------------------------ 
    1165       ! ... Record and data counters 
    1166       inrc = kt - kit000 + 2 
    1167       ipro = prodatqc%npstp(inrc) 
    1168  
    1169       ! Initialize daily mean for first timestep 
    1170       idayend = MOD( kt - kit000 + 1, kdaystp ) 
    1171  
    1172       ! Added kt == 0 test to catch restart case  
    1173       IF ( idayend == 1 .OR. kt == 0) THEN 
    1174          IF (lwp) WRITE(numout,*) 'Reset prodatqc%vdmean on time-step: ',kt 
    1175          prodatqc%vdmean(:,:,:,1) = 0.0 
    1176          prodatqc%vdmean(:,:,:,2) = 0.0 
    1177       ENDIF 
    1178  
    1179       ! Increment the zonal velocity field for computing daily mean 
    1180       prodatqc%vdmean(:,:,:,1) = prodatqc%vdmean(:,:,:,1) + pun(:,:,:) 
    1181       ! Increment the meridional velocity field for computing daily mean 
    1182       prodatqc%vdmean(:,:,:,2) = prodatqc%vdmean(:,:,:,2) + pvn(:,:,:) 
    1183     
    1184       ! Compute the daily mean at the end of day 
    1185       zdaystp = 1.0 / REAL( kdaystp ) 
    1186       IF ( idayend == 0 ) THEN 
    1187          prodatqc%vdmean(:,:,:,1) = prodatqc%vdmean(:,:,:,1) * zdaystp 
    1188          prodatqc%vdmean(:,:,:,2) = prodatqc%vdmean(:,:,:,2) * zdaystp 
    1189       ENDIF 
    1190  
    1191       ! Get the data for interpolation 
    1192       ALLOCATE( & 
    1193          & igrdiu(2,2,ipro),      & 
    1194          & igrdju(2,2,ipro),      & 
    1195          & igrdiv(2,2,ipro),      & 
    1196          & igrdjv(2,2,ipro),      & 
    1197          & zglamu(2,2,ipro), zglamv(2,2,ipro), & 
    1198          & zgphiu(2,2,ipro), zgphiv(2,2,ipro), & 
    1199          & zumask(2,2,kpk,ipro), zvmask(2,2,kpk,ipro), & 
    1200          & zintu(2,2,kpk,ipro),  & 
    1201          & zintv(2,2,kpk,ipro)   & 
    1202          & ) 
    1203  
    1204       DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 
    1205          iobs = jobs - prodatqc%nprofup 
    1206          igrdiu(1,1,iobs) = prodatqc%mi(jobs,1)-1 
    1207          igrdju(1,1,iobs) = prodatqc%mj(jobs,1)-1 
    1208          igrdiu(1,2,iobs) = prodatqc%mi(jobs,1)-1 
    1209          igrdju(1,2,iobs) = prodatqc%mj(jobs,1) 
    1210          igrdiu(2,1,iobs) = prodatqc%mi(jobs,1) 
    1211          igrdju(2,1,iobs) = prodatqc%mj(jobs,1)-1 
    1212          igrdiu(2,2,iobs) = prodatqc%mi(jobs,1) 
    1213          igrdju(2,2,iobs) = prodatqc%mj(jobs,1) 
    1214          igrdiv(1,1,iobs) = prodatqc%mi(jobs,2)-1 
    1215          igrdjv(1,1,iobs) = prodatqc%mj(jobs,2)-1 
    1216          igrdiv(1,2,iobs) = prodatqc%mi(jobs,2)-1 
    1217          igrdjv(1,2,iobs) = prodatqc%mj(jobs,2) 
    1218          igrdiv(2,1,iobs) = prodatqc%mi(jobs,2) 
    1219          igrdjv(2,1,iobs) = prodatqc%mj(jobs,2)-1 
    1220          igrdiv(2,2,iobs) = prodatqc%mi(jobs,2) 
    1221          igrdjv(2,2,iobs) = prodatqc%mj(jobs,2) 
    1222       END DO 
    1223  
    1224       CALL obs_int_comm_2d( 2, 2, ipro, igrdiu, igrdju, glamu, zglamu ) 
    1225       CALL obs_int_comm_2d( 2, 2, ipro, igrdiu, igrdju, gphiu, zgphiu ) 
    1226       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiu, igrdju, pumask, zumask ) 
    1227       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiu, igrdju, pun, zintu ) 
    1228  
    1229       CALL obs_int_comm_2d( 2, 2, ipro, igrdiv, igrdjv, glamv, zglamv ) 
    1230       CALL obs_int_comm_2d( 2, 2, ipro, igrdiv, igrdjv, gphiv, zgphiv ) 
    1231       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiv, igrdjv, pvmask, zvmask ) 
    1232       CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiv, igrdjv, pvn, zintv ) 
    1233  
    1234       ! At the end of the day also get interpolated means 
    1235       IF ( idayend == 0 ) THEN 
    1236  
    1237          ALLOCATE( & 
    1238             & zinmu(2,2,kpk,ipro),  & 
    1239             & zinmv(2,2,kpk,ipro)   & 
    1240             & ) 
    1241  
    1242          CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiu, igrdju, & 
    1243             &                  prodatqc%vdmean(:,:,:,1), zinmu ) 
    1244          CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiv, igrdjv, & 
    1245             &                  prodatqc%vdmean(:,:,:,2), zinmv ) 
    1246  
    1247       ENDIF 
    1248  
    1249 ! loop over observations 
    1250  
    1251       DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 
    1252  
    1253          iobs = jobs - prodatqc%nprofup 
    1254  
    1255          IF ( kt /= prodatqc%mstp(jobs) ) THEN 
    1256              
    1257             IF(lwp) THEN 
    1258                WRITE(numout,*) 
    1259                WRITE(numout,*) ' E R R O R : Observation',              & 
    1260                   &            ' time step is not consistent with the', & 
    1261                   &            ' model time step' 
    1262                WRITE(numout,*) ' =========' 
    1263                WRITE(numout,*) 
    1264                WRITE(numout,*) ' Record  = ', jobs,                    & 
    1265                   &            ' kt      = ', kt,                      & 
    1266                   &            ' mstp    = ', prodatqc%mstp(jobs), & 
    1267                   &            ' ntyp    = ', prodatqc%ntyp(jobs) 
    1268             ENDIF 
    1269             CALL ctl_stop( 'obs_pro_opt', 'Inconsistent time' ) 
    1270          ENDIF 
    1271           
    1272          zlam = prodatqc%rlam(jobs) 
    1273          zphi = prodatqc%rphi(jobs) 
    1274  
    1275          ! Initialize observation masks 
    1276  
    1277          zobsmasku(:) = 0.0 
    1278          zobsmaskv(:) = 0.0 
    1279           
    1280          ! Horizontal weights and vertical mask 
    1281  
    1282          IF  ( prodatqc%npvend(jobs,1) > 0 ) THEN 
    1283  
    1284             CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     & 
    1285                &                   zglamu(:,:,iobs), zgphiu(:,:,iobs), & 
    1286                &                   zumask(:,:,:,iobs), zweigu, zobsmasku ) 
    1287  
    1288          ENDIF 
    1289  
    1290           
    1291          IF ( prodatqc%npvend(jobs,2) > 0 ) THEN 
    1292  
    1293             CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     & 
    1294                &                   zglamv(:,:,iobs), zgphiv(:,:,iobs), & 
    1295                &                   zvmask(:,:,:,iobs), zweigv, zobsmasku ) 
    1296  
    1297          ENDIF 
    1298  
    1299          ! Ensure that the vertical mask on u and v are consistent. 
    1300  
    1301          zobsmask(:) = MIN( zobsmasku(:), zobsmaskv(:) ) 
    1302  
    1303          IF ( prodatqc%npvend(jobs,1) > 0 ) THEN 
    1304  
    1305             zobsk(:) = obfillflt 
    1306  
    1307        IF ( ld_dailyav ) THEN 
    1308  
    1309                IF ( idayend == 0 )  THEN 
    1310                    
    1311                   ! Daily averaged data 
    1312                    
    1313                   CALL obs_int_h2d( kpk, kpk,      & 
    1314                      &              zweigu, zinmu(:,:,:,iobs), zobsk ) 
    1315                    
    1316                    
    1317                ELSE 
    1318                 
    1319                   CALL ctl_stop( ' A nonzero' //     & 
    1320                      &           ' number of U profile data should' // & 
    1321                      &           ' only occur at the end of a given day' ) 
    1322  
    1323                ENDIF 
    1324            
    1325             ELSE  
    1326                 
    1327                ! Point data 
    1328  
    1329                CALL obs_int_h2d( kpk, kpk,      & 
    1330                   &              zweigu, zintu(:,:,:,iobs), zobsk ) 
    1331  
    1332             ENDIF 
    1333  
    1334             !------------------------------------------------------------- 
    1335             ! Compute vertical second-derivative of the interpolating  
    1336             ! polynomial at obs points 
    1337             !------------------------------------------------------------- 
    1338              
    1339             IF ( k1dint == 1 ) THEN 
    1340                CALL obs_int_z1d_spl( kpk, zobsk, zobs2k,   & 
    1341                   &                  pgdept, zobsmask ) 
    1342             ENDIF 
    1343              
    1344             !----------------------------------------------------------------- 
    1345             !  Vertical interpolation to the observation point 
    1346             !----------------------------------------------------------------- 
    1347             ista = prodatqc%npvsta(jobs,1) 
    1348             iend = prodatqc%npvend(jobs,1) 
    1349             CALL obs_int_z1d( kpk,                & 
    1350                & prodatqc%var(1)%mvk(ista:iend),  & 
    1351                & k1dint, iend - ista + 1,         & 
    1352                & prodatqc%var(1)%vdep(ista:iend), & 
    1353                & zobsk, zobs2k,                   & 
    1354                & prodatqc%var(1)%vmod(ista:iend), & 
    1355                & pgdept, zobsmask ) 
    1356  
    1357          ENDIF 
    1358  
    1359          IF ( prodatqc%npvend(jobs,2) > 0 ) THEN 
    1360  
    1361             zobsk(:) = obfillflt 
    1362  
    1363             IF ( ld_dailyav ) THEN 
    1364  
    1365                IF ( idayend == 0 )  THEN 
    1366  
    1367                   ! Daily averaged data 
    1368                    
    1369                   CALL obs_int_h2d( kpk, kpk,      & 
    1370                      &              zweigv, zinmv(:,:,:,iobs), zobsk ) 
    1371                    
    1372                ELSE 
    1373  
    1374                   CALL ctl_stop( ' A nonzero' //     & 
    1375                      &           ' number of V profile data should' // & 
    1376                      &           ' only occur at the end of a given day' ) 
    1377  
    1378                ENDIF 
    1379  
    1380             ELSE 
    1381                 
    1382                ! Point data 
    1383  
    1384                CALL obs_int_h2d( kpk, kpk,      & 
    1385                   &              zweigv, zintv(:,:,:,iobs), zobsk ) 
    1386  
    1387             ENDIF 
    1388  
    1389  
    1390             !------------------------------------------------------------- 
    1391             ! Compute vertical second-derivative of the interpolating  
    1392             ! polynomial at obs points 
    1393             !------------------------------------------------------------- 
    1394              
    1395             IF ( k1dint == 1 ) THEN 
    1396                CALL obs_int_z1d_spl( kpk, zobsk, zobs2k, & 
    1397                   &                  pgdept, zobsmask ) 
    1398             ENDIF 
    1399              
    1400             !---------------------------------------------------------------- 
    1401             !  Vertical interpolation to the observation point 
    1402             !---------------------------------------------------------------- 
    1403             ista = prodatqc%npvsta(jobs,2) 
    1404             iend = prodatqc%npvend(jobs,2) 
    1405             CALL obs_int_z1d( kpk, & 
    1406                & prodatqc%var(2)%mvk(ista:iend),& 
    1407                & k1dint, iend - ista + 1, & 
    1408                & prodatqc%var(2)%vdep(ista:iend),& 
    1409                & zobsk, zobs2k, & 
    1410                & prodatqc%var(2)%vmod(ista:iend),& 
    1411                & pgdept, zobsmask ) 
    1412  
    1413          ENDIF 
    1414  
    1415       END DO 
    1416   
    1417       ! Deallocate the data for interpolation 
    1418       DEALLOCATE( & 
    1419          & igrdiu, & 
    1420          & igrdju, & 
    1421          & igrdiv, & 
    1422          & igrdjv, & 
    1423          & zglamu, zglamv, & 
    1424          & zgphiu, zgphiv, & 
    1425          & zumask, zvmask, & 
    1426          & zintu, & 
    1427          & zintv  & 
    1428          & ) 
    1429       ! At the end of the day also get interpolated means 
    1430       IF ( idayend == 0 ) THEN 
    1431          DEALLOCATE( & 
    1432             & zinmu,  & 
    1433             & zinmv   & 
    1434             & ) 
    1435       ENDIF 
    1436  
    1437       prodatqc%nprofup = prodatqc%nprofup + ipro  
    1438        
    1439    END SUBROUTINE obs_vel_opt 
     1014 
     1015      surfdataqc%nsurfup = surfdataqc%nsurfup + isurf 
     1016 
     1017   END SUBROUTINE obs_surf_opt 
    14401018 
    14411019END MODULE obs_oper 
    1442  

  • branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90

    r10005 r10120  
    77 
    88   !!--------------------------------------------------------------------- 
    9    !!   obs_pre_pro  : First level check and screening of T/S profiles 
    10    !!   obs_pre_sla  : First level check and screening of SLA observations 
    11    !!   obs_pre_sst  : First level check and screening of SLA observations 
    12    !!   obs_pre_seaice : First level check and screening of sea ice observations 
    13    !!   obs_pre_vel  : First level check and screening of velocity obs. 
    14    !!   obs_scr      : Basic screening of the observations 
    15    !!   obs_coo_tim  : Compute number of time steps to the observation time 
    16    !!   obs_sor      : Sort the observation arrays 
     9   !!   obs_pre_prof  : First level check and screening of profile observations 
     10   !!   obs_pre_surf  : First level check and screening of surface observations 
     11   !!   obs_scr       : Basic screening of the observations 
     12   !!   obs_coo_tim   : Compute number of time steps to the observation time 
     13   !!   obs_sor       : Sort the observation arrays 
    1714   !!--------------------------------------------------------------------- 
    1815   !! * Modules used 
    … …  
    2724   USE obs_inter_sup      ! Interpolation support 
    2825   USE obs_oper           ! Observation operators 
     26#if defined key_bdy 
     27   USE bdy_oce, ONLY : &        ! Boundary information 
     28      idx_bdy, nb_bdy 
     29#endif 
    2930   USE lib_mpp, ONLY : & 
    3031      & ctl_warn, ctl_stop 
    … …  
    3637 
    3738   PUBLIC & 
    38       & obs_pre_pro, &    ! First level check and screening of profiles 
    39       & obs_pre_sla, &    ! First level check and screening of SLA data 
    40       & obs_pre_sst, &    ! First level check and screening of SLA data 
    41       & obs_pre_seaice, & ! First level check and screening of sea ice data 
    42       & obs_pre_vel, &     ! First level check and screening of velocity profiles 
    43       & calc_month_len     ! Calculate the number of days in the months of a year   
     39      & obs_pre_prof, &    ! First level check and screening of profile obs 
     40      & obs_pre_surf, &    ! First level check and screening of surface obs 
     41      & calc_month_len     ! Calculate the number of days in the months of a year 
    4442 
    4543   !!---------------------------------------------------------------------- 
    … …  
    4947   !!---------------------------------------------------------------------- 
    5048 
     49!! * Substitutions  
     50#  include "domzgr_substitute.h90"   
     51 
    5152CONTAINS 
    5253 
    53    SUBROUTINE obs_pre_pro( profdata, prodatqc, ld_t3d, ld_s3d, ld_nea, & 
    54       &                    kdailyavtypes ) 
    55       !!---------------------------------------------------------------------- 
    56       !!                    ***  ROUTINE obs_pre_pro  *** 
    57       !! 
    58       !! ** Purpose : First level check and screening of T and S profiles 
    59       !! 
    60       !! ** Method  : First level check and screening of T and S profiles 
    61       !! 
    62       !! ** Action  :  
    63       !! 
    64       !! References : 
    65       !!    
    66       !! History : 
    67       !!        !  2007-01  (K. Mogensen) Merge of obs_pre_t3d and obs_pre_s3d  
    68       !!        !  2007-03  (K. Mogensen) General handling of profiles 
    69       !!        !  2007-06  (K. Mogensen et al) Reject obs. near land. 
    70       !!---------------------------------------------------------------------- 
    71       !! * Modules used 
    72       USE domstp              ! Domain: set the time-step 
    73       USE par_oce             ! Ocean parameters 
    74       USE dom_oce, ONLY : &   ! Geographical information 
    75          & glamt,   & 
    76          & gphit,   & 
    77          & gdept_1d,& 
    78          & tmask,   & 
    79          & nproc 
    80       !! * Arguments 
    81       TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Full set of profile data 
    82       TYPE(obs_prof), INTENT(INOUT) :: prodatqc     ! Subset of profile data not failing screening 
    83       LOGICAL, INTENT(IN) :: ld_t3d         ! Switch for temperature 
    84       LOGICAL, INTENT(IN) :: ld_s3d         ! Switch for salinity 
    85       LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land 
    86       INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    87          & kdailyavtypes! Types for daily averages 
    88       !! * Local declarations    
    89       INTEGER :: iyea0         ! Initial date 
    90       INTEGER :: imon0         !  - (year, month, day, hour, minute) 
    91       INTEGER :: iday0    
    92       INTEGER :: ihou0 
    93       INTEGER :: imin0 
    94       INTEGER :: icycle        ! Current assimilation cycle 
    95                                ! Counters for observations that 
    96       INTEGER :: iotdobs       !  - outside time domain 
    97       INTEGER :: iosdtobs      !  - outside space domain (temperature) 
    98       INTEGER :: iosdsobs      !  - outside space domain (salinity) 
    99       INTEGER :: ilantobs      !  - within a model land cell (temperature) 
    100       INTEGER :: ilansobs      !  - within a model land cell (salinity) 
    101       INTEGER :: inlatobs      !  - close to land (temperature) 
    102       INTEGER :: inlasobs      !  - close to land (salinity) 
    103       INTEGER :: igrdobs       !  - fail the grid search 
    104                                ! Global counters for observations that 
    105       INTEGER :: iotdobsmpp    !  - outside time domain 
    106       INTEGER :: iosdtobsmpp   !  - outside space domain (temperature) 
    107       INTEGER :: iosdsobsmpp   !  - outside space domain (salinity) 
    108       INTEGER :: ilantobsmpp   !  - within a model land cell (temperature) 
    109       INTEGER :: ilansobsmpp   !  - within a model land cell (salinity) 
    110       INTEGER :: inlatobsmpp   !  - close to land (temperature) 
    111       INTEGER :: inlasobsmpp   !  - close to land (salinity) 
    112       INTEGER :: igrdobsmpp    !  - fail the grid search 
    113       TYPE(obs_prof_valid) ::  llvalid     ! Profile selection  
    114       TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: & 
    115          & llvvalid            ! T,S selection  
    116       INTEGER :: jvar          ! Variable loop variable 
    117       INTEGER :: jobs          ! Obs. loop variable 
    118       INTEGER :: jstp          ! Time loop variable 
    119       INTEGER :: inrc          ! Time index variable 
    120        
    121       IF(lwp) WRITE(numout,*)'obs_pre_pro : Preparing the profile observations...' 
    122  
    123       ! Initial date initialization (year, month, day, hour, minute) 
    124       iyea0 =   ndate0 / 10000 
    125       imon0 = ( ndate0 - iyea0 * 10000 ) / 100 
    126       iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100 
    127       ihou0 =   nn_time0 / 100 
    128       imin0 = ( nn_time0 - ihou0 * 100 ) 
    129  
    130       icycle = no     ! Assimilation cycle 
    131  
    132       ! Diagnotics counters for various failures. 
    133  
    134       iotdobs  = 0 
    135       igrdobs  = 0 
    136       iosdtobs = 0 
    137       iosdsobs = 0 
    138       ilantobs = 0 
    139       ilansobs = 0 
    140       inlatobs = 0 
    141       inlasobs = 0 
    142  
    143       ! ----------------------------------------------------------------------- 
    144       ! Find time coordinate for profiles 
    145       ! ----------------------------------------------------------------------- 
    146  
    147       IF ( PRESENT(kdailyavtypes) ) THEN 
    148          CALL obs_coo_tim_prof( icycle, & 
    149             &                iyea0,   imon0,   iday0,   ihou0,   imin0,      & 
    150             &                profdata%nprof,   profdata%nyea, profdata%nmon, & 
    151             &                profdata%nday,    profdata%nhou, profdata%nmin, & 
    152             &                profdata%ntyp,    profdata%nqc,  profdata%mstp, & 
    153             &                iotdobs, kdailyavtypes = kdailyavtypes        ) 
    154       ELSE 
    155          CALL obs_coo_tim_prof( icycle, & 
    156             &                iyea0,   imon0,   iday0,   ihou0,   imin0,      & 
    157             &                profdata%nprof,   profdata%nyea, profdata%nmon, & 
    158             &                profdata%nday,    profdata%nhou, profdata%nmin, & 
    159             &                profdata%ntyp,    profdata%nqc,  profdata%mstp, & 
    160             &                iotdobs ) 
    161       ENDIF 
    162       CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 
    163        
    164       ! ----------------------------------------------------------------------- 
    165       ! Check for profiles failing the grid search 
    166       ! ----------------------------------------------------------------------- 
    167  
    168       CALL obs_coo_grd( profdata%nprof,   profdata%mi, profdata%mj, & 
    169          &              profdata%nqc,     igrdobs                         ) 
    170  
    171       CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 
    172  
    173       ! ----------------------------------------------------------------------- 
    174       ! Reject all observations for profiles with nqc > 10 
    175       ! ----------------------------------------------------------------------- 
    176  
    177       CALL obs_pro_rej( profdata ) 
    178  
    179       ! ----------------------------------------------------------------------- 
    180       ! Check for land points. This includes points below the model 
    181       ! bathymetry so this is done for every point in the profile 
    182       ! ----------------------------------------------------------------------- 
    183  
    184       ! Temperature 
    185  
    186       CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(1),   & 
    187          &                 profdata%npvsta(:,1),  profdata%npvend(:,1), & 
    188          &                 jpi,                   jpj,                  & 
    189          &                 jpk,                                         & 
    190          &                 profdata%mi,           profdata%mj,          &  
    191          &                 profdata%var(1)%mvk,                         & 
    192          &                 profdata%rlam,         profdata%rphi,        & 
    193          &                 profdata%var(1)%vdep,                        & 
    194          &                 glamt,                 gphit,                & 
    195          &                 gdept_1d,              tmask,                & 
    196          &                 profdata%nqc,          profdata%var(1)%nvqc, & 
    197          &                 iosdtobs,              ilantobs,             & 
    198          &                 inlatobs,              ld_nea                ) 
    199  
    200       CALL obs_mpp_sum_integer( iosdtobs, iosdtobsmpp ) 
    201       CALL obs_mpp_sum_integer( ilantobs, ilantobsmpp ) 
    202       CALL obs_mpp_sum_integer( inlatobs, inlatobsmpp ) 
    203  
    204       ! Salinity 
    205  
    206       CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(2),   & 
    207          &                 profdata%npvsta(:,2),  profdata%npvend(:,2), & 
    208          &                 jpi,                   jpj,                  & 
    209          &                 jpk,                                         & 
    210          &                 profdata%mi,           profdata%mj,          &  
    211          &                 profdata%var(2)%mvk,                         & 
    212          &                 profdata%rlam,         profdata%rphi,        & 
    213          &                 profdata%var(2)%vdep,                        & 
    214          &                 glamt,                 gphit,                & 
    215          &                 gdept_1d,              tmask,                & 
    216          &                 profdata%nqc,          profdata%var(2)%nvqc, & 
    217          &                 iosdsobs,              ilansobs,             & 
    218          &                 inlasobs,              ld_nea                ) 
    219  
    220       CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    221       CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    222       CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
    223  
    224       ! ----------------------------------------------------------------------- 
    225       ! Copy useful data from the profdata data structure to 
    226       ! the prodatqc data structure  
    227       ! ----------------------------------------------------------------------- 
    228  
    229       ! Allocate the selection arrays 
    230  
    231       ALLOCATE( llvalid%luse(profdata%nprof) ) 
    232       DO jvar = 1,profdata%nvar 
    233          ALLOCATE( llvvalid(jvar)%luse(profdata%nvprot(jvar)) ) 
    234       END DO 
    235  
    236       ! We want all data which has qc flags <= 10 
    237  
    238       llvalid%luse(:) = ( profdata%nqc(:)  <= 10 ) 
    239       DO jvar = 1,profdata%nvar 
    240          llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= 10 ) 
    241       END DO 
    242  
    243       ! The actual copying 
    244  
    245       CALL obs_prof_compress( profdata,     prodatqc,       .TRUE.,  numout, & 
    246          &                    lvalid=llvalid, lvvalid=llvvalid ) 
    247  
    248       ! Dellocate the selection arrays 
    249       DEALLOCATE( llvalid%luse ) 
    250       DO jvar = 1,profdata%nvar 
    251          DEALLOCATE( llvvalid(jvar)%luse ) 
    252       END DO 
    253  
    254       ! ----------------------------------------------------------------------- 
    255       ! Print information about what observations are left after qc 
    256       ! ----------------------------------------------------------------------- 
    257  
    258       ! Update the total observation counter array 
    259        
    260       IF(lwp) THEN 
    261          WRITE(numout,*) 
    262          WRITE(numout,*) 'obs_pre_pro :' 
    263          WRITE(numout,*) '~~~~~~~~~~~' 
    264          WRITE(numout,*) 
    265          WRITE(numout,*) ' Profiles outside time domain                = ', & 
    266             &            iotdobsmpp 
    267          WRITE(numout,*) ' Remaining profiles that failed grid search  = ', & 
    268             &            igrdobsmpp 
    269          WRITE(numout,*) ' Remaining T data outside space domain       = ', & 
    270             &            iosdtobsmpp 
    271          WRITE(numout,*) ' Remaining T data at land points             = ', & 
    272             &            ilantobsmpp 
    273          IF (ld_nea) THEN 
    274             WRITE(numout,*) ' Remaining T data near land points (removed) = ',& 
    275                &            inlatobsmpp 
    276          ELSE 
    277             WRITE(numout,*) ' Remaining T data near land points (kept)    = ',& 
    278                &            inlatobsmpp 
    279          ENDIF 
    280          WRITE(numout,*) ' T data accepted                             = ', & 
    281             &            prodatqc%nvprotmpp(1) 
    282          WRITE(numout,*) ' Remaining S data outside space domain       = ', & 
    283             &            iosdsobsmpp 
    284          WRITE(numout,*) ' Remaining S data at land points             = ', & 
    285             &            ilansobsmpp 
    286          IF (ld_nea) THEN 
    287             WRITE(numout,*) ' Remaining S data near land points (removed) = ',& 
    288                &            inlasobsmpp 
    289          ELSE 
    290             WRITE(numout,*) ' Remaining S data near land points (kept)    = ',& 
    291                &            inlasobsmpp 
    292          ENDIF 
    293          WRITE(numout,*) ' S data accepted                             = ', & 
    294             &            prodatqc%nvprotmpp(2) 
    295  
    296          WRITE(numout,*) 
    297          WRITE(numout,*) ' Number of observations per time step :' 
    298          WRITE(numout,*) 
    299          WRITE(numout,997) 
    300          WRITE(numout,998) 
    301       ENDIF 
    302        
    303       DO jobs = 1, prodatqc%nprof 
    304          inrc = prodatqc%mstp(jobs) + 2 - nit000 
    305          prodatqc%npstp(inrc)  = prodatqc%npstp(inrc) + 1 
    306          DO jvar = 1, prodatqc%nvar 
    307             IF ( prodatqc%npvend(jobs,jvar) > 0 ) THEN 
    308                prodatqc%nvstp(inrc,jvar) = prodatqc%nvstp(inrc,jvar) + & 
    309                   &                      ( prodatqc%npvend(jobs,jvar) - & 
    310                   &                        prodatqc%npvsta(jobs,jvar) + 1 ) 
    311             ENDIF 
    312          END DO 
    313       END DO 
    314        
    315        
    316       CALL obs_mpp_sum_integers( prodatqc%npstp, prodatqc%npstpmpp, & 
    317          &                       nitend - nit000 + 2 ) 
    318       DO jvar = 1, prodatqc%nvar 
    319          CALL obs_mpp_sum_integers( prodatqc%nvstp(:,jvar), & 
    320             &                       prodatqc%nvstpmpp(:,jvar), & 
    321             &                       nitend - nit000 + 2 ) 
    322       END DO 
    323  
    324       IF ( lwp ) THEN 
    325          DO jstp = nit000 - 1, nitend 
    326             inrc = jstp - nit000 + 2 
    327             WRITE(numout,999) jstp, prodatqc%npstpmpp(inrc), & 
    328                &                    prodatqc%nvstpmpp(inrc,1), & 
    329                &                    prodatqc%nvstpmpp(inrc,2) 
    330          END DO 
    331       ENDIF 
    332  
    333 997   FORMAT(10X,'Time step',5X,'Profiles',5X,'Temperature',5X,'Salinity') 
    334 998   FORMAT(10X,'---------',5X,'--------',5X,'-----------',5X,'--------') 
    335 999   FORMAT(10X,I9,5X,I8,5X,I11,5X,I8) 
    336        
    337    END SUBROUTINE obs_pre_pro 
    338  
    339    SUBROUTINE obs_pre_sla( sladata, sladatqc, ld_sla, ld_nea ) 
     54   SUBROUTINE obs_pre_surf( surfdata, surfdataqc, ld_nea, ld_bound_reject, & 
     55                            kqc_cutoff ) 
    34056      !!---------------------------------------------------------------------- 
    34157      !!                    ***  ROUTINE obs_pre_sla  *** 
    34258      !! 
    343       !! ** Purpose : First level check and screening of SLA observations 
    344       !! 
    345       !! ** Method  : First level check and screening of SLA observations 
     59      !! ** Purpose : First level check and screening of surface observations 
     60      !! 
     61      !! ** Method  : First level check and screening of surface observations 
    34662      !! 
    34763      !! ** Action  :  
    … …  
    35268      !!        !  2007-03  (A. Weaver, K. Mogensen) Original 
    35369      !!        !  2007-06  (K. Mogensen et al) Reject obs. near land. 
     70      !!        !  2015-02  (M. Martin) Combined routine for surface types. 
    35471      !!---------------------------------------------------------------------- 
    35572      !! * Modules used 
    … …  
    36279         & nproc 
    36380      !! * Arguments 
    364       TYPE(obs_surf), INTENT(INOUT) :: sladata    ! Full set of SLA data 
    365       TYPE(obs_surf), INTENT(INOUT) :: sladatqc   ! Subset of SLA data not failing screening 
    366       LOGICAL, INTENT(IN) :: ld_sla         ! Switch for SLA data 
    367       LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land 
     81      TYPE(obs_surf), INTENT(INOUT) :: surfdata    ! Full set of surface data 
     82      TYPE(obs_surf), INTENT(INOUT) :: surfdataqc  ! Subset of surface data not failing screening 
     83      LOGICAL, INTENT(IN) :: ld_nea                ! Switch for rejecting observation near land 
     84      LOGICAL, INTENT(IN) :: ld_bound_reject       ! Switch for rejecting obs near the boundary 
     85      INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff   ! cut off for QC value 
    36886      !! * Local declarations 
     87      INTEGER :: iqc_cutoff = 255   ! cut off for QC value 
    36988      INTEGER :: iyea0        ! Initial date 
    37089      INTEGER :: imon0        !  - (year, month, day, hour, minute) 
    … …  
    37998      INTEGER :: inlasobs     !  - close to land 
    38099      INTEGER :: igrdobs      !  - fail the grid search 
     100      INTEGER :: ibdysobs     !  - close to open boundary 
    381101                              ! Global counters for observations that 
    382102      INTEGER :: iotdobsmpp     !  - outside time domain 
    … …  
    385105      INTEGER :: inlasobsmpp    !  - close to land 
    386106      INTEGER :: igrdobsmpp     !  - fail the grid search 
     107      INTEGER :: ibdysobsmpp  !  - close to open boundary 
    387108      LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    388109         & llvalid            ! SLA data selection 
    … …  
    391112      INTEGER :: inrc         ! Time index variable 
    392113 
    393       IF(lwp) WRITE(numout,*)'obs_pre_sla : Preparing the SLA observations...' 
    394  
     114      IF(lwp) WRITE(numout,*)'obs_pre_surf : Preparing the surface observations...' 
     115      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     116       
    395117      ! Initial date initialization (year, month, day, hour, minute) 
    396118      iyea0 =   ndate0 / 10000 
    … …  
    409131      ilansobs = 0 
    410132      inlasobs = 0 
    411  
    412       ! ----------------------------------------------------------------------- 
    413       ! Find time coordinate for SLA data 
     133      ibdysobs = 0  
     134 
     135      ! Set QC cutoff to optional value if provided 
     136      IF ( PRESENT(kqc_cutoff) ) iqc_cutoff=kqc_cutoff 
     137 
     138      ! ----------------------------------------------------------------------- 
     139      ! Find time coordinate for surface data 
    414140      ! ----------------------------------------------------------------------- 
    415141 
    416142      CALL obs_coo_tim( icycle, & 
    417143         &              iyea0,   imon0,   iday0,   ihou0,   imin0,      & 
    418          &              sladata%nsurf,   sladata%nyea, sladata%nmon, & 
    419          &              sladata%nday,    sladata%nhou, sladata%nmin, & 
    420          &              sladata%nqc,     sladata%mstp, iotdobs        ) 
     144         &              surfdata%nsurf,   surfdata%nyea, surfdata%nmon, & 
     145         &              surfdata%nday,    surfdata%nhou, surfdata%nmin, & 
     146         &              surfdata%nqc,     surfdata%mstp, iotdobs        ) 
    421147 
    422148      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 
    423149       
    424150      ! ----------------------------------------------------------------------- 
    425       ! Check for SLA data failing the grid search 
    426       ! ----------------------------------------------------------------------- 
    427  
    428       CALL obs_coo_grd( sladata%nsurf,   sladata%mi, sladata%mj, & 
    429          &              sladata%nqc,     igrdobs                         ) 
     151      ! Check for surface data failing the grid search 
     152      ! ----------------------------------------------------------------------- 
     153 
     154      CALL obs_coo_grd( surfdata%nsurf,   surfdata%mi, surfdata%mj, & 
     155         &              surfdata%nqc,     igrdobs                         ) 
    430156 
    431157      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 
    … …  
    435161      ! ----------------------------------------------------------------------- 
    436162 
    437       CALL obs_coo_spc_2d( sladata%nsurf,              & 
     163      CALL obs_coo_spc_2d( surfdata%nsurf,              & 
    438164         &                 jpi,          jpj,          & 
    439          &                 sladata%mi,   sladata%mj,   &  
    440          &                 sladata%rlam, sladata%rphi, & 
     165         &                 surfdata%mi,   surfdata%mj,   &  
     166         &                 surfdata%rlam, surfdata%rphi, & 
    441167         &                 glamt,        gphit,        & 
    442          &                 tmask(:,:,1), sladata%nqc,  & 
     168         &                 tmask(:,:,1), surfdata%nqc,  & 
    443169         &                 iosdsobs,     ilansobs,     & 
    444          &                 inlasobs,     ld_nea        ) 
     170         &                 inlasobs,     ld_nea,       & 
     171         &                 ibdysobs,     ld_bound_reject, & 
     172         &                 iqc_cutoff                     ) 
    445173 
    446174      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    447175      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    448176      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
    449  
    450       ! ----------------------------------------------------------------------- 
    451       ! Copy useful data from the sladata data structure to 
    452       ! the sladatqc data structure  
     177      CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 
     178 
     179      ! ----------------------------------------------------------------------- 
     180      ! Copy useful data from the surfdata data structure to 
     181      ! the surfdataqc data structure  
    453182      ! ----------------------------------------------------------------------- 
    454183 
    455184      ! Allocate the selection arrays 
    456185 
    457       ALLOCATE( llvalid(sladata%nsurf) ) 
    458        
    459       ! We want all data which has qc flags <= 10 
    460  
    461       llvalid(:)  = ( sladata%nqc(:)  <= 10 ) 
     186      ALLOCATE( llvalid(surfdata%nsurf) ) 
     187       
     188      ! We want all data which has qc flags <= iqc_cutoff 
     189 
     190      llvalid(:)  = ( surfdata%nqc(:)  <= iqc_cutoff ) 
    462191 
    463192      ! The actual copying 
    464193 
    465       CALL obs_surf_compress( sladata,     sladatqc,       .TRUE.,  numout, & 
     194      CALL obs_surf_compress( surfdata,     surfdataqc,       .TRUE.,  numout, & 
    466195         &                    lvalid=llvalid ) 
    467196 
    … …  
    477206      IF(lwp) THEN 
    478207         WRITE(numout,*) 
    479          WRITE(numout,*) 'obs_pre_sla :' 
    480          WRITE(numout,*) '~~~~~~~~~~~' 
    481          WRITE(numout,*) 
    482          WRITE(numout,*) ' SLA data outside time domain                  = ', & 
     208         WRITE(numout,*) ' '//surfdataqc%cvars(1)//' data outside time domain                  = ', & 
    483209            &            iotdobsmpp 
    484          WRITE(numout,*) ' Remaining SLA data that failed grid search    = ', & 
     210         WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data that failed grid search    = ', & 
    485211            &            igrdobsmpp 
    486          WRITE(numout,*) ' Remaining SLA data outside space domain       = ', & 
     212         WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data outside space domain       = ', & 
    487213            &            iosdsobsmpp 
    488          WRITE(numout,*) ' Remaining SLA data at land points             = ', & 
     214         WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data at land points             = ', & 
    489215            &            ilansobsmpp 
    490216         IF (ld_nea) THEN 
    491             WRITE(numout,*) ' Remaining SLA data near land points (removed) = ', & 
     217            WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data near land points (removed) = ', & 
    492218               &            inlasobsmpp 
    493219         ELSE 
    494             WRITE(numout,*) ' Remaining SLA data near land points (kept)    = ', & 
     220            WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data near land points (kept)    = ', & 
    495221               &            inlasobsmpp 
    496222         ENDIF 
    497          WRITE(numout,*) ' SLA data accepted                             = ', & 
    498             &            sladatqc%nsurfmpp 
     223         WRITE(numout,*) ' Remaining '//surfdataqc%cvars(1)//' data near open boundary (removed) = ', & 
     224            &            ibdysobsmpp   
     225         WRITE(numout,*) ' '//surfdataqc%cvars(1)//' data accepted                             = ', & 
     226            &            surfdataqc%nsurfmpp 
    499227 
    500228         WRITE(numout,*) 
    501229         WRITE(numout,*) ' Number of observations per time step :' 
    502230         WRITE(numout,*) 
    503          WRITE(numout,1997) 
    504          WRITE(numout,1998) 
     231         WRITE(numout,'(10X,A,10X,A)')'Time step',surfdataqc%cvars(1) 
     232         WRITE(numout,'(10X,A,5X,A)')'---------','-----------------' 
     233         CALL FLUSH(numout) 
    505234      ENDIF 
    506235       
    507       DO jobs = 1, sladatqc%nsurf 
    508          inrc = sladatqc%mstp(jobs) + 2 - nit000 
    509          sladatqc%nsstp(inrc)  = sladatqc%nsstp(inrc) + 1 
     236      DO jobs = 1, surfdataqc%nsurf 
     237         inrc = surfdataqc%mstp(jobs) + 2 - nit000 
     238         surfdataqc%nsstp(inrc)  = surfdataqc%nsstp(inrc) + 1 
    510239      END DO 
    511240       
    512       CALL obs_mpp_sum_integers( sladatqc%nsstp, sladatqc%nsstpmpp, & 
     241      CALL obs_mpp_sum_integers( surfdataqc%nsstp, surfdataqc%nsstpmpp, & 
    513242         &                       nitend - nit000 + 2 ) 
    514243 
    … …  
    516245         DO jstp = nit000 - 1, nitend 
    517246            inrc = jstp - nit000 + 2 
    518             WRITE(numout,1999) jstp, sladatqc%nsstpmpp(inrc) 
     247            WRITE(numout,1999) jstp, surfdataqc%nsstpmpp(inrc) 
     248            CALL FLUSH(numout) 
    519249         END DO 
    520250      ENDIF 
    521251 
    522 1997  FORMAT(10X,'Time step',5X,'Sea level anomaly') 
    523 1998  FORMAT(10X,'---------',5X,'-----------------') 
    5242521999  FORMAT(10X,I9,5X,I17) 
    525253 
    526    END SUBROUTINE obs_pre_sla 
    527  
    528    SUBROUTINE obs_pre_sst( sstdata, sstdatqc, ld_sst, ld_nea ) 
    529       !!---------------------------------------------------------------------- 
    530       !!                    ***  ROUTINE obs_pre_sst  *** 
    531       !! 
    532       !! ** Purpose : First level check and screening of SST observations 
    533       !! 
    534       !! ** Method  : First level check and screening of SST observations 
    535       !! 
    536       !! ** Action  :  
    537       !! 
    538       !! References : 
    539       !!    
     254   END SUBROUTINE obs_pre_surf 
     255 
     256 
     257   SUBROUTINE obs_pre_prof( profdata, prodatqc, ld_var1, ld_var2, & 
     258      &                     kpi, kpj, kpk, & 
     259      &                     zmask1, pglam1, pgphi1, zmask2, pglam2, pgphi2,  & 
     260      &                     ld_nea, ld_bound_reject, kdailyavtypes,  kqc_cutoff ) 
     261 
     262!!---------------------------------------------------------------------- 
     263      !!                    ***  ROUTINE obs_pre_prof  *** 
     264      !! 
     265      !! ** Purpose : First level check and screening of profiles 
     266      !! 
     267      !! ** Method  : First level check and screening of profiles 
     268      !! 
    540269      !! History : 
    541       !!        !  2007-03  (S. Ricci) SST data preparation  
     270      !!        !  2007-06  (K. Mogensen) original : T and S profile data 
     271      !!        !  2008-09  (M. Valdivieso) : TAO velocity data 
     272      !!        !  2009-01  (K. Mogensen) : New feedback stricture 
     273      !!        !  2015-02  (M. Martin) : Combined profile routine. 
     274      !! 
    542275      !!---------------------------------------------------------------------- 
    543276      !! * Modules used 
    … …  
    545278      USE par_oce             ! Ocean parameters 
    546279      USE dom_oce, ONLY : &   ! Geographical information 
    547          & glamt,   & 
    548          & gphit,   & 
    549          & tmask,   & 
     280         & gdept_1d,             & 
    550281         & nproc 
     282 
    551283      !! * Arguments 
    552       TYPE(obs_surf), INTENT(INOUT) :: sstdata     ! Full set of SST data 
    553       TYPE(obs_surf), INTENT(INOUT) :: sstdatqc    ! Subset of SST data not failing screening 
    554       LOGICAL :: ld_sst             ! Switch for SST data 
    555       LOGICAL :: ld_nea             ! Switch for rejecting observation near land 
     284      TYPE(obs_prof), INTENT(INOUT) :: profdata   ! Full set of profile data 
     285      TYPE(obs_prof), INTENT(INOUT) :: prodatqc   ! Subset of profile data not failing screening 
     286      LOGICAL, INTENT(IN) :: ld_var1              ! Observed variables switches 
     287      LOGICAL, INTENT(IN) :: ld_var2 
     288      LOGICAL, INTENT(IN) :: ld_nea               ! Switch for rejecting observation near land 
     289      LOGICAL, INTENT(IN) :: ld_bound_reject      ! Switch for rejecting observations near the boundary 
     290      INTEGER, INTENT(IN) :: kpi, kpj, kpk        ! Local domain sizes 
     291      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
     292         & kdailyavtypes                          ! Types for daily averages 
     293      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 
     294         & zmask1, & 
     295         & zmask2 
     296      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
     297         & pglam1, & 
     298         & pglam2, & 
     299         & pgphi1, & 
     300         & pgphi2 
     301      INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff   ! cut off for QC value 
     302 
    556303      !! * Local declarations 
     304      INTEGER :: iqc_cutoff = 255   ! cut off for QC value 
    557305      INTEGER :: iyea0        ! Initial date 
    558306      INTEGER :: imon0        !  - (year, month, day, hour, minute) 
    559       INTEGER :: iday0    
     307      INTEGER :: iday0     
    560308      INTEGER :: ihou0     
    561309      INTEGER :: imin0 
    562310      INTEGER :: icycle       ! Current assimilation cycle 
    563                               ! Counters for observations that 
     311                              ! Counters for observations that are 
    564312      INTEGER :: iotdobs      !  - outside time domain 
    565       INTEGER :: iosdsobs     !  - outside space domain 
    566       INTEGER :: ilansobs     !  - within a model land cell 
    567       INTEGER :: inlasobs     !  - close to land 
     313      INTEGER :: iosdv1obs    !  - outside space domain (variable 1) 
     314      INTEGER :: iosdv2obs    !  - outside space domain (variable 2) 
     315      INTEGER :: ilanv1obs    !  - within a model land cell (variable 1) 
     316      INTEGER :: ilanv2obs    !  - within a model land cell (variable 2) 
     317      INTEGER :: inlav1obs    !  - close to land (variable 1) 
     318      INTEGER :: inlav2obs    !  - close to land (variable 2) 
     319      INTEGER :: ibdyv1obs    !  - boundary (variable 1)  
     320      INTEGER :: ibdyv2obs    !  - boundary (variable 2)       
    568321      INTEGER :: igrdobs      !  - fail the grid search 
    569                               ! Global counters for observations that 
     322      INTEGER :: iuvchku      !  - reject u if v rejected and vice versa 
     323      INTEGER :: iuvchkv      ! 
     324                              ! Global counters for observations that are 
    570325      INTEGER :: iotdobsmpp   !  - outside time domain 
    571       INTEGER :: iosdsobsmpp  !  - outside space domain 
    572       INTEGER :: ilansobsmpp  !  - within a model land cell 
    573       INTEGER :: inlasobsmpp  !  - close to land 
     326      INTEGER :: iosdv1obsmpp !  - outside space domain (variable 1) 
     327      INTEGER :: iosdv2obsmpp !  - outside space domain (variable 2) 
     328      INTEGER :: ilanv1obsmpp !  - within a model land cell (variable 1) 
     329      INTEGER :: ilanv2obsmpp !  - within a model land cell (variable 2) 
     330      INTEGER :: inlav1obsmpp !  - close to land (variable 1) 
     331      INTEGER :: inlav2obsmpp !  - close to land (variable 2) 
     332      INTEGER :: ibdyv1obsmpp !  - boundary (variable 1)  
     333      INTEGER :: ibdyv2obsmpp !  - boundary (variable 2)       
    574334      INTEGER :: igrdobsmpp   !  - fail the grid search 
    575       LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    576          & llvalid            ! SST data selection 
     335      INTEGER :: iuvchkumpp   !  - reject var1 if var2 rejected and vice versa 
     336      INTEGER :: iuvchkvmpp   ! 
     337      TYPE(obs_prof_valid) ::  llvalid      ! Profile selection  
     338      TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: & 
     339         & llvvalid           ! var1,var2 selection  
     340      INTEGER :: jvar         ! Variable loop variable 
    577341      INTEGER :: jobs         ! Obs. loop variable 
    578342      INTEGER :: jstp         ! Time loop variable 
    579343      INTEGER :: inrc         ! Time index variable 
    580344 
    581       IF(lwp) WRITE(numout,*)'obs_pre_sst : Preparing the SST observations...' 
     345      IF(lwp) WRITE(numout,*)'obs_pre_prof: Preparing the profile data...' 
     346      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    582347 
    583348      ! Initial date initialization (year, month, day, hour, minute) 
    … …  
    592357      ! Diagnotics counters for various failures. 
    593358 
    594       iotdobs  = 0 
    595       igrdobs  = 0 
    596       iosdsobs = 0 
    597       ilansobs = 0 
    598       inlasobs = 0 
    599  
    600       ! ----------------------------------------------------------------------- 
    601       ! Find time coordinate for SST data 
    602       ! ----------------------------------------------------------------------- 
    603  
    604       CALL obs_coo_tim( icycle, & 
    605          &              iyea0,   imon0,   iday0,   ihou0,   imin0,      & 
    606          &              sstdata%nsurf,   sstdata%nyea, sstdata%nmon, & 
    607          &              sstdata%nday,    sstdata%nhou, sstdata%nmin, & 
    608          &              sstdata%nqc,     sstdata%mstp, iotdobs        ) 
    609       CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 
    610       ! ----------------------------------------------------------------------- 
    611       ! Check for SST data failing the grid search 
    612       ! ----------------------------------------------------------------------- 
    613  
    614       CALL obs_coo_grd( sstdata%nsurf,   sstdata%mi, sstdata%mj, & 
    615          &              sstdata%nqc,     igrdobs                         ) 
    616       CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 
    617  
    618       ! ----------------------------------------------------------------------- 
    619       ! Check for land points.  
    620       ! ----------------------------------------------------------------------- 
    621  
    622       CALL obs_coo_spc_2d( sstdata%nsurf,              & 
    623          &                 jpi,          jpj,          & 
    624          &                 sstdata%mi,   sstdata%mj,   &  
    625          &                 sstdata%rlam, sstdata%rphi, & 
    626          &                 glamt,        gphit,        & 
    627          &                 tmask(:,:,1), sstdata%nqc,  & 
    628          &                 iosdsobs,     ilansobs,     & 
    629          &                 inlasobs,     ld_nea        ) 
    630  
    631       CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    632       CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    633       CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
    634  
    635       ! ----------------------------------------------------------------------- 
    636       ! Copy useful data from the sstdata data structure to 
    637       ! the sstdatqc data structure  
    638       ! ----------------------------------------------------------------------- 
    639  
    640       ! Allocate the selection arrays 
    641  
    642       ALLOCATE( llvalid(sstdata%nsurf) ) 
    643        
    644       ! We want all data which has qc flags <= 0 
    645  
    646       llvalid(:)  = ( sstdata%nqc(:)  <= 10 ) 
    647  
    648       ! The actual copying 
    649  
    650       CALL obs_surf_compress( sstdata,     sstdatqc,       .TRUE.,  numout, & 
    651          &                    lvalid=llvalid ) 
    652  
    653       ! Dellocate the selection arrays 
    654       DEALLOCATE( llvalid ) 
    655  
    656       ! ----------------------------------------------------------------------- 
    657       ! Print information about what observations are left after qc 
    658       ! ----------------------------------------------------------------------- 
    659  
    660       ! Update the total observation counter array 
    661        
    662       IF(lwp) THEN 
    663          WRITE(numout,*) 
    664          WRITE(numout,*) 'obs_pre_sst :' 
    665          WRITE(numout,*) '~~~~~~~~~~~' 
    666          WRITE(numout,*) 
    667          WRITE(numout,*) ' SST data outside time domain                  = ', & 
    668             &            iotdobsmpp 
    669          WRITE(numout,*) ' Remaining SST data that failed grid search    = ', & 
    670             &            igrdobsmpp 
    671          WRITE(numout,*) ' Remaining SST data outside space domain       = ', & 
    672             &            iosdsobsmpp 
    673          WRITE(numout,*) ' Remaining SST data at land points             = ', & 
    674             &            ilansobsmpp 
    675          IF (ld_nea) THEN 
    676             WRITE(numout,*) ' Remaining SST data near land points (removed) = ', & 
    677                &            inlasobsmpp 
    678          ELSE 
    679             WRITE(numout,*) ' Remaining SST data near land points (kept)    = ', & 
    680                &            inlasobsmpp 
    681          ENDIF 
    682          WRITE(numout,*) ' SST data accepted                             = ', & 
    683             &            sstdatqc%nsurfmpp 
    684  
    685          WRITE(numout,*) 
    686          WRITE(numout,*) ' Number of observations per time step :' 
    687          WRITE(numout,*) 
    688          WRITE(numout,1997) 
    689          WRITE(numout,1998) 
     359      iotdobs   = 0 
     360      igrdobs   = 0 
     361      iosdv1obs = 0 
     362      iosdv2obs = 0 
     363      ilanv1obs = 0 
     364      ilanv2obs = 0 
     365      inlav1obs = 0 
     366      inlav2obs = 0 
     367      ibdyv1obs = 0 
     368      ibdyv2obs = 0 
     369      iuvchku   = 0 
     370      iuvchkv   = 0 
     371 
     372 
     373      ! Set QC cutoff to optional value if provided 
     374      IF ( PRESENT(kqc_cutoff) ) iqc_cutoff=kqc_cutoff 
     375 
     376      ! ----------------------------------------------------------------------- 
     377      ! Find time coordinate for profiles 
     378      ! ----------------------------------------------------------------------- 
     379 
     380      IF ( PRESENT(kdailyavtypes) ) THEN 
     381         CALL obs_coo_tim_prof( icycle, & 
     382            &              iyea0,   imon0,   iday0,   ihou0,   imin0,      & 
     383            &              profdata%nprof,   profdata%nyea, profdata%nmon, & 
     384            &              profdata%nday,    profdata%nhou, profdata%nmin, & 
     385            &              profdata%ntyp,    profdata%nqc,  profdata%mstp, & 
     386            &              iotdobs, kdailyavtypes = kdailyavtypes,         & 
     387            &              kqc_cutoff = iqc_cutoff ) 
     388      ELSE 
     389         CALL obs_coo_tim_prof( icycle, & 
     390            &              iyea0,   imon0,   iday0,   ihou0,   imin0,      & 
     391            &              profdata%nprof,   profdata%nyea, profdata%nmon, & 
     392            &              profdata%nday,    profdata%nhou, profdata%nmin, & 
     393            &              profdata%ntyp,    profdata%nqc,  profdata%mstp, & 
     394            &              iotdobs,          kqc_cutoff = iqc_cutoff ) 
    690395      ENDIF 
    691        
    692       DO jobs = 1, sstdatqc%nsurf 
    693          inrc = sstdatqc%mstp(jobs) + 2 - nit000 
    694          sstdatqc%nsstp(inrc)  = sstdatqc%nsstp(inrc) + 1 
    695       END DO 
    696        
    697       CALL obs_mpp_sum_integers( sstdatqc%nsstp, sstdatqc%nsstpmpp, & 
    698          &                       nitend - nit000 + 2 ) 
    699  
    700       IF ( lwp ) THEN 
    701          DO jstp = nit000 - 1, nitend 
    702             inrc = jstp - nit000 + 2 
    703             WRITE(numout,1999) jstp, sstdatqc%nsstpmpp(inrc) 
    704          END DO 
    705       ENDIF 
    706  
    707 1997  FORMAT(10X,'Time step',5X,'Sea surface temperature') 
    708 1998  FORMAT(10X,'---------',5X,'-----------------') 
    709 1999  FORMAT(10X,I9,5X,I17) 
    710        
    711    END SUBROUTINE obs_pre_sst 
    712  
    713    SUBROUTINE obs_pre_seaice( seaicedata, seaicedatqc, ld_seaice, ld_nea ) 
    714       !!---------------------------------------------------------------------- 
    715       !!                    ***  ROUTINE obs_pre_seaice  *** 
    716       !! 
    717       !! ** Purpose : First level check and screening of Sea Ice observations 
    718       !! 
    719       !! ** Method  : First level check and screening of Sea Ice observations 
    720       !! 
    721       !! ** Action  :  
    722       !! 
    723       !! References : 
    724       !!    
    725       !! History : 
    726       !!        !  2007-11 (D. Lea) based on obs_pre_sst 
    727       !!---------------------------------------------------------------------- 
    728       !! * Modules used 
    729       USE domstp              ! Domain: set the time-step 
    730       USE par_oce             ! Ocean parameters 
    731       USE dom_oce, ONLY : &   ! Geographical information 
    732          & glamt,   & 
    733          & gphit,   & 
    734          & tmask,   & 
    735          & nproc 
    736       !! * Arguments 
    737       TYPE(obs_surf), INTENT(INOUT) :: seaicedata     ! Full set of Sea Ice data 
    738       TYPE(obs_surf), INTENT(INOUT) :: seaicedatqc    ! Subset of sea ice data not failing screening 
    739       LOGICAL :: ld_seaice     ! Switch for sea ice data 
    740       LOGICAL :: ld_nea        ! Switch for rejecting observation near land 
    741       !! * Local declarations 
    742       INTEGER :: iyea0         ! Initial date 
    743       INTEGER :: imon0         !  - (year, month, day, hour, minute) 
    744       INTEGER :: iday0     
    745       INTEGER :: ihou0     
    746       INTEGER :: imin0 
    747       INTEGER :: icycle       ! Current assimilation cycle 
    748                               ! Counters for observations that 
    749       INTEGER :: iotdobs      !  - outside time domain 
    750       INTEGER :: iosdsobs     !  - outside space domain 
    751       INTEGER :: ilansobs     !  - within a model land cell 
    752       INTEGER :: inlasobs     !  - close to land 
    753       INTEGER :: igrdobs      !  - fail the grid search 
    754                               ! Global counters for observations that 
    755       INTEGER :: iotdobsmpp   !  - outside time domain 
    756       INTEGER :: iosdsobsmpp  !  - outside space domain 
    757       INTEGER :: ilansobsmpp  !  - within a model land cell 
    758       INTEGER :: inlasobsmpp  !  - close to land 
    759       INTEGER :: igrdobsmpp   !  - fail the grid search 
    760       LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    761          & llvalid            ! data selection 
    762       INTEGER :: jobs         ! Obs. loop variable 
    763       INTEGER :: jstp         ! Time loop variable 
    764       INTEGER :: inrc         ! Time index variable 
    765  
    766       IF (lwp) WRITE(numout,*)'obs_pre_seaice : Preparing the sea ice observations...' 
    767  
    768       ! Initial date initialization (year, month, day, hour, minute) 
    769       iyea0 =   ndate0 / 10000 
    770       imon0 = ( ndate0 - iyea0 * 10000 ) / 100 
    771       iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100 
    772       ihou0 =   nn_time0 / 100 
    773       imin0 = ( nn_time0 - ihou0 * 100 ) 
    774  
    775       icycle = no     ! Assimilation cycle 
    776  
    777       ! Diagnotics counters for various failures. 
    778  
    779       iotdobs  = 0 
    780       igrdobs  = 0 
    781       iosdsobs = 0 
    782       ilansobs = 0 
    783       inlasobs = 0 
    784  
    785       ! ----------------------------------------------------------------------- 
    786       ! Find time coordinate for sea ice data 
    787       ! ----------------------------------------------------------------------- 
    788  
    789       CALL obs_coo_tim( icycle, & 
    790          &              iyea0,   imon0,   iday0,   ihou0,   imin0,      & 
    791          &              seaicedata%nsurf,   seaicedata%nyea, seaicedata%nmon, & 
    792          &              seaicedata%nday,    seaicedata%nhou, seaicedata%nmin, & 
    793          &              seaicedata%nqc,     seaicedata%mstp, iotdobs        ) 
    794       CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 
    795       ! ----------------------------------------------------------------------- 
    796       ! Check for sea ice data failing the grid search 
    797       ! ----------------------------------------------------------------------- 
    798  
    799       CALL obs_coo_grd( seaicedata%nsurf,   seaicedata%mi, seaicedata%mj, & 
    800          &              seaicedata%nqc,     igrdobs                         ) 
    801       CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 
    802  
    803       ! ----------------------------------------------------------------------- 
    804       ! Check for land points.  
    805       ! ----------------------------------------------------------------------- 
    806  
    807       CALL obs_coo_spc_2d( seaicedata%nsurf,                 & 
    808          &                 jpi,             jpj,             & 
    809          &                 seaicedata%mi,   seaicedata%mj,   &  
    810          &                 seaicedata%rlam, seaicedata%rphi, & 
    811          &                 glamt,           gphit,           & 
    812          &                 tmask(:,:,1),    seaicedata%nqc,  & 
    813          &                 iosdsobs,        ilansobs,        & 
    814          &                 inlasobs,        ld_nea           ) 
    815  
    816       CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    817       CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    818       CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
    819  
    820       ! ----------------------------------------------------------------------- 
    821       ! Copy useful data from the seaicedata data structure to 
    822       ! the seaicedatqc data structure  
    823       ! ----------------------------------------------------------------------- 
    824  
    825       ! Allocate the selection arrays 
    826  
    827       ALLOCATE( llvalid(seaicedata%nsurf) ) 
    828        
    829       ! We want all data which has qc flags <= 0 
    830  
    831       llvalid(:)  = ( seaicedata%nqc(:)  <= 10 ) 
    832  
    833       ! The actual copying 
    834  
    835       CALL obs_surf_compress( seaicedata,     seaicedatqc,       .TRUE.,  numout, & 
    836          &                    lvalid=llvalid ) 
    837  
    838       ! Dellocate the selection arrays 
    839       DEALLOCATE( llvalid ) 
    840  
    841       ! ----------------------------------------------------------------------- 
    842       ! Print information about what observations are left after qc 
    843       ! ----------------------------------------------------------------------- 
    844  
    845       ! Update the total observation counter array 
    846        
    847       IF(lwp) THEN 
    848          WRITE(numout,*) 
    849          WRITE(numout,*) 'obs_pre_seaice :' 
    850          WRITE(numout,*) '~~~~~~~~~~~' 
    851          WRITE(numout,*) 
    852          WRITE(numout,*) ' Sea ice data outside time domain                  = ', & 
    853             &            iotdobsmpp 
    854          WRITE(numout,*) ' Remaining sea ice data that failed grid search    = ', & 
    855             &            igrdobsmpp 
    856          WRITE(numout,*) ' Remaining sea ice data outside space domain       = ', & 
    857             &            iosdsobsmpp 
    858          WRITE(numout,*) ' Remaining sea ice data at land points             = ', & 
    859             &            ilansobsmpp 
    860          IF (ld_nea) THEN 
    861             WRITE(numout,*) ' Remaining sea ice data near land points (removed) = ', & 
    862                &            inlasobsmpp 
    863          ELSE 
    864             WRITE(numout,*) ' Remaining sea ice data near land points (kept)    = ', & 
    865                &            inlasobsmpp 
    866          ENDIF 
    867          WRITE(numout,*) ' Sea ice data accepted                             = ', & 
    868             &            seaicedatqc%nsurfmpp 
    869  
    870          WRITE(numout,*) 
    871          WRITE(numout,*) ' Number of observations per time step :' 
    872          WRITE(numout,*) 
    873          WRITE(numout,1997) 
    874          WRITE(numout,1998) 
    875       ENDIF 
    876        
    877       DO jobs = 1, seaicedatqc%nsurf 
    878          inrc = seaicedatqc%mstp(jobs) + 2 - nit000 
    879          seaicedatqc%nsstp(inrc)  = seaicedatqc%nsstp(inrc) + 1 
    880       END DO 
    881        
    882       CALL obs_mpp_sum_integers( seaicedatqc%nsstp, seaicedatqc%nsstpmpp, & 
    883          &                       nitend - nit000 + 2 ) 
    884  
    885       IF ( lwp ) THEN 
    886          DO jstp = nit000 - 1, nitend 
    887             inrc = jstp - nit000 + 2 
    888             WRITE(numout,1999) jstp, seaicedatqc%nsstpmpp(inrc) 
    889          END DO 
    890       ENDIF 
    891  
    892 1997  FORMAT(10X,'Time step',5X,'Sea ice data           ') 
    893 1998  FORMAT(10X,'---------',5X,'-----------------') 
    894 1999  FORMAT(10X,I9,5X,I17) 
    895        
    896    END SUBROUTINE obs_pre_seaice 
    897  
    898    SUBROUTINE obs_pre_vel( profdata, prodatqc, ld_vel3d, ld_nea, ld_dailyav ) 
    899       !!---------------------------------------------------------------------- 
    900       !!                    ***  ROUTINE obs_pre_taovel  *** 
    901       !! 
    902       !! ** Purpose : First level check and screening of U and V profiles 
    903       !! 
    904       !! ** Method  : First level check and screening of U and V profiles 
    905       !! 
    906       !! History : 
    907       !!        !  2007-06  (K. Mogensen) original : T and S profile data 
    908       !!        !  2008-09  (M. Valdivieso) : TAO velocity data 
    909       !!        !  2009-01  (K. Mogensen) : New feedback strictuer 
    910       !! 
    911       !!---------------------------------------------------------------------- 
    912       !! * Modules used 
    913       USE domstp              ! Domain: set the time-step 
    914       USE par_oce             ! Ocean parameters 
    915       USE dom_oce, ONLY : &   ! Geographical information 
    916          & glamt, glamu, glamv,    & 
    917          & gphit, gphiu, gphiv,    & 
    918          & gdept_1d,             & 
    919          & tmask, umask, vmask,  & 
    920          & nproc 
    921       !! * Arguments 
    922       TYPE(obs_prof), INTENT(INOUT) :: profdata   ! Full set of profile data 
    923       TYPE(obs_prof), INTENT(INOUT) :: prodatqc   ! Subset of profile data not failing screening 
    924       LOGICAL, INTENT(IN) :: ld_vel3d      ! Switch for zonal and meridional velocity components 
    925       LOGICAL, INTENT(IN) :: ld_nea        ! Switch for rejecting observation near land 
    926       LOGICAL, INTENT(IN) :: ld_dailyav    ! Switch for daily average data 
    927       !! * Local declarations 
    928       INTEGER :: iyea0        ! Initial date 
    929       INTEGER :: imon0        !  - (year, month, day, hour, minute) 
    930       INTEGER :: iday0     
    931       INTEGER :: ihou0     
    932       INTEGER :: imin0 
    933       INTEGER :: icycle       ! Current assimilation cycle 
    934                               ! Counters for observations that 
    935       INTEGER :: iotdobs      !  - outside time domain 
    936       INTEGER :: iosduobs     !  - outside space domain (zonal velocity component) 
    937       INTEGER :: iosdvobs     !  - outside space domain (meridional velocity component) 
    938       INTEGER :: ilanuobs     !  - within a model land cell (zonal velocity component) 
    939       INTEGER :: ilanvobs     !  - within a model land cell (meridional velocity component) 
    940       INTEGER :: inlauobs     !  - close to land (zonal velocity component) 
    941       INTEGER :: inlavobs     !  - close to land (meridional velocity component) 
    942       INTEGER :: igrdobs      !  - fail the grid search 
    943       INTEGER :: iuvchku      !  - reject u if v rejected and vice versa 
    944       INTEGER :: iuvchkv      ! 
    945                               ! Global counters for observations that 
    946       INTEGER :: iotdobsmpp   !  - outside time domain 
    947       INTEGER :: iosduobsmpp  !  - outside space domain (zonal velocity component) 
    948       INTEGER :: iosdvobsmpp  !  - outside space domain (meridional velocity component) 
    949       INTEGER :: ilanuobsmpp  !  - within a model land cell (zonal velocity component) 
    950       INTEGER :: ilanvobsmpp  !  - within a model land cell (meridional velocity component) 
    951       INTEGER :: inlauobsmpp  !  - close to land (zonal velocity component) 
    952       INTEGER :: inlavobsmpp  !  - close to land (meridional velocity component) 
    953       INTEGER :: igrdobsmpp   !  - fail the grid search 
    954       INTEGER :: iuvchkumpp   !  - reject u if v rejected and vice versa 
    955       INTEGER :: iuvchkvmpp   ! 
    956       TYPE(obs_prof_valid) ::  llvalid      ! Profile selection  
    957       TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: & 
    958          & llvvalid           ! U,V selection  
    959       INTEGER :: jvar         ! Variable loop variable 
    960       INTEGER :: jobs         ! Obs. loop variable 
    961       INTEGER :: jstp         ! Time loop variable 
    962       INTEGER :: inrc         ! Time index variable 
    963  
    964       IF(lwp) WRITE(numout,*)'obs_pre_vel: Preparing the velocity profile data' 
    965  
    966       ! Initial date initialization (year, month, day, hour, minute) 
    967       iyea0 =   ndate0 / 10000 
    968       imon0 = ( ndate0 - iyea0 * 10000 ) / 100 
    969       iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100 
    970       ihou0 =   nn_time0 / 100 
    971       imin0 = ( nn_time0 - ihou0 * 100 ) 
    972  
    973       icycle = no     ! Assimilation cycle 
    974  
    975       ! Diagnotics counters for various failures. 
    976  
    977       iotdobs  = 0 
    978       igrdobs  = 0 
    979       iosduobs = 0 
    980       iosdvobs = 0 
    981       ilanuobs = 0 
    982       ilanvobs = 0 
    983       inlauobs = 0 
    984       inlavobs = 0 
    985       iuvchku  = 0 
    986       iuvchkv = 0 
    987  
    988       ! ----------------------------------------------------------------------- 
    989       ! Find time coordinate for profiles 
    990       ! ----------------------------------------------------------------------- 
    991  
    992       CALL obs_coo_tim_prof( icycle, & 
    993          &              iyea0,   imon0,   iday0,   ihou0,   imin0,      & 
    994          &              profdata%nprof,   profdata%nyea, profdata%nmon, & 
    995          &              profdata%nday,    profdata%nhou, profdata%nmin, & 
    996          &              profdata%ntyp,    profdata%nqc,  profdata%mstp, & 
    997          &              iotdobs, ld_dailyav = ld_dailyav        ) 
    998      
     396 
    999397      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 
    1000398       
    … …  
    1011409 
    1012410      ! ----------------------------------------------------------------------- 
    1013       ! Reject all observations for profiles with nqc > 10 
    1014       ! ----------------------------------------------------------------------- 
    1015  
    1016       CALL obs_pro_rej( profdata ) 
     411      ! Reject all observations for profiles with nqc > iqc_cutoff 
     412      ! ----------------------------------------------------------------------- 
     413 
     414      CALL obs_pro_rej( profdata, kqc_cutoff = iqc_cutoff ) 
    1017415 
    1018416      ! ----------------------------------------------------------------------- 
    … …  
    1021419      ! ----------------------------------------------------------------------- 
    1022420 
    1023       ! Zonal Velocity Component 
    1024  
     421      ! Variable 1 
    1025422      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(1),   & 
    1026423         &                 profdata%npvsta(:,1),  profdata%npvend(:,1), & 
    1027424         &                 jpi,                   jpj,                  & 
    1028425         &                 jpk,                                         & 
    1029          &                 profdata%mi,           profdata%mj,          &  
     426         &                 profdata%mi,           profdata%mj,          & 
    1030427         &                 profdata%var(1)%mvk,                         & 
    1031428         &                 profdata%rlam,         profdata%rphi,        & 
    1032429         &                 profdata%var(1)%vdep,                        & 
    1033          &                 glamu,                 gphiu,                & 
    1034          &                 gdept_1d,              umask,                & 
     430         &                 pglam1,                pgphi1,               & 
     431         &                 gdept_1d,              zmask1,               & 
    1035432         &                 profdata%nqc,          profdata%var(1)%nvqc, & 
    1036          &                 iosduobs,              ilanuobs,             & 
    1037          &                 inlauobs,              ld_nea                ) 
    1038  
    1039       CALL obs_mpp_sum_integer( iosduobs, iosduobsmpp ) 
    1040       CALL obs_mpp_sum_integer( ilanuobs, ilanuobsmpp ) 
    1041       CALL obs_mpp_sum_integer( inlauobs, inlauobsmpp ) 
    1042  
    1043       ! Meridional Velocity Component 
    1044  
     433         &                 iosdv1obs,             ilanv1obs,            & 
     434         &                 inlav1obs,             ld_nea,               & 
     435         &                 ibdyv1obs,             ld_bound_reject,      & 
     436         &                 iqc_cutoff       ) 
     437 
     438      CALL obs_mpp_sum_integer( iosdv1obs, iosdv1obsmpp ) 
     439      CALL obs_mpp_sum_integer( ilanv1obs, ilanv1obsmpp ) 
     440      CALL obs_mpp_sum_integer( inlav1obs, inlav1obsmpp ) 
     441      CALL obs_mpp_sum_integer( ibdyv1obs, ibdyv1obsmpp ) 
     442 
     443      ! Variable 2 
    1045444      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(2),   & 
    1046445         &                 profdata%npvsta(:,2),  profdata%npvend(:,2), & 
    … …  
    1051450         &                 profdata%rlam,         profdata%rphi,        & 
    1052451         &                 profdata%var(2)%vdep,                        & 
    1053          &                 glamv,                 gphiv,                & 
    1054          &                 gdept_1d,              vmask,                & 
     452         &                 pglam2,                pgphi2,               & 
     453         &                 gdept_1d,              zmask2,               & 
    1055454         &                 profdata%nqc,          profdata%var(2)%nvqc, & 
    1056          &                 iosdvobs,              ilanvobs,             & 
    1057          &                 inlavobs,              ld_nea                ) 
    1058  
    1059       CALL obs_mpp_sum_integer( iosdvobs, iosdvobsmpp ) 
    1060       CALL obs_mpp_sum_integer( ilanvobs, ilanvobsmpp ) 
    1061       CALL obs_mpp_sum_integer( inlavobs, inlavobsmpp ) 
     455         &                 iosdv2obs,             ilanv2obs,            & 
     456         &                 inlav2obs,             ld_nea,               & 
     457         &                 ibdyv2obs,             ld_bound_reject,      & 
     458         &                 iqc_cutoff       ) 
     459 
     460      CALL obs_mpp_sum_integer( iosdv2obs, iosdv2obsmpp ) 
     461      CALL obs_mpp_sum_integer( ilanv2obs, ilanv2obsmpp ) 
     462      CALL obs_mpp_sum_integer( inlav2obs, inlav2obsmpp ) 
     463      CALL obs_mpp_sum_integer( ibdyv2obs, ibdyv2obsmpp ) 
    1062464 
    1063465      ! ----------------------------------------------------------------------- 
    … …  
    1065467      ! ----------------------------------------------------------------------- 
    1066468 
    1067       CALL obs_uv_rej( profdata, iuvchku, iuvchkv ) 
    1068       CALL obs_mpp_sum_integer( iuvchku, iuvchkumpp ) 
    1069       CALL obs_mpp_sum_integer( iuvchkv, iuvchkvmpp ) 
     469      IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN 
     470         CALL obs_uv_rej( profdata, iuvchku, iuvchkv, iqc_cutoff ) 
     471         CALL obs_mpp_sum_integer( iuvchku, iuvchkumpp ) 
     472         CALL obs_mpp_sum_integer( iuvchkv, iuvchkvmpp ) 
     473      ENDIF 
    1070474 
    1071475      ! ----------------------------------------------------------------------- 
    … …  
    1081485      END DO 
    1082486 
    1083       ! We want all data which has qc flags = 0 
    1084  
    1085       llvalid%luse(:) = ( profdata%nqc(:)  <= 10 ) 
     487      ! We want all data which has qc flags <= iqc_cutoff 
     488 
     489      llvalid%luse(:) = ( profdata%nqc(:)  <= iqc_cutoff ) 
    1086490      DO jvar = 1,profdata%nvar 
    1087          llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= 10 ) 
     491         llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= iqc_cutoff ) 
    1088492      END DO 
    1089493 
    … …  
    1106510       
    1107511      IF(lwp) THEN 
     512       
    1108513         WRITE(numout,*) 
    1109          WRITE(numout,*) 'obs_pre_vel :' 
    1110          WRITE(numout,*) '~~~~~~~~~~~' 
    1111          WRITE(numout,*) 
    1112          WRITE(numout,*) ' Profiles outside time domain                = ', & 
     514         WRITE(numout,*) ' Profiles outside time domain                     = ', & 
    1113515            &            iotdobsmpp 
    1114          WRITE(numout,*) ' Remaining profiles that failed grid search  = ', & 
     516         WRITE(numout,*) ' Remaining profiles that failed grid search       = ', & 
    1115517            &            igrdobsmpp 
    1116          WRITE(numout,*) ' Remaining U data outside space domain       = ', & 
    1117             &            iosduobsmpp 
    1118          WRITE(numout,*) ' Remaining U data at land points             = ', & 
    1119             &            ilanuobsmpp 
     518         WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data outside space domain       = ', & 
     519            &            iosdv1obsmpp 
     520         WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data at land points             = ', & 
     521            &            ilanv1obsmpp 
    1120522         IF (ld_nea) THEN 
    1121             WRITE(numout,*) ' Remaining U data near land points (removed) = ',& 
    1122                &            inlauobsmpp 
     523            WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data near land points (removed) = ',& 
     524               &            inlav1obsmpp 
    1123525         ELSE 
    1124             WRITE(numout,*) ' Remaining U data near land points (kept)    = ',& 
    1125                &            inlauobsmpp 
    1126          ENDIF 
    1127          WRITE(numout,*) ' U observation rejected since V rejected     = ', & 
    1128             &            iuvchku      
    1129          WRITE(numout,*) ' U data accepted                             = ', & 
     526            WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data near land points (kept)    = ',& 
     527               &            inlav1obsmpp 
     528         ENDIF 
     529         IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN 
     530            WRITE(numout,*) ' U observation rejected since V rejected     = ', & 
     531               &            iuvchku 
     532         ENDIF 
     533         WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data near open boundary (removed) = ',& 
     534               &            ibdyv1obsmpp 
     535         WRITE(numout,*) ' '//prodatqc%cvars(1)//' data accepted                             = ', & 
    1130536            &            prodatqc%nvprotmpp(1) 
    1131          WRITE(numout,*) ' Remaining V data outside space domain       = ', & 
    1132             &            iosdvobsmpp 
    1133          WRITE(numout,*) ' Remaining V data at land points             = ', & 
    1134             &            ilanvobsmpp 
     537         WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data outside space domain       = ', & 
     538            &            iosdv2obsmpp 
     539         WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data at land points             = ', & 
     540            &            ilanv2obsmpp 
    1135541         IF (ld_nea) THEN 
    1136             WRITE(numout,*) ' Remaining V data near land points (removed) = ',& 
    1137                &            inlavobsmpp 
     542            WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near land points (removed) = ',& 
     543               &            inlav2obsmpp 
    1138544         ELSE 
    1139             WRITE(numout,*) ' Remaining V data near land points (kept)    = ',& 
    1140                &            inlavobsmpp 
    1141          ENDIF 
    1142          WRITE(numout,*) ' V observation rejected since U rejected     = ', & 
    1143             &            iuvchkv      
    1144          WRITE(numout,*) ' V data accepted                             = ', & 
     545            WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near land points (kept)    = ',& 
     546               &            inlav2obsmpp 
     547         ENDIF 
     548         IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN 
     549            WRITE(numout,*) ' V observation rejected since U rejected     = ', & 
     550               &            iuvchkv 
     551         ENDIF 
     552         WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near open boundary (removed) = ',& 
     553               &            ibdyv2obsmpp 
     554         WRITE(numout,*) ' '//prodatqc%cvars(2)//' data accepted                             = ', & 
    1145555            &            prodatqc%nvprotmpp(2) 
    1146556 
    … …  
    1148558         WRITE(numout,*) ' Number of observations per time step :' 
    1149559         WRITE(numout,*) 
    1150          WRITE(numout,997) 
     560         WRITE(numout,'(10X,A,5X,A,5X,A,A)')'Time step','Profiles', & 
     561            &                               '     '//prodatqc%cvars(1)//'     ', & 
     562            &                               '     '//prodatqc%cvars(2)//'     ' 
    1151563         WRITE(numout,998) 
    1152564      ENDIF 
    … …  
    1182594      ENDIF 
    1183595 
    1184 997   FORMAT(10X,'Time step',5X,'Profiles',5X,'Zonal Comp.',5X,'Meridional Comp.') 
    1185596998   FORMAT(10X,'---------',5X,'--------',5X,'-----------',5X,'----------------') 
    1186597999   FORMAT(10X,I9,5X,I8,5X,I11,5X,I8) 
    1187598 
    1188    END SUBROUTINE obs_pre_vel 
     599   END SUBROUTINE obs_pre_prof 
    1189600 
    1190601   SUBROUTINE obs_coo_tim( kcycle, & 
    … …  
    1293704            &        .AND. ( kobsmin(jobs) <= kmin0 ) ) ) THEN 
    1294705            kobsstp(jobs) = -1 
    1295             kobsqc(jobs)  = kobsqc(jobs) + 11 
     706            kobsqc(jobs)  = IBSET(kobsqc(jobs),13) 
    1296707            kotdobs       = kotdobs + 1 
    1297708            CYCLE 
    … …  
    1344755         IF ( ( kobsstp(jobs) < ( nit000 - 1 ) ) & 
    1345756            & .OR.( kobsstp(jobs) > nitend ) ) THEN 
    1346             kobsqc(jobs) = kobsqc(jobs) + 12 
     757            kobsqc(jobs) = IBSET(kobsqc(jobs),13) 
    1347758            kotdobs = kotdobs + 1 
    1348759            CYCLE 
    … …  
    1389800      &                    kobsyea, kobsmon, kobsday, kobshou, kobsmin,   & 
    1390801      &                    ktyp,    kobsqc,  kobsstp, kotdobs, kdailyavtypes, & 
    1391       &                    ld_dailyav ) 
     802      &                    kqc_cutoff ) 
    1392803      !!---------------------------------------------------------------------- 
    1393804      !!                    ***  ROUTINE obs_coo_tim *** 
    … …  
    1433844      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    1434845         & kdailyavtypes    ! Types for daily averages 
    1435       LOGICAL, OPTIONAL :: ld_dailyav    ! All types are daily averages 
     846      INTEGER, OPTIONAL, INTENT(IN) :: kqc_cutoff           ! QC cutoff value 
     847 
    1436848      !! * Local declarations 
    1437849      INTEGER :: jobs 
     850      INTEGER :: iqc_cutoff=255 
    1438851 
    1439852      !----------------------------------------------------------------------- 
    … …  
    1454867         DO jobs = 1, kobsno 
    1455868             
    1456             IF ( kobsqc(jobs) <= 10 ) THEN 
     869            IF ( kobsqc(jobs) <= iqc_cutoff ) THEN 
    1457870                
    1458871               IF ( ( kobsstp(jobs) == (nit000 - 1) ).AND.& 
    1459872                  & ( ANY (kdailyavtypes(:) == ktyp(jobs)) ) ) THEN 
    1460                   kobsqc(jobs) = kobsqc(jobs) + 14 
     873                  kobsqc(jobs) = IBSET(kobsqc(jobs),13) 
    1461874                  kotdobs      = kotdobs + 1 
    1462875                  CYCLE 
    … …  
    1467880      ENDIF 
    1468881 
    1469       !------------------------------------------------------------------------ 
    1470       ! If ld_dailyav is set then all data assumed to be daily averaged 
    1471       !------------------------------------------------------------------------ 
    1472        
    1473       IF ( PRESENT( ld_dailyav) ) THEN 
    1474          IF (ld_dailyav) THEN 
    1475             DO jobs = 1, kobsno 
    1476                 
    1477                IF ( kobsqc(jobs) <= 10 ) THEN 
    1478                    
    1479                   IF ( kobsstp(jobs) == (nit000 - 1) ) THEN 
    1480                      kobsqc(jobs) = kobsqc(jobs) + 14 
    1481                      kotdobs      = kotdobs + 1 
    1482                      CYCLE 
    1483                   ENDIF 
    1484                    
    1485                ENDIF 
    1486             END DO 
    1487          ENDIF 
    1488       ENDIF 
    1489882 
    1490883   END SUBROUTINE obs_coo_tim_prof 
    … …  
    1521914      DO jobs = 1, kobsno 
    1522915         IF ( ( kobsi(jobs) <= 0 ) .AND. ( kobsj(jobs) <= 0 ) ) THEN 
    1523             kobsqc(jobs) = kobsqc(jobs) + 18 
     916            kobsqc(jobs) = IBSET(kobsqc(jobs),12) 
    1524917            kgrdobs = kgrdobs + 1 
    1525918         ENDIF 
    … …  
    1532925      &                       plam,   pphi,    pmask,            & 
    1533926      &                       kobsqc, kosdobs, klanobs,          & 
    1534       &                       knlaobs,ld_nea                     ) 
     927      &                       knlaobs,ld_nea,                    & 
     928      &                       kbdyobs,ld_bound_reject,           & 
     929      &                       kqc_cutoff                         ) 
    1535930      !!---------------------------------------------------------------------- 
    1536931      !!                    ***  ROUTINE obs_coo_spc_2d  *** 
    … …  
    1565960      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: & 
    1566961         & kobsqc             ! Observation quality control 
    1567       INTEGER, INTENT(INOUT) :: kosdobs   ! Observations outside space domain 
    1568       INTEGER, INTENT(INOUT) :: klanobs   ! Observations within a model land cell 
    1569       INTEGER, INTENT(INOUT) :: knlaobs   ! Observations near land 
    1570       LOGICAL, INTENT(IN) :: ld_nea       ! Flag observations near land 
     962      INTEGER, INTENT(INOUT) :: kosdobs          ! Observations outside space domain 
     963      INTEGER, INTENT(INOUT) :: klanobs          ! Observations within a model land cell 
     964      INTEGER, INTENT(INOUT) :: knlaobs          ! Observations near land 
     965      INTEGER, INTENT(INOUT) :: kbdyobs          ! Observations near boundary 
     966      LOGICAL, INTENT(IN)    :: ld_nea           ! Flag observations near land 
     967      LOGICAL, INTENT(IN)    :: ld_bound_reject  ! Flag observations near open boundary  
     968      INTEGER, INTENT(IN)    :: kqc_cutoff       ! Cutoff QC value 
     969 
    1571970      !! * Local declarations 
    1572971      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
    1573972         & zgmsk              ! Grid mask 
     973#if defined key_bdy  
     974      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
     975         & zbmsk              ! Boundary mask 
     976      REAL(KIND=wp), DIMENSION(jpi,jpj) :: zbdymask 
     977#endif  
    1574978      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
    1575979         & zglam, &           ! Model longitude at grid points 
    … …  
    1588992         ! For invalid points use 2,2 
    1589993 
    1590          IF ( kobsqc(jobs) >= 10 ) THEN 
     994         IF ( kobsqc(jobs) >= kqc_cutoff ) THEN 
    1591995 
    1592996            igrdi(1,1,jobs) = 1 
    … …  
    16131017 
    16141018      END DO 
    1615        
    1616       CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pmask, zgmsk ) 
    1617       CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, plam, zglam ) 
    1618       CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pphi, zgphi ) 
     1019 
     1020#if defined key_bdy              
     1021      ! Create a mask grid points in boundary rim 
     1022      IF (ld_bound_reject) THEN 
     1023         zbdymask(:,:) = 1.0_wp 
     1024         DO ji = 1, nb_bdy 
     1025            DO jj = 1, idx_bdy(ji)%nblen(1) 
     1026               zbdymask(idx_bdy(ji)%nbi(jj,1),idx_bdy(ji)%nbj(jj,1)) = 0.0_wp 
     1027            ENDDO 
     1028         ENDDO 
     1029  
     1030         CALL obs_int_comm_2d( 2, 2, kobsno, kpi, kpj, igrdi, igrdj, zbdymask, zbmsk ) 
     1031      ENDIF 
     1032#endif        
     1033       
     1034      CALL obs_int_comm_2d( 2, 2, kobsno, kpi, kpj, igrdi, igrdj, pmask, zgmsk ) 
     1035      CALL obs_int_comm_2d( 2, 2, kobsno, kpi, kpj, igrdi, igrdj, plam, zglam ) 
     1036      CALL obs_int_comm_2d( 2, 2, kobsno, kpi, kpj, igrdi, igrdj, pphi, zgphi ) 
    16191037 
    16201038      DO jobs = 1, kobsno 
    16211039 
    16221040         ! Skip bad observations 
    1623          IF ( kobsqc(jobs) >= 10 ) CYCLE 
     1041         IF ( kobsqc(jobs) >= kqc_cutoff ) CYCLE 
    16241042 
    16251043         ! Flag if the observation falls outside the model spatial domain 
    … …  
    16281046            &  .OR. ( pobsphi(jobs) <  -90. ) & 
    16291047            &  .OR. ( pobsphi(jobs) >   90. ) ) THEN 
    1630             kobsqc(jobs) = kobsqc(jobs) + 11 
     1048            kobsqc(jobs) = IBSET(kobsqc(jobs),11) 
    16311049            kosdobs = kosdobs + 1 
    16321050            CYCLE 
    … …  
    16351053         ! Flag if the observation falls with a model land cell 
    16361054         IF ( SUM( zgmsk(1:2,1:2,jobs) ) == 0.0_wp ) THEN 
    1637             kobsqc(jobs) = kobsqc(jobs)  + 12 
     1055            kobsqc(jobs) = IBSET(kobsqc(jobs),10) 
    16381056            klanobs = klanobs + 1 
    16391057            CYCLE 
    … …  
    16491067               IF ( ( ABS( zgphi(ji,jj,jobs) - pobsphi(jobs) ) < 1.0e-6_wp ) & 
    16501068                  & .AND. & 
    1651                   & ( ABS( zglam(ji,jj,jobs) - pobslam(jobs) ) < 1.0e-6_wp ) & 
    1652                   & ) THEN 
     1069                  & ( ABS( MOD( zglam(ji,jj,jobs) - pobslam(jobs),360.0) ) & 
     1070                  & < 1.0e-6_wp ) ) THEN 
    16531071                  lgridobs = .TRUE. 
    16541072                  iig = ji 
    … …  
    16571075            END DO 
    16581076         END DO 
    1659    
    1660          ! For observations on the grid reject them if their are at 
    1661          ! a masked point 
    1662           
     1077  
    16631078         IF (lgridobs) THEN 
    16641079            IF (zgmsk(iig,ijg,jobs) == 0.0_wp ) THEN 
    1665                kobsqc(jobs) = kobsqc(jobs) + 12 
     1080               kobsqc(jobs) = IBSET(kobsqc(jobs),10) 
    16661081               klanobs = klanobs + 1 
    16671082               CYCLE 
    16681083            ENDIF 
    16691084         ENDIF 
    1670                        
     1085 
     1086  
    16711087         ! Flag if the observation falls is close to land 
    16721088         IF ( MINVAL( zgmsk(1:2,1:2,jobs) ) == 0.0_wp) THEN 
    1673             IF (ld_nea) kobsqc(jobs) = kobsqc(jobs) + 14 
    16741089            knlaobs = knlaobs + 1 
    1675             CYCLE 
    1676          ENDIF 
     1090            IF (ld_nea) THEN 
     1091               kobsqc(jobs) = IBSET(kobsqc(jobs),9) 
     1092               CYCLE 
     1093            ENDIF 
     1094         ENDIF 
     1095 
     1096#if defined key_bdy 
     1097         ! Flag if the observation falls close to the boundary rim 
     1098         IF (ld_bound_reject) THEN 
     1099            IF ( MINVAL( zbmsk(1:2,1:2,jobs) ) == 0.0_wp ) THEN 
     1100               kobsqc(jobs) = IBSET(kobsqc(jobs),8) 
     1101               kbdyobs = kbdyobs + 1 
     1102               CYCLE 
     1103            ENDIF 
     1104            ! for observations on the grid... 
     1105            IF (lgridobs) THEN 
     1106               IF (zbmsk(iig,ijg,jobs) == 0.0_wp ) THEN 
     1107                  kobsqc(jobs) = IBSET(kobsqc(jobs),8) 
     1108                  kbdyobs = kbdyobs + 1 
     1109                  CYCLE 
     1110               ENDIF 
     1111            ENDIF 
     1112         ENDIF 
     1113#endif  
    16771114             
    16781115      END DO 
    … …  
    16861123      &                       plam,    pphi,    pdep,    pmask, & 
    16871124      &                       kpobsqc, kobsqc,  kosdobs,        & 
    1688       &                       klanobs, knlaobs, ld_nea          ) 
     1125      &                       klanobs, knlaobs, ld_nea,         & 
     1126      &                       kbdyobs, ld_bound_reject,         & 
     1127      &                       kqc_cutoff                        ) 
    16891128      !!---------------------------------------------------------------------- 
    16901129      !!                    ***  ROUTINE obs_coo_spc_3d  *** 
    … …  
    17091148      !! * Modules used 
    17101149      USE dom_oce, ONLY : &       ! Geographical information 
    1711          & gdepw_1d                         
     1150         & gdepw_1d,      & 
     1151         & gdepw_0,       &                        
     1152#if defined key_vvl 
     1153         & gdepw_n,       &  
     1154         & gdept_n,       & 
     1155#endif 
     1156         & ln_zco,        & 
     1157         & ln_zps,        & 
     1158         & lk_vvl                         
    17121159 
    17131160      !! * Arguments 
    … …  
    17431190      INTEGER, INTENT(INOUT) :: klanobs     ! Observations within a model land cell 
    17441191      INTEGER, INTENT(INOUT) :: knlaobs     ! Observations near land 
     1192      INTEGER, INTENT(INOUT) :: kbdyobs     ! Observations near boundary 
    17451193      LOGICAL, INTENT(IN) :: ld_nea         ! Flag observations near land 
     1194      LOGICAL, INTENT(IN) :: ld_bound_reject  ! Flag observations near open boundary 
     1195      INTEGER, INTENT(IN) :: kqc_cutoff     ! Cutoff QC value 
     1196 
    17461197      !! * Local declarations 
    17471198      REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: & 
    17481199         & zgmsk              ! Grid mask 
     1200#if defined key_bdy  
     1201      REAL(KIND=wp), DIMENSION(2,2,kprofno) :: & 
     1202         & zbmsk              ! Boundary mask 
     1203      REAL(KIND=wp), DIMENSION(jpi,jpj) :: zbdymask 
     1204#endif  
     1205      REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: & 
     1206         & zgdepw          
    17491207      REAL(KIND=wp), DIMENSION(2,2,kprofno) :: & 
    17501208         & zglam, &           ! Model longitude at grid points 
    … …  
    17541212         & igrdj 
    17551213      LOGICAL :: lgridobs           ! Is observation on a model grid point. 
     1214      LOGICAL :: ll_next_to_land    ! Is a profile next to land  
    17561215      INTEGER :: iig, ijg           ! i,j of observation on model grid point. 
    17571216      INTEGER :: jobs, jobsp, jk, ji, jj 
    … …  
    17631222         ! For invalid points use 2,2 
    17641223 
    1765          IF ( kpobsqc(jobs) >= 10 ) THEN 
     1224         IF ( kpobsqc(jobs) >= kqc_cutoff ) THEN 
    17661225             
    17671226            igrdi(1,1,jobs) = 1 
    … …  
    17881247          
    17891248      END DO 
    1790        
    1791       CALL obs_int_comm_3d( 2, 2, kprofno, kpk, igrdi, igrdj, pmask, zgmsk ) 
    1792       CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, plam, zglam ) 
    1793       CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, pphi, zgphi ) 
     1249 
     1250#if defined key_bdy  
     1251      ! Create a mask grid points in boundary rim 
     1252      IF (ld_bound_reject) THEN            
     1253         zbdymask(:,:) = 1.0_wp 
     1254         DO ji = 1, nb_bdy 
     1255            DO jj = 1, idx_bdy(ji)%nblen(1) 
     1256               zbdymask(idx_bdy(ji)%nbi(jj,1),idx_bdy(ji)%nbj(jj,1)) = 0.0_wp 
     1257            ENDDO 
     1258         ENDDO 
     1259      ENDIF 
     1260  
     1261      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, zbdymask, zbmsk ) 
     1262#endif  
     1263       
     1264      CALL obs_int_comm_3d( 2, 2, kprofno, kpi, kpj, kpk, igrdi, igrdj, pmask, zgmsk ) 
     1265      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, plam, zglam ) 
     1266      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, pphi, zgphi ) 
     1267      ! Need to know the bathy depth for each observation for sco 
     1268      CALL obs_int_comm_3d( 2, 2, kprofno, kpi, kpj, kpk, igrdi, igrdj, fsdepw(:,:,:), & 
     1269         &                  zgdepw ) 
    17941270 
    17951271      DO jobs = 1, kprofno 
    17961272 
    17971273         ! Skip bad profiles 
    1798          IF ( kpobsqc(jobs) >= 10 ) CYCLE 
     1274         IF ( kpobsqc(jobs) >= kqc_cutoff ) CYCLE 
    17991275 
    18001276         ! Check if this observation is on a grid point 
    … …  
    18071283               IF ( ( ABS( zgphi(ji,jj,jobs) - pobsphi(jobs) ) < 1.0e-6_wp ) & 
    18081284                  & .AND. & 
    1809                   & ( ABS( zglam(ji,jj,jobs) - pobslam(jobs) ) < 1.0e-6_wp ) & 
     1285                  & ( ABS( MOD( zglam(ji,jj,jobs) - pobslam(jobs),360.0) ) < 1.0e-6_wp ) & 
    18101286                  & ) THEN 
    18111287                  lgridobs = .TRUE. 
    … …  
    18161292         END DO 
    18171293 
     1294         ! Check if next to land  
     1295         IF (  ANY( zgmsk(1:2,1:2,1,jobs) == 0.0_wp ) ) THEN  
     1296            ll_next_to_land=.TRUE.  
     1297         ELSE  
     1298            ll_next_to_land=.FALSE.  
     1299         ENDIF  
     1300          
    18181301         ! Reject observations 
    18191302 
    … …  
    18271310               &  .OR. ( pobsdep(jobsp) < 0.0          )       & 
    18281311               &  .OR. ( pobsdep(jobsp) > gdepw_1d(kpk)) ) THEN 
    1829                kobsqc(jobsp) = kobsqc(jobsp) + 11 
     1312               kobsqc(jobsp) = IBSET(kobsqc(jobsp),11) 
    18301313               kosdobs = kosdobs + 1 
    18311314               CYCLE 
    18321315            ENDIF 
    18331316 
    1834             ! Flag if the observation falls with a model land cell 
    1835             IF ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) & 
    1836                &  == 0.0_wp ) THEN 
    1837                kobsqc(jobsp) = kobsqc(jobsp) + 12 
    1838                klanobs = klanobs + 1 
    1839                CYCLE 
     1317            ! To check if an observations falls within land there are two cases:  
     1318            ! 1: z-coordibnates, where the check uses the mask  
     1319            ! 2: terrain following (eg s-coordinates),   
     1320            !    where we use the depth of the bottom cell to mask observations  
     1321              
     1322            IF( (.NOT. lk_vvl) .AND. ( ln_zps .OR. ln_zco )  ) THEN !(CASE 1)  
     1323                 
     1324               ! Flag if the observation falls with a model land cell  
     1325               IF ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) &  
     1326                  &  == 0.0_wp ) THEN  
     1327                  kobsqc(jobsp) = IBSET(kobsqc(jobsp),10) 
     1328                  klanobs = klanobs + 1  
     1329                  CYCLE  
     1330               ENDIF  
     1331              
     1332               ! Flag if the observation is close to land  
     1333               IF ( MINVAL( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) == &  
     1334                  &  0.0_wp) THEN  
     1335                  knlaobs = knlaobs + 1  
     1336                  IF (ld_nea) THEN    
     1337                     kobsqc(jobsp) = IBSET(kobsqc(jobsp),10) 
     1338                  ENDIF   
     1339               ENDIF  
     1340              
     1341            ELSE ! Case 2  
     1342               ! Flag if the observation is deeper than the bathymetry  
     1343               ! Or if it is within the mask  
     1344               IF ( ANY( zgdepw(1:2,1:2,kpk,jobs) < pobsdep(jobsp) ) & 
     1345                  &     .OR. &  
     1346                  &  ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) & 
     1347                  &  == 0.0_wp) ) THEN 
     1348                  kobsqc(jobsp) = IBSET(kobsqc(jobsp),10) 
     1349                  klanobs = klanobs + 1  
     1350                  CYCLE  
     1351               ENDIF  
     1352                 
     1353               ! Flag if the observation is close to land  
     1354               IF ( ll_next_to_land ) THEN  
     1355                  knlaobs = knlaobs + 1  
     1356                  IF (ld_nea) THEN    
     1357                     kobsqc(jobsp) = IBSET(kobsqc(jobsp),10) 
     1358                  ENDIF   
     1359               ENDIF  
     1360              
    18401361            ENDIF 
    18411362 
    … …  
    18451366            IF (lgridobs) THEN 
    18461367               IF (zgmsk(iig,ijg,kobsk(jobsp)-1,jobs) == 0.0_wp ) THEN 
    1847                   kobsqc(jobsp) = kobsqc(jobsp) + 12 
     1368                  kobsqc(jobsp) = IBSET(kobsqc(jobs),10) 
    18481369                  klanobs = klanobs + 1 
    18491370                  CYCLE 
    … …  
    18511372            ENDIF 
    18521373             
    1853             ! Flag if the observation falls is close to land 
    1854             IF ( MINVAL( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) == & 
    1855                &  0.0_wp) THEN 
    1856                IF (ld_nea) kobsqc(jobsp) = kobsqc(jobsp) + 14 
    1857                knlaobs = knlaobs + 1 
    1858             ENDIF 
    1859  
    18601374            ! Set observation depth equal to that of the first model depth 
    18611375            IF ( pobsdep(jobsp) <= pdep(1) ) THEN 
    … …  
    18631377            ENDIF 
    18641378             
     1379#if defined key_bdy 
     1380            ! Flag if the observation falls close to the boundary rim 
     1381            IF (ld_bound_reject) THEN 
     1382               IF ( MINVAL( zbmsk(1:2,1:2,jobs) ) == 0.0_wp ) THEN 
     1383                  kobsqc(jobsp) = IBSET(kobsqc(jobs),8) 
     1384                  kbdyobs = kbdyobs + 1 
     1385                  CYCLE 
     1386               ENDIF 
     1387               ! for observations on the grid... 
     1388               IF (lgridobs) THEN 
     1389                  IF (zbmsk(iig,ijg,jobs) == 0.0_wp ) THEN 
     1390                     kobsqc(jobsp) = IBSET(kobsqc(jobs),8) 
     1391                     kbdyobs = kbdyobs + 1 
     1392                     CYCLE 
     1393                  ENDIF 
     1394               ENDIF 
     1395            ENDIF 
     1396#endif  
     1397             
    18651398         END DO 
    18661399      END DO 
    … …  
    18681401   END SUBROUTINE obs_coo_spc_3d 
    18691402 
    1870    SUBROUTINE obs_pro_rej( profdata ) 
     1403   SUBROUTINE obs_pro_rej( profdata, kqc_cutoff ) 
    18711404      !!---------------------------------------------------------------------- 
    18721405      !!                    ***  ROUTINE obs_pro_rej *** 
    … …  
    18861419      !! * Arguments 
    18871420      TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Profile data 
     1421      INTEGER, INTENT(IN) :: kqc_cutoff             ! QC cutoff value 
     1422 
    18881423      !! * Local declarations 
    18891424      INTEGER :: jprof 
    … …  
    18951430      DO jprof = 1, profdata%nprof 
    18961431 
    1897          IF ( profdata%nqc(jprof) > 10 ) THEN 
     1432         IF ( profdata%nqc(jprof) > kqc_cutoff ) THEN 
    18981433             
    18991434            DO jvar = 1, profdata%nvar 
    … …  
    19031438                   
    19041439                  profdata%var(jvar)%nvqc(jobs) = & 
    1905                      & profdata%var(jvar)%nvqc(jobs) + 26 
     1440                     & IBSET(profdata%var(jvar)%nvqc(jobs),14) 
    19061441 
    19071442               END DO 
    … …  
    19151450   END SUBROUTINE obs_pro_rej 
    19161451 
    1917    SUBROUTINE obs_uv_rej( profdata, knumu, knumv ) 
     1452   SUBROUTINE obs_uv_rej( profdata, knumu, knumv, kqc_cutoff ) 
    19181453      !!---------------------------------------------------------------------- 
    19191454      !!                    ***  ROUTINE obs_uv_rej *** 
    … …  
    19351470      INTEGER, INTENT(INOUT) :: knumu             ! Number of u rejected 
    19361471      INTEGER, INTENT(INOUT) :: knumv             ! Number of v rejected 
     1472      INTEGER, INTENT(IN) :: kqc_cutoff           ! QC cutoff value 
     1473 
    19371474      !! * Local declarations 
    19381475      INTEGER :: jprof 
    … …  
    19541491         DO jobs = profdata%npvsta(jprof,1), profdata%npvend(jprof,1) 
    19551492             
    1956             IF ( ( profdata%var(1)%nvqc(jobs) > 10 ) .AND. & 
    1957                & ( profdata%var(2)%nvqc(jobs) <= 10) ) THEN 
    1958                profdata%var(2)%nvqc(jobs) = profdata%var(2)%nvqc(jobs) + 42 
     1493            IF ( ( profdata%var(1)%nvqc(jobs) >  kqc_cutoff ) .AND. & 
     1494               & ( profdata%var(2)%nvqc(jobs) <=  kqc_cutoff) ) THEN 
     1495               profdata%var(2)%nvqc(jobs) = IBSET(profdata%var(1)%nvqc(jobs),15) 
    19591496               knumv = knumv + 1 
    19601497            ENDIF 
    1961             IF ( ( profdata%var(2)%nvqc(jobs) > 10 ) .AND. & 
    1962                & ( profdata%var(1)%nvqc(jobs) <= 10) ) THEN 
    1963                profdata%var(1)%nvqc(jobs) = profdata%var(1)%nvqc(jobs) + 42 
     1498            IF ( ( profdata%var(2)%nvqc(jobs) >  kqc_cutoff ) .AND. & 
     1499               & ( profdata%var(1)%nvqc(jobs) <=  kqc_cutoff) ) THEN 
     1500               profdata%var(1)%nvqc(jobs) = IBSET(profdata%var(1)%nvqc(jobs),15) 
    19641501               knumu = knumu + 1 
    19651502            ENDIF 

  • branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90

    r6486 r10120  
    104104      ! Bookkeeping arrays with sizes equal to number of variables 
    105105 
     106      CHARACTER(len=8), POINTER, DIMENSION(:) :: & 
     107         & cvars          !: Variable names 
     108 
    106109      INTEGER, POINTER, DIMENSION(:) :: & 
    107110         & nvprot,   &    !: Local total number of profile T data 
    … …  
    237240 
    238241      ALLOCATE( & 
     242         & prof%cvars(kvar),    & 
    239243         & prof%nvprot(kvar),   & 
    240244         & prof%nvprotmpp(kvar) & 
    … …  
    242246          
    243247      DO jvar = 1, kvar 
     248         prof%cvars    (jvar) = "NotSet" 
    244249         prof%nvprot   (jvar) = ko3dt(jvar) 
    245250         prof%nvprotmpp(jvar) = 0 
    … …  
    452457 
    453458      DEALLOCATE( & 
    454          & prof%nvprot,  & 
     459         & prof%cvars,    & 
     460         & prof%nvprot,   & 
    455461         & prof%nvprotmpp & 
    456462         ) 
    … …  
    770776      newprof%npj      = prof%npj 
    771777      newprof%npk      = prof%npk 
     778      newprof%cvars(:) = prof%cvars(:) 
    772779  
    773780      ! Deallocate temporary data 

  • branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90

    r6486 r10120  
    5050CONTAINS 
    5151 
    52    SUBROUTINE obs_rea_altbias( kslano, sladata, k2dint, bias_file ) 
     52   SUBROUTINE obs_rea_altbias( sladata, k2dint, bias_file ) 
    5353      !!--------------------------------------------------------------------- 
    5454      !! 
    … …  
    7070      ! 
    7171      !! * Arguments 
    72       INTEGER, INTENT(IN) :: kslano      ! Number of SLA Products 
    73       TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: & 
     72      TYPE(obs_surf), INTENT(INOUT) :: & 
    7473         & sladata       ! SLA data 
    7574      INTEGER, INTENT(IN) :: k2dint 
    … …  
    8079      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_rea_altbias' 
    8180 
    82       INTEGER :: jslano       ! Data set loop variable 
    8381      INTEGER :: jobs         ! Obs loop variable 
    8482      INTEGER :: jpialtbias   ! Number of grid point in latitude for the bias 
    … …  
    130128         ! Get the Alt bias data 
    131129          
    132          CALL iom_get( numaltbias, jpdom_data, 'altbias', z_altbias(:,:), 1 ) 
     130         CALL iom_get( numaltbias, jpdom_autoglo, 'altbias', z_altbias(:,:), 1 ) 
    133131          
    134132         ! Close the file 
    … …  
    144142      ! Intepolate the bias already on the model grid at the observation point 
    145143   
    146       DO jslano = 1, kslano 
    147  
    148          ALLOCATE( & 
    149             & igrdi(2,2,sladata(jslano)%nsurf), & 
    150             & igrdj(2,2,sladata(jslano)%nsurf), & 
    151             & zglam(2,2,sladata(jslano)%nsurf), & 
    152             & zgphi(2,2,sladata(jslano)%nsurf), & 
    153             & zmask(2,2,sladata(jslano)%nsurf), & 
    154             & zbias(2,2,sladata(jslano)%nsurf)  & 
    155             & ) 
    156           
    157          DO jobs = 1, sladata(jslano)%nsurf 
    158  
    159             igrdi(1,1,jobs) = sladata(jslano)%mi(jobs)-1 
    160             igrdj(1,1,jobs) = sladata(jslano)%mj(jobs)-1 
    161             igrdi(1,2,jobs) = sladata(jslano)%mi(jobs)-1 
    162             igrdj(1,2,jobs) = sladata(jslano)%mj(jobs) 
    163             igrdi(2,1,jobs) = sladata(jslano)%mi(jobs) 
    164             igrdj(2,1,jobs) = sladata(jslano)%mj(jobs)-1 
    165             igrdi(2,2,jobs) = sladata(jslano)%mi(jobs) 
    166             igrdj(2,2,jobs) = sladata(jslano)%mj(jobs) 
    167  
    168          END DO 
    169  
    170          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 
    171             &                  igrdi, igrdj, glamt, zglam ) 
    172          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 
    173             &                  igrdi, igrdj, gphit, zgphi ) 
    174          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 
    175             &                  igrdi, igrdj, tmask(:,:,1), zmask ) 
    176          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, & 
    177             &                  igrdi, igrdj, z_altbias, zbias ) 
    178  
    179          DO jobs = 1, sladata(jslano)%nsurf 
    180  
    181             zlam = sladata(jslano)%rlam(jobs) 
    182             zphi = sladata(jslano)%rphi(jobs) 
    183             iico = sladata(jslano)%mi(jobs) 
    184             ijco = sladata(jslano)%mj(jobs) 
     144      ALLOCATE( & 
     145         & igrdi(2,2,sladata%nsurf), & 
     146         & igrdj(2,2,sladata%nsurf), & 
     147         & zglam(2,2,sladata%nsurf), & 
     148         & zgphi(2,2,sladata%nsurf), & 
     149         & zmask(2,2,sladata%nsurf), & 
     150         & zbias(2,2,sladata%nsurf)  & 
     151         & ) 
     152          
     153      DO jobs = 1, sladata%nsurf 
     154 
     155         igrdi(1,1,jobs) = sladata%mi(jobs)-1 
     156         igrdj(1,1,jobs) = sladata%mj(jobs)-1 
     157         igrdi(1,2,jobs) = sladata%mi(jobs)-1 
     158         igrdj(1,2,jobs) = sladata%mj(jobs) 
     159         igrdi(2,1,jobs) = sladata%mi(jobs) 
     160         igrdj(2,1,jobs) = sladata%mj(jobs)-1 
     161         igrdi(2,2,jobs) = sladata%mi(jobs) 
     162         igrdj(2,2,jobs) = sladata%mj(jobs) 
     163 
     164      END DO 
     165 
     166      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
     167         &                  igrdi, igrdj, glamt, zglam ) 
     168      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
     169         &                  igrdi, igrdj, gphit, zgphi ) 
     170      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
     171         &                  igrdi, igrdj, tmask(:,:,1), zmask ) 
     172      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, & 
     173         &                  igrdi, igrdj, z_altbias, zbias ) 
     174 
     175      DO jobs = 1, sladata%nsurf 
     176 
     177         zlam = sladata%rlam(jobs) 
     178         zphi = sladata%rphi(jobs) 
     179         iico = sladata%mi(jobs) 
     180         ijco = sladata%mj(jobs) 
    185181             
    186             CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
    187                &                   zglam(:,:,jobs), zgphi(:,:,jobs), & 
    188                &                   zmask(:,:,jobs), zweig, zobsmask ) 
     182         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
     183            &                   zglam(:,:,jobs), zgphi(:,:,jobs), & 
     184            &                   zmask(:,:,jobs), zweig, zobsmask ) 
    189185             
    190             CALL obs_int_h2d( 1, 1,      & 
    191                &              zweig, zbias(:,:,jobs),  zext ) 
    192  
    193             ! adjust mdt with bias field 
    194             sladata(jslano)%rext(jobs,2) = & 
    195                sladata(jslano)%rext(jobs,2) - zext(1) 
     186         CALL obs_int_h2d( 1, 1,      & 
     187            &              zweig, zbias(:,:,jobs),  zext ) 
     188 
     189         ! adjust mdt with bias field 
     190         sladata%rext(jobs,2) = sladata%rext(jobs,2) - zext(1) 
    196191             
    197          END DO 
    198  
    199          DEALLOCATE( & 
    200             & igrdi, & 
    201             & igrdj, & 
    202             & zglam, & 
    203             & zgphi, & 
    204             & zmask, & 
    205             & zbias  & 
    206             & ) 
    207           
    208192      END DO 
    209193 
     194      DEALLOCATE( & 
     195         & igrdi, & 
     196         & igrdj, & 
     197         & zglam, & 
     198         & zgphi, & 
     199         & zmask, & 
     200         & zbias  & 
     201         & ) 
     202          
    210203      CALL wrk_dealloc(jpi,jpj,z_altbias)  
    211204 

  • branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90

    r6486 r10120  
    2525   USE netcdf                   ! NetCDF library 
    2626   USE obs_oper                 ! Observation operators 
    27    USE obs_prof_io              ! Profile files I/O (non-FB files) 
    2827   USE lib_mpp                  ! For ctl_warn/stop 
     28   USE obs_fbm                  ! Feedback routines 
    2929 
    3030   IMPLICIT NONE 
    … …  
    3333   PRIVATE 
    3434 
    35    PUBLIC obs_rea_pro_dri  ! Read the profile observations  
     35   PUBLIC obs_rea_prof  ! Read the profile observations  
    3636 
    3737   !!---------------------------------------------------------------------- 
    … …  
    4242 
    4343CONTAINS 
    44   
    45    SUBROUTINE obs_rea_pro_dri( kformat, & 
    46       &                        profdata, knumfiles, cfilenames, & 
    47       &                        kvars, kextr, kstp, ddobsini, ddobsend, & 
    48       &                        ldt3d, lds3d, ldignmis, ldsatt, ldavtimset, & 
    49       &                        ldmod, kdailyavtypes ) 
     44 
     45   SUBROUTINE obs_rea_prof( profdata, knumfiles, cdfilenames, & 
     46      &                     kvars, kextr, kstp, ddobsini, ddobsend, & 
     47      &                     ldvar1, ldvar2, ldignmis, ldsatt, & 
     48      &                     ldmod, kdailyavtypes ) 
    5049      !!--------------------------------------------------------------------- 
    5150      !! 
    52       !!                   *** ROUTINE obs_rea_pro_dri *** 
     51      !!                   *** ROUTINE obs_rea_prof *** 
    5352      !! 
    5453      !! ** Purpose : Read from file the profile observations 
    5554      !! 
    56       !! ** Method  : Depending on kformat either ENACT, CORIOLIS or 
    57       !!              feedback data files are read 
     55      !! ** Method  : Read feedback data in and transform to NEMO internal  
     56      !!              profile data structure 
    5857      !! 
    5958      !! ** Action  :  
    … …  
    6362      !! History :   
    6463      !!      ! :  2009-09 (K. Mogensen) : New merged version of old routines 
     64      !!      ! :  2015-08 (M. Martin) : Merged profile and velocity routines 
    6565      !!---------------------------------------------------------------------- 
    66       !! * Modules used 
    67     
     66 
    6867      !! * Arguments 
    69       INTEGER ::  kformat    ! Format of input data 
    70       !                      ! 1: ENACT 
    71       !                      ! 2: Coriolis 
    72       TYPE(obs_prof), INTENT(OUT) ::  profdata     ! Profile data to be read 
    73       INTEGER, INTENT(IN) :: knumfiles      ! Number of files to read in 
     68      TYPE(obs_prof), INTENT(OUT) :: & 
     69         & profdata                     ! Profile data to be read 
     70      INTEGER, INTENT(IN) :: knumfiles  ! Number of files to read 
    7471      CHARACTER(LEN=128), INTENT(IN) ::  & 
    75          & cfilenames(knumfiles)  ! File names to read in 
     72         & cdfilenames(knumfiles)        ! File names to read in 
    7673      INTEGER, INTENT(IN) :: kvars      ! Number of variables in profdata 
    77       INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var in profdata 
    78       INTEGER, INTENT(IN) :: kstp        ! Ocean time-step index 
    79       LOGICAL, INTENT(IN) :: ldt3d       ! Observed variables switches 
    80       LOGICAL, INTENT(IN) :: lds3d 
    81       LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files 
    82       LOGICAL, INTENT(IN) :: ldsatt      ! Compute salinity at all temperature points 
    83       LOGICAL, INTENT(IN) :: ldavtimset  ! Correct time for daily averaged data 
    84       LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data 
    85       REAL(KIND=dp), INTENT(IN) :: ddobsini    ! Obs. ini time in YYYYMMDD.HHMMSS 
    86       REAL(KIND=dp), INTENT(IN) :: ddobsend    ! Obs. end time in YYYYMMDD.HHMMSS 
     74      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var 
     75      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index 
     76      LOGICAL, INTENT(IN) :: ldvar1     ! Observed variables switches 
     77      LOGICAL, INTENT(IN) :: ldvar2 
     78      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files 
     79      LOGICAL, INTENT(IN) :: ldsatt     ! Compute salinity at all temperature points 
     80      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data 
     81      REAL(dp), INTENT(IN) :: ddobsini  ! Obs. ini time in YYYYMMDD.HHMMSS 
     82      REAL(dp), INTENT(IN) :: ddobsend  ! Obs. end time in YYYYMMDD.HHMMSS 
    8783      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    88          & kdailyavtypes 
     84         & kdailyavtypes                ! Types of daily average observations 
    8985 
    9086      !! * Local declarations 
    91       CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_pro_dri' 
     87      CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_prof' 
     88      CHARACTER(len=8) :: clrefdate 
     89      CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: clvars 
    9290      INTEGER :: jvar 
    9391      INTEGER :: ji 
    … …  
    105103      INTEGER :: imin 
    106104      INTEGER :: isec 
     105      INTEGER :: iprof 
     106      INTEGER :: iproftot 
     107      INTEGER :: ivar1t0 
     108      INTEGER :: ivar2t0 
     109      INTEGER :: ivar1t 
     110      INTEGER :: ivar2t 
     111      INTEGER :: ip3dt 
     112      INTEGER :: ios 
     113      INTEGER :: ioserrcount 
     114      INTEGER :: ivar1tmpp 
     115      INTEGER :: ivar2tmpp 
     116      INTEGER :: ip3dtmpp 
     117      INTEGER :: itype 
    107118      INTEGER, DIMENSION(knumfiles) :: & 
    108119         & irefdate 
    109120      INTEGER, DIMENSION(ntyp1770+1) :: & 
    110          & itypt,    & 
    111          & ityptmpp, & 
    112          & ityps,    & 
    113          & itypsmpp  
    114       INTEGER :: it3dtmpp 
    115       INTEGER :: is3dtmpp 
    116       INTEGER :: ip3dtmpp 
     121         & itypvar1,    & 
     122         & itypvar1mpp, & 
     123         & itypvar2,    & 
     124         & itypvar2mpp  
    117125      INTEGER, DIMENSION(:), ALLOCATABLE :: & 
    118          & iobsi,    & 
    119          & iobsj,    & 
    120          & iproc,    & 
     126         & iobsi1,    & 
     127         & iobsj1,    & 
     128         & iproc1,    & 
     129         & iobsi2,    & 
     130         & iobsj2,    & 
     131         & iproc2,    & 
    121132         & iindx,    & 
    122133         & ifileidx, & 
    123134         & iprofidx 
    124       INTEGER :: itype 
    125135      INTEGER, DIMENSION(imaxavtypes) :: & 
    126136         & idailyavtypes 
     137      INTEGER, DIMENSION(kvars) :: & 
     138         & iv3dt 
    127139      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    128140         & zphi, & 
    129141         & zlam 
    130       real(wp), DIMENSION(:), ALLOCATABLE :: & 
     142      REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    131143         & zdat 
     144      REAL(wp), DIMENSION(knumfiles) :: & 
     145         & djulini, & 
     146         & djulend 
    132147      LOGICAL :: llvalprof 
     148      LOGICAL :: lldavtimset 
    133149      TYPE(obfbdata), POINTER, DIMENSION(:) :: & 
    134150         & inpfiles 
    135       real(wp), DIMENSION(knumfiles) :: & 
    136          & djulini, & 
    137          & djulend 
    138       INTEGER :: iprof 
    139       INTEGER :: iproftot 
    140       INTEGER :: it3dt0 
    141       INTEGER :: is3dt0 
    142       INTEGER :: it3dt 
    143       INTEGER :: is3dt 
    144       INTEGER :: ip3dt 
    145       INTEGER :: ios 
    146       INTEGER :: ioserrcount 
    147       INTEGER, DIMENSION(kvars) :: & 
    148          & iv3dt 
    149       CHARACTER(len=8) :: cl_refdate 
    150     
     151 
    151152      ! Local initialization 
    152153      iprof = 0 
    153       it3dt0 = 0 
    154       is3dt0 = 0 
     154      ivar1t0 = 0 
     155      ivar2t0 = 0 
    155156      ip3dt = 0 
    156157 
    157158      ! Daily average types 
     159      lldavtimset = .FALSE. 
    158160      IF ( PRESENT(kdailyavtypes) ) THEN 
    159161         idailyavtypes(:) = kdailyavtypes(:) 
     162         IF ( ANY (idailyavtypes(:) /= -1) ) lldavtimset = .TRUE. 
    160163      ELSE 
    161164         idailyavtypes(:) = -1 
    … …  
    163166 
    164167      !----------------------------------------------------------------------- 
    165       ! Check data the model part is just with feedback data files 
    166       !----------------------------------------------------------------------- 
    167       IF ( ldmod .AND. ( kformat /= 0 ) ) THEN 
    168          CALL ctl_stop( 'Model can only be read from feedback data' ) 
    169          RETURN 
    170       ENDIF 
    171  
    172       !----------------------------------------------------------------------- 
    173168      ! Count the number of files needed and allocate the obfbdata type 
    174169      !----------------------------------------------------------------------- 
    175        
     170 
    176171      inobf = knumfiles 
    177        
     172 
    178173      ALLOCATE( inpfiles(inobf) ) 
    179174 
    180175      prof_files : DO jj = 1, inobf 
    181            
     176 
    182177         !--------------------------------------------------------------------- 
    183178         ! Prints 
    … …  
    186181            WRITE(numout,*) 
    187182            WRITE(numout,*) ' obs_rea_pro_dri : Reading from file = ', & 
    188                & TRIM( TRIM( cfilenames(jj) ) ) 
     183               & TRIM( TRIM( cdfilenames(jj) ) ) 
    189184            WRITE(numout,*) ' ~~~~~~~~~~~~~~~' 
    190185            WRITE(numout,*) 
    … …  
    194189         !  Initialization: Open file and get dimensions only 
    195190         !--------------------------------------------------------------------- 
    196           
    197          iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, & 
     191 
     192         iflag = nf90_open( TRIM( cdfilenames(jj) ), nf90_nowrite, & 
    198193            &                      i_file_id ) 
    199           
     194 
    200195         IF ( iflag /= nf90_noerr ) THEN 
    201196 
    202197            IF ( ldignmis ) THEN 
    203198               inpfiles(jj)%nobs = 0 
    204                CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // & 
     199               CALL ctl_warn( 'File ' // TRIM( cdfilenames(jj) ) // & 
    205200                  &           ' not found' ) 
    206201            ELSE  
    207                CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // & 
     202               CALL ctl_stop( 'File ' // TRIM( cdfilenames(jj) ) // & 
    208203                  &           ' not found' ) 
    209204            ENDIF 
    210205 
    211206         ELSE  
    212              
     207 
    213208            !------------------------------------------------------------------ 
    214             !  Close the file since it is opened in read_proffile 
     209            !  Close the file since it is opened in read_obfbdata 
    215210            !------------------------------------------------------------------ 
    216              
     211 
    217212            iflag = nf90_close( i_file_id ) 
    218213 
    … …  
    220215            !  Read the profile file into inpfiles 
    221216            !------------------------------------------------------------------ 
    222             IF ( kformat == 0 ) THEN 
    223                CALL init_obfbdata( inpfiles(jj) ) 
    224                IF(lwp) THEN 
    225                   WRITE(numout,*) 
    226                   WRITE(numout,*)'Reading from feedback file :', & 
    227                      &           TRIM( cfilenames(jj) ) 
    228                ENDIF 
    229                CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), & 
    230                   &                ldgrid = .TRUE. ) 
    231                IF ( inpfiles(jj)%nvar < 2 ) THEN 
    232                   CALL ctl_stop( 'Feedback format error' ) 
    233                   RETURN 
    234                ENDIF 
    235                IF ( TRIM(inpfiles(jj)%cname(1)) /= 'POTM' ) THEN 
    236                   CALL ctl_stop( 'Feedback format error' ) 
    237                   RETURN 
    238                ENDIF 
    239                IF ( TRIM(inpfiles(jj)%cname(2)) /= 'PSAL' ) THEN 
    240                   CALL ctl_stop( 'Feedback format error' ) 
    241                   RETURN 
    242                ENDIF 
    243                IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN 
    244                   CALL ctl_stop( 'Model not in input data' ) 
    245                   RETURN 
    246                ENDIF 
    247             ELSEIF ( kformat == 1 ) THEN 
    248                CALL read_enactfile( TRIM( cfilenames(jj) ), inpfiles(jj), & 
    249                   &                 numout, lwp, .TRUE. ) 
    250             ELSEIF ( kformat == 2 ) THEN 
    251                CALL read_coriofile( TRIM( cfilenames(jj) ), inpfiles(jj), & 
    252                   &                 numout, lwp, .TRUE. ) 
     217            CALL init_obfbdata( inpfiles(jj) ) 
     218            CALL read_obfbdata( TRIM( cdfilenames(jj) ), inpfiles(jj), & 
     219               &                ldgrid = .TRUE. ) 
     220 
     221            IF ( inpfiles(jj)%nvar < 2 ) THEN 
     222               CALL ctl_stop( 'Feedback format error: ', & 
     223                  &           ' less than 2 vars in profile file' ) 
     224            ENDIF 
     225 
     226            IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN 
     227               CALL ctl_stop( 'Model not in input data' ) 
     228            ENDIF 
     229 
     230            IF ( jj == 1 ) THEN 
     231               ALLOCATE( clvars( inpfiles(jj)%nvar ) ) 
     232               DO ji = 1, inpfiles(jj)%nvar 
     233                 clvars(ji) = inpfiles(jj)%cname(ji) 
     234               END DO 
    253235            ELSE 
    254                CALL ctl_stop( 'File format unknown' ) 
    255             ENDIF 
    256              
     236               DO ji = 1, inpfiles(jj)%nvar 
     237                  IF ( inpfiles(jj)%cname(ji) /= clvars(ji) ) THEN 
     238                     CALL ctl_stop( 'Feedback file variables not consistent', & 
     239                        &           ' with previous files for this type' ) 
     240                  ENDIF 
     241               END DO 
     242            ENDIF 
     243 
    257244            !------------------------------------------------------------------ 
    258245            !  Change longitude (-180,180) 
    … …  
    272259            !  Calculate the date  (change eventually) 
    273260            !------------------------------------------------------------------ 
    274             cl_refdate=inpfiles(jj)%cdjuldref(1:8) 
    275             READ(cl_refdate,'(I8)') irefdate(jj) 
    276              
     261            clrefdate=inpfiles(jj)%cdjuldref(1:8) 
     262            READ(clrefdate,'(I8)') irefdate(jj) 
     263 
    277264            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec ) 
    278265            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), & 
    … …  
    283270 
    284271            ioserrcount=0 
    285             IF ( ldavtimset ) THEN 
     272            IF ( lldavtimset ) THEN 
     273 
     274               IF ( ANY ( idailyavtypes(:) /= -1 ) .AND. lwp) THEN 
     275                  WRITE(numout,*)' Resetting time of daily averaged', & 
     276                     &           ' observations to the end of the day' 
     277               ENDIF 
     278 
    286279               DO ji = 1, inpfiles(jj)%nobs 
    287                   !  
    288                   !  for daily averaged data for example 
    289                   !  MRB data (itype==820) force the time 
    290                   !  to be the  end of the day 
    291                   ! 
    292280                  READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 900 ) itype 
    293281900               IF ( ios /= 0 ) THEN 
    294                      itype = 0         ! Set type to zero if there is a problem in the string conversion 
    295                   ENDIF 
    296                   IF ( ANY (idailyavtypes == itype ) ) THEN 
    297                      inpfiles(jj)%ptim(ji) = & 
    298                      & INT(inpfiles(jj)%ptim(ji)) + 1 
    299                   ENDIF 
     282                     ! Set type to zero if there is a problem in the string conversion 
     283                     itype = 0 
     284                  ENDIF 
     285 
     286                  IF ( ANY ( idailyavtypes(:) == itype ) ) THEN 
     287                  !  for daily averaged data force the time 
     288                  !  to be the last time-step of the day, but still within the day. 
     289                     IF ( inpfiles(jj)%ptim(ji) >= 0. ) THEN 
     290                        inpfiles(jj)%ptim(ji) = & 
     291                           & INT(inpfiles(jj)%ptim(ji)) + 0.9999 
     292                     ELSE 
     293                        inpfiles(jj)%ptim(ji) = & 
     294                           & INT(inpfiles(jj)%ptim(ji)) - 0.0001 
     295                     ENDIF 
     296                  ENDIF 
     297 
    300298               END DO 
    301             ENDIF 
    302              
     299 
     300            ENDIF 
     301 
    303302            IF ( inpfiles(jj)%nobs > 0 ) THEN 
    304                inpfiles(jj)%iproc = -1 
    305                inpfiles(jj)%iobsi = -1 
    306                inpfiles(jj)%iobsj = -1 
     303               inpfiles(jj)%iproc(:,:) = -1 
     304               inpfiles(jj)%iobsi(:,:) = -1 
     305               inpfiles(jj)%iobsj(:,:) = -1 
    307306            ENDIF 
    308307            inowin = 0 
    309308            DO ji = 1, inpfiles(jj)%nobs 
    310                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    311                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    312                   & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     309               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 
    313312               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    314313                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    318317            ALLOCATE( zlam(inowin)  ) 
    319318            ALLOCATE( zphi(inowin)  ) 
    320             ALLOCATE( iobsi(inowin) ) 
    321             ALLOCATE( iobsj(inowin) ) 
    322             ALLOCATE( iproc(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) ) 
    323325            inowin = 0 
    324326            DO ji = 1, inpfiles(jj)%nobs 
    325                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    326                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    327                   & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     327               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 
    328330               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    329331                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    334336            END DO 
    335337 
    336             CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' ) 
     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 
    337350 
    338351            inowin = 0 
    339352            DO ji = 1, inpfiles(jj)%nobs 
    340                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    341                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    342                   & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     353               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 
    343356               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    344357                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    345358                  inowin = inowin + 1 
    346                   inpfiles(jj)%iproc(ji,1) = iproc(inowin) 
    347                   inpfiles(jj)%iobsi(ji,1) = iobsi(inowin) 
    348                   inpfiles(jj)%iobsj(ji,1) = iobsj(inowin) 
     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') 
     369                  ENDIF 
    349370               ENDIF 
    350371            END DO 
    351             DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc ) 
     372            DEALLOCATE( zlam, zphi, iobsi1, iobsj1, iproc1, iobsi2, iobsj2, iproc2 ) 
    352373 
    353374            DO ji = 1, inpfiles(jj)%nobs 
    354                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    355                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    356                   & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     375               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 
    357378               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    358379                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    363384                  ENDIF 
    364385                  llvalprof = .FALSE. 
    365                   IF ( ldt3d ) THEN 
     386                  IF ( ldvar1 ) THEN 
    366387                     loop_t_count : DO ij = 1,inpfiles(jj)%nlev 
    367388                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    368389                           & CYCLE 
    369                         IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    370                            & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    371                            it3dt0 = it3dt0 + 1 
     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 
    372393                        ENDIF 
    373394                     END DO loop_t_count 
    374395                  ENDIF 
    375                   IF ( lds3d ) THEN 
     396                  IF ( ldvar2 ) THEN 
    376397                     loop_s_count : DO ij = 1,inpfiles(jj)%nlev 
    377398                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    378399                           & CYCLE 
    379                         IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    380                            & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    381                            is3dt0 = is3dt0 + 1 
     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 
    382403                        ENDIF 
    383404                     END DO loop_s_count 
    … …  
    386407                     IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    387408                        & CYCLE 
    388                      IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    389                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    390                         &     ldt3d ) .OR. & 
    391                         & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    392                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    393                         &     lds3d ) ) THEN 
     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 
    394415                        ip3dt = ip3dt + 1 
    395416                        llvalprof = .TRUE. 
    … …  
    405426 
    406427      END DO prof_files 
    407        
     428 
    408429      !----------------------------------------------------------------------- 
    409430      ! Get the time ordered indices of the input data 
    … …  
    416437      DO jj = 1, inobf 
    417438         DO ji = 1, inpfiles(jj)%nobs 
    418             IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    419             IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    420                & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     439            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 
    421442            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    422443               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    431452      DO jj = 1, inobf 
    432453         DO ji = 1, inpfiles(jj)%nobs 
    433             IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    434             IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    435                & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     454            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 
    436457            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    437458               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    … …  
    446467         &               zdat,     & 
    447468         &               iindx   ) 
    448        
     469 
    449470      iv3dt(:) = -1 
    450471      IF (ldsatt) THEN 
    … …  
    452473         iv3dt(2) = ip3dt 
    453474      ELSE 
    454          iv3dt(1) = it3dt0 
    455          iv3dt(2) = is3dt0 
     475         iv3dt(1) = ivar1t0 
     476         iv3dt(2) = ivar2t0 
    456477      ENDIF 
    457478      CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, & 
    458479         &                 kstp, jpi, jpj, jpk ) 
    459        
     480 
    460481      ! * Read obs/positions, QC, all variable and assign to profdata 
    461482 
    462483      profdata%nprof     = 0 
    463484      profdata%nvprot(:) = 0 
    464  
     485      profdata%cvars(:)  = clvars(:) 
    465486      iprof = 0 
    466487 
    467488      ip3dt = 0 
    468       it3dt = 0 
    469       is3dt = 0 
    470       itypt   (:) = 0 
    471       ityptmpp(:) = 0 
    472        
    473       ityps   (:) = 0 
    474       itypsmpp(:) = 0 
    475        
    476       ioserrcount = 0       
     489      ivar1t = 0 
     490      ivar2t = 0 
     491      itypvar1   (:) = 0 
     492      itypvar1mpp(:) = 0 
     493 
     494      itypvar2   (:) = 0 
     495      itypvar2mpp(:) = 0 
     496 
     497      ioserrcount = 0 
    477498      DO jk = 1, iproftot 
    478           
     499 
    479500         jj = ifileidx(iindx(jk)) 
    480501         ji = iprofidx(iindx(jk)) 
    481502 
    482          IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    483          IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    484             & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     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 
    485506 
    486507         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  & 
    487508            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN 
    488              
     509 
    489510            IF ( nproc == 0 ) THEN 
    490511               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE 
    … …  
    492513               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE 
    493514            ENDIF 
    494              
     515 
    495516            llvalprof = .FALSE. 
    496517 
    497518            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    498519 
    499             IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    500                & ( inpfiles(jj)%ivqc(ji,2) > 2 ) ) CYCLE 
     520            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 
    501523 
    502524            loop_prof : DO ij = 1, inpfiles(jj)%nlev 
    503                 
     525 
    504526               IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    505527                  & CYCLE 
    506                 
    507                IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    508                   & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    509                    
     528 
     529               IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
     530                  & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
     531 
    510532                  llvalprof = .TRUE.  
    511533                  EXIT loop_prof 
    512                    
     534 
    513535               ENDIF 
    514                 
    515                IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    516                   & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    517                    
     536 
     537               IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
     538                  & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
     539 
    518540                  llvalprof = .TRUE.  
    519541                  EXIT loop_prof 
    520                    
     542 
    521543               ENDIF 
    522                 
     544 
    523545            END DO loop_prof 
    524              
     546 
    525547            ! Set profile information 
    526              
     548 
    527549            IF ( llvalprof ) THEN 
    528                 
     550 
    529551               iprof = iprof + 1 
    530552 
    … …  
    545567               profdata%nhou(iprof) = ihou 
    546568               profdata%nmin(iprof) = imin 
    547                 
     569 
    548570               ! Profile space coordinates 
    549571               profdata%rlam(iprof) = inpfiles(jj)%plam(ji) 
    … …  
    551573 
    552574               ! Coordinate search parameters 
    553                profdata%mi  (iprof,:) = inpfiles(jj)%iobsi(ji,1) 
    554                profdata%mj  (iprof,:) = inpfiles(jj)%iobsj(ji,1) 
    555                 
     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) 
     579 
    556580               ! Profile WMO number 
    557581               profdata%cwmo(iprof) = inpfiles(jj)%cdwmo(ji) 
    558                 
     582 
    559583               ! Instrument type 
    560584               READ( inpfiles(jj)%cdtyp(ji), '(I4)', IOSTAT = ios, ERR = 901 ) itype 
    … …  
    564588                  itype = 0 
    565589               ENDIF 
    566                 
     590 
    567591               profdata%ntyp(iprof) = itype 
    568                 
     592 
    569593               ! QC stuff 
    570594 
    … …  
    585609               profdata%nqc(iprof)  = 0 !TODO 
    586610 
    587                loop_p : DO ij = 1, inpfiles(jj)%nlev             
    588                    
     611               loop_p : DO ij = 1, inpfiles(jj)%nlev 
     612 
    589613                  IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    590614                     & CYCLE 
    … …  
    592616                  IF (ldsatt) THEN 
    593617 
    594                      IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    595                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    596                         &     ldt3d ) .OR. & 
    597                         & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    598                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    599                         &     lds3d ) ) THEN 
     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 
    600624                        ip3dt = ip3dt + 1 
    601625                     ELSE 
    602626                        CYCLE 
    603627                     ENDIF 
    604                       
    605                   ENDIF 
    606  
    607                   IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    608                      &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    609                      &       ldt3d ) .OR. ldsatt ) THEN 
    610                       
     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 
    611635                     IF (ldsatt) THEN 
    612636 
    613                         it3dt = ip3dt 
     637                        ivar1t = ip3dt 
    614638 
    615639                     ELSE 
    616640 
    617                         it3dt = it3dt + 1 
    618                          
     641                        ivar1t = ivar1t + 1 
     642 
    619643                     ENDIF 
    620644 
    621                      ! Depth of T observation 
    622                      profdata%var(1)%vdep(it3dt) = & 
     645                     ! Depth of var1 observation 
     646                     profdata%var(1)%vdep(ivar1t) = & 
    623647                        &                inpfiles(jj)%pdep(ij,ji) 
    624                       
    625                      ! Depth of T observation QC 
    626                      profdata%var(1)%idqc(it3dt) = & 
     648 
     649                     ! Depth of var1 observation QC 
     650                     profdata%var(1)%idqc(ivar1t) = & 
    627651                        &                inpfiles(jj)%idqc(ij,ji) 
    628                       
    629                      ! Depth of T observation QC flags 
    630                      profdata%var(1)%idqcf(:,it3dt) = & 
     652 
     653                     ! Depth of var1 observation QC flags 
     654                     profdata%var(1)%idqcf(:,ivar1t) = & 
    631655                        &                inpfiles(jj)%idqcf(:,ij,ji) 
    632                       
     656 
    633657                     ! Profile index 
    634                      profdata%var(1)%nvpidx(it3dt) = iprof 
    635                       
     658                     profdata%var(1)%nvpidx(ivar1t) = iprof 
     659 
    636660                     ! Vertical index in original profile 
    637                      profdata%var(1)%nvlidx(it3dt) = ij 
    638  
    639                      ! Profile potential T value 
    640                      IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    641                         & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    642                         profdata%var(1)%vobs(it3dt) = & 
     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) = & 
    643667                           &                inpfiles(jj)%pob(ij,ji,1) 
    644668                        IF ( ldmod ) THEN 
    645                            profdata%var(1)%vmod(it3dt) = & 
     669                           profdata%var(1)%vmod(ivar1t) = & 
    646670                              &                inpfiles(jj)%padd(ij,ji,1,1) 
    647671                        ENDIF 
    648                         ! Count number of profile T data as function of type 
    649                         itypt( profdata%ntyp(iprof) + 1 ) = & 
    650                            & itypt( profdata%ntyp(iprof) + 1 ) + 1 
     672                        ! Count number of profile var1 data as function of type 
     673                        itypvar1( profdata%ntyp(iprof) + 1 ) = & 
     674                           & itypvar1( profdata%ntyp(iprof) + 1 ) + 1 
    651675                     ELSE 
    652                         profdata%var(1)%vobs(it3dt) = fbrmdi 
     676                        profdata%var(1)%vobs(ivar1t) = fbrmdi 
    653677                     ENDIF 
    654678 
    655                      ! Profile T qc 
    656                      profdata%var(1)%nvqc(it3dt) = & 
     679                     ! Profile var1 qc 
     680                     profdata%var(1)%nvqc(ivar1t) = & 
    657681                        & inpfiles(jj)%ivlqc(ij,ji,1) 
    658682 
    659                      ! Profile T qc flags 
    660                      profdata%var(1)%nvqcf(:,it3dt) = & 
     683                     ! Profile var1 qc flags 
     684                     profdata%var(1)%nvqcf(:,ivar1t) = & 
    661685                        & inpfiles(jj)%ivlqcf(:,ij,ji,1) 
    662686 
    663687                     ! Profile insitu T value 
    664                      profdata%var(1)%vext(it3dt,1) = & 
    665                         &                inpfiles(jj)%pext(ij,ji,1) 
    666                       
    667                   ENDIF 
    668                    
    669                   IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    670                      &   ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    671                      &   lds3d ) .OR. ldsatt ) THEN 
    672                       
     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 
    673699                     IF (ldsatt) THEN 
    674700 
    675                         is3dt = ip3dt 
     701                        ivar2t = ip3dt 
    676702 
    677703                     ELSE 
    678704 
    679                         is3dt = is3dt + 1 
    680                          
     705                        ivar2t = ivar2t + 1 
     706 
    681707                     ENDIF 
    682708 
    683                      ! Depth of S observation 
    684                      profdata%var(2)%vdep(is3dt) = & 
     709                     ! Depth of var2 observation 
     710                     profdata%var(2)%vdep(ivar2t) = & 
    685711                        &                inpfiles(jj)%pdep(ij,ji) 
    686                       
    687                      ! Depth of S observation QC 
    688                      profdata%var(2)%idqc(is3dt) = & 
     712 
     713                     ! Depth of var2 observation QC 
     714                     profdata%var(2)%idqc(ivar2t) = & 
    689715                        &                inpfiles(jj)%idqc(ij,ji) 
    690                       
    691                      ! Depth of S observation QC flags 
    692                      profdata%var(2)%idqcf(:,is3dt) = & 
     716 
     717                     ! Depth of var2 observation QC flags 
     718                     profdata%var(2)%idqcf(:,ivar2t) = & 
    693719                        &                inpfiles(jj)%idqcf(:,ij,ji) 
    694                       
     720 
    695721                     ! Profile index 
    696                      profdata%var(2)%nvpidx(is3dt) = iprof 
    697                       
     722                     profdata%var(2)%nvpidx(ivar2t) = iprof 
     723 
    698724                     ! Vertical index in original profile 
    699                      profdata%var(2)%nvlidx(is3dt) = ij 
    700  
    701                      ! Profile S value 
    702                      IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    703                         & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
    704                         profdata%var(2)%vobs(is3dt) = & 
     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) = & 
    705731                           &                inpfiles(jj)%pob(ij,ji,2) 
    706732                        IF ( ldmod ) THEN 
    707                            profdata%var(2)%vmod(is3dt) = & 
     733                           profdata%var(2)%vmod(ivar2t) = & 
    708734                              &                inpfiles(jj)%padd(ij,ji,1,2) 
    709735                        ENDIF 
    710                         ! Count number of profile S data as function of type 
    711                         ityps( profdata%ntyp(iprof) + 1 ) = & 
    712                            & ityps( profdata%ntyp(iprof) + 1 ) + 1 
     736                        ! Count number of profile var2 data as function of type 
     737                        itypvar2( profdata%ntyp(iprof) + 1 ) = & 
     738                           & itypvar2( profdata%ntyp(iprof) + 1 ) + 1 
    713739                     ELSE 
    714                         profdata%var(2)%vobs(is3dt) = fbrmdi 
     740                        profdata%var(2)%vobs(ivar2t) = fbrmdi 
    715741                     ENDIF 
    716                       
    717                      ! Profile S qc 
    718                      profdata%var(2)%nvqc(is3dt) = & 
     742 
     743                     ! Profile var2 qc 
     744                     profdata%var(2)%nvqc(ivar2t) = & 
    719745                        & inpfiles(jj)%ivlqc(ij,ji,2) 
    720746 
    721                      ! Profile S qc flags 
    722                      profdata%var(2)%nvqcf(:,is3dt) = & 
     747                     ! Profile var2 qc flags 
     748                     profdata%var(2)%nvqcf(:,ivar2t) = & 
    723749                        & inpfiles(jj)%ivlqcf(:,ij,ji,2) 
    724750 
    725751                  ENDIF 
    726              
     752 
    727753               END DO loop_p 
    728754 
    … …  
    736762      ! Sum up over processors 
    737763      !----------------------------------------------------------------------- 
    738        
    739       CALL obs_mpp_sum_integer ( it3dt0, it3dtmpp ) 
    740       CALL obs_mpp_sum_integer ( is3dt0, is3dtmpp ) 
    741       CALL obs_mpp_sum_integer ( ip3dt, ip3dtmpp ) 
    742        
    743       CALL obs_mpp_sum_integers( itypt, ityptmpp, ntyp1770 + 1 ) 
    744       CALL obs_mpp_sum_integers( ityps, itypsmpp, ntyp1770 + 1 ) 
    745        
     764 
     765      CALL obs_mpp_sum_integer ( ivar1t0, ivar1tmpp ) 
     766      CALL obs_mpp_sum_integer ( ivar2t0, ivar2tmpp ) 
     767      CALL obs_mpp_sum_integer ( ip3dt,   ip3dtmpp ) 
     768 
     769      CALL obs_mpp_sum_integers( itypvar1, itypvar1mpp, ntyp1770 + 1 ) 
     770      CALL obs_mpp_sum_integers( itypvar2, itypvar2mpp, ntyp1770 + 1 ) 
     771 
    746772      !----------------------------------------------------------------------- 
    747773      ! Output number of observations. 
    … …  
    749775      IF(lwp) THEN 
    750776         WRITE(numout,*)  
    751          WRITE(numout,'(1X,A)') 'Profile data' 
     777         WRITE(numout,'(A)') ' Profile data' 
    752778         WRITE(numout,'(1X,A)') '------------' 
    753779         WRITE(numout,*)  
    754          WRITE(numout,'(1X,A)') 'Profile T data' 
    755          WRITE(numout,'(1X,A)') '--------------' 
     780         WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(1) ) 
     781         WRITE(numout,'(1X,A)') '------------------------' 
    756782         DO ji = 0, ntyp1770 
    757             IF ( ityptmpp(ji+1) > 0 ) THEN 
     783            IF ( itypvar1mpp(ji+1) > 0 ) THEN 
    758784               WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 
    759785                  & cwmonam1770(ji)(1:52),' = ', & 
    760                   & ityptmpp(ji+1) 
     786                  & itypvar1mpp(ji+1) 
    761787            ENDIF 
    762788         END DO 
    … …  
    764790            & '---------------------------------------------------------------' 
    765791         WRITE(numout,'(1X,A55,I8)') & 
    766             & 'Total profile T data                                 = ',& 
    767             & it3dtmpp 
     792            & 'Total profile data for variable '//TRIM( profdata%cvars(1) )// & 
     793            & '             = ', ivar1tmpp 
    768794         WRITE(numout,'(1X,A)') & 
    769795            & '---------------------------------------------------------------' 
    770796         WRITE(numout,*)  
    771          WRITE(numout,'(1X,A)') 'Profile S data' 
    772          WRITE(numout,'(1X,A)') '--------------' 
     797         WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(2) ) 
     798         WRITE(numout,'(1X,A)') '------------------------' 
    773799         DO ji = 0, ntyp1770 
    774             IF ( itypsmpp(ji+1) > 0 ) THEN 
     800            IF ( itypvar2mpp(ji+1) > 0 ) THEN 
    775801               WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 
    776802                  & cwmonam1770(ji)(1:52),' = ', & 
    777                   & itypsmpp(ji+1) 
     803                  & itypvar2mpp(ji+1) 
    778804            ENDIF 
    779805         END DO 
    … …  
    781807            & '---------------------------------------------------------------' 
    782808         WRITE(numout,'(1X,A55,I8)') & 
    783             & 'Total profile S data                                 = ',& 
    784             & is3dtmpp 
     809            & 'Total profile data for variable '//TRIM( profdata%cvars(2) )// & 
     810            & '             = ', ivar2tmpp 
    785811         WRITE(numout,'(1X,A)') & 
    786812            & '---------------------------------------------------------------' 
    787813         WRITE(numout,*)  
    788814      ENDIF 
    789        
     815 
    790816      IF (ldsatt) THEN 
    791817         profdata%nvprot(1)    = ip3dt 
    … …  
    794820         profdata%nvprotmpp(2) = ip3dtmpp 
    795821      ELSE 
    796          profdata%nvprot(1)    = it3dt 
    797          profdata%nvprot(2)    = is3dt 
    798          profdata%nvprotmpp(1) = it3dtmpp 
    799          profdata%nvprotmpp(2) = is3dtmpp 
     822         profdata%nvprot(1)    = ivar1t 
     823         profdata%nvprot(2)    = ivar2t 
     824         profdata%nvprotmpp(1) = ivar1tmpp 
     825         profdata%nvprotmpp(2) = ivar2tmpp 
    800826      ENDIF 
    801827      profdata%nprof        = iprof 
    … …  
    804830      ! Model level search 
    805831      !----------------------------------------------------------------------- 
    806       IF ( ldt3d ) THEN 
     832      IF ( ldvar1 ) THEN 
    807833         CALL obs_level_search( jpk, gdept_1d, & 
    808834            & profdata%nvprot(1), profdata%var(1)%vdep, & 
    809835            & profdata%var(1)%mvk ) 
    810836      ENDIF 
    811       IF ( lds3d ) THEN 
     837      IF ( ldvar2 ) THEN 
    812838         CALL obs_level_search( jpk, gdept_1d, & 
    813839            & profdata%nvprot(2), profdata%var(2)%vdep, & 
    814840            & profdata%var(2)%mvk ) 
    815841      ENDIF 
    816        
     842 
    817843      !----------------------------------------------------------------------- 
    818844      ! Set model equivalent to 99999 
    … …  
    826852      ! Deallocate temporary data 
    827853      !----------------------------------------------------------------------- 
    828       DEALLOCATE( ifileidx, iprofidx, zdat ) 
     854      DEALLOCATE( ifileidx, iprofidx, zdat, clvars ) 
    829855 
    830856      !----------------------------------------------------------------------- 
    … …  
    836862      DEALLOCATE( inpfiles ) 
    837863 
    838    END SUBROUTINE obs_rea_pro_dri 
     864   END SUBROUTINE obs_rea_prof 
    839865 
    840866END MODULE obs_read_prof 

  • branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90

    r6486 r10120  
    3131   PRIVATE 
    3232    
    33    PUBLIC   obs_rea_mdt     ! called by ? 
    34    PUBLIC   obs_offset_mdt  ! called by ? 
    35  
    36    INTEGER , PUBLIC ::   nmsshc    = 1         ! MDT correction scheme 
    37    REAL(wp), PUBLIC ::   mdtcorr   = 1.61_wp   ! User specified MDT correction 
    38    REAL(wp), PUBLIC ::   mdtcutoff = 65.0_wp   ! MDT cutoff for computed correction 
     33   PUBLIC   obs_rea_mdt     ! called by dia_obs_init 
     34   PUBLIC   obs_offset_mdt  ! called by obs_rea_mdt 
     35 
     36   INTEGER , PUBLIC :: nn_msshc    = 1         ! MDT correction scheme 
     37   REAL(wp), PUBLIC :: rn_mdtcorr   = 1.61_wp  ! User specified MDT correction 
     38   REAL(wp), PUBLIC :: rn_mdtcutoff = 65.0_wp  ! MDT cutoff for computed correction 
    3939 
    4040   !!---------------------------------------------------------------------- 
    … …  
    4545CONTAINS 
    4646 
    47    SUBROUTINE obs_rea_mdt( kslano, sladata, k2dint ) 
     47   SUBROUTINE obs_rea_mdt( sladata, k2dint ) 
    4848      !!--------------------------------------------------------------------- 
    4949      !! 
    … …  
    5858      USE iom 
    5959      ! 
    60       INTEGER                          , INTENT(IN)    ::   kslano    ! Number of SLA Products 
    61       TYPE(obs_surf), DIMENSION(kslano), INTENT(inout) ::   sladata   ! SLA data 
    62       INTEGER                          , INTENT(in)    ::   k2dint    ! ? 
     60      TYPE(obs_surf), INTENT(inout) ::   sladata   ! SLA data 
     61      INTEGER       , INTENT(in)    ::   k2dint    ! ? 
    6362      ! 
    6463      CHARACTER(LEN=12), PARAMETER ::   cpname  = 'obs_rea_mdt' 
    6564      CHARACTER(LEN=20), PARAMETER ::   mdtname = 'slaReferenceLevel.nc' 
    6665 
    67       INTEGER ::   jslano              ! Data set loop variable 
    6866      INTEGER ::   jobs                ! Obs loop variable 
    6967      INTEGER ::   jpimdt, jpjmdt      ! Number of grid point in lat/lon for the MDT 
    … …  
    8886      IF(lwp)WRITE(numout,*) ' obs_rea_mdt : Read MDT for referencing altimeter anomalies' 
    8987      IF(lwp)WRITE(numout,*) ' ------------- ' 
     88      CALL FLUSH(numout) 
    9089 
    9190      CALL iom_open( mdtname, nummdt )       ! Open the file 
    … …  
    109108 
    110109      ! Remove the offset between the MDT used with the sla and the model MDT 
    111       IF( nmsshc == 1 .OR. nmsshc == 2 )   CALL obs_offset_mdt( z_mdt, zfill ) 
     110      IF( nn_msshc == 1 .OR. nn_msshc == 2 ) & 
     111         & CALL obs_offset_mdt( jpi, jpj, z_mdt, zfill ) 
    112112 
    113113      ! Intepolate the MDT already on the model grid at the observation point 
    114114   
    115       DO jslano = 1, kslano 
    116          ALLOCATE( & 
    117             & igrdi(2,2,sladata(jslano)%nsurf), & 
    118             & igrdj(2,2,sladata(jslano)%nsurf), & 
    119             & zglam(2,2,sladata(jslano)%nsurf), & 
    120             & zgphi(2,2,sladata(jslano)%nsurf), & 
    121             & zmask(2,2,sladata(jslano)%nsurf), & 
    122             & zmdtl(2,2,sladata(jslano)%nsurf)  & 
    123             & ) 
     115      ALLOCATE( & 
     116         & igrdi(2,2,sladata%nsurf), & 
     117         & igrdj(2,2,sladata%nsurf), & 
     118         & zglam(2,2,sladata%nsurf), & 
     119         & zgphi(2,2,sladata%nsurf), & 
     120         & zmask(2,2,sladata%nsurf), & 
     121         & zmdtl(2,2,sladata%nsurf)  & 
     122         & ) 
    124123          
    125          DO jobs = 1, sladata(jslano)%nsurf 
    126  
    127             igrdi(1,1,jobs) = sladata(jslano)%mi(jobs)-1 
    128             igrdj(1,1,jobs) = sladata(jslano)%mj(jobs)-1 
    129             igrdi(1,2,jobs) = sladata(jslano)%mi(jobs)-1 
    130             igrdj(1,2,jobs) = sladata(jslano)%mj(jobs) 
    131             igrdi(2,1,jobs) = sladata(jslano)%mi(jobs) 
    132             igrdj(2,1,jobs) = sladata(jslano)%mj(jobs)-1 
    133             igrdi(2,2,jobs) = sladata(jslano)%mi(jobs) 
    134             igrdj(2,2,jobs) = sladata(jslano)%mj(jobs) 
    135  
    136          END DO 
    137  
    138          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, glamt  , zglam ) 
    139          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, gphit  , zgphi ) 
    140          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, mdtmask, zmask ) 
    141          CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, z_mdt  , zmdtl ) 
    142  
    143          DO jobs = 1, sladata(jslano)%nsurf 
     124      DO jobs = 1, sladata%nsurf 
     125 
     126         igrdi(1,1,jobs) = sladata%mi(jobs)-1 
     127         igrdj(1,1,jobs) = sladata%mj(jobs)-1 
     128         igrdi(1,2,jobs) = sladata%mi(jobs)-1 
     129         igrdj(1,2,jobs) = sladata%mj(jobs) 
     130         igrdi(2,1,jobs) = sladata%mi(jobs) 
     131         igrdj(2,1,jobs) = sladata%mj(jobs)-1 
     132         igrdi(2,2,jobs) = sladata%mi(jobs) 
     133         igrdj(2,2,jobs) = sladata%mj(jobs) 
     134 
     135      END DO 
     136 
     137      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, glamt  , zglam ) 
     138      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, gphit  , zgphi ) 
     139      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, mdtmask, zmask ) 
     140      CALL obs_int_comm_2d( 2, 2, sladata%nsurf, jpi, jpj, igrdi, igrdj, z_mdt  , zmdtl ) 
     141 
     142      DO jobs = 1, sladata%nsurf 
    144143             
    145             zlam = sladata(jslano)%rlam(jobs) 
    146             zphi = sladata(jslano)%rphi(jobs) 
    147  
    148             CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
    149                &                   zglam(:,:,jobs), zgphi(:,:,jobs), & 
    150                &                   zmask(:,:,jobs), zweig, zobsmask ) 
     144         zlam = sladata%rlam(jobs) 
     145         zphi = sladata%rphi(jobs) 
     146 
     147         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         & 
     148            &                   zglam(:,:,jobs), zgphi(:,:,jobs), & 
     149            &                   zmask(:,:,jobs), zweig, zobsmask ) 
    151150             
    152             CALL obs_int_h2d( 1, 1, zweig, zmdtl(:,:,jobs),  zext ) 
     151         CALL obs_int_h2d( 1, 1, zweig, zmdtl(:,:,jobs),  zext ) 
    153152  
    154             sladata(jslano)%rext(jobs,2) = zext(1) 
     153         sladata%rext(jobs,2) = zext(1) 
    155154 
    156155! mark any masked data with a QC flag 
    157             IF( zobsmask(1) == 0 )   sladata(jslano)%nqc(jobs) = 11 
     156         IF( zobsmask(1) == 0 )   sladata%nqc(jobs) = IBSET(sladata%nqc(jobs),15) 
    158157 
    159158         END DO 
    160159          
    161          DEALLOCATE( & 
    162             & igrdi, & 
    163             & igrdj, & 
    164             & zglam, & 
    165             & zgphi, & 
    166             & zmask, & 
    167             & zmdtl  & 
    168             & ) 
    169  
    170       END DO 
     160      DEALLOCATE( & 
     161         & igrdi, & 
     162         & igrdj, & 
     163         & zglam, & 
     164         & zgphi, & 
     165         & zmask, & 
     166         & zmdtl  & 
     167         & ) 
    171168 
    172169      CALL wrk_dealloc(jpi,jpj,z_mdt,mdtmask)  
     170      IF(lwp)WRITE(numout,*) ' ------------- ' 
    173171      ! 
    174172   END SUBROUTINE obs_rea_mdt 
    175173 
    176174 
    177    SUBROUTINE obs_offset_mdt( mdt, zfill ) 
     175   SUBROUTINE obs_offset_mdt( kpi, kpj, mdt, zfill ) 
    178176      !!--------------------------------------------------------------------- 
    179177      !! 
    … …  
    188186      !! ** Action  :  
    189187      !!---------------------------------------------------------------------- 
    190       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   mdt     ! MDT used on the model grid 
    191       REAL(wp)                    , INTENT(in   ) ::   zfill  
     188      INTEGER, INTENT(IN) ::  kpi, kpj 
     189      REAL(wp), DIMENSION(kpi,kpj), INTENT(INOUT) ::   mdt     ! MDT used on the model grid 
     190      REAL(wp)                    , INTENT(IN   ) ::   zfill  
    192191      !  
    193192      INTEGER  :: ji, jj 
    … …  
    205204        DO jj = 1, jpj 
    206205           zpromsk(ji,jj) = tmask_i(ji,jj) 
    207            IF (    ( gphit(ji,jj) .GT.  mdtcutoff ) & 
    208               &.OR.( gphit(ji,jj) .LT. -mdtcutoff ) & 
     206           IF (    ( gphit(ji,jj) .GT.  rn_mdtcutoff ) & 
     207              &.OR.( gphit(ji,jj) .LT. -rn_mdtcutoff ) & 
    209208              &.OR.( mdt(ji,jj) .EQ. zfill ) ) & 
    210209              &        zpromsk(ji,jj) = 0.0 
    … …  
    212211      END DO  
    213212 
    214       ! Compute MSSH mean over [0,360] x [-mdtcutoff,mdtcutoff] 
     213      ! Compute MSSH mean over [0,360] x [-rn_mdtcutoff,rn_mdtcutoff] 
    215214 
    216215      zarea = 0.0 
    … …  
    240239      !  Correct spatial mean of the MSSH 
    241240 
    242       IF( nmsshc == 1 )   mdt(:,:) = mdt(:,:) - zcorr   
     241      IF( nn_msshc == 1 )   mdt(:,:) = mdt(:,:) - zcorr   
    243242 
    244243      ! User defined value : 1.6 m for the Rio MDT compared to ORCA2 MDT 
    245244 
    246       IF( nmsshc == 2 )   mdt(:,:) = mdt(:,:) - mdtcorr 
     245      IF( nn_msshc == 2 )   mdt(:,:) = mdt(:,:) - rn_mdtcorr 
    247246 
    248247      IF(lwp) THEN 
    249248         WRITE(numout,*) 
    250          WRITE(numout,*) ' obs_readmdt : mdtcutoff     = ', mdtcutoff 
     249         WRITE(numout,*) ' obs_readmdt : rn_mdtcutoff     = ', rn_mdtcutoff 
    251250         WRITE(numout,*) ' -----------   zcorr_mdt     = ', zcorr_mdt 
    252251         WRITE(numout,*) '               zcorr_bcketa  = ', zcorr_bcketa 
    253252         WRITE(numout,*) '               zcorr         = ', zcorr 
    254          WRITE(numout,*) '               nmsshc        = ', nmsshc 
     253         WRITE(numout,*) '               nn_msshc        = ', nn_msshc 
    255254      ENDIF 
    256255 
    257       IF ( nmsshc == 0 ) WRITE(numout,*) '           MSSH correction is not applied' 
    258       IF ( nmsshc == 1 ) WRITE(numout,*) '           MSSH correction is applied' 
    259       IF ( nmsshc == 2 ) WRITE(numout,*) '           User defined MSSH correction'  
     256      IF ( nn_msshc == 0 ) WRITE(numout,*) '           MSSH correction is not applied' 
     257      IF ( nn_msshc == 1 ) WRITE(numout,*) '           MSSH correction is applied' 
     258      IF ( nn_msshc == 2 ) WRITE(numout,*) '           User defined MSSH correction'  
    260259 
    261260      CALL wrk_dealloc( jpi,jpj, zpromsk ) 

  • branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90

    r6486 r10120  
    140140      END DO 
    141141 
    142       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, & 
     142      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 
    143143         &                  glamu, zglamu ) 
    144       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, & 
     144      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 
    145145         &                  gphiu, zgphiu ) 
    146       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, & 
     146      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 
    147147         &                  umask(:,:,1), zmasku ) 
    148       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, & 
     148      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 
    149149         &                  zsingu, zsinlu ) 
    150       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, & 
     150      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiu, igrdju, & 
    151151         &                  zcosgu, zcoslu ) 
    152       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, & 
     152      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 
    153153         &                  glamv, zglamv ) 
    154       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, & 
     154      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 
    155155         &                  gphiv, zgphiv ) 
    156       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, & 
     156      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 
    157157         &                  vmask(:,:,1), zmaskv ) 
    158       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, & 
     158      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 
    159159         &                  zsingv, zsinlv ) 
    160       CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, & 
     160      CALL obs_int_comm_2d( 2, 2, profdata%nprof, jpi, jpj, igrdiv, igrdjv, & 
    161161         &                  zcosgv, zcoslv ) 
    162162 
    … …  
    195195         DO jk = profdata%npvsta(ji,1), profdata%npvend(ji,1) 
    196196            IF ( ( profdata%var(1)%vmod(jk) /= fbrmdi ) .AND. & 
    197                & ( profdata%var(1)%vmod(jk) /= fbrmdi ) ) THEN 
     197               & ( profdata%var(2)%vmod(jk) /= fbrmdi ) ) THEN 
    198198               pu(jk) = profdata%var(1)%vmod(jk) * zcos - & 
    199                   &     profdata%var(2)%vmod(jk) * zsin  
     199                  &     profdata%var(2)%vmod(jk) * zsin 
    200200               pv(jk) = profdata%var(2)%vmod(jk) * zcos + & 
    201201                  &     profdata%var(1)%vmod(jk) * zsin 
    … …  
    204204               pv(jk) = fbrmdi 
    205205            ENDIF 
     206 
    206207         END DO 
    207208 

  • branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90

    r6486 r10120  
    5050      INTEGER :: npj 
    5151      INTEGER :: nsurfup    !: Observation counter used in obs_oper 
     52      INTEGER :: nrec       !: Number of surface observation records in window 
    5253 
    5354      ! Arrays with size equal to the number of surface observations 
    … …  
    5657         & mi,   &        !: i-th grid coord. for interpolating to surface observation 
    5758         & mj,   &        !: j-th grid coord. for interpolating to surface observation 
     59         & mt,   &        !: time record number for gridded data 
    5860         & nsidx,&        !: Surface observation number 
    5961         & nsfil,&        !: Surface observation number in file 
    … …  
    6769         & ntyp           !: Type of surface observation product 
    6870 
     71      CHARACTER(len=8), POINTER, DIMENSION(:) :: & 
     72         & cvars          !: Variable names 
     73 
    6974      CHARACTER(LEN=8), POINTER, DIMENSION(:) :: & 
    7075         & cwmo           !: WMO indentifier 
    … …  
    9095         & nsstpmpp       !: Global number of surface observations per time step 
    9196 
     97      ! Arrays with size equal to the number of observation records in the window 
     98      INTEGER, POINTER, DIMENSION(:) :: & 
     99         & mrecstp   ! Time step of the records 
     100 
    92101      ! Arrays used to store source indices when  
    93102      ! compressing obs_surf derived types 
    … …  
    97106      INTEGER, POINTER, DIMENSION(:) :: & 
    98107         & nsind          !: Source indices of surface data in compressed data 
     108 
     109      ! Is this a gridded product? 
     110      
     111      LOGICAL :: lgrid 
    99112 
    100113   END TYPE obs_surf 
    … …  
    130143      !!* Local variables 
    131144      INTEGER :: ji 
     145      INTEGER :: jvar 
    132146 
    133147      ! Set bookkeeping variables 
    … …  
    140154      surf%npi      = kpi 
    141155      surf%npj      = kpj 
     156 
     157      ! Allocate arrays of size number of variables 
     158 
     159      ALLOCATE( & 
     160         & surf%cvars(kvar)    & 
     161         & ) 
     162 
     163      DO jvar = 1, kvar 
     164         surf%cvars(jvar) = "NotSet" 
     165      END DO 
    142166       
    143167      ! Allocate arrays of number of surface data size 
    … …  
    146170         & surf%mi(ksurf),      & 
    147171         & surf%mj(ksurf),      & 
     172         & surf%mt(ksurf),      & 
    148173         & surf%nsidx(ksurf),   & 
    149174         & surf%nsfil(ksurf),   & 
    … …  
    162187         & ) 
    163188 
     189      surf%mt(:) = -1 
     190 
    164191 
    165192      ! Allocate arrays of number of surface data size * number of variables 
    … …  
    176203         & ) 
    177204 
     205      surf%rext(:,:) = 0.0_wp  
     206 
    178207      ! Allocate arrays of number of time step size 
    179208 
    … …  
    203232 
    204233      surf%nsurfup     = 0 
     234       
     235      ! Not gridded by default 
     236           
     237      surf%lgrid       = .FALSE. 
    205238               
    206239   END SUBROUTINE obs_surf_alloc 
    … …  
    228261         & surf%mi,      & 
    229262         & surf%mj,      & 
     263         & surf%mt,      & 
    230264         & surf%nsidx,   & 
    231265         & surf%nsfil,   & 
    … …  
    269303         & surf%nsstp,     & 
    270304         & surf%nsstpmpp   & 
     305         & ) 
     306 
     307      ! Dellocate arrays of size number of variables 
     308 
     309      DEALLOCATE( & 
     310         & surf%cvars     & 
    271311         & ) 
    272312 
    … …  
    350390            newsurf%mi(insurf)    = surf%mi(ji) 
    351391            newsurf%mj(insurf)    = surf%mj(ji) 
     392            newsurf%mt(insurf)    = surf%mt(ji) 
    352393            newsurf%nsidx(insurf) = surf%nsidx(ji) 
    353394            newsurf%nsfil(insurf) = surf%nsfil(ji) 
    … …  
    392433      ! Set book keeping variables which do not depend on number of obs. 
    393434 
    394       newsurf%nstp  = surf%nstp 
     435      newsurf%nstp     = surf%nstp 
     436      newsurf%cvars(:) = surf%cvars(:) 
     437       
     438      ! Set gridded stuff 
     439       
     440      newsurf%mt(insurf)    = surf%mt(ji) 
    395441  
    396442      ! Deallocate temporary data 
    … …  
    433479         oldsurf%mi(jj)    = surf%mi(ji) 
    434480         oldsurf%mj(jj)    = surf%mj(ji) 
     481         oldsurf%mt(jj)    = surf%mt(ji) 
    435482         oldsurf%nsidx(jj) = surf%nsidx(ji) 
    436483         oldsurf%nsfil(jj) = surf%nsfil(ji) 

  • branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_types.F90

    r6486 r10120  
    117117 
    118118         cwmonam1770(ji) = 'Not defined' 
    119          ctypshort(ji) = 'XBT' 
     119         ctypshort(ji) = '---' 
    120120 
    121121!         IF ( ji < 1000 ) THEN 

  • branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90

    r6486 r10120  
    66 
    77   !!---------------------------------------------------------------------- 
    8    !!   obs_wri_p3d   : Write profile observation diagnostics in NetCDF format 
    9    !!   obs_wri_sla   : Write SLA observation related diagnostics 
    10    !!   obs_wri_sst   : Write SST observation related diagnostics 
    11    !!   obs_wri_seaice: Write seaice observation related diagnostics 
    12    !!   obs_wri_vel   : Write velocity observation diagnostics in NetCDF format 
    13    !!   obs_wri_stats : Print basic statistics on the data being written out 
     8   !!   obs_wri_prof   : Write profile observations in feedback format 
     9   !!   obs_wri_surf   : Write surface observations in feedback format 
     10   !!   obs_wri_stats  : Print basic statistics on the data being written out 
    1411   !!---------------------------------------------------------------------- 
    1512 
    … …  
    3027   USE obs_conv             ! Conversion between units 
    3128   USE obs_const 
    32    USE obs_sla_types 
    33    USE obs_rot_vel          ! Rotation of velocities 
    3429   USE obs_mpp              ! MPP support routines for observation diagnostics 
    3530   USE lib_mpp        ! MPP routines 
    … …  
    3934   !! * Routine accessibility 
    4035   PRIVATE 
    41    PUBLIC obs_wri_p3d, &    ! Write profile observation related diagnostics 
    42       &   obs_wri_sla, &    ! Write SLA observation related diagnostics 
    43       &   obs_wri_sst, &    ! Write SST observation related diagnostics 
    44       &   obs_wri_sss, &    ! Write SSS observation related diagnostics 
    45       &   obs_wri_seaice, & ! Write seaice observation related diagnostics 
    46       &   obs_wri_vel, &    ! Write velocity observation related diagnostics 
     36   PUBLIC obs_wri_prof, &    ! Write profile observation files 
     37      &   obs_wri_surf, &    ! Write surface observation files 
    4738      &   obswriinfo 
    4839    
    … …  
    6354CONTAINS 
    6455 
    65    SUBROUTINE obs_wri_p3d( cprefix, profdata, padd, pext ) 
     56   SUBROUTINE obs_wri_prof( profdata, padd, pext ) 
    6657      !!----------------------------------------------------------------------- 
    6758      !! 
    68       !!                     *** ROUTINE obs_wri_p3d  *** 
    69       !! 
    70       !! ** Purpose : Write temperature and salinity (profile) observation  
    71       !!              related diagnostics 
     59      !!                     *** ROUTINE obs_wri_prof  *** 
     60      !! 
     61      !! ** Purpose : Write profile feedback files 
    7262      !! 
    7363      !! ** Method  : NetCDF 
    … …  
    8272      !!      ! 07-03  (K. Mogensen) General handling of profiles 
    8373      !!      ! 09-01  (K. Mogensen) New feedback format 
     74      !!      ! 15-02  (M. Martin) Combined routine for writing profiles 
    8475      !!----------------------------------------------------------------------- 
    8576 
    86       !! * Modules used 
    87  
    8877      !! * Arguments 
    89       CHARACTER(LEN=*), INTENT(IN) :: cprefix        ! Prefix for output files 
    9078      TYPE(obs_prof), INTENT(INOUT) :: profdata      ! Full set of profile data 
    9179      TYPE(obswriinfo), OPTIONAL :: padd             ! Additional info for each variable 
    9280      TYPE(obswriinfo), OPTIONAL :: pext             ! Extra info 
    93        
     81 
    9482      !! * Local declarations 
    9583      TYPE(obfbdata) :: fbdata 
    96       CHARACTER(LEN=40) :: cfname 
     84      CHARACTER(LEN=40) :: clfname 
     85      CHARACTER(LEN=10) :: clfiletype 
    9786      INTEGER :: ilevel 
    9887      INTEGER :: jvar 
    … …  
    10291      INTEGER :: ja 
    10392      INTEGER :: je 
     93      INTEGER :: iadd 
     94      INTEGER :: iext 
    10495      REAL(wp) :: zpres 
    105       INTEGER :: nadd 
    106       INTEGER :: next 
    10796 
    10897      IF ( PRESENT( padd ) ) THEN 
    109          nadd = padd%inum 
     98         iadd = padd%inum 
    11099      ELSE 
    111          nadd = 0 
     100         iadd = 0 
    112101      ENDIF 
    113102 
    114103      IF ( PRESENT( pext ) ) THEN 
    115          next = pext%inum 
     104         iext = pext%inum 
    116105      ELSE 
    117          next = 0 
    118       ENDIF 
    119        
     106         iext = 0 
     107      ENDIF 
     108 
    120109      CALL init_obfbdata( fbdata ) 
    121110 
    … …  
    125114         ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) ) 
    126115      END DO 
    127       CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, & 
    128          &                 1 + nadd, 1 + next, .TRUE. ) 
    129  
    130       fbdata%cname(1)      = 'POTM' 
    131       fbdata%cname(2)      = 'PSAL' 
    132       fbdata%coblong(1)    = 'Potential temperature' 
    133       fbdata%coblong(2)    = 'Practical salinity' 
    134       fbdata%cobunit(1)    = 'Degrees centigrade' 
    135       fbdata%cobunit(2)    = 'PSU' 
    136       fbdata%cextname(1)   = 'TEMP' 
    137       fbdata%cextlong(1)   = 'Insitu temperature' 
    138       fbdata%cextunit(1)   = 'Degrees centigrade' 
    139       DO je = 1, next 
    140          fbdata%cextname(1+je) = pext%cdname(je) 
    141          fbdata%cextlong(1+je) = pext%cdlong(je,1) 
    142          fbdata%cextunit(1+je) = pext%cdunit(je,1) 
    143       END DO 
     116 
     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 
     145               fbdata%caddlong(1+ja,jvar) = padd%cdlong(ja,jvar) 
     146               fbdata%caddunit(1+ja,jvar) = padd%cdunit(ja,jvar) 
     147            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 
    144179      fbdata%caddname(1)   = 'Hx' 
    145       fbdata%caddlong(1,1) = 'Model interpolated potential temperature' 
    146       fbdata%caddlong(1,2) = 'Model interpolated practical salinity' 
    147       fbdata%caddunit(1,1) = 'Degrees centigrade' 
    148       fbdata%caddunit(1,2) = 'PSU' 
    149       fbdata%cgrid(:)      = 'T' 
    150       DO ja = 1, nadd 
    151          fbdata%caddname(1+ja) = padd%cdname(ja) 
    152          DO jvar = 1, 2 
    153             fbdata%caddlong(1+ja,jvar) = padd%cdlong(ja,jvar) 
    154             fbdata%caddunit(1+ja,jvar) = padd%cdunit(ja,jvar) 
    155          END DO 
    156       END DO 
    157           
    158       WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 
     180 
     181      WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 
    159182 
    160183      IF(lwp) THEN 
    161184         WRITE(numout,*) 
    162          WRITE(numout,*)'obs_wri_p3d :' 
     185         WRITE(numout,*)'obs_wri_prof :' 
    163186         WRITE(numout,*)'~~~~~~~~~~~~~' 
    164          WRITE(numout,*)'Writing profile feedback file : ',TRIM(cfname) 
    165       ENDIF 
    166  
    167       ! Transform obs_prof data structure into obfbdata structure 
     187         WRITE(numout,*)'Writing '//TRIM(clfiletype)//' feedback file : ',TRIM(clfname) 
     188      ENDIF 
     189 
     190      ! Transform obs_prof data structure into obfb data structure 
    168191      fbdata%cdjuldref = '19500101000000' 
    169192      DO jo = 1, profdata%nprof 
    … …  
    173196         fbdata%ivqc(jo,:)    = profdata%ivqc(jo,:) 
    174197         fbdata%ivqcf(:,jo,:) = profdata%ivqcf(:,jo,:) 
    175          IF ( profdata%nqc(jo) > 10 ) THEN 
    176             fbdata%ioqc(jo)    = 4 
     198         IF ( profdata%nqc(jo) > 255 ) THEN 
     199            fbdata%ioqc(jo)    = IBSET(profdata%nqc(jo),2) 
    177200            fbdata%ioqcf(1,jo) = profdata%nqcf(1,jo) 
    178             fbdata%ioqcf(2,jo) = profdata%nqc(jo) - 10 
     201            fbdata%ioqcf(2,jo) = profdata%nqc(jo) 
    179202         ELSE 
    180203            fbdata%ioqc(jo)    = profdata%nqc(jo) 
    … …  
    213236               fbdata%idqc(ik,jo)        = profdata%var(jvar)%idqc(jk) 
    214237               fbdata%idqcf(:,ik,jo)     = profdata%var(jvar)%idqcf(:,jk) 
    215                IF ( profdata%var(jvar)%nvqc(jk) > 10 ) THEN 
    216                   fbdata%ivlqc(ik,jo,jvar) = 4 
     238               IF ( profdata%var(jvar)%nvqc(jk) > 255 ) THEN 
     239                  fbdata%ivlqc(ik,jo,jvar) = IBSET(profdata%var(jvar)%nvqc(jk),2) 
    217240                  fbdata%ivlqcf(1,ik,jo,jvar) = profdata%var(jvar)%nvqcf(1,jk) 
    218                   fbdata%ivlqcf(2,ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) - 10 
     241                  fbdata%ivlqcf(2,ik,jo,jvar) = IAND(profdata%var(jvar)%nvqc(jk),b'0000 0000 1111 1111') 
    219242               ELSE 
    220243                  fbdata%ivlqc(ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) 
    … …  
    222245               ENDIF 
    223246               fbdata%iobsk(ik,jo,jvar)  = profdata%var(jvar)%mvk(jk) 
    224                DO ja = 1, nadd 
     247               DO ja = 1, iadd 
    225248                  fbdata%padd(ik,jo,1+ja,jvar) = & 
    226249                     & profdata%var(jvar)%vext(jk,padd%ipoint(ja)) 
    227250               END DO 
    228                DO je = 1, next 
     251               DO je = 1, iext 
    229252                  fbdata%pext(ik,jo,1+je) = & 
    230253                     & profdata%var(jvar)%vext(jk,pext%ipoint(je)) 
    231254               END DO 
    232                IF ( jvar == 1 ) THEN 
     255               IF ( ( jvar == 1 ) .AND. & 
     256                  & ( TRIM(profdata%cvars(1)) == 'POTM' ) ) THEN 
    233257                  fbdata%pext(ik,jo,1) = profdata%var(jvar)%vext(jk,1) 
    234258               ENDIF  
    … …  
    237261      END DO 
    238262 
    239       ! Convert insitu temperature to potential temperature using the model 
    240       ! salinity if no potential temperature 
    241       DO jo = 1, fbdata%nobs 
    242          IF ( fbdata%pphi(jo) < 9999.0 ) THEN 
    243             DO jk = 1, fbdata%nlev 
    244                IF ( ( fbdata%pob(jk,jo,1) >= 9999.0 ) .AND. & 
    245                   & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. & 
    246                   & ( fbdata%padd(jk,jo,1,2) < 9999.0 ) .AND. & 
    247                   & ( fbdata%pext(jk,jo,1) < 9999.0 ) ) THEN 
    248                   zpres = dep_to_p( REAL(fbdata%pdep(jk,jo),wp), & 
    249                      &              REAL(fbdata%pphi(jo),wp) ) 
    250                   fbdata%pob(jk,jo,1) = potemp( & 
    251                      &                     REAL(fbdata%padd(jk,jo,1,2), wp),  & 
    252                      &                     REAL(fbdata%pext(jk,jo,1), wp), & 
    253                      &                     zpres, 0.0_wp ) 
    254                ENDIF 
    255             END DO 
    256          ENDIF 
    257       END DO 
    258        
     263      IF ( TRIM(profdata%cvars(1)) == 'POTM' ) THEN 
     264         ! Convert insitu temperature to potential temperature using the model 
     265         ! salinity if no potential temperature 
     266         DO jo = 1, fbdata%nobs 
     267            IF ( fbdata%pphi(jo) < 9999.0 ) THEN 
     268               DO jk = 1, fbdata%nlev 
     269                  IF ( ( fbdata%pob(jk,jo,1) >= 9999.0 ) .AND. & 
     270                     & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. & 
     271                     & ( fbdata%padd(jk,jo,1,2) < 9999.0 ) .AND. & 
     272                     & ( fbdata%pext(jk,jo,1) < 9999.0 ) ) THEN 
     273                     zpres = dep_to_p( REAL(fbdata%pdep(jk,jo),wp), & 
     274                        &              REAL(fbdata%pphi(jo),wp) ) 
     275                     fbdata%pob(jk,jo,1) = potemp( & 
     276                        &                     REAL(fbdata%padd(jk,jo,1,2), wp),  & 
     277                        &                     REAL(fbdata%pext(jk,jo,1), wp), & 
     278                        &                     zpres, 0.0_wp ) 
     279                  ENDIF 
     280               END DO 
     281            ENDIF 
     282         END DO 
     283      ENDIF 
     284 
    259285      ! Write the obfbdata structure 
    260       CALL write_obfbdata( cfname, fbdata ) 
     286      CALL write_obfbdata( clfname, fbdata ) 
    261287 
    262288      ! Output some basic statistics 
    … …  
    264290 
    265291      CALL dealloc_obfbdata( fbdata ) 
    266       
    267    END SUBROUTINE obs_wri_p3d 
    268  
    269    SUBROUTINE obs_wri_sla( cprefix, sladata, padd, pext ) 
     292 
     293   END SUBROUTINE obs_wri_prof 
     294 
     295   SUBROUTINE obs_wri_surf( surfdata, padd, pext ) 
    270296      !!----------------------------------------------------------------------- 
    271297      !! 
    272       !!                     *** ROUTINE obs_wri_sla  *** 
    273       !! 
    274       !! ** Purpose : Write SLA observation diagnostics 
    275       !!              related  
     298      !!                     *** ROUTINE obs_wri_surf  *** 
     299      !! 
     300      !! ** Purpose : Write surface observation files 
    276301      !! 
    277302      !! ** Method  : NetCDF 
    … …  
    281306      !!      ! 07-03  (K. Mogensen) Original 
    282307      !!      ! 09-01  (K. Mogensen) New feedback format. 
     308      !!      ! 15-02  (M. Martin) Combined surface writing routine. 
    283309      !!----------------------------------------------------------------------- 
    284310 
    … …  
    287313 
    288314      !! * Arguments 
    289       CHARACTER(LEN=*), INTENT(IN) :: cprefix          ! Prefix for output files 
    290       TYPE(obs_surf), INTENT(INOUT) :: sladata         ! Full set of SLAa 
     315      TYPE(obs_surf), INTENT(INOUT) :: surfdata         ! Full set of surface data 
    291316      TYPE(obswriinfo), OPTIONAL :: padd               ! Additional info for each variable 
    292317      TYPE(obswriinfo), OPTIONAL :: pext               ! Extra info 
    … …  
    294319      !! * Local declarations 
    295320      TYPE(obfbdata) :: fbdata 
    296       CHARACTER(LEN=40) :: cfname         ! netCDF filename 
    297       CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_sla' 
     321      CHARACTER(LEN=40) :: clfname         ! netCDF filename 
     322      CHARACTER(LEN=10) :: clfiletype 
     323      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_surf' 
    298324      INTEGER :: jo 
    299325      INTEGER :: ja 
    300326      INTEGER :: je 
    301       INTEGER :: nadd 
    302       INTEGER :: next 
     327      INTEGER :: iadd 
     328      INTEGER :: iext 
    303329 
    304330      IF ( PRESENT( padd ) ) THEN 
    305          nadd = padd%inum 
     331         iadd = padd%inum 
    306332      ELSE 
    307          nadd = 0 
     333         iadd = 0 
    308334      ENDIF 
    309335 
    310336      IF ( PRESENT( pext ) ) THEN 
    311          next = pext%inum 
     337         iext = pext%inum 
    312338      ELSE 
    313          next = 0 
     339         iext = 0 
    314340      ENDIF 
    315341 
    316342      CALL init_obfbdata( fbdata ) 
    317343 
    318       CALL alloc_obfbdata( fbdata, 1, sladata%nsurf, 1, & 
    319          &                 2 + nadd, 1 + next, .TRUE. ) 
    320  
    321       fbdata%cname(1)      = 'SLA' 
    322       fbdata%coblong(1)    = 'Sea level anomaly' 
    323       fbdata%cobunit(1)    = 'Metres' 
    324       fbdata%cextname(1)   = 'MDT' 
    325       fbdata%cextlong(1)   = 'Mean dynamic topography' 
    326       fbdata%cextunit(1)   = 'Metres' 
    327       DO je = 1, next 
    328          fbdata%cextname(1+je) = pext%cdname(je) 
    329          fbdata%cextlong(1+je) = pext%cdlong(je,1) 
    330          fbdata%cextunit(1+je) = pext%cdunit(je,1) 
    331       END DO 
     344      SELECT CASE ( TRIM(surfdata%cvars(1)) ) 
     345      CASE('SLA') 
     346 
     347         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     348            &                 2 + iadd, 1 + iext, .TRUE. ) 
     349 
     350         clfiletype = 'slafb' 
     351         fbdata%cname(1)      = surfdata%cvars(1) 
     352         fbdata%coblong(1)    = 'Sea level anomaly' 
     353         fbdata%cobunit(1)    = 'Metres' 
     354         fbdata%cextname(1)   = 'MDT' 
     355         fbdata%cextlong(1)   = 'Mean dynamic topography' 
     356         fbdata%cextunit(1)   = 'Metres' 
     357         DO je = 1, iext 
     358            fbdata%cextname(je) = pext%cdname(je) 
     359            fbdata%cextlong(je) = pext%cdlong(je,1) 
     360            fbdata%cextunit(je) = pext%cdunit(je,1) 
     361         END DO 
     362         fbdata%caddlong(1,1) = 'Model interpolated SSH - MDT' 
     363         fbdata%caddunit(1,1) = 'Metres'  
     364         fbdata%caddname(2)   = 'SSH' 
     365         fbdata%caddlong(2,1) = 'Model Sea surface height' 
     366         fbdata%caddunit(2,1) = 'Metres' 
     367         fbdata%cgrid(1)      = 'T' 
     368         DO ja = 1, iadd 
     369            fbdata%caddname(2+ja) = padd%cdname(ja) 
     370            fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1) 
     371            fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1) 
     372         END DO 
     373 
     374      CASE('SST') 
     375 
     376         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     377            &                 1 + iadd, iext, .TRUE. ) 
     378 
     379         clfiletype = 'sstfb' 
     380         fbdata%cname(1)      = surfdata%cvars(1) 
     381         fbdata%coblong(1)    = 'Sea surface temperature' 
     382         fbdata%cobunit(1)    = 'Degree centigrade' 
     383         DO je = 1, iext 
     384            fbdata%cextname(je) = pext%cdname(je) 
     385            fbdata%cextlong(je) = pext%cdlong(je,1) 
     386            fbdata%cextunit(je) = pext%cdunit(je,1) 
     387         END DO 
     388         fbdata%caddlong(1,1) = 'Model interpolated SST' 
     389         fbdata%caddunit(1,1) = 'Degree centigrade' 
     390         fbdata%cgrid(1)      = 'T' 
     391         DO ja = 1, iadd 
     392            fbdata%caddname(1+ja) = padd%cdname(ja) 
     393            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     394            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     395         END DO 
     396 
     397      CASE('ICECONC') 
     398 
     399         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     400            &                 1 + iadd, iext, .TRUE. ) 
     401 
     402         clfiletype = 'sicfb' 
     403         fbdata%cname(1)      = surfdata%cvars(1) 
     404         fbdata%coblong(1)    = 'Sea ice' 
     405         fbdata%cobunit(1)    = 'Fraction' 
     406         DO je = 1, iext 
     407            fbdata%cextname(je) = pext%cdname(je) 
     408            fbdata%cextlong(je) = pext%cdlong(je,1) 
     409            fbdata%cextunit(je) = pext%cdunit(je,1) 
     410         END DO 
     411         fbdata%caddlong(1,1) = 'Model interpolated ICE' 
     412         fbdata%caddunit(1,1) = 'Fraction' 
     413         fbdata%cgrid(1)      = 'T' 
     414         DO ja = 1, iadd 
     415            fbdata%caddname(1+ja) = padd%cdname(ja) 
     416            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     417            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     418         END DO 
     419 
     420      CASE('SSS') 
     421 
     422         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     423            &                 1 + iadd, iext, .TRUE. ) 
     424 
     425         clfiletype = 'sssfb' 
     426         fbdata%cname(1)      = surfdata%cvars(1) 
     427         fbdata%coblong(1)    = 'Sea surface salinity' 
     428         fbdata%cobunit(1)    = 'psu' 
     429         DO je = 1, iext 
     430            fbdata%cextname(je) = pext%cdname(je) 
     431            fbdata%cextlong(je) = pext%cdlong(je,1) 
     432            fbdata%cextunit(je) = pext%cdunit(je,1) 
     433         END DO 
     434         fbdata%caddlong(1,1) = 'Model interpolated SSS' 
     435         fbdata%caddunit(1,1) = 'psu' 
     436         fbdata%cgrid(1)      = 'T' 
     437         DO ja = 1, iadd 
     438            fbdata%caddname(1+ja) = padd%cdname(ja) 
     439            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     440            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     441         END DO 
     442 
     443      CASE('LOGCHL','LogChl','logchl') 
     444 
     445         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     446            &                 1 + iadd, iext, .TRUE. ) 
     447 
     448         clfiletype = 'logchlfb' 
     449         fbdata%cname(1)      = surfdata%cvars(1) 
     450         fbdata%coblong(1)    = 'logchl concentration' 
     451         fbdata%cobunit(1)    = 'mg/m3' 
     452         DO je = 1, iext 
     453            fbdata%cextname(je) = pext%cdname(je) 
     454            fbdata%cextlong(je) = pext%cdlong(je,1) 
     455            fbdata%cextunit(je) = pext%cdunit(je,1) 
     456         END DO 
     457         fbdata%caddlong(1,1) = 'Model interpolated LOGCHL' 
     458         fbdata%caddunit(1,1) = 'mg/m3' 
     459         fbdata%cgrid(1)      = 'T' 
     460         DO ja = 1, iadd 
     461            fbdata%caddname(1+ja) = padd%cdname(ja) 
     462            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     463            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     464         END DO 
     465 
     466      CASE('SPM','Spm','spm') 
     467 
     468         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     469            &                 1 + iadd, iext, .TRUE. ) 
     470 
     471         clfiletype = 'spmfb' 
     472         fbdata%cname(1)      = surfdata%cvars(1) 
     473         fbdata%coblong(1)    = 'spm' 
     474         fbdata%cobunit(1)    = 'g/m3' 
     475         DO je = 1, iext 
     476            fbdata%cextname(je) = pext%cdname(je) 
     477            fbdata%cextlong(je) = pext%cdlong(je,1) 
     478            fbdata%cextunit(je) = pext%cdunit(je,1) 
     479         END DO 
     480         fbdata%caddlong(1,1) = 'Model interpolated spm' 
     481         fbdata%caddunit(1,1) = 'g/m3' 
     482         fbdata%cgrid(1)      = 'T' 
     483         DO ja = 1, iadd 
     484            fbdata%caddname(1+ja) = padd%cdname(ja) 
     485            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     486            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     487         END DO 
     488 
     489      CASE('FCO2','fCO2','fco2') 
     490 
     491         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     492            &                 1 + iadd, iext, .TRUE. ) 
     493 
     494         clfiletype = 'fco2fb' 
     495         fbdata%cname(1)      = surfdata%cvars(1) 
     496         fbdata%coblong(1)    = 'fco2' 
     497         fbdata%cobunit(1)    = 'uatm' 
     498         DO je = 1, iext 
     499            fbdata%cextname(je) = pext%cdname(je) 
     500            fbdata%cextlong(je) = pext%cdlong(je,1) 
     501            fbdata%cextunit(je) = pext%cdunit(je,1) 
     502         END DO 
     503         fbdata%caddlong(1,1) = 'Model interpolated fco2' 
     504         fbdata%caddunit(1,1) = 'uatm' 
     505         fbdata%cgrid(1)      = 'T' 
     506         DO ja = 1, iadd 
     507            fbdata%caddname(1+ja) = padd%cdname(ja) 
     508            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     509            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     510         END DO 
     511 
     512      CASE('PCO2','pCO2','pco2') 
     513 
     514         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     515            &                 1 + iadd, iext, .TRUE. ) 
     516 
     517         clfiletype = 'pco2fb' 
     518         fbdata%cname(1)      = surfdata%cvars(1) 
     519         fbdata%coblong(1)    = 'pco2' 
     520         fbdata%cobunit(1)    = 'uatm' 
     521         DO je = 1, iext 
     522            fbdata%cextname(je) = pext%cdname(je) 
     523            fbdata%cextlong(je) = pext%cdlong(je,1) 
     524            fbdata%cextunit(je) = pext%cdunit(je,1) 
     525         END DO 
     526         fbdata%caddlong(1,1) = 'Model interpolated pco2' 
     527         fbdata%caddunit(1,1) = 'uatm' 
     528         fbdata%cgrid(1)      = 'T' 
     529         DO ja = 1, iadd 
     530            fbdata%caddname(1+ja) = padd%cdname(ja) 
     531            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     532            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     533         END DO 
     534 
     535      CASE DEFAULT 
     536 
     537         CALL ctl_stop( 'Unknown observation type '//TRIM(surfdata%cvars(1))//' in obs_wri_surf' ) 
     538 
     539      END SELECT 
     540 
    332541      fbdata%caddname(1)   = 'Hx' 
    333       fbdata%caddlong(1,1) = 'Model interpolated SSH - MDT' 
    334       fbdata%caddunit(1,1) = 'Metres'  
    335       fbdata%caddname(2)   = 'SSH' 
    336       fbdata%caddlong(2,1) = 'Model Sea surface height' 
    337       fbdata%caddunit(2,1) = 'Metres' 
    338       fbdata%cgrid(1)      = 'T' 
    339       DO ja = 1, nadd 
    340          fbdata%caddname(2+ja) = padd%cdname(ja) 
    341          fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1) 
    342          fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1) 
    343       END DO 
    344  
    345       WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 
     542 
     543      WRITE(clfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(clfiletype), nproc 
    346544 
    347545      IF(lwp) THEN 
    348546         WRITE(numout,*) 
    349          WRITE(numout,*)'obs_wri_sla :' 
     547         WRITE(numout,*)'obs_wri_surf :' 
    350548         WRITE(numout,*)'~~~~~~~~~~~~~' 
    351          WRITE(numout,*)'Writing SLA feedback file : ',TRIM(cfname) 
    352       ENDIF 
    353  
    354       ! Transform obs_prof data structure into obfbdata structure 
     549         WRITE(numout,*)'Writing '//TRIM(surfdata%cvars(1))//' feedback file : ',TRIM(clfname) 
     550      ENDIF 
     551 
     552      ! Transform surf data structure into obfbdata structure 
    355553      fbdata%cdjuldref = '19500101000000' 
    356       DO jo = 1, sladata%nsurf 
    357          fbdata%plam(jo)      = sladata%rlam(jo) 
    358          fbdata%pphi(jo)      = sladata%rphi(jo) 
    359          WRITE(fbdata%cdtyp(jo),'(I4)') sladata%ntyp(jo) 
     554      DO jo = 1, surfdata%nsurf 
     555         fbdata%plam(jo)      = surfdata%rlam(jo) 
     556         fbdata%pphi(jo)      = surfdata%rphi(jo) 
     557         WRITE(fbdata%cdtyp(jo),'(I4)') surfdata%ntyp(jo) 
    360558         fbdata%ivqc(jo,:)    = 0 
    361559         fbdata%ivqcf(:,jo,:) = 0 
    362          IF ( sladata%nqc(jo) > 10 ) THEN 
     560         IF ( surfdata%nqc(jo) > 255 ) THEN 
    363561            fbdata%ioqc(jo)    = 4 
    364562            fbdata%ioqcf(1,jo) = 0 
    365             fbdata%ioqcf(2,jo) = sladata%nqc(jo) - 10 
     563            fbdata%ioqcf(2,jo) = IAND(surfdata%nqc(jo),b'0000 0000 1111 1111') 
    366564         ELSE 
    367             fbdata%ioqc(jo)    = sladata%nqc(jo) 
     565            fbdata%ioqc(jo)    = surfdata%nqc(jo) 
    368566            fbdata%ioqcf(:,jo) = 0 
    369567         ENDIF 
    … …  
    372570         fbdata%itqc(jo)      = 0 
    373571         fbdata%itqcf(:,jo)   = 0 
    374          fbdata%cdwmo(jo)     = sladata%cwmo(jo) 
    375          fbdata%kindex(jo)    = sladata%nsfil(jo) 
     572         fbdata%cdwmo(jo)     = surfdata%cwmo(jo) 
     573         fbdata%kindex(jo)    = surfdata%nsfil(jo) 
    376574         IF (ln_grid_global) THEN 
    377             fbdata%iobsi(jo,1) = sladata%mi(jo) 
    378             fbdata%iobsj(jo,1) = sladata%mj(jo) 
     575            fbdata%iobsi(jo,1) = surfdata%mi(jo) 
     576            fbdata%iobsj(jo,1) = surfdata%mj(jo) 
    379577         ELSE 
    380             fbdata%iobsi(jo,1) = mig(sladata%mi(jo)) 
    381             fbdata%iobsj(jo,1) = mjg(sladata%mj(jo)) 
     578            fbdata%iobsi(jo,1) = mig(surfdata%mi(jo)) 
     579            fbdata%iobsj(jo,1) = mjg(surfdata%mj(jo)) 
    382580         ENDIF 
    383581         CALL greg2jul( 0, & 
    384             &           sladata%nmin(jo), & 
    385             &           sladata%nhou(jo), & 
    386             &           sladata%nday(jo), & 
    387             &           sladata%nmon(jo), & 
    388             &           sladata%nyea(jo), & 
     582            &           surfdata%nmin(jo), & 
     583            &           surfdata%nhou(jo), & 
     584            &           surfdata%nday(jo), & 
     585            &           surfdata%nmon(jo), & 
     586            &           surfdata%nyea(jo), & 
    389587            &           fbdata%ptim(jo),   & 
    390588            &           krefdate = 19500101 ) 
    391          fbdata%padd(1,jo,1,1) = sladata%rmod(jo,1) 
    392          fbdata%padd(1,jo,2,1) = sladata%rext(jo,1) 
    393          fbdata%pob(1,jo,1)    = sladata%robs(jo,1)  
     589         fbdata%padd(1,jo,1,1) = surfdata%rmod(jo,1) 
     590         IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) fbdata%padd(1,jo,2,1) = surfdata%rext(jo,1) 
     591         fbdata%pob(1,jo,1)    = surfdata%robs(jo,1)  
    394592         fbdata%pdep(1,jo)     = 0.0 
    395593         fbdata%idqc(1,jo)     = 0 
    396594         fbdata%idqcf(:,1,jo)  = 0 
    397          IF ( sladata%nqc(jo) > 10 ) THEN 
     595         IF ( surfdata%nqc(jo) > 255 ) THEN 
    398596            fbdata%ivqc(jo,1)       = 4 
    399597            fbdata%ivlqc(1,jo,1)    = 4 
    400598            fbdata%ivlqcf(1,1,jo,1) = 0 
    401             fbdata%ivlqcf(2,1,jo,1) = sladata%nqc(jo) - 10 
     599            fbdata%ivlqcf(2,1,jo,1) = IAND(surfdata%nqc(jo),b'0000 0000 1111 1111') 
    402600         ELSE 
    403             fbdata%ivqc(jo,1)       = sladata%nqc(jo) 
    404             fbdata%ivlqc(1,jo,1)    = sladata%nqc(jo) 
     601            fbdata%ivqc(jo,1)       = surfdata%nqc(jo) 
     602            fbdata%ivlqc(1,jo,1)    = surfdata%nqc(jo) 
    405603            fbdata%ivlqcf(:,1,jo,1) = 0 
    406604         ENDIF 
    407605         fbdata%iobsk(1,jo,1)  = 0 
    408          fbdata%pext(1,jo,1) = sladata%rext(jo,2) 
    409          DO ja = 1, nadd 
     606         IF ( TRIM(surfdata%cvars(1)) == 'SLA' ) fbdata%pext(1,jo,1) = surfdata%rext(jo,2) 
     607         DO ja = 1, iadd 
    410608            fbdata%padd(1,jo,2+ja,1) = & 
    411                & sladata%rext(jo,padd%ipoint(ja)) 
    412          END DO 
    413          DO je = 1, next 
     609               & surfdata%rext(jo,padd%ipoint(ja)) 
     610         END DO 
     611         DO je = 1, iext 
    414612            fbdata%pext(1,jo,1+je) = & 
    415                & sladata%rext(jo,pext%ipoint(je)) 
     613               & surfdata%rext(jo,pext%ipoint(je)) 
    416614         END DO 
    417615      END DO 
    418616 
    419617      ! Write the obfbdata structure 
    420       CALL write_obfbdata( cfname, fbdata ) 
     618      CALL write_obfbdata( clfname, fbdata ) 
    421619 
    422620      ! Output some basic statistics 
    … …  
    425623      CALL dealloc_obfbdata( fbdata ) 
    426624 
    427    END SUBROUTINE obs_wri_sla 
    428  
    429    SUBROUTINE obs_wri_sst( cprefix, sstdata, padd, pext ) 
    430       !!----------------------------------------------------------------------- 
    431       !! 
    432       !!                     *** ROUTINE obs_wri_sst  *** 
    433       !! 
    434       !! ** Purpose : Write SST observation diagnostics 
    435       !!              related  
    436       !! 
    437       !! ** Method  : NetCDF 
    438       !!  
    439       !! ** Action  : 
    440       !! 
    441       !!      ! 07-07  (S. Ricci) Original 
    442       !!      ! 09-01  (K. Mogensen) New feedback format. 
    443       !!----------------------------------------------------------------------- 
    444  
    445       !! * Modules used 
    446       IMPLICIT NONE 
    447  
    448       !! * Arguments 
    449       CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files 
    450       TYPE(obs_surf), INTENT(INOUT) :: sstdata      ! Full set of SST 
    451       TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable 
    452       TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info 
    453  
    454       !! * Local declarations  
    455       TYPE(obfbdata) :: fbdata 
    456       CHARACTER(LEN=40) ::  cfname             ! netCDF filename 
    457       CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_sst' 
    458       INTEGER :: jo 
    459       INTEGER :: ja 
    460       INTEGER :: je 
    461       INTEGER :: nadd 
    462       INTEGER :: next 
    463  
    464       IF ( PRESENT( padd ) ) THEN 
    465          nadd = padd%inum 
    466       ELSE 
    467          nadd = 0 
    468       ENDIF 
    469  
    470       IF ( PRESENT( pext ) ) THEN 
    471          next = pext%inum 
    472       ELSE 
    473          next = 0 
    474       ENDIF 
    475  
    476       CALL init_obfbdata( fbdata ) 
    477  
    478       CALL alloc_obfbdata( fbdata, 1, sstdata%nsurf, 1, & 
    479          &                 1 + nadd, next, .TRUE. ) 
    480  
    481       fbdata%cname(1)      = 'SST' 
    482       fbdata%coblong(1)    = 'Sea surface temperature' 
    483       fbdata%cobunit(1)    = 'Degree centigrade' 
    484       DO je = 1, next 
    485          fbdata%cextname(je) = pext%cdname(je) 
    486          fbdata%cextlong(je) = pext%cdlong(je,1) 
    487          fbdata%cextunit(je) = pext%cdunit(je,1) 
    488       END DO 
    489       fbdata%caddname(1)   = 'Hx' 
    490       fbdata%caddlong(1,1) = 'Model interpolated SST' 
    491       fbdata%caddunit(1,1) = 'Degree centigrade' 
    492       fbdata%cgrid(1)      = 'T' 
    493       DO ja = 1, nadd 
    494          fbdata%caddname(1+ja) = padd%cdname(ja) 
    495          fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
    496          fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
    497       END DO 
    498  
    499       WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 
    500  
    501       IF(lwp) THEN 
    502          WRITE(numout,*) 
    503          WRITE(numout,*)'obs_wri_sst :' 
    504          WRITE(numout,*)'~~~~~~~~~~~~~' 
    505          WRITE(numout,*)'Writing SST feedback file : ',TRIM(cfname) 
    506       ENDIF 
    507  
    508       ! Transform obs_prof data structure into obfbdata structure 
    509       fbdata%cdjuldref = '19500101000000' 
    510       DO jo = 1, sstdata%nsurf 
    511          fbdata%plam(jo)      = sstdata%rlam(jo) 
    512          fbdata%pphi(jo)      = sstdata%rphi(jo) 
    513          WRITE(fbdata%cdtyp(jo),'(I4)') sstdata%ntyp(jo) 
    514          fbdata%ivqc(jo,:)    = 0 
    515          fbdata%ivqcf(:,jo,:) = 0 
    516          IF ( sstdata%nqc(jo) > 10 ) THEN 
    517             fbdata%ioqc(jo)    = 4 
    518             fbdata%ioqcf(1,jo) = 0 
    519             fbdata%ioqcf(2,jo) = sstdata%nqc(jo) - 10 
    520          ELSE 
    521             fbdata%ioqc(jo)    = MAX(sstdata%nqc(jo),1) 
    522             fbdata%ioqcf(:,jo) = 0 
    523          ENDIF 
    524          fbdata%ipqc(jo)      = 0 
    525          fbdata%ipqcf(:,jo)   = 0 
    526          fbdata%itqc(jo)      = 0 
    527          fbdata%itqcf(:,jo)   = 0 
    528          fbdata%cdwmo(jo)     = '' 
    529          fbdata%kindex(jo)    = sstdata%nsfil(jo) 
    530          IF (ln_grid_global) THEN 
    531             fbdata%iobsi(jo,1) = sstdata%mi(jo) 
    532             fbdata%iobsj(jo,1) = sstdata%mj(jo) 
    533          ELSE 
    534             fbdata%iobsi(jo,1) = mig(sstdata%mi(jo)) 
    535             fbdata%iobsj(jo,1) = mjg(sstdata%mj(jo)) 
    536          ENDIF 
    537          CALL greg2jul( 0, & 
    538             &           sstdata%nmin(jo), & 
    539             &           sstdata%nhou(jo), & 
    540             &           sstdata%nday(jo), & 
    541             &           sstdata%nmon(jo), & 
    542             &           sstdata%nyea(jo), & 
    543             &           fbdata%ptim(jo),   & 
    544             &           krefdate = 19500101 ) 
    545          fbdata%padd(1,jo,1,1) = sstdata%rmod(jo,1) 
    546          fbdata%pob(1,jo,1)    = sstdata%robs(jo,1) 
    547          fbdata%pdep(1,jo)     = 0.0 
    548          fbdata%idqc(1,jo)     = 0 
    549          fbdata%idqcf(:,1,jo)  = 0 
    550          IF ( sstdata%nqc(jo) > 10 ) THEN 
    551             fbdata%ivqc(jo,1)       = 4 
    552             fbdata%ivlqc(1,jo,1)    = 4 
    553             fbdata%ivlqcf(1,1,jo,1) = 0 
    554             fbdata%ivlqcf(2,1,jo,1) = sstdata%nqc(jo) - 10 
    555          ELSE 
    556             fbdata%ivqc(jo,1)       = MAX(sstdata%nqc(jo),1) 
    557             fbdata%ivlqc(1,jo,1)    = MAX(sstdata%nqc(jo),1) 
    558             fbdata%ivlqcf(:,1,jo,1) = 0 
    559          ENDIF 
    560          fbdata%iobsk(1,jo,1)  = 0 
    561          DO ja = 1, nadd 
    562             fbdata%padd(1,jo,1+ja,1) = & 
    563                & sstdata%rext(jo,padd%ipoint(ja)) 
    564          END DO 
    565          DO je = 1, next 
    566             fbdata%pext(1,jo,je) = & 
    567                & sstdata%rext(jo,pext%ipoint(je)) 
    568          END DO 
    569  
    570       END DO 
    571  
    572       ! Write the obfbdata structure 
    573  
    574       CALL write_obfbdata( cfname, fbdata ) 
    575  
    576       ! Output some basic statistics 
    577       CALL obs_wri_stats( fbdata ) 
    578  
    579       CALL dealloc_obfbdata( fbdata ) 
    580  
    581    END SUBROUTINE obs_wri_sst 
    582  
    583    SUBROUTINE obs_wri_sss 
    584    END SUBROUTINE obs_wri_sss 
    585  
    586    SUBROUTINE obs_wri_seaice( cprefix, seaicedata, padd, pext ) 
    587       !!----------------------------------------------------------------------- 
    588       !! 
    589       !!                     *** ROUTINE obs_wri_seaice  *** 
    590       !! 
    591       !! ** Purpose : Write sea ice observation diagnostics 
    592       !!              related  
    593       !! 
    594       !! ** Method  : NetCDF 
    595       !!  
    596       !! ** Action  : 
    597       !! 
    598       !!      ! 07-07  (S. Ricci) Original 
    599       !!      ! 09-01  (K. Mogensen) New feedback format. 
    600       !!----------------------------------------------------------------------- 
    601  
    602       !! * Modules used 
    603       IMPLICIT NONE 
    604  
    605       !! * Arguments 
    606       CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files 
    607       TYPE(obs_surf), INTENT(INOUT) :: seaicedata   ! Full set of sea ice 
    608       TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable 
    609       TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info 
    610  
    611       !! * Local declarations  
    612       TYPE(obfbdata) :: fbdata 
    613       CHARACTER(LEN=40) :: cfname             ! netCDF filename 
    614       CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_seaice' 
    615       INTEGER :: jo 
    616       INTEGER :: ja 
    617       INTEGER :: je 
    618       INTEGER :: nadd 
    619       INTEGER :: next 
    620  
    621       IF ( PRESENT( padd ) ) THEN 
    622          nadd = padd%inum 
    623       ELSE 
    624          nadd = 0 
    625       ENDIF 
    626  
    627       IF ( PRESENT( pext ) ) THEN 
    628          next = pext%inum 
    629       ELSE 
    630          next = 0 
    631       ENDIF 
    632  
    633       CALL init_obfbdata( fbdata ) 
    634  
    635       CALL alloc_obfbdata( fbdata, 1, seaicedata%nsurf, 1, 1, 0, .TRUE. ) 
    636  
    637       fbdata%cname(1)      = 'SEAICE' 
    638       fbdata%coblong(1)    = 'Sea ice' 
    639       fbdata%cobunit(1)    = 'Fraction' 
    640       DO je = 1, next 
    641          fbdata%cextname(je) = pext%cdname(je) 
    642          fbdata%cextlong(je) = pext%cdlong(je,1) 
    643          fbdata%cextunit(je) = pext%cdunit(je,1) 
    644       END DO 
    645       fbdata%caddname(1)   = 'Hx' 
    646       fbdata%caddlong(1,1) = 'Model interpolated ICE' 
    647       fbdata%caddunit(1,1) = 'Fraction' 
    648       fbdata%cgrid(1)      = 'T' 
    649       DO ja = 1, nadd 
    650          fbdata%caddname(1+ja) = padd%cdname(ja) 
    651          fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
    652          fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
    653       END DO 
    654  
    655       WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 
    656  
    657       IF(lwp) THEN 
    658          WRITE(numout,*) 
    659          WRITE(numout,*)'obs_wri_seaice :' 
    660          WRITE(numout,*)'~~~~~~~~~~~~~~~~' 
    661          WRITE(numout,*)'Writing SEAICE feedback file : ',TRIM(cfname) 
    662       ENDIF 
    663  
    664       ! Transform obs_prof data structure into obfbdata structure 
    665       fbdata%cdjuldref = '19500101000000' 
    666       DO jo = 1, seaicedata%nsurf 
    667          fbdata%plam(jo)      = seaicedata%rlam(jo) 
    668          fbdata%pphi(jo)      = seaicedata%rphi(jo) 
    669          WRITE(fbdata%cdtyp(jo),'(I4)') seaicedata%ntyp(jo) 
    670          fbdata%ivqc(jo,:)    = 0 
    671          fbdata%ivqcf(:,jo,:) = 0 
    672          IF ( seaicedata%nqc(jo) > 10 ) THEN 
    673             fbdata%ioqc(jo)    = 4 
    674             fbdata%ioqcf(1,jo) = 0 
    675             fbdata%ioqcf(2,jo) = seaicedata%nqc(jo) - 10 
    676          ELSE 
    677             fbdata%ioqc(jo)    = MAX(seaicedata%nqc(jo),1) 
    678             fbdata%ioqcf(:,jo) = 0 
    679          ENDIF 
    680          fbdata%ipqc(jo)      = 0 
    681          fbdata%ipqcf(:,jo)   = 0 
    682          fbdata%itqc(jo)      = 0 
    683          fbdata%itqcf(:,jo)   = 0 
    684          fbdata%cdwmo(jo)     = '' 
    685          fbdata%kindex(jo)    = seaicedata%nsfil(jo) 
    686          IF (ln_grid_global) THEN 
    687             fbdata%iobsi(jo,1) = seaicedata%mi(jo) 
    688             fbdata%iobsj(jo,1) = seaicedata%mj(jo) 
    689          ELSE 
    690             fbdata%iobsi(jo,1) = mig(seaicedata%mi(jo)) 
    691             fbdata%iobsj(jo,1) = mjg(seaicedata%mj(jo)) 
    692          ENDIF 
    693          CALL greg2jul( 0, & 
    694             &           seaicedata%nmin(jo), & 
    695             &           seaicedata%nhou(jo), & 
    696             &           seaicedata%nday(jo), & 
    697             &           seaicedata%nmon(jo), & 
    698             &           seaicedata%nyea(jo), & 
    699             &           fbdata%ptim(jo),   & 
    700             &           krefdate = 19500101 ) 
    701          fbdata%padd(1,jo,1,1) = seaicedata%rmod(jo,1) 
    702          fbdata%pob(1,jo,1)    = seaicedata%robs(jo,1) 
    703          fbdata%pdep(1,jo)     = 0.0 
    704          fbdata%idqc(1,jo)     = 0 
    705          fbdata%idqcf(:,1,jo)  = 0 
    706          IF ( seaicedata%nqc(jo) > 10 ) THEN 
    707             fbdata%ivlqc(1,jo,1) = 4 
    708             fbdata%ivlqcf(1,1,jo,1) = 0 
    709             fbdata%ivlqcf(2,1,jo,1) = seaicedata%nqc(jo) - 10 
    710          ELSE 
    711             fbdata%ivlqc(1,jo,1) = MAX(seaicedata%nqc(jo),1) 
    712             fbdata%ivlqcf(:,1,jo,1) = 0 
    713          ENDIF 
    714          fbdata%iobsk(1,jo,1)  = 0 
    715          DO ja = 1, nadd 
    716             fbdata%padd(1,jo,1+ja,1) = & 
    717                & seaicedata%rext(jo,padd%ipoint(ja)) 
    718          END DO 
    719          DO je = 1, next 
    720             fbdata%pext(1,jo,je) = & 
    721                & seaicedata%rext(jo,pext%ipoint(je)) 
    722          END DO 
    723  
    724       END DO 
    725  
    726       ! Write the obfbdata structure 
    727       CALL write_obfbdata( cfname, fbdata ) 
    728  
    729       ! Output some basic statistics 
    730       CALL obs_wri_stats( fbdata ) 
    731  
    732       CALL dealloc_obfbdata( fbdata ) 
    733  
    734    END SUBROUTINE obs_wri_seaice 
    735  
    736    SUBROUTINE obs_wri_vel( cprefix, profdata, k2dint, padd, pext ) 
    737       !!----------------------------------------------------------------------- 
    738       !! 
    739       !!                     *** ROUTINE obs_wri_vel  *** 
    740       !! 
    741       !! ** Purpose : Write current (profile) observation  
    742       !!              related diagnostics 
    743       !! 
    744       !! ** Method  : NetCDF 
    745       !!  
    746       !! ** Action  : 
    747       !! 
    748       !! History : 
    749       !!      ! 09-01  (K. Mogensen) New feedback format routine 
    750       !!----------------------------------------------------------------------- 
    751  
    752       !! * Modules used 
    753  
    754       !! * Arguments 
    755       CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files 
    756       TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Full set of profile data 
    757       INTEGER, INTENT(IN) :: k2dint                 ! Horizontal interpolation method 
    758       TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable 
    759       TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info 
    760  
    761       !! * Local declarations 
    762       TYPE(obfbdata) :: fbdata 
    763       CHARACTER(LEN=40) :: cfname 
    764       INTEGER :: ilevel 
    765       INTEGER :: jvar 
    766       INTEGER :: jk 
    767       INTEGER :: ik 
    768       INTEGER :: jo 
    769       INTEGER :: ja 
    770       INTEGER :: je 
    771       INTEGER :: nadd 
    772       INTEGER :: next 
    773       REAL(wp) :: zpres 
    774       REAL(wp), DIMENSION(:), ALLOCATABLE :: & 
    775          & zu, & 
    776          & zv 
    777  
    778       IF ( PRESENT( padd ) ) THEN 
    779          nadd = padd%inum 
    780       ELSE 
    781          nadd = 0 
    782       ENDIF 
    783  
    784       IF ( PRESENT( pext ) ) THEN 
    785          next = pext%inum 
    786       ELSE 
    787          next = 0 
    788       ENDIF 
    789  
    790       CALL init_obfbdata( fbdata ) 
    791  
    792       ! Find maximum level 
    793       ilevel = 0 
    794       DO jvar = 1, 2 
    795          ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) ) 
    796       END DO 
    797       CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 2, 0, .TRUE. ) 
    798  
    799       fbdata%cname(1)      = 'UVEL' 
    800       fbdata%cname(2)      = 'VVEL' 
    801       fbdata%coblong(1)    = 'Zonal velocity' 
    802       fbdata%coblong(2)    = 'Meridional velocity' 
    803       fbdata%cobunit(1)    = 'm/s' 
    804       fbdata%cobunit(2)    = 'm/s' 
    805       DO je = 1, next 
    806          fbdata%cextname(je) = pext%cdname(je) 
    807          fbdata%cextlong(je) = pext%cdlong(je,1) 
    808          fbdata%cextunit(je) = pext%cdunit(je,1) 
    809       END DO 
    810       fbdata%caddname(1)   = 'Hx' 
    811       fbdata%caddlong(1,1) = 'Model interpolated zonal velocity' 
    812       fbdata%caddlong(1,2) = 'Model interpolated meridional velocity' 
    813       fbdata%caddunit(1,1) = 'm/s' 
    814       fbdata%caddunit(1,2) = 'm/s' 
    815       fbdata%caddname(2)   = 'HxG' 
    816       fbdata%caddlong(2,1) = 'Model interpolated zonal velocity (model grid)' 
    817       fbdata%caddlong(2,2) = 'Model interpolated meridional velocity (model grid)' 
    818       fbdata%caddunit(2,1) = 'm/s' 
    819       fbdata%caddunit(2,2) = 'm/s'  
    820       fbdata%cgrid(1)      = 'U'  
    821       fbdata%cgrid(2)      = 'V' 
    822       DO ja = 1, nadd 
    823          fbdata%caddname(2+ja) = padd%cdname(ja) 
    824          fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1) 
    825          fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1) 
    826       END DO 
    827  
    828       WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc 
    829  
    830       IF(lwp) THEN 
    831          WRITE(numout,*) 
    832          WRITE(numout,*)'obs_wri_vel :' 
    833          WRITE(numout,*)'~~~~~~~~~~~~~' 
    834          WRITE(numout,*)'Writing velocuty feedback file : ',TRIM(cfname) 
    835       ENDIF 
    836  
    837       ALLOCATE( & 
    838          & zu(profdata%nvprot(1)), & 
    839          & zv(profdata%nvprot(2))  & 
    840          & ) 
    841       CALL obs_rotvel( profdata, k2dint, zu, zv ) 
    842  
    843       ! Transform obs_prof data structure into obfbdata structure 
    844       fbdata%cdjuldref = '19500101000000' 
    845       DO jo = 1, profdata%nprof 
    846          fbdata%plam(jo)      = profdata%rlam(jo) 
    847          fbdata%pphi(jo)      = profdata%rphi(jo) 
    848          WRITE(fbdata%cdtyp(jo),'(I4)') profdata%ntyp(jo) 
    849          fbdata%ivqc(jo,:)    = profdata%ivqc(jo,:) 
    850          fbdata%ivqcf(:,jo,:) = profdata%ivqcf(:,jo,:) 
    851          IF ( profdata%nqc(jo) > 10 ) THEN 
    852             fbdata%ioqc(jo)    = 4 
    853             fbdata%ioqcf(1,jo) = profdata%nqcf(1,jo) 
    854             fbdata%ioqcf(2,jo) = profdata%nqc(jo) - 10 
    855          ELSE 
    856             fbdata%ioqc(jo)    = profdata%nqc(jo) 
    857             fbdata%ioqcf(:,jo) = profdata%nqcf(:,jo) 
    858          ENDIF 
    859          fbdata%ipqc(jo)      = profdata%ipqc(jo) 
    860          fbdata%ipqcf(:,jo)   = profdata%ipqcf(:,jo) 
    861          fbdata%itqc(jo)      = profdata%itqc(jo) 
    862          fbdata%itqcf(:,jo)   = profdata%itqcf(:,jo) 
    863          fbdata%cdwmo(jo)     = profdata%cwmo(jo) 
    864          fbdata%kindex(jo)    = profdata%npfil(jo) 
    865          DO jvar = 1, profdata%nvar 
    866             IF (ln_grid_global) THEN 
    867                fbdata%iobsi(jo,jvar) = profdata%mi(jo,jvar) 
    868                fbdata%iobsj(jo,jvar) = profdata%mj(jo,jvar) 
    869             ELSE 
    870                fbdata%iobsi(jo,jvar) = mig(profdata%mi(jo,jvar)) 
    871                fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar)) 
    872             ENDIF 
    873          END DO 
    874          CALL greg2jul( 0, & 
    875             &           profdata%nmin(jo), & 
    876             &           profdata%nhou(jo), & 
    877             &           profdata%nday(jo), & 
    878             &           profdata%nmon(jo), & 
    879             &           profdata%nyea(jo), & 
    880             &           fbdata%ptim(jo),   & 
    881             &           krefdate = 19500101 ) 
    882          ! Reform the profiles arrays for output 
    883          DO jvar = 1, 2 
    884             DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar) 
    885                ik = profdata%var(jvar)%nvlidx(jk) 
    886                IF ( jvar == 1 ) THEN 
    887                   fbdata%padd(ik,jo,1,jvar) = zu(jk) 
    888                ELSE 
    889                   fbdata%padd(ik,jo,1,jvar) = zv(jk) 
    890                ENDIF 
    891                fbdata%padd(ik,jo,2,jvar) = profdata%var(jvar)%vmod(jk) 
    892                fbdata%pob(ik,jo,jvar)    = profdata%var(jvar)%vobs(jk) 
    893                fbdata%pdep(ik,jo)        = profdata%var(jvar)%vdep(jk) 
    894                fbdata%idqc(ik,jo)        = profdata%var(jvar)%idqc(jk) 
    895                fbdata%idqcf(:,ik,jo)     = profdata%var(jvar)%idqcf(:,jk) 
    896                IF ( profdata%var(jvar)%nvqc(jk) > 10 ) THEN 
    897                   fbdata%ivlqc(ik,jo,jvar) = 4 
    898                   fbdata%ivlqcf(1,ik,jo,jvar) = profdata%var(jvar)%nvqcf(1,jk) 
    899                   fbdata%ivlqcf(2,ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) - 10 
    900                ELSE 
    901                   fbdata%ivlqc(ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) 
    902                   fbdata%ivlqcf(:,ik,jo,jvar) = profdata%var(jvar)%nvqcf(:,jk) 
    903                ENDIF 
    904                fbdata%iobsk(ik,jo,jvar)  = profdata%var(jvar)%mvk(jk) 
    905                DO ja = 1, nadd 
    906                   fbdata%padd(ik,jo,2+ja,jvar) = & 
    907                      & profdata%var(jvar)%vext(jk,padd%ipoint(ja)) 
    908                END DO 
    909                DO je = 1, next 
    910                   fbdata%pext(ik,jo,je) = & 
    911                      & profdata%var(jvar)%vext(jk,pext%ipoint(je)) 
    912                END DO 
    913             END DO 
    914          END DO 
    915       END DO 
    916  
    917       ! Write the obfbdata structure 
    918       CALL write_obfbdata( cfname, fbdata ) 
    919        
    920       ! Output some basic statistics 
    921       CALL obs_wri_stats( fbdata ) 
    922  
    923       CALL dealloc_obfbdata( fbdata ) 
    924       
    925       DEALLOCATE( & 
    926          & zu, & 
    927          & zv  & 
    928          & ) 
    929  
    930    END SUBROUTINE obs_wri_vel 
     625   END SUBROUTINE obs_wri_surf 
    931626 
    932627   SUBROUTINE obs_wri_stats( fbdata ) 
    … …  
    951646      INTEGER :: jo 
    952647      INTEGER :: jk 
    953  
    954 !      INTEGER :: nlev 
    955 !      INTEGER :: nlevmpp 
    956 !      INTEGER :: nobsmpp 
    957       INTEGER :: numgoodobs 
    958       INTEGER :: numgoodobsmpp 
     648      INTEGER :: inumgoodobs 
     649      INTEGER :: inumgoodobsmpp 
    959650      REAL(wp) :: zsumx 
    960651      REAL(wp) :: zsumx2 
    961652      REAL(wp) :: zomb 
     653       
    962654 
    963655      IF (lwp) THEN 
    964656         WRITE(numout,*) '' 
    965657         WRITE(numout,*) 'obs_wri_stats :' 
    966          WRITE(numout,*) '~~~~~~~~~~~~~~~'  
     658         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    967659      ENDIF 
    968660 
    … …  
    970662         zsumx=0.0_wp 
    971663         zsumx2=0.0_wp 
    972          numgoodobs=0 
     664         inumgoodobs=0 
    973665         DO jo = 1, fbdata%nobs 
    974666            DO jk = 1, fbdata%nlev 
    … …  
    976668                  & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. & 
    977669                  & ( fbdata%padd(jk,jo,1,jvar) < 9999.0 ) ) THEN 
    978         
    979              zomb=fbdata%pob(jk, jo, jvar)-fbdata%padd(jk, jo, 1, jvar) 
     670 
     671                  zomb=fbdata%pob(jk, jo, jvar)-fbdata%padd(jk, jo, 1, jvar) 
    980672                  zsumx=zsumx+zomb 
    981673                  zsumx2=zsumx2+zomb**2 
    982                   numgoodobs=numgoodobs+1 
    983           ENDIF 
     674                  inumgoodobs=inumgoodobs+1 
     675               ENDIF 
    984676            ENDDO 
    985677         ENDDO 
    986678 
    987          CALL obs_mpp_sum_integer( numgoodobs, numgoodobsmpp ) 
     679         CALL obs_mpp_sum_integer( inumgoodobs, inumgoodobsmpp ) 
    988680         CALL mpp_sum(zsumx) 
    989681         CALL mpp_sum(zsumx2) 
    990682 
    991683         IF (lwp) THEN 
    992        WRITE(numout,*) 'Type: ',fbdata%cname(jvar),'  Total number of good observations: ',numgoodobsmpp  
    993        WRITE(numout,*) 'Overall mean obs minus model of the good observations: ',zsumx/numgoodobsmpp 
    994             WRITE(numout,*) 'Overall RMS obs minus model of the good observations: ',sqrt( zsumx2/numgoodobsmpp ) 
    995        WRITE(numout,*) '' 
     684            WRITE(numout,*) 'Type: ',fbdata%cname(jvar),'  Total number of good observations: ',inumgoodobsmpp  
     685            WRITE(numout,*) 'Overall mean obs minus model of the good observations: ',zsumx/inumgoodobsmpp 
     686            WRITE(numout,*) 'Overall RMS obs minus model of the good observations: ',sqrt( zsumx2/inumgoodobsmpp ) 
     687            WRITE(numout,*) '' 
    996688         ENDIF 
    997   
     689 
    998690      ENDDO 
    999691 

  • branches/UKMO/dev_r5518_GO6_starthour_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_h2d.h90

    r6486 r10120  
    12401240         & zdum,  & 
    12411241         & zaamax 
    1242         
     1242       
     1243      imax = -1  
    12431244      ! Main computation 
    12441245      pflt = 1.0_wp 
Note: See TracChangeset for help on using the changeset viewer.