Changeset 9306


Ignore:
Timestamp:
2018-02-05T16:07:40+01:00 (2 years ago)
Author:
dford
Message:

Add extra biogeochemical variables to OBS code, and make profile obs operator code more generic. See internal Met Office NEMO ticket 733.

Location:
branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/CONFIG/SHARED/namelist_ref

    r7992 r9306  
    12011201   ln_vel3d   = .false.             ! Logical switch for velocity observations 
    12021202   ln_sss     = .false.             ! Logical swithc for SSS observations 
    1203    ln_logchl  = .false.             ! Logical switch for log(Chl) obs 
    1204    ln_spm     = .false.             ! Logical switch for SPM obs 
    1205    ln_fco2    = .false.              
    1206    ln_pco2    = .false. 
     1203   ln_slchltot = .false.            ! Logical switch for surface total              log10(chlorophyll) obs 
     1204   ln_slchldia = .false.            ! Logical switch for surface diatom             log10(chlorophyll) obs 
     1205   ln_slchlnon = .false.            ! Logical switch for surface non-diatom         log10(chlorophyll) obs 
     1206   ln_slchldin = .false.            ! Logical switch for surface dinoflagellate     log10(chlorophyll) obs 
     1207   ln_slchlmic = .false.            ! Logical switch for surface microphytoplankton log10(chlorophyll) obs 
     1208   ln_slchlnan = .false.            ! Logical switch for surface nanophytoplankton  log10(chlorophyll) obs 
     1209   ln_slchlpic = .false.            ! Logical switch for surface picophytoplankton  log10(chlorophyll) obs 
     1210   ln_schltot  = .false.            ! Logical switch for surface total              chlorophyll        obs 
     1211   ln_slphytot = .false.            ! Logical switch for surface total      log10(phytoplankton carbon) obs 
     1212   ln_slphydia = .false.            ! Logical switch for surface diatom     log10(phytoplankton carbon) obs 
     1213   ln_slphynon = .false.            ! Logical switch for surface non-diatom log10(phytoplankton carbon) obs 
     1214   ln_sspm     = .false.            ! Logical switch for surface suspended particulate matter obs 
     1215   ln_sfco2    = .false.            ! Logical switch for surface fugacity         of carbon dioxide obs 
     1216   ln_spco2    = .false.            ! Logical switch for surface partial pressure of carbon dioxide obs 
     1217   ln_plchltot = .false.            ! Logical switch for profile total log10(chlorophyll) obs 
     1218   ln_pchltot  = .false.            ! Logical switch for profile total chlorophyll obs 
     1219   ln_pno3     = .false.            ! Logical switch for profile nitrate obs 
     1220   ln_psi4     = .false.            ! Logical switch for profile silicate obs 
     1221   ln_ppo4     = .false.            ! Logical switch for profile phosphate obs 
     1222   ln_pdic     = .false.            ! Logical switch for profile dissolved inorganic carbon obs 
     1223   ln_palk     = .false.            ! Logical switch for profile alkalinity obs 
     1224   ln_pph      = .false.            ! Logical switch for profile pH obs 
     1225   ln_po2      = .false.            ! Logical switch for profile dissolved oxygen obs 
    12071226   ln_altbias = .false.             ! Logical switch for altimeter bias correction 
    12081227   ln_sstbias = .false.             ! Logical switch for SST bias correction 
     
    12131232   ln_s_at_t  = .false.             ! Logical switch for computing model S at T obs if not there 
    12141233   ln_sstnight = .false.            ! Logical switch for calculating night-time average for SST obs 
    1215    ln_sla_fp_indegs = .true.        ! Logical: T=> averaging footpring is in degrees, F=> in metres 
     1234   ln_default_fp_indegs = .true.    ! Logical: T=> averaging footprint is in degrees, F=> in metres 
     1235   ln_sla_fp_indegs = .true.        ! Logical: T=> averaging footprint is in degrees, F=> in metres 
    12161236   ln_sst_fp_indegs = .true. 
    12171237   ln_sss_fp_indegs = .true. 
    12181238   ln_sic_fp_indegs = .true. 
    12191239! All of the *files* variables below are arrays. Use namelist_cfg to add more files 
    1220    cn_profbfiles = 'profiles_01.nc'    ! Profile feedback input observation file names 
    1221    cn_slafbfiles = 'sla_01.nc'         ! SLA feedback input observation file names 
    1222    cn_sstfbfiles = 'sst_01.nc'         ! SST feedback input observation file names 
    1223    cn_sicfbfiles = 'sic_01.nc'         ! SIC feedback input observation file names 
    1224    cn_velfbfiles = 'vel_01.nc'         ! Velocity feedback input observation file names 
    1225    cn_sssfbfiles = 'sss_01.nc'         ! SSS feedback input observation file names 
    1226    cn_altbiasfile = 'altbias.nc'       ! Altimeter bias input file name 
    1227    cn_sstbiasfiles = 'sstbias.nc'      ! SST bias input file names 
    1228    cn_gridsearchfile = 'gridsearch.nc' ! Grid search file name 
    1229    rn_gridsearchres = 0.5              ! Grid search resolution 
    1230    rn_sla_avglamscl = 0.               ! E/W diameter of SLA observation footprint (metres/degrees) 
    1231    rn_sla_avgphiscl = 0.               ! N/S diameter of SLA observation footprint (metres/degrees) 
    1232    rn_sst_avglamscl = 0. 
    1233    rn_sst_avgphiscl = 0. 
    1234    rn_sss_avglamscl = 0. 
    1235    rn_sss_avgphiscl = 0. 
    1236    rn_sic_avglamscl = 0. 
    1237    rn_sic_avgphiscl = 0. 
    1238    nn_1dint = 0                        ! Type of vertical interpolation method 
    1239    nn_2dint = 0                        ! Default horizontal interpolation method 
    1240    nn_2dint_sla = 0                    ! Horizontal interpolation method for SLA 
    1241    nn_2dint_sst = 0                    ! Horizontal interpolation method for SST 
    1242    nn_2dint_sss = 0                    ! Horizontal interpolation method for SSS 
    1243    nn_2dint_sic = 0                    ! Horizontal interpolation method for SIC 
    1244    nn_msshc = 0                        ! MSSH correction scheme 
    1245    rn_mdtcorr = 1.61                   ! MDT  correction 
    1246    rn_mdtcutoff = 65.0                 ! MDT cutoff for computed correction 
    1247    nn_profdavtypes = -1                ! Profile daily average types - array 
     1240   cn_profbfiles = 'profiles_01.nc'      ! Profile feedback input observation file names 
     1241   cn_slafbfiles = 'sla_01.nc'           ! SLA feedback input observation file names 
     1242   cn_sstfbfiles = 'sst_01.nc'           ! SST feedback input observation file names 
     1243   cn_sicfbfiles = 'sic_01.nc'           ! SIC feedback input observation file names 
     1244   cn_velfbfiles = 'vel_01.nc'           ! Velocity feedback input observation file names 
     1245   cn_sssfbfiles = 'sss_01.nc'           ! SSS feedback input observation file names 
     1246   cn_slchltotfbfiles = 'slchltot_01.nc' ! Surface total              log10(chlorophyll) obs file names 
     1247   cn_slchldiafbfiles = 'slchldia_01.nc' ! Surface diatom             log10(chlorophyll) obs file names 
     1248   cn_slchlnonfbfiles = 'slchlnon_01.nc' ! Surface non-diatom         log10(chlorophyll) obs file names 
     1249   cn_slchldinfbfiles = 'slchldin_01.nc' ! Surface dinoflagellate     log10(chlorophyll) obs file names 
     1250   cn_slchlmicfbfiles = 'slchlmic_01.nc' ! Surface microphytoplankton log10(chlorophyll) obs file names 
     1251   cn_slchlnanfbfiles = 'slchlnan_01.nc' ! Surface nanophytoplankton  log10(chlorophyll) obs file names 
     1252   cn_slchlpicfbfiles = 'slchlpic_01.nc' ! Surface picophytoplankton  log10(chlorophyll) obs file names 
     1253   cn_schltotfbfiles  = 'schltot_01.nc'  ! Surface total              chlorophyll        obs file names 
     1254   cn_slphytotfbfiles = 'slphytot_01.nc' ! Surface total      log10(phytoplankton carbon) obs file names 
     1255   cn_slphydiafbfiles = 'slphydia_01.nc' ! Surface diatom     log10(phytoplankton carbon) obs file names 
     1256   cn_slphynonfbfiles = 'slphynon_01.nc' ! Surface non-diatom log10(phytoplankton carbon) obs file names 
     1257   cn_sspmfbfiles     = 'sspm_01.nc'     ! Surface suspended particulate matter obs file names 
     1258   cn_sfco2fbfiles    = 'sfco2_01.nc'    ! Surface fugacity         of carbon dioxide obs file names 
     1259   cn_spco2fbfiles    = 'spco2_01.nc'    ! Surface partial pressure of carbon dioxide obs file names 
     1260   cn_plchltotfbfiles = 'plchltot_01.nc' ! Profile total log10(chlorophyll) obs file names 
     1261   cn_pchltotfbfiles  = 'pchltot_01.nc'  ! Profile total chlorophyll obs file names 
     1262   cn_pno3fbfiles     = 'pno3_01.nc'     ! Profile nitrate obs file names 
     1263   cn_psi4fbfiles     = 'psi4_01.nc'     ! Profile silicate obs file names 
     1264   cn_ppo4fbfiles     = 'ppo4_01.nc'     ! Profile phosphate obs file names 
     1265   cn_pdicfbfiles     = 'pdic_01.nc'     ! Profile dissolved inorganic carbon obs file names 
     1266   cn_palkfbfiles     = 'palk_01.nc'     ! Profile alkalinity obs file names 
     1267   cn_pphfbfiles      = 'pph_01.nc'      ! Profile pH obs file names 
     1268   cn_po2fbfiles      = 'po2_01.nc'      ! Profile dissolved oxygen obs file names 
     1269   cn_altbiasfile = 'altbias.nc'         ! Altimeter bias input file name 
     1270   cn_sstbiasfiles = 'sstbias.nc'        ! SST bias input file names 
     1271   cn_gridsearchfile = 'gridsearch.nc'   ! Grid search file name 
     1272   rn_gridsearchres = 0.5                ! Grid search resolution 
     1273   rn_default_avglamscl = 0.             ! Default E/W diameter of observation footprint (metres/degrees) 
     1274   rn_default_avgphiscl = 0.             ! Default N/S diameter of observation footprint (metres/degrees) 
     1275   rn_sla_avglamscl = 0.                 ! E/W diameter of SLA observation footprint (metres/degrees) 
     1276   rn_sla_avgphiscl = 0.                 ! N/S diameter of SLA observation footprint (metres/degrees) 
     1277   rn_sst_avglamscl = 0.                 ! E/W diameter of SST observation footprint (metres/degrees) 
     1278   rn_sst_avgphiscl = 0.                 ! N/S diameter of SST observation footprint (metres/degrees) 
     1279   rn_sss_avglamscl = 0.                 ! E/W diameter of SSS observation footprint (metres/degrees) 
     1280   rn_sss_avgphiscl = 0.                 ! N/S diameter of SSS observation footprint (metres/degrees) 
     1281   rn_sic_avglamscl = 0.                 ! E/W diameter of SIC observation footprint (metres/degrees) 
     1282   rn_sic_avgphiscl = 0.                 ! N/S diameter of SIC observation footprint (metres/degrees) 
     1283   nn_1dint = 0                          ! Type of vertical interpolation method 
     1284   nn_2dint_default = 0                  ! Default horizontal interpolation method 
     1285   nn_2dint_sla = -1                     ! Horizontal interpolation method for SLA 
     1286   nn_2dint_sst = -1                     ! Horizontal interpolation method for SST 
     1287   nn_2dint_sss = -1                     ! Horizontal interpolation method for SSS 
     1288   nn_2dint_sic = -1                     ! Horizontal interpolation method for SIC 
     1289   nn_msshc = 0                          ! MSSH correction scheme 
     1290   rn_mdtcorr = 1.61                     ! MDT  correction 
     1291   rn_mdtcutoff = 65.0                   ! MDT cutoff for computed correction 
     1292   nn_profdavtypes = -1                  ! Profile daily average types - array 
    12481293    
    12491294/ 
  • branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r8653 r9306  
    4545   !! * Module variables 
    4646   LOGICAL, PUBLIC :: & 
    47       &       lk_diaobs = .TRUE.  !: Include this for backwards compatibility at NEMO 3.6. 
    48    LOGICAL :: ln_diaobs           !: Logical switch for the obs operator 
    49    LOGICAL :: ln_sstnight         !: Logical switch for night mean SST obs 
    50    LOGICAL :: ln_sla_fp_indegs    !: T=> SLA obs footprint size specified in degrees, F=> in metres 
    51    LOGICAL :: ln_sst_fp_indegs    !: T=> SST obs footprint size specified in degrees, F=> in metres 
    52    LOGICAL :: ln_sss_fp_indegs    !: T=> SSS obs footprint size specified in degrees, F=> in metres 
    53    LOGICAL :: ln_sic_fp_indegs    !: T=> sea-ice obs footprint size specified in degrees, F=> in metres 
    54  
    55    REAL(wp) :: rn_sla_avglamscl !: E/W diameter of SLA observation footprint (metres) 
    56    REAL(wp) :: rn_sla_avgphiscl !: N/S diameter of SLA observation footprint (metres) 
    57    REAL(wp) :: rn_sst_avglamscl !: E/W diameter of SST observation footprint (metres) 
    58    REAL(wp) :: rn_sst_avgphiscl !: N/S diameter of SST observation footprint (metres) 
    59    REAL(wp) :: rn_sss_avglamscl !: E/W diameter of SSS observation footprint (metres) 
    60    REAL(wp) :: rn_sss_avgphiscl !: N/S diameter of SSS observation footprint (metres) 
    61    REAL(wp) :: rn_sic_avglamscl !: E/W diameter of sea-ice observation footprint (metres) 
    62    REAL(wp) :: rn_sic_avgphiscl !: N/S diameter of sea-ice observation footprint (metres) 
    63  
    64    INTEGER :: nn_1dint       !: Vertical interpolation method 
    65    INTEGER :: nn_2dint       !: Default horizontal interpolation method 
    66    INTEGER :: nn_2dint_sla   !: SLA horizontal interpolation method  
    67    INTEGER :: nn_2dint_sst   !: SST horizontal interpolation method  
    68    INTEGER :: nn_2dint_sss   !: SSS horizontal interpolation method  
    69    INTEGER :: nn_2dint_sic   !: Seaice horizontal interpolation method  
     47      &       lk_diaobs = .TRUE.   !: Include this for backwards compatibility at NEMO 3.6. 
     48   LOGICAL :: ln_diaobs            !: Logical switch for the obs operator 
     49   LOGICAL :: ln_sstnight          !: Logical switch for night mean SST obs 
     50   LOGICAL :: ln_default_fp_indegs !: T=> Default obs footprint size specified in degrees, F=> in metres 
     51   LOGICAL :: ln_sla_fp_indegs     !: T=>     SLA obs footprint size specified in degrees, F=> in metres 
     52   LOGICAL :: ln_sst_fp_indegs     !: T=>     SST obs footprint size specified in degrees, F=> in metres 
     53   LOGICAL :: ln_sss_fp_indegs     !: T=>     SSS obs footprint size specified in degrees, F=> in metres 
     54   LOGICAL :: ln_sic_fp_indegs     !: T=> sea-ice obs footprint size specified in degrees, F=> in metres 
     55 
     56   REAL(wp) :: rn_default_avglamscl !: Default E/W diameter of observation footprint 
     57   REAL(wp) :: rn_default_avgphiscl !: Default N/S diameter of observation footprint 
     58   REAL(wp) :: rn_sla_avglamscl     !: E/W diameter of SLA observation footprint 
     59   REAL(wp) :: rn_sla_avgphiscl     !: N/S diameter of SLA observation footprint 
     60   REAL(wp) :: rn_sst_avglamscl     !: E/W diameter of SST observation footprint 
     61   REAL(wp) :: rn_sst_avgphiscl     !: N/S diameter of SST observation footprint 
     62   REAL(wp) :: rn_sss_avglamscl     !: E/W diameter of SSS observation footprint 
     63   REAL(wp) :: rn_sss_avgphiscl     !: N/S diameter of SSS observation footprint 
     64   REAL(wp) :: rn_sic_avglamscl     !: E/W diameter of sea-ice observation footprint 
     65   REAL(wp) :: rn_sic_avgphiscl     !: N/S diameter of sea-ice observation footprint 
     66 
     67   INTEGER :: nn_1dint         !: Vertical interpolation method 
     68   INTEGER :: nn_2dint_default !: Default horizontal interpolation method 
     69   INTEGER :: nn_2dint_sla     !: SLA horizontal interpolation method (-1 = default) 
     70   INTEGER :: nn_2dint_sst     !: SST horizontal interpolation method (-1 = default) 
     71   INTEGER :: nn_2dint_sss     !: SSS horizontal interpolation method (-1 = default) 
     72   INTEGER :: nn_2dint_sic     !: Seaice horizontal interpolation method (-1 = default) 
    7073  
    7174   INTEGER, DIMENSION(imaxavtypes) :: & 
     
    9598      & profdataqc           !: Profile data after quality control 
    9699 
    97    CHARACTER(len=6), PUBLIC, DIMENSION(:), ALLOCATABLE :: & 
     100   CHARACTER(len=8), PUBLIC, DIMENSION(:), ALLOCATABLE :: & 
    98101      & cobstypesprof, &     !: Profile obs types 
    99102      & cobstypessurf        !: Surface obs types 
     
    141144      INTEGER :: jfile           ! Counter for files 
    142145      INTEGER :: jnumsstbias     ! Number of SST bias files to read and apply 
     146      INTEGER :: n2dint_type     ! Local version of nn_2dint* 
    143147 
    144148      CHARACTER(len=128), DIMENSION(jpmaxnfiles) :: & 
    145          & cn_profbfiles,    &   ! T/S profile input filenames 
    146          & cn_sstfbfiles,    &   ! Sea surface temperature input filenames 
    147          & cn_slafbfiles,    &   ! Sea level anomaly input filenames 
    148          & cn_sicfbfiles,    &   ! Seaice concentration input filenames 
    149          & cn_velfbfiles,    &   ! Velocity profile input filenames 
    150          & cn_sssfbfiles,    &   ! Sea surface salinity input filenames 
    151          & cn_logchlfbfiles, &   ! Log(Chl) input filenames 
    152          & cn_spmfbfiles,    &   ! Sediment input filenames 
    153          & cn_fco2fbfiles,   &   ! fco2 input filenames 
    154          & cn_pco2fbfiles,   &   ! pco2 input filenames 
     149         & cn_profbfiles,      & ! T/S profile input filenames 
     150         & cn_sstfbfiles,      & ! Sea surface temperature input filenames 
     151         & cn_slafbfiles,      & ! Sea level anomaly input filenames 
     152         & cn_sicfbfiles,      & ! Seaice concentration input filenames 
     153         & cn_velfbfiles,      & ! Velocity profile input filenames 
     154         & cn_sssfbfiles,      & ! Sea surface salinity input filenames 
     155         & cn_slchltotfbfiles, & ! Surface total              log10(chlorophyll) input filenames 
     156         & cn_slchldiafbfiles, & ! Surface diatom             log10(chlorophyll) input filenames 
     157         & cn_slchlnonfbfiles, & ! Surface non-diatom         log10(chlorophyll) input filenames 
     158         & cn_slchldinfbfiles, & ! Surface dinoflagellate     log10(chlorophyll) input filenames 
     159         & cn_slchlmicfbfiles, & ! Surface microphytoplankton log10(chlorophyll) input filenames 
     160         & cn_slchlnanfbfiles, & ! Surface nanophytoplankton  log10(chlorophyll) input filenames 
     161         & cn_slchlpicfbfiles, & ! Surface picophytoplankton  log10(chlorophyll) input filenames 
     162         & cn_schltotfbfiles,  & ! Surface total              chlorophyll        input filenames 
     163         & cn_slphytotfbfiles, & ! Surface total      log10(phytoplankton carbon) input filenames 
     164         & cn_slphydiafbfiles, & ! Surface diatom     log10(phytoplankton carbon) input filenames 
     165         & cn_slphynonfbfiles, & ! Surface non-diatom log10(phytoplankton carbon) input filenames 
     166         & cn_sspmfbfiles,     & ! Surface suspended particulate matter input filenames 
     167         & cn_sfco2fbfiles,    & ! Surface fugacity         of carbon dioxide input filenames 
     168         & cn_spco2fbfiles,    & ! Surface partial pressure of carbon dioxide input filenames 
     169         & cn_plchltotfbfiles, & ! Profile total log10(chlorophyll) input filenames 
     170         & cn_pchltotfbfiles,  & ! Profile total chlorophyll input filenames 
     171         & cn_pno3fbfiles,     & ! Profile nitrate input filenames 
     172         & cn_psi4fbfiles,     & ! Profile silicate input filenames 
     173         & cn_ppo4fbfiles,     & ! Profile phosphate input filenames 
     174         & cn_pdicfbfiles,     & ! Profile dissolved inorganic carbon input filenames 
     175         & cn_palkfbfiles,     & ! Profile alkalinity input filenames 
     176         & cn_pphfbfiles,      & ! Profile pH input filenames 
     177         & cn_po2fbfiles,      & ! Profile dissolved oxygen input filenames 
    155178         & cn_sstbiasfiles       ! SST bias input filenames 
    156179 
     
    166189      LOGICAL :: ln_sss          ! Logical switch for sea surface salinity obs 
    167190      LOGICAL :: ln_vel3d        ! Logical switch for velocity (u,v) obs 
    168       LOGICAL :: ln_logchl       ! Logical switch for log(Chl) obs 
    169       LOGICAL :: ln_spm          ! Logical switch for sediment obs 
    170       LOGICAL :: ln_fco2         ! Logical switch for fco2 obs 
    171       LOGICAL :: ln_pco2         ! Logical switch for pco2 obs 
     191      LOGICAL :: ln_slchltot     ! Logical switch for surface total              log10(chlorophyll) obs 
     192      LOGICAL :: ln_slchldia     ! Logical switch for surface diatom             log10(chlorophyll) obs 
     193      LOGICAL :: ln_slchlnon     ! Logical switch for surface non-diatom         log10(chlorophyll) obs 
     194      LOGICAL :: ln_slchldin     ! Logical switch for surface dinoflagellate     log10(chlorophyll) obs 
     195      LOGICAL :: ln_slchlmic     ! Logical switch for surface microphytoplankton log10(chlorophyll) obs 
     196      LOGICAL :: ln_slchlnan     ! Logical switch for surface nanophytoplankton  log10(chlorophyll) obs 
     197      LOGICAL :: ln_slchlpic     ! Logical switch for surface picophytoplankton  log10(chlorophyll) obs 
     198      LOGICAL :: ln_schltot      ! Logical switch for surface total              chlorophyll        obs 
     199      LOGICAL :: ln_slphytot     ! Logical switch for surface total      log10(phytoplankton carbon) obs 
     200      LOGICAL :: ln_slphydia     ! Logical switch for surface diatom     log10(phytoplankton carbon) obs 
     201      LOGICAL :: ln_slphynon     ! Logical switch for surface non-diatom log10(phytoplankton carbon) obs 
     202      LOGICAL :: ln_sspm         ! Logical switch for surface suspended particulate matter obs 
     203      LOGICAL :: ln_sfco2        ! Logical switch for surface fugacity         of carbon dioxide obs 
     204      LOGICAL :: ln_spco2        ! Logical switch for surface partial pressure of carbon dioxide obs 
     205      LOGICAL :: ln_plchltot     ! Logical switch for profile total log10(chlorophyll) obs 
     206      LOGICAL :: ln_pchltot      ! Logical switch for profile total chlorophyll obs 
     207      LOGICAL :: ln_pno3         ! Logical switch for profile nitrate obs 
     208      LOGICAL :: ln_psi4         ! Logical switch for profile silicate obs 
     209      LOGICAL :: ln_ppo4         ! Logical switch for profile phosphate obs 
     210      LOGICAL :: ln_pdic         ! Logical switch for profile dissolved inorganic carbon obs 
     211      LOGICAL :: ln_palk         ! Logical switch for profile alkalinity obs 
     212      LOGICAL :: ln_pph          ! Logical switch for profile pH obs 
     213      LOGICAL :: ln_po2          ! Logical switch for profile dissolved oxygen obs 
    172214      LOGICAL :: ln_nea          ! Logical switch to remove obs near land 
    173215      LOGICAL :: ln_altbias      ! Logical switch for altimeter bias 
     
    180222      REAL(dp) :: rn_dobsend     ! Obs window end date   YYYYMMDD.HHMMSS 
    181223 
     224      REAL(wp) :: ztype_avglamscl ! Local version of rn_*_avglamscl 
     225      REAL(wp) :: ztype_avgphiscl ! Local version of rn_*_avgphiscl 
     226 
    182227      CHARACTER(len=128), DIMENSION(:,:), ALLOCATABLE :: & 
    183228         & clproffiles, &        ! Profile filenames 
    184229         & clsurffiles           ! Surface filenames 
    185230 
    186       LOGICAL :: llvar1          ! Logical for profile variable 1 
    187       LOGICAL :: llvar2          ! Logical for profile variable 1 
    188  
    189       REAL(wp), POINTER, DIMENSION(:,:) :: & 
    190          & zglam1, &             ! Model longitudes for profile variable 1 
    191          & zglam2                ! Model longitudes for profile variable 2 
    192       REAL(wp), POINTER, DIMENSION(:,:) :: & 
    193          & zgphi1, &             ! Model latitudes for profile variable 1 
    194          & zgphi2                ! Model latitudes for profile variable 2 
     231      LOGICAL, DIMENSION(:), ALLOCATABLE :: llvar   ! Logical for profile variable read 
     232      LOGICAL :: ltype_fp_indegs ! Local version of ln_*_fp_indegs 
     233      LOGICAL :: ltype_night     ! Local version of ln_sstnight (false for other variables) 
     234 
    195235      REAL(wp), POINTER, DIMENSION(:,:,:) :: & 
    196          & zmask1, &             ! Model land/sea mask associated with variable 1 
    197          & zmask2                ! Model land/sea mask associated with variable 2 
     236         & zglam                 ! Model longitudes for profile variables 
     237      REAL(wp), POINTER, DIMENSION(:,:,:) :: & 
     238         & zgphi                 ! Model latitudes for profile variables 
     239      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: & 
     240         & zmask                 ! Model land/sea mask associated with variables 
    198241 
    199242 
    200243      NAMELIST/namobs/ln_diaobs, ln_t3d, ln_s3d, ln_sla,              & 
    201244         &            ln_sst, ln_sic, ln_sss, ln_vel3d,               & 
    202          &            ln_logchl, ln_spm, ln_fco2, ln_pco2,            & 
     245         &            ln_slchltot, ln_slchldia, ln_slchlnon,          & 
     246         &            ln_slchldin, ln_slchlmic, ln_slchlnan,          & 
     247         &            ln_slchlpic, ln_schltot,                        & 
     248         &            ln_slphytot, ln_slphydia, ln_slphynon,          & 
     249         &            ln_sspm,     ln_sfco2,    ln_spco2,             & 
     250         &            ln_plchltot, ln_pchltot,  ln_pno3,              & 
     251         &            ln_psi4,     ln_ppo4,     ln_pdic,              & 
     252         &            ln_palk,     ln_pph,      ln_po2,               & 
    203253         &            ln_altbias, ln_sstbias, ln_nea,                 & 
    204254         &            ln_grid_global, ln_grid_search_lookup,          & 
    205255         &            ln_ignmis, ln_s_at_t, ln_bound_reject,          & 
    206          &            ln_sstnight,                                    & 
     256         &            ln_sstnight, ln_default_fp_indegs,              & 
    207257         &            ln_sla_fp_indegs, ln_sst_fp_indegs,             & 
    208258         &            ln_sss_fp_indegs, ln_sic_fp_indegs,             & 
     
    210260         &            cn_sstfbfiles, cn_sicfbfiles,                   & 
    211261         &            cn_velfbfiles, cn_sssfbfiles,                   & 
    212          &            cn_logchlfbfiles, cn_spmfbfiles,                & 
    213          &            cn_fco2fbfiles, cn_pco2fbfiles,                 & 
     262         &            cn_slchltotfbfiles, cn_slchldiafbfiles,         & 
     263         &            cn_slchlnonfbfiles, cn_slchldinfbfiles,         & 
     264         &            cn_slchlmicfbfiles, cn_slchlnanfbfiles,         & 
     265         &            cn_slchlpicfbfiles, cn_schltotfbfiles,          & 
     266         &            cn_slphytotfbfiles, cn_slphydiafbfiles,         & 
     267         &            cn_slphynonfbfiles, cn_sspmfbfiles,             & 
     268         &            cn_sfco2fbfiles, cn_spco2fbfiles,               & 
     269         &            cn_plchltotfbfiles, cn_pchltotfbfiles,          & 
     270         &            cn_pno3fbfiles, cn_psi4fbfiles, cn_ppo4fbfiles, & 
     271         &            cn_pdicfbfiles, cn_palkfbfiles, cn_pphfbfiles,  & 
     272         &            cn_po2fbfiles,                                  & 
    214273         &            cn_sstbiasfiles, cn_altbiasfile,                & 
    215274         &            cn_gridsearchfile, rn_gridsearchres,            & 
    216275         &            rn_dobsini, rn_dobsend,                         & 
     276         &            rn_default_avglamscl, rn_default_avgphiscl,     & 
    217277         &            rn_sla_avglamscl, rn_sla_avgphiscl,             & 
    218278         &            rn_sst_avglamscl, rn_sst_avgphiscl,             & 
    219279         &            rn_sss_avglamscl, rn_sss_avgphiscl,             & 
    220280         &            rn_sic_avglamscl, rn_sic_avgphiscl,             & 
    221          &            nn_1dint, nn_2dint,                             & 
     281         &            nn_1dint, nn_2dint_default,                     & 
    222282         &            nn_2dint_sla, nn_2dint_sst,                     & 
    223283         &            nn_2dint_sss, nn_2dint_sic,                     & 
     
    225285         &            nn_profdavtypes 
    226286 
    227       CALL wrk_alloc( jpi, jpj, zglam1 ) 
    228       CALL wrk_alloc( jpi, jpj, zglam2 ) 
    229       CALL wrk_alloc( jpi, jpj, zgphi1 ) 
    230       CALL wrk_alloc( jpi, jpj, zgphi2 ) 
    231       CALL wrk_alloc( jpi, jpj, jpk, zmask1 ) 
    232       CALL wrk_alloc( jpi, jpj, jpk, zmask2 ) 
    233  
    234287      !----------------------------------------------------------------------- 
    235288      ! Read namelist parameters 
     
    237290 
    238291      ! Some namelist arrays need initialising 
    239       cn_profbfiles(:)    = '' 
    240       cn_slafbfiles(:)    = '' 
    241       cn_sstfbfiles(:)    = '' 
    242       cn_sicfbfiles(:)    = '' 
    243       cn_velfbfiles(:)    = '' 
    244       cn_sssfbfiles(:)    = '' 
    245       cn_logchlfbfiles(:) = '' 
    246       cn_spmfbfiles(:)    = '' 
    247       cn_fco2fbfiles(:)   = '' 
    248       cn_pco2fbfiles(:)   = '' 
    249       cn_sstbiasfiles(:)  = '' 
    250       nn_profdavtypes(:)  = -1 
     292      cn_profbfiles(:)      = '' 
     293      cn_slafbfiles(:)      = '' 
     294      cn_sstfbfiles(:)      = '' 
     295      cn_sicfbfiles(:)      = '' 
     296      cn_velfbfiles(:)      = '' 
     297      cn_sssfbfiles(:)      = '' 
     298      cn_slchltotfbfiles(:) = '' 
     299      cn_slchldiafbfiles(:) = '' 
     300      cn_slchlnonfbfiles(:) = '' 
     301      cn_slchldinfbfiles(:) = '' 
     302      cn_slchlmicfbfiles(:) = '' 
     303      cn_slchlnanfbfiles(:) = '' 
     304      cn_slchlpicfbfiles(:) = '' 
     305      cn_schltotfbfiles(:)  = '' 
     306      cn_slphytotfbfiles(:) = '' 
     307      cn_slphydiafbfiles(:) = '' 
     308      cn_slphynonfbfiles(:) = '' 
     309      cn_sspmfbfiles(:)     = '' 
     310      cn_sfco2fbfiles(:)    = '' 
     311      cn_spco2fbfiles(:)    = '' 
     312      cn_plchltotfbfiles(:) = '' 
     313      cn_pchltotfbfiles(:)  = '' 
     314      cn_pno3fbfiles(:)     = '' 
     315      cn_psi4fbfiles(:)     = '' 
     316      cn_ppo4fbfiles(:)     = '' 
     317      cn_pdicfbfiles(:)     = '' 
     318      cn_palkfbfiles(:)     = '' 
     319      cn_pphfbfiles(:)      = '' 
     320      cn_po2fbfiles(:)      = '' 
     321      cn_sstbiasfiles(:)    = '' 
     322      nn_profdavtypes(:)    = -1 
    251323 
    252324      CALL ini_date( rn_dobsini ) 
     
    286358         WRITE(numout,*) '             Logical switch for velocity observations               ln_vel3d = ', ln_vel3d 
    287359         WRITE(numout,*) '             Logical switch for SSS observations                      ln_sss = ', ln_sss 
    288          WRITE(numout,*) '             Logical switch for log(Chl) observations              ln_logchl = ', ln_logchl 
    289          WRITE(numout,*) '             Logical switch for SPM observations                      ln_spm = ', ln_spm 
    290          WRITE(numout,*) '             Logical switch for FCO2 observations                    ln_fco2 = ', ln_fco2 
    291          WRITE(numout,*) '             Logical switch for PCO2 observations                    ln_pco2 = ', ln_pco2 
     360         WRITE(numout,*) '             Logical switch for surface total logchl obs         ln_slchltot = ', ln_slchltot 
     361         WRITE(numout,*) '             Logical switch for surface diatom logchl obs        ln_slchldia = ', ln_slchldia 
     362         WRITE(numout,*) '             Logical switch for surface non-diatom logchl obs    ln_slchlnon = ', ln_slchlnon 
     363         WRITE(numout,*) '             Logical switch for surface dino logchl obs          ln_slchldin = ', ln_slchldin 
     364         WRITE(numout,*) '             Logical switch for surface micro logchl obs         ln_slchlmic = ', ln_slchlmic 
     365         WRITE(numout,*) '             Logical switch for surface nano logchl obs          ln_slchlnan = ', ln_slchlnan 
     366         WRITE(numout,*) '             Logical switch for surface pico logchl obs          ln_slchlpic = ', ln_slchlpic 
     367         WRITE(numout,*) '             Logical switch for surface total chl obs             ln_schltot = ', ln_schltot 
     368         WRITE(numout,*) '             Logical switch for surface total log(phyC) obs      ln_slphytot = ', ln_slphytot 
     369         WRITE(numout,*) '             Logical switch for surface diatom log(phyC) obs     ln_slphydia = ', ln_slphydia 
     370         WRITE(numout,*) '             Logical switch for surface non-diatom log(phyC) obs ln_slphynon = ', ln_slphynon 
     371         WRITE(numout,*) '             Logical switch for surface SPM observations             ln_sspm = ', ln_sspm 
     372         WRITE(numout,*) '             Logical switch for surface fCO2 observations           ln_sfco2 = ', ln_sfco2 
     373         WRITE(numout,*) '             Logical switch for surface pCO2 observations           ln_spco2 = ', ln_spco2 
     374         WRITE(numout,*) '             Logical switch for profile total logchl obs         ln_plchltot = ', ln_plchltot 
     375         WRITE(numout,*) '             Logical switch for profile total chl obs             ln_pchltot = ', ln_pchltot 
     376         WRITE(numout,*) '             Logical switch for profile nitrate obs                  ln_pno3 = ', ln_pno3 
     377         WRITE(numout,*) '             Logical switch for profile silicate obs                 ln_psi4 = ', ln_psi4 
     378         WRITE(numout,*) '             Logical switch for profile phosphate obs                ln_ppo4 = ', ln_ppo4 
     379         WRITE(numout,*) '             Logical switch for profile DIC obs                      ln_pdic = ', ln_pdic 
     380         WRITE(numout,*) '             Logical switch for profile alkalinity obs               ln_palk = ', ln_palk 
     381         WRITE(numout,*) '             Logical switch for profile pH obs                        ln_pph = ', ln_pph 
     382         WRITE(numout,*) '             Logical switch for profile oxygen obs                    ln_po2 = ', ln_po2 
    292383         WRITE(numout,*) '             Global distribution of observations              ln_grid_global = ', ln_grid_global 
    293384         WRITE(numout,*) '             Logical switch for obs grid search lookup ln_grid_search_lookup = ', ln_grid_search_lookup 
     
    297388         WRITE(numout,*) '             Final date in window YYYYMMDD.HHMMSS                 rn_dobsend = ', rn_dobsend 
    298389         WRITE(numout,*) '             Type of vertical interpolation method                  nn_1dint = ', nn_1dint 
    299          WRITE(numout,*) '             Type of horizontal interpolation method                nn_2dint = ', nn_2dint 
     390         WRITE(numout,*) '             Default horizontal interpolation method        nn_2dint_default = ', nn_2dint_default 
     391         WRITE(numout,*) '             Type of horizontal interpolation method for SLA    nn_2dint_sla = ', nn_2dint_sla 
     392         WRITE(numout,*) '             Type of horizontal interpolation method for SST    nn_2dint_sst = ', nn_2dint_sst 
     393         WRITE(numout,*) '             Type of horizontal interpolation method for SSS    nn_2dint_sss = ', nn_2dint_sss 
     394         WRITE(numout,*) '             Type of horizontal interpolation method for SIC    nn_2dint_sic = ', nn_2dint_sic 
     395         WRITE(numout,*) '             Default E/W diameter of obs footprint      rn_default_avglamscl = ', rn_default_avglamscl 
     396         WRITE(numout,*) '             Default N/S diameter of obs footprint      rn_default_avgphiscl = ', rn_default_avgphiscl 
     397         WRITE(numout,*) '             Default obs footprint in deg [T] or m [F]  ln_default_fp_indegs = ', ln_default_fp_indegs 
     398         WRITE(numout,*) '             SLA E/W diameter of obs footprint              rn_sla_avglamscl = ', rn_sla_avglamscl 
     399         WRITE(numout,*) '             SLA N/S diameter of obs footprint              rn_sla_avgphiscl = ', rn_sla_avgphiscl 
     400         WRITE(numout,*) '             SLA obs footprint in deg [T] or m [F]          ln_sla_fp_indegs = ', ln_sla_fp_indegs 
     401         WRITE(numout,*) '             SST E/W diameter of obs footprint              rn_sst_avglamscl = ', rn_sst_avglamscl 
     402         WRITE(numout,*) '             SST N/S diameter of obs footprint              rn_sst_avgphiscl = ', rn_sst_avgphiscl 
     403         WRITE(numout,*) '             SST obs footprint in deg [T] or m [F]          ln_sst_fp_indegs = ', ln_sst_fp_indegs 
     404         WRITE(numout,*) '             SIC E/W diameter of obs footprint              rn_sic_avglamscl = ', rn_sic_avglamscl 
     405         WRITE(numout,*) '             SIC N/S diameter of obs footprint              rn_sic_avgphiscl = ', rn_sic_avgphiscl 
     406         WRITE(numout,*) '             SIC obs footprint in deg [T] or m [F]          ln_sic_fp_indegs = ', ln_sic_fp_indegs 
    300407         WRITE(numout,*) '             Rejection of observations near land switch               ln_nea = ', ln_nea 
    301408         WRITE(numout,*) '             Rejection of obs near open bdys                 ln_bound_reject = ', ln_bound_reject 
     
    314421      !----------------------------------------------------------------------- 
    315422 
    316       nproftypes = COUNT( (/ln_t3d .OR. ln_s3d, ln_vel3d /) ) 
    317       nsurftypes = COUNT( (/ln_sla, ln_sst, ln_sic, ln_sss, & 
    318          &                  ln_logchl, ln_spm, ln_fco2, ln_pco2 /) ) 
     423      nproftypes = COUNT( (/ln_t3d .OR. ln_s3d, ln_vel3d, ln_plchltot,          & 
     424         &                  ln_pchltot,  ln_pno3,     ln_psi4,     ln_ppo4,     & 
     425         &                  ln_pdic,     ln_palk,     ln_pph,      ln_po2 /) ) 
     426      nsurftypes = COUNT( (/ln_sla, ln_sst, ln_sic, ln_sss,                     & 
     427         &                  ln_slchltot, ln_slchldia, ln_slchlnon, ln_slchldin, & 
     428         &                  ln_slchlmic, ln_slchlnan, ln_slchlpic, ln_schltot,  & 
     429         &                  ln_slphytot, ln_slphydia, ln_slphynon, ln_sspm,     & 
     430         &                  ln_sfco2,    ln_spco2 /) ) 
    319431 
    320432      IF ( nproftypes == 0 .AND. nsurftypes == 0 ) THEN 
     
    337449         IF (ln_t3d .OR. ln_s3d) THEN 
    338450            jtype = jtype + 1 
    339             CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'prof  ', & 
    340                &                   cn_profbfiles, ifilesprof, cobstypesprof, clproffiles ) 
     451            cobstypesprof(jtype) = 'prof' 
     452            clproffiles(jtype,:) = cn_profbfiles 
    341453         ENDIF 
    342454         IF (ln_vel3d) THEN 
    343455            jtype = jtype + 1 
    344             CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'vel   ', & 
    345                &                   cn_velfbfiles, ifilesprof, cobstypesprof, clproffiles ) 
    346          ENDIF 
     456            cobstypesprof(jtype) =  'vel' 
     457            clproffiles(jtype,:) = cn_velfbfiles 
     458         ENDIF 
     459         IF (ln_plchltot) THEN 
     460            jtype = jtype + 1 
     461            cobstypesprof(jtype) = 'plchltot' 
     462            clproffiles(jtype,:) = cn_plchltotfbfiles 
     463         ENDIF 
     464         IF (ln_pchltot) THEN 
     465            jtype = jtype + 1 
     466            cobstypesprof(jtype) = 'pchltot' 
     467            clproffiles(jtype,:) = cn_pchltotfbfiles 
     468         ENDIF 
     469         IF (ln_pno3) THEN 
     470            jtype = jtype + 1 
     471            cobstypesprof(jtype) = 'pno3' 
     472            clproffiles(jtype,:) = cn_pno3fbfiles 
     473         ENDIF 
     474         IF (ln_psi4) THEN 
     475            jtype = jtype + 1 
     476            cobstypesprof(jtype) = 'psi4' 
     477            clproffiles(jtype,:) = cn_psi4fbfiles 
     478         ENDIF 
     479         IF (ln_ppo4) THEN 
     480            jtype = jtype + 1 
     481            cobstypesprof(jtype) = 'ppo4' 
     482            clproffiles(jtype,:) = cn_ppo4fbfiles 
     483         ENDIF 
     484         IF (ln_pdic) THEN 
     485            jtype = jtype + 1 
     486            cobstypesprof(jtype) = 'pdic' 
     487            clproffiles(jtype,:) = cn_pdicfbfiles 
     488         ENDIF 
     489         IF (ln_palk) THEN 
     490            jtype = jtype + 1 
     491            cobstypesprof(jtype) = 'palk' 
     492            clproffiles(jtype,:) = cn_palkfbfiles 
     493         ENDIF 
     494         IF (ln_pph) THEN 
     495            jtype = jtype + 1 
     496            cobstypesprof(jtype) = 'pph' 
     497            clproffiles(jtype,:) = cn_pphfbfiles 
     498         ENDIF 
     499         IF (ln_po2) THEN 
     500            jtype = jtype + 1 
     501            cobstypesprof(jtype) = 'po2' 
     502            clproffiles(jtype,:) = cn_po2fbfiles 
     503         ENDIF 
     504 
     505         CALL obs_settypefiles( nproftypes, jpmaxnfiles, ifilesprof, cobstypesprof, clproffiles ) 
    347506 
    348507      ENDIF 
     
    363522         IF (ln_sla) THEN 
    364523            jtype = jtype + 1 
    365             CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sla   ', & 
    366                &                   cn_slafbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
    367             CALL obs_setinterpopts( nsurftypes, jtype, 'sla   ',      & 
    368                &                  nn_2dint, nn_2dint_sla,             & 
    369                &                  rn_sla_avglamscl, rn_sla_avgphiscl, & 
    370                &                  ln_sla_fp_indegs, .FALSE.,          & 
    371                &                  n2dintsurf, ravglamscl, ravgphiscl, & 
    372                &                  lfpindegs, llnightav ) 
     524            cobstypessurf(jtype) = 'sla' 
     525            clsurffiles(jtype,:) = cn_slafbfiles 
    373526         ENDIF 
    374527         IF (ln_sst) THEN 
    375528            jtype = jtype + 1 
    376             CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sst   ', & 
    377                &                   cn_sstfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
    378             CALL obs_setinterpopts( nsurftypes, jtype, 'sst   ',      & 
    379                &                  nn_2dint, nn_2dint_sst,             & 
    380                &                  rn_sst_avglamscl, rn_sst_avgphiscl, & 
    381                &                  ln_sst_fp_indegs, ln_sstnight,      & 
    382                &                  n2dintsurf, ravglamscl, ravgphiscl, & 
    383                &                  lfpindegs, llnightav ) 
    384          ENDIF 
    385 #if defined key_lim2 || defined key_lim3 || defined key_cice 
     529            cobstypessurf(jtype) = 'sst' 
     530            clsurffiles(jtype,:) = cn_sstfbfiles 
     531         ENDIF 
    386532         IF (ln_sic) THEN 
    387533            jtype = jtype + 1 
    388             CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sic   ', & 
    389                &                   cn_sicfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
    390             CALL obs_setinterpopts( nsurftypes, jtype, 'sic   ',      & 
    391                &                  nn_2dint, nn_2dint_sic,             & 
    392                &                  rn_sic_avglamscl, rn_sic_avgphiscl, & 
    393                &                  ln_sic_fp_indegs, .FALSE.,          & 
    394                &                  n2dintsurf, ravglamscl, ravgphiscl, & 
    395                &                  lfpindegs, llnightav ) 
    396          ENDIF 
    397 #endif 
     534            cobstypessurf(jtype) = 'sic' 
     535            clsurffiles(jtype,:) = cn_sicfbfiles 
     536         ENDIF 
    398537         IF (ln_sss) THEN 
    399538            jtype = jtype + 1 
    400             CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sss   ', & 
    401                &                   cn_sssfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
    402             CALL obs_setinterpopts( nsurftypes, jtype, 'sss   ',      & 
    403                &                  nn_2dint, nn_2dint_sss,             & 
    404                &                  rn_sss_avglamscl, rn_sss_avgphiscl, & 
    405                &                  ln_sss_fp_indegs, .FALSE.,          & 
    406                &                  n2dintsurf, ravglamscl, ravgphiscl, & 
    407                &                  lfpindegs, llnightav ) 
    408          ENDIF 
    409  
    410          IF (ln_logchl) THEN 
    411             jtype = jtype + 1 
    412             CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'logchl', & 
    413                &                   cn_logchlfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
    414             CALL obs_setinterpopts( nsurftypes, jtype, 'logchl',         & 
    415                &                    nn_2dint, -1, 0., 0., .TRUE., .FALSE., & 
    416                &                    n2dintsurf, ravglamscl, ravgphiscl,    & 
     539            cobstypessurf(jtype) = 'sss' 
     540            clsurffiles(jtype,:) = cn_sssfbfiles 
     541         ENDIF 
     542         IF (ln_slchltot) THEN 
     543            jtype = jtype + 1 
     544            cobstypessurf(jtype) = 'slchltot' 
     545            clsurffiles(jtype,:) = cn_slchltotfbfiles 
     546         ENDIF 
     547         IF (ln_slchldia) THEN 
     548            jtype = jtype + 1 
     549            cobstypessurf(jtype) = 'slchldia' 
     550            clsurffiles(jtype,:) = cn_slchldiafbfiles 
     551         ENDIF 
     552         IF (ln_slchlnon) THEN 
     553            jtype = jtype + 1 
     554            cobstypessurf(jtype) = 'slchlnon' 
     555            clsurffiles(jtype,:) = cn_slchlnonfbfiles 
     556         ENDIF 
     557         IF (ln_slchldin) THEN 
     558            jtype = jtype + 1 
     559            cobstypessurf(jtype) = 'slchldin' 
     560            clsurffiles(jtype,:) = cn_slchldinfbfiles 
     561         ENDIF 
     562         IF (ln_slchlmic) THEN 
     563            jtype = jtype + 1 
     564            cobstypessurf(jtype) = 'slchlmic' 
     565            clsurffiles(jtype,:) = cn_slchlmicfbfiles 
     566         ENDIF 
     567         IF (ln_slchlnan) THEN 
     568            jtype = jtype + 1 
     569            cobstypessurf(jtype) = 'slchlnan' 
     570            clsurffiles(jtype,:) = cn_slchlnanfbfiles 
     571         ENDIF 
     572         IF (ln_slchlpic) THEN 
     573            jtype = jtype + 1 
     574            cobstypessurf(jtype) = 'slchlpic' 
     575            clsurffiles(jtype,:) = cn_slchlpicfbfiles 
     576         ENDIF 
     577         IF (ln_schltot) THEN 
     578            jtype = jtype + 1 
     579            cobstypessurf(jtype) = 'schltot' 
     580            clsurffiles(jtype,:) = cn_schltotfbfiles 
     581         ENDIF 
     582         IF (ln_slphytot) THEN 
     583            jtype = jtype + 1 
     584            cobstypessurf(jtype) = 'slphytot' 
     585            clsurffiles(jtype,:) = cn_slphytotfbfiles 
     586         ENDIF 
     587         IF (ln_slphydia) THEN 
     588            jtype = jtype + 1 
     589            cobstypessurf(jtype) = 'slphydia' 
     590            clsurffiles(jtype,:) = cn_slphydiafbfiles 
     591         ENDIF 
     592         IF (ln_slphynon) THEN 
     593            jtype = jtype + 1 
     594            cobstypessurf(jtype) = 'slphynon' 
     595            clsurffiles(jtype,:) = cn_slphynonfbfiles 
     596         ENDIF 
     597         IF (ln_sspm) THEN 
     598            jtype = jtype + 1 
     599            cobstypessurf(jtype) = 'sspm' 
     600            clsurffiles(jtype,:) = cn_sspmfbfiles 
     601         ENDIF 
     602         IF (ln_sfco2) THEN 
     603            jtype = jtype + 1 
     604            cobstypessurf(jtype) = 'sfco2' 
     605            clsurffiles(jtype,:) = cn_sfco2fbfiles 
     606         ENDIF 
     607         IF (ln_spco2) THEN 
     608            jtype = jtype + 1 
     609            cobstypessurf(jtype) = 'spco2' 
     610            clsurffiles(jtype,:) = cn_spco2fbfiles 
     611         ENDIF 
     612 
     613         CALL obs_settypefiles( nsurftypes, jpmaxnfiles, ifilessurf, cobstypessurf, clsurffiles ) 
     614 
     615         DO jtype = 1, nsurftypes 
     616 
     617            IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN 
     618               IF ( nn_2dint_sla == -1 ) THEN 
     619                  n2dint_type  = nn_2dint_default 
     620               ELSE 
     621                  n2dint_type  = nn_2dint_sla 
     622               ENDIF 
     623               ztype_avglamscl = rn_sla_avglamscl 
     624               ztype_avgphiscl = rn_sla_avgphiscl 
     625               ltype_fp_indegs = ln_sla_fp_indegs 
     626               ltype_night     = .FALSE. 
     627            ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sst' ) THEN 
     628               IF ( nn_2dint_sst == -1 ) THEN 
     629                  n2dint_type  = nn_2dint_default 
     630               ELSE 
     631                  n2dint_type  = nn_2dint_sst 
     632               ENDIF 
     633               ztype_avglamscl = rn_sst_avglamscl 
     634               ztype_avgphiscl = rn_sst_avgphiscl 
     635               ltype_fp_indegs = ln_sst_fp_indegs 
     636               ltype_night     = ln_sstnight 
     637            ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sic' ) THEN 
     638               IF ( nn_2dint_sic == -1 ) THEN 
     639                  n2dint_type  = nn_2dint_default 
     640               ELSE 
     641                  n2dint_type  = nn_2dint_sic 
     642               ENDIF 
     643               ztype_avglamscl = rn_sic_avglamscl 
     644               ztype_avgphiscl = rn_sic_avgphiscl 
     645               ltype_fp_indegs = ln_sic_fp_indegs 
     646               ltype_night     = .FALSE. 
     647            ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sss' ) THEN 
     648               IF ( nn_2dint_sss == -1 ) THEN 
     649                  n2dint_type  = nn_2dint_default 
     650               ELSE 
     651                  n2dint_type  = nn_2dint_sss 
     652               ENDIF 
     653               ztype_avglamscl = rn_sss_avglamscl 
     654               ztype_avgphiscl = rn_sss_avgphiscl 
     655               ltype_fp_indegs = ln_sss_fp_indegs 
     656               ltype_night     = .FALSE. 
     657            ELSE 
     658               n2dint_type     = nn_2dint_default 
     659               ztype_avglamscl = rn_default_avglamscl 
     660               ztype_avgphiscl = rn_default_avgphiscl 
     661               ltype_fp_indegs = ln_default_fp_indegs 
     662               ltype_night     = .FALSE. 
     663            ENDIF 
     664             
     665            CALL obs_setinterpopts( nsurftypes, jtype, TRIM(cobstypessurf(jtype)), & 
     666               &                    nn_2dint_default, n2dint_type,                 & 
     667               &                    ztype_avglamscl, ztype_avgphiscl,              & 
     668               &                    ltype_fp_indegs, ltype_night,                  & 
     669               &                    n2dintsurf, ravglamscl, ravgphiscl,            & 
    417670               &                    lfpindegs, llnightav ) 
    418          ENDIF 
    419  
    420          IF (ln_spm) THEN 
    421             jtype = jtype + 1 
    422             CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'spm   ', & 
    423                &                   cn_spmfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
    424             CALL obs_setinterpopts( nsurftypes, jtype, 'spm   ',         & 
    425                &                    nn_2dint, -1, 0., 0., .TRUE., .FALSE., & 
    426                &                    n2dintsurf, ravglamscl, ravgphiscl,    & 
    427                &                    lfpindegs, llnightav ) 
    428          ENDIF 
    429  
    430          IF (ln_fco2) THEN 
    431             jtype = jtype + 1 
    432             CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'fco2  ', & 
    433                &                   cn_fco2fbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
    434             CALL obs_setinterpopts( nsurftypes, jtype, 'fco2  ',         & 
    435                &                    nn_2dint, -1, 0., 0., .TRUE., .FALSE., & 
    436                &                    n2dintsurf, ravglamscl, ravgphiscl,    & 
    437                &                    lfpindegs, llnightav ) 
    438          ENDIF 
    439  
    440          IF (ln_pco2) THEN 
    441             jtype = jtype + 1 
    442             CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'pco2  ', & 
    443                &                   cn_pco2fbfiles, ifilessurf, cobstypessurf, clsurffiles ) 
    444             CALL obs_setinterpopts( nsurftypes, jtype, 'pco2  ',         & 
    445                &                    nn_2dint, -1, 0., 0., .TRUE., .FALSE., & 
    446                &                    n2dintsurf, ravglamscl, ravgphiscl,    & 
    447                &                    lfpindegs, llnightav ) 
    448          ENDIF 
     671 
     672         END DO 
    449673 
    450674      ENDIF 
     
    467691      ENDIF 
    468692 
    469       IF ( ( nn_2dint < 0 ) .OR. ( nn_2dint > 6 ) ) THEN 
    470          CALL ctl_stop(' Choice of horizontal (2D) interpolation method', & 
     693      IF ( ( nn_2dint_default < 0 ) .OR. ( nn_2dint_default > 6 ) ) THEN 
     694         CALL ctl_stop(' Choice of default horizontal (2D) interpolation method', & 
    471695            &                    ' is not available') 
    472696      ENDIF 
     
    491715         DO jtype = 1, nproftypes 
    492716 
    493             nvarsprof(jtype) = 2 
    494717            IF ( TRIM(cobstypesprof(jtype)) == 'prof' ) THEN 
     718               nvarsprof(jtype) = 2 
    495719               nextrprof(jtype) = 1 
    496                llvar1 = ln_t3d 
    497                llvar2 = ln_s3d 
    498                zglam1 = glamt 
    499                zgphi1 = gphit 
    500                zmask1 = tmask 
    501                zglam2 = glamt 
    502                zgphi2 = gphit 
    503                zmask2 = tmask 
    504             ENDIF 
    505             IF ( TRIM(cobstypesprof(jtype)) == 'vel' )  THEN 
     720               ALLOCATE(llvar(nvarsprof(jtype))) 
     721               CALL wrk_alloc( jpi, jpj,      nvarsprof(jtype), zglam ) 
     722               CALL wrk_alloc( jpi, jpj,      nvarsprof(jtype), zgphi ) 
     723               CALL wrk_alloc( jpi, jpj, jpk, nvarsprof(jtype), zmask ) 
     724               llvar(1)       = ln_t3d 
     725               llvar(2)       = ln_s3d 
     726               zglam(:,:,1)   = glamt(:,:) 
     727               zglam(:,:,2)   = glamt(:,:) 
     728               zgphi(:,:,1)   = gphit(:,:) 
     729               zgphi(:,:,2)   = gphit(:,:) 
     730               zmask(:,:,:,1) = tmask(:,:,:) 
     731               zmask(:,:,:,2) = tmask(:,:,:) 
     732            ELSE IF ( TRIM(cobstypesprof(jtype)) == 'vel' )  THEN 
     733               nvarsprof(jtype) = 2 
    506734               nextrprof(jtype) = 2 
    507                llvar1 = ln_vel3d 
    508                llvar2 = ln_vel3d 
    509                zglam1 = glamu 
    510                zgphi1 = gphiu 
    511                zmask1 = umask 
    512                zglam2 = glamv 
    513                zgphi2 = gphiv 
    514                zmask2 = vmask 
     735               ALLOCATE(llvar(nvarsprof(jtype))) 
     736               CALL wrk_alloc( jpi, jpj,      nvarsprof(jtype), zglam ) 
     737               CALL wrk_alloc( jpi, jpj,      nvarsprof(jtype), zgphi ) 
     738               CALL wrk_alloc( jpi, jpj, jpk, nvarsprof(jtype), zmask ) 
     739               llvar(1)       = ln_vel3d 
     740               llvar(2)       = ln_vel3d 
     741               zglam(:,:,1)   = glamu(:,:) 
     742               zglam(:,:,2)   = glamv(:,:) 
     743               zgphi(:,:,1)   = gphiu(:,:) 
     744               zgphi(:,:,2)   = gphiv(:,:) 
     745               zmask(:,:,:,1) = umask(:,:,:) 
     746               zmask(:,:,:,2) = vmask(:,:,:) 
     747            ELSE 
     748               nvarsprof(jtype) = 1 
     749               nextrprof(jtype) = 0 
     750               ALLOCATE(llvar(nvarsprof(jtype))) 
     751               CALL wrk_alloc( jpi, jpj,      nvarsprof(jtype), zglam ) 
     752               CALL wrk_alloc( jpi, jpj,      nvarsprof(jtype), zgphi ) 
     753               CALL wrk_alloc( jpi, jpj, jpk, nvarsprof(jtype), zmask ) 
     754               llvar(1)       = .TRUE. 
     755               zglam(:,:,1)   = glamt(:,:) 
     756               zgphi(:,:,1)   = gphit(:,:) 
     757               zmask(:,:,:,1) = tmask(:,:,:) 
    515758            ENDIF 
    516759 
     
    519762               &               clproffiles(jtype,1:ifilesprof(jtype)), & 
    520763               &               nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, & 
    521                &               rn_dobsini, rn_dobsend, llvar1, llvar2, & 
     764               &               rn_dobsini, rn_dobsend, llvar, & 
    522765               &               ln_ignmis, ln_s_at_t, .FALSE., & 
    523766               &               kdailyavtypes = nn_profdavtypes ) 
     
    528771 
    529772            CALL obs_pre_prof( profdata(jtype), profdataqc(jtype), & 
    530                &               llvar1, llvar2, & 
     773               &               llvar, & 
    531774               &               jpi, jpj, jpk, & 
    532                &               zmask1, zglam1, zgphi1, zmask2, zglam2, zgphi2,  & 
     775               &               zmask, zglam, zgphi,  & 
    533776               &               ln_nea, ln_bound_reject, & 
    534777               &               kdailyavtypes = nn_profdavtypes ) 
     778             
     779            DEALLOCATE( llvar ) 
     780            CALL wrk_dealloc( jpi, jpj,      nvarsprof(jtype), zglam ) 
     781            CALL wrk_dealloc( jpi, jpj,      nvarsprof(jtype), zgphi ) 
     782            CALL wrk_dealloc( jpi, jpj, jpk, nvarsprof(jtype), zmask ) 
    535783 
    536784         END DO 
     
    587835 
    588836      ENDIF 
    589  
    590       CALL wrk_dealloc( jpi, jpj, zglam1 ) 
    591       CALL wrk_dealloc( jpi, jpj, zglam2 ) 
    592       CALL wrk_dealloc( jpi, jpj, zgphi1 ) 
    593       CALL wrk_dealloc( jpi, jpj, zgphi2 ) 
    594       CALL wrk_dealloc( jpi, jpj, jpk, zmask1 ) 
    595       CALL wrk_dealloc( jpi, jpj, jpk, zmask2 ) 
    596837 
    597838   END SUBROUTINE dia_obs_init 
     
    639880#endif 
    640881#if defined key_hadocc 
    641       USE trc, ONLY :  &           ! HadOCC chlorophyll, fCO2 and pCO2 
     882      USE trc, ONLY :  &           ! HadOCC variables 
     883         & trn, & 
    642884         & HADOCC_CHL, & 
    643885         & HADOCC_FCO2, & 
    644886         & HADOCC_PCO2, & 
    645887         & HADOCC_FILL_FLT 
    646 #elif defined key_medusa && defined key_foam_medusa 
    647       USE trc, ONLY :  &           ! MEDUSA chlorophyll, fCO2 and pCO2 
     888      USE par_hadocc 
     889      USE had_bgc_const, ONLY: c2n_p 
     890#elif defined key_medusa && defined key_foam_medusa 
     891      USE trc, ONLY :  &           ! MEDUSA variables 
    648892         & trn 
    649       USE par_medusa, ONLY: & 
    650          & jpchn, & 
    651          & jpchd 
     893      USE par_medusa 
     894      USE sms_medusa, ONLY: & 
     895         & xthetapn, & 
     896         & xthetapd 
    652897#if defined key_roam 
    653898      USE sms_medusa, ONLY: & 
    654899         & f2_pco2w, & 
    655          & f2_fco2w 
     900         & f2_fco2w, & 
     901         & f3_pH 
    656902#endif 
    657903#elif defined key_fabm 
     
    674920      INTEGER :: jtype             ! Data loop variable 
    675921      INTEGER :: jvar              ! Variable number 
    676       INTEGER :: ji, jj            ! Loop counters 
    677       REAL(wp) :: tiny                  ! small number 
    678       REAL(wp), POINTER, DIMENSION(:,:,:) :: & 
    679          & zprofvar1, &            ! Model values for 1st variable in a prof ob 
    680          & zprofvar2               ! Model values for 2nd variable in a prof ob 
    681       REAL(wp), POINTER, DIMENSION(:,:,:) :: & 
    682          & zprofmask1, &           ! Mask associated with zprofvar1 
    683          & zprofmask2              ! Mask associated with zprofvar2 
     922      INTEGER :: ji, jj, jk        ! Loop counters 
     923      REAL(wp) :: tiny             ! small number 
     924      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: & 
     925         & zprofvar                ! Model values for variables in a prof ob 
     926      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: & 
     927         & zprofmask               ! Mask associated with zprofvar 
    684928      REAL(wp), POINTER, DIMENSION(:,:) :: & 
    685929         & zsurfvar, &             ! Model values equivalent to surface ob. 
    686930         & zsurfmask               ! Mask associated with surface variable 
    687       REAL(wp), POINTER, DIMENSION(:,:) :: & 
    688          & zglam1,    &            ! Model longitudes for prof variable 1 
    689          & zglam2,    &            ! Model longitudes for prof variable 2 
    690          & zgphi1,    &            ! Model latitudes for prof variable 1 
    691          & zgphi2                  ! Model latitudes for prof variable 2 
    692  
    693  
    694       !Allocate local work arrays 
    695       CALL wrk_alloc( jpi, jpj, jpk, zprofvar1 ) 
    696       CALL wrk_alloc( jpi, jpj, jpk, zprofvar2 ) 
    697       CALL wrk_alloc( jpi, jpj, jpk, zprofmask1 ) 
    698       CALL wrk_alloc( jpi, jpj, jpk, zprofmask2 ) 
    699       CALL wrk_alloc( jpi, jpj, zsurfvar ) 
    700       CALL wrk_alloc( jpi, jpj, zsurfmask ) 
    701       CALL wrk_alloc( jpi, jpj, zglam1 ) 
    702       CALL wrk_alloc( jpi, jpj, zglam2 ) 
    703       CALL wrk_alloc( jpi, jpj, zgphi1 ) 
    704       CALL wrk_alloc( jpi, jpj, zgphi2 ) 
     931      REAL(wp), POINTER, DIMENSION(:,:,:) :: & 
     932         & zglam,    &             ! Model longitudes for prof variables 
     933         & zgphi                   ! Model latitudes for prof variables 
     934      LOGICAL :: llog10            ! Perform log10 transform of variable 
     935 
    705936 
    706937      IF(lwp) THEN 
     
    721952         DO jtype = 1, nproftypes 
    722953 
     954            ! Allocate local work arrays 
     955            CALL wrk_alloc( jpi, jpj, jpk, profdataqc(jtype)%nvar, zprofvar  ) 
     956            CALL wrk_alloc( jpi, jpj, jpk, profdataqc(jtype)%nvar, zprofmask ) 
     957            CALL wrk_alloc( jpi, jpj,      profdataqc(jtype)%nvar, zglam     ) 
     958            CALL wrk_alloc( jpi, jpj,      profdataqc(jtype)%nvar, zgphi     ) 
     959             
     960            ! Defaults which might change 
     961            DO jvar = 1, profdataqc(jtype)%nvar 
     962               zprofmask(:,:,:,jvar) = tmask(:,:,:) 
     963               zglam(:,:,jvar)       = glamt(:,:) 
     964               zgphi(:,:,jvar)       = gphit(:,:) 
     965            END DO 
     966 
    723967            SELECT CASE ( TRIM(cobstypesprof(jtype)) ) 
     968 
    724969            CASE('prof') 
    725                zprofvar1(:,:,:) = tsn(:,:,:,jp_tem) 
    726                zprofvar2(:,:,:) = tsn(:,:,:,jp_sal) 
    727                zprofmask1(:,:,:) = tmask(:,:,:) 
    728                zprofmask2(:,:,:) = tmask(:,:,:) 
    729                zglam1(:,:) = glamt(:,:) 
    730                zglam2(:,:) = glamt(:,:) 
    731                zgphi1(:,:) = gphit(:,:) 
    732                zgphi2(:,:) = gphit(:,:) 
     970               zprofvar(:,:,:,1) = tsn(:,:,:,jp_tem) 
     971               zprofvar(:,:,:,2) = tsn(:,:,:,jp_sal) 
     972 
    733973            CASE('vel') 
    734                zprofvar1(:,:,:) = un(:,:,:) 
    735                zprofvar2(:,:,:) = vn(:,:,:) 
    736                zprofmask1(:,:,:) = umask(:,:,:) 
    737                zprofmask2(:,:,:) = vmask(:,:,:) 
    738                zglam1(:,:) = glamu(:,:) 
    739                zglam2(:,:) = glamv(:,:) 
    740                zgphi1(:,:) = gphiu(:,:) 
    741                zgphi2(:,:) = gphiv(:,:) 
     974               zprofvar(:,:,:,1) = un(:,:,:) 
     975               zprofvar(:,:,:,2) = vn(:,:,:) 
     976               zprofmask(:,:,:,1) = umask(:,:,:) 
     977               zprofmask(:,:,:,2) = vmask(:,:,:) 
     978               zglam(:,:,1) = glamu(:,:) 
     979               zglam(:,:,2) = glamv(:,:) 
     980               zgphi(:,:,1) = gphiu(:,:) 
     981               zgphi(:,:,2) = gphiv(:,:) 
     982 
     983            CASE('plchltot') 
     984#if defined key_hadocc 
     985               ! Chlorophyll from HadOCC 
     986               zprofvar(:,:,:,1) = HADOCC_CHL(:,:,:) 
     987#elif defined key_medusa && defined key_foam_medusa 
     988               ! Add non-diatom and diatom chlorophyll from MEDUSA 
     989               zprofvar(:,:,:,1) = trn(:,:,:,jpchn) + trn(:,:,:,jpchd) 
     990#elif defined key_fabm 
     991               ! Add all chlorophyll groups from ERSEM 
     992               zprofvar(:,:,:,1) = trn(:,:,:,jp_fabm_chl1) + trn(:,:,:,jp_fabm_chl2) + & 
     993                  &                trn(:,:,:,jp_fabm_chl3) + trn(:,:,:,jp_fabm_chl4) 
     994#else 
     995               CALL ctl_stop( ' Trying to run plchltot observation operator', & 
     996                  &           ' but no biogeochemical model appears to have been defined' ) 
     997#endif 
     998               ! Take the log10 where we can, otherwise exclude 
     999               tiny = 1.0e-20 
     1000               WHERE(zprofvar(:,:,:,:) > tiny .AND. zprofvar(:,:,:,:) /= obfillflt ) 
     1001                  zprofvar(:,:,:,:)  = LOG10(zprofvar(:,:,:,:)) 
     1002               ELSEWHERE 
     1003                  zprofvar(:,:,:,:)  = obfillflt 
     1004                  zprofmask(:,:,:,:) = 0 
     1005               END WHERE 
     1006               ! Mask out model below any excluded values, 
     1007               ! to avoid interpolation issues 
     1008               DO jvar = 1, profdataqc(jtype)%nvar 
     1009                 DO jj = 1, jpj 
     1010                    DO ji = 1, jpi 
     1011                       depth_loop: DO jk = 1, jpk 
     1012                          IF ( zprofmask(ji,jj,jk,jvar) == 0 ) THEN 
     1013                             zprofmask(ji,jj,jk:jpk,jvar) = 0 
     1014                             EXIT depth_loop 
     1015                          ENDIF 
     1016                       END DO depth_loop 
     1017                    END DO 
     1018                 END DO 
     1019              END DO 
     1020 
     1021            CASE('pchltot') 
     1022#if defined key_hadocc 
     1023               ! Chlorophyll from HadOCC 
     1024               zprofvar(:,:,:,1) = HADOCC_CHL(:,:,:) 
     1025#elif defined key_medusa && defined key_foam_medusa 
     1026               ! Add non-diatom and diatom chlorophyll from MEDUSA 
     1027               zprofvar(:,:,:,1) = trn(:,:,:,jpchn) + trn(:,:,:,jpchd) 
     1028#elif defined key_fabm 
     1029               ! Add all chlorophyll groups from ERSEM 
     1030               zprofvar(:,:,:,1) = trn(:,:,:,jp_fabm_chl1) + trn(:,:,:,jp_fabm_chl2) + & 
     1031                  &                trn(:,:,:,jp_fabm_chl3) + trn(:,:,:,jp_fabm_chl4) 
     1032#else 
     1033               CALL ctl_stop( ' Trying to run pchltot observation operator', & 
     1034                  &           ' but no biogeochemical model appears to have been defined' ) 
     1035#endif 
     1036 
     1037            CASE('pno3') 
     1038#if defined key_hadocc 
     1039               ! Dissolved inorganic nitrogen from HadOCC 
     1040               zprofvar(:,:,:,1) = trn(:,:,:,jp_had_nut) 
     1041#elif defined key_medusa && defined key_foam_medusa 
     1042               ! Dissolved inorganic nitrogen from MEDUSA 
     1043               zprofvar(:,:,:,1) = trn(:,:,:,jpdin) 
     1044#elif defined key_fabm 
     1045               ! Nitrate from ERSEM 
     1046               zprofvar(:,:,:,1) = trn(:,:,:,jp_fabm_n3n) 
     1047#else 
     1048               CALL ctl_stop( ' Trying to run pno3 observation operator', & 
     1049                  &           ' but no biogeochemical model appears to have been defined' ) 
     1050#endif 
     1051 
     1052            CASE('psi4') 
     1053#if defined key_hadocc 
     1054               CALL ctl_stop( ' Trying to run psi4 observation operator', & 
     1055                  &           ' but HadOCC does not simulate silicate' ) 
     1056#elif defined key_medusa && defined key_foam_medusa 
     1057               ! Silicate from MEDUSA 
     1058               zprofvar(:,:,:,1) = trn(:,:,:,jpsil) 
     1059#elif defined key_fabm 
     1060               ! Silicate from ERSEM 
     1061               zprofvar(:,:,:,1) = trn(:,:,:,jp_fabm_n5s) 
     1062#else 
     1063               CALL ctl_stop( ' Trying to run psi4 observation operator', & 
     1064                  &           ' but no biogeochemical model appears to have been defined' ) 
     1065#endif 
     1066 
     1067            CASE('ppo4') 
     1068#if defined key_hadocc 
     1069               CALL ctl_stop( ' Trying to run ppo4 observation operator', & 
     1070                  &           ' but HadOCC does not simulate phosphate' ) 
     1071#elif defined key_medusa && defined key_foam_medusa 
     1072               CALL ctl_stop( ' Trying to run ppo4 observation operator', & 
     1073                  &           ' but MEDUSA does not simulate phosphate' ) 
     1074#elif defined key_fabm 
     1075               ! Phosphate from ERSEM 
     1076               zprofvar(:,:,:,1) = trn(:,:,:,jp_fabm_n1p) 
     1077#else 
     1078               CALL ctl_stop( ' Trying to run ppo4 observation operator', & 
     1079                  &           ' but no biogeochemical model appears to have been defined' ) 
     1080#endif 
     1081 
     1082            CASE('pdic') 
     1083#if defined key_hadocc 
     1084               ! Dissolved inorganic carbon from HadOCC 
     1085               zprofvar(:,:,:,1) = trn(:,:,:,jp_had_dic) 
     1086#elif defined key_medusa && defined key_foam_medusa 
     1087               ! Dissolved inorganic carbon from MEDUSA 
     1088               zprofvar(:,:,:,1) = trn(:,:,:,jpdic) 
     1089#elif defined key_fabm 
     1090               ! Dissolved inorganic carbon from ERSEM 
     1091               zprofvar(:,:,:,1) = trn(:,:,:,jp_fabm_o3c) 
     1092#else 
     1093               CALL ctl_stop( ' Trying to run pdic observation operator', & 
     1094                  &           ' but no biogeochemical model appears to have been defined' ) 
     1095#endif 
     1096 
     1097            CASE('palk') 
     1098#if defined key_hadocc 
     1099               ! Alkalinity from HadOCC 
     1100               zprofvar(:,:,:,1) = trn(:,:,:,jp_had_alk) 
     1101#elif defined key_medusa && defined key_foam_medusa 
     1102               ! Alkalinity from MEDUSA 
     1103               zprofvar(:,:,:,1) = trn(:,:,:,jpalk) 
     1104#elif defined key_fabm 
     1105               ! Alkalinity from ERSEM 
     1106               zprofvar(:,:,:,1) = trn(:,:,:,jp_fabm_o3a) 
     1107#else 
     1108               CALL ctl_stop( ' Trying to run palk observation operator', & 
     1109                  &           ' but no biogeochemical model appears to have been defined' ) 
     1110#endif 
     1111 
     1112            CASE('pph') 
     1113#if defined key_hadocc 
     1114               CALL ctl_stop( ' Trying to run pph observation operator', & 
     1115                  &           ' but HadOCC has no pH diagnostic defined' ) 
     1116#elif defined key_medusa && defined key_foam_medusa 
     1117               ! pH from MEDUSA 
     1118               zprofvar(:,:,:,1) = f3_pH(:,:,:) 
     1119#elif defined key_fabm 
     1120               ! pH from ERSEM 
     1121               zprofvar(:,:,:,1) = trn(:,:,:,jp_fabm_o3ph) 
     1122#else 
     1123               CALL ctl_stop( ' Trying to run pph observation operator', & 
     1124                  &           ' but no biogeochemical model appears to have been defined' ) 
     1125#endif 
     1126 
     1127            CASE('po2') 
     1128#if defined key_hadocc 
     1129               CALL ctl_stop( ' Trying to run po2 observation operator', & 
     1130                  &           ' but HadOCC does not simulate oxygen' ) 
     1131#elif defined key_medusa && defined key_foam_medusa 
     1132               ! Oxygen from MEDUSA 
     1133               zprofvar(:,:,:,1) = trn(:,:,:,jpoxy) 
     1134#elif defined key_fabm 
     1135               ! Oxygen from ERSEM 
     1136               zprofvar(:,:,:,1) = trn(:,:,:,jp_fabm_o2o) 
     1137#else 
     1138               CALL ctl_stop( ' Trying to run po2 observation operator', & 
     1139                  &           ' but no biogeochemical model appears to have been defined' ) 
     1140#endif 
     1141 
    7421142            CASE DEFAULT 
    7431143               CALL ctl_stop( 'Unknown profile observation type '//TRIM(cobstypesprof(jtype))//' in dia_obs' ) 
     1144 
    7441145            END SELECT 
    7451146 
    746             CALL obs_prof_opt( profdataqc(jtype), kstp, jpi, jpj, jpk,  & 
    747                &               nit000, idaystp,                         & 
    748                &               zprofvar1, zprofvar2,                    & 
    749                &               fsdept(:,:,:), fsdepw(:,:,:),            &  
    750                &               zprofmask1, zprofmask2,                  & 
    751                &               zglam1, zglam2, zgphi1, zgphi2,          & 
    752                &               nn_1dint, nn_2dint,                      & 
    753                &               kdailyavtypes = nn_profdavtypes ) 
     1147            DO jvar = 1, profdataqc(jtype)%nvar 
     1148               CALL obs_prof_opt( profdataqc(jtype), kstp, jpi, jpj, jpk,  & 
     1149                  &               nit000, idaystp, jvar,                   & 
     1150                  &               zprofvar(:,:,:,jvar),                    & 
     1151                  &               fsdept(:,:,:), fsdepw(:,:,:),            &  
     1152                  &               zprofmask(:,:,:,jvar),                   & 
     1153                  &               zglam(:,:,jvar), zgphi(:,:,jvar),        & 
     1154                  &               nn_1dint, nn_2dint_default,              & 
     1155                  &               kdailyavtypes = nn_profdavtypes ) 
     1156            END DO 
     1157 
     1158            CALL wrk_dealloc( jpi, jpj, jpk, profdataqc(jtype)%nvar, zprofvar  ) 
     1159            CALL wrk_dealloc( jpi, jpj, jpk, profdataqc(jtype)%nvar, zprofmask ) 
     1160            CALL wrk_dealloc( jpi, jpj,      profdataqc(jtype)%nvar, zglam     ) 
     1161            CALL wrk_dealloc( jpi, jpj,      profdataqc(jtype)%nvar, zgphi     ) 
    7541162 
    7551163         END DO 
     
    7581166 
    7591167      IF ( nsurftypes > 0 ) THEN 
     1168 
     1169         !Allocate local work arrays 
     1170         CALL wrk_alloc( jpi, jpj, zsurfvar ) 
     1171         CALL wrk_alloc( jpi, jpj, zsurfmask ) 
    7601172 
    7611173         DO jtype = 1, nsurftypes 
     
    7631175            !Defaults which might be changed 
    7641176            zsurfmask(:,:) = tmask(:,:,1) 
     1177            llog10 = .FALSE. 
    7651178 
    7661179            SELECT CASE ( TRIM(cobstypessurf(jtype)) ) 
     
    7931206               ENDIF 
    7941207 
    795             CASE('logchl') 
    796 #if defined key_hadocc 
    797                zsurfvar(:,:) = HADOCC_CHL(:,:,1)    ! (not log) chlorophyll from HadOCC 
     1208            CASE('slchltot') 
     1209#if defined key_hadocc 
     1210               ! Surface chlorophyll from HadOCC 
     1211               zsurfvar(:,:) = HADOCC_CHL(:,:,1) 
    7981212#elif defined key_medusa && defined key_foam_medusa 
    7991213               ! Add non-diatom and diatom surface chlorophyll from MEDUSA 
    8001214               zsurfvar(:,:) = trn(:,:,1,jpchn) + trn(:,:,1,jpchd) 
    8011215#elif defined key_fabm 
    802                chl_3d(:,:,:) = fabm_get_bulk_diagnostic_data(model, jp_fabmdia_chltot) 
    803                zsurfvar(:,:) = chl_3d(:,:,1) 
    804 #else 
    805                CALL ctl_stop( ' Trying to run logchl observation operator', & 
    806                   &           ' but no biogeochemical model appears to have been defined' ) 
    807 #endif 
    808                zsurfmask(:,:) = tmask(:,:,1)         ! create a special mask to exclude certain things 
    809                ! Take the log10 where we can, otherwise exclude 
    810                tiny = 1.0e-20 
    811                WHERE(zsurfvar(:,:) > tiny .AND. zsurfvar(:,:) /= obfillflt ) 
    812                   zsurfvar(:,:)  = LOG10(zsurfvar(:,:)) 
    813                ELSEWHERE 
    814                   zsurfvar(:,:)  = obfillflt 
    815                   zsurfmask(:,:) = 0 
    816                END WHERE 
    817             CASE('spm') 
     1216               ! Add all surface chlorophyll groups from ERSEM 
     1217               zsurfvar(:,:) = trn(:,:,1,jp_fabm_chl1) + trn(:,:,1,jp_fabm_chl2) + & 
     1218                  &            trn(:,:,1,jp_fabm_chl3) + trn(:,:,1,jp_fabm_chl4) 
     1219#else 
     1220               CALL ctl_stop( ' Trying to run slchltot observation operator', & 
     1221                  &           ' but no biogeochemical model appears to have been defined' ) 
     1222#endif 
     1223               llog10 = .TRUE. 
     1224 
     1225            CASE('slchldia') 
     1226#if defined key_hadocc 
     1227               CALL ctl_stop( ' Trying to run slchldia observation operator', & 
     1228                  &           ' but HadOCC does not explicitly simulate diatoms' ) 
     1229#elif defined key_medusa && defined key_foam_medusa 
     1230               ! Diatom surface chlorophyll from MEDUSA 
     1231               zsurfvar(:,:) = trn(:,:,1,jpchd) 
     1232#elif defined key_fabm 
     1233               ! Diatom surface chlorophyll from ERSEM 
     1234               zsurfvar(:,:) = trn(:,:,1,jp_fabm_chl1) 
     1235#else 
     1236               CALL ctl_stop( ' Trying to run slchldia observation operator', & 
     1237                  &           ' but no biogeochemical model appears to have been defined' ) 
     1238#endif 
     1239               llog10 = .TRUE. 
     1240 
     1241            CASE('slchlnon') 
     1242#if defined key_hadocc 
     1243               CALL ctl_stop( ' Trying to run slchlnon observation operator', & 
     1244                  &           ' but HadOCC does not explicitly simulate non-diatoms' ) 
     1245#elif defined key_medusa && defined key_foam_medusa 
     1246               ! Non-diatom surface chlorophyll from MEDUSA 
     1247               zsurfvar(:,:) = trn(:,:,1,jpchn) 
     1248#elif defined key_fabm 
     1249               ! Add all non-diatom surface chlorophyll groups from ERSEM 
     1250               zsurfvar(:,:) = trn(:,:,1,jp_fabm_chl2) + & 
     1251                  &            trn(:,:,1,jp_fabm_chl3) + trn(:,:,1,jp_fabm_chl4) 
     1252#else 
     1253               CALL ctl_stop( ' Trying to run slchlnon observation operator', & 
     1254                  &           ' but no biogeochemical model appears to have been defined' ) 
     1255#endif 
     1256               llog10 = .TRUE. 
     1257 
     1258            CASE('slchldin') 
     1259#if defined key_hadocc 
     1260               CALL ctl_stop( ' Trying to run slchldin observation operator', & 
     1261                  &           ' but HadOCC does not explicitly simulate dinoflagellates' ) 
     1262#elif defined key_medusa && defined key_foam_medusa 
     1263               CALL ctl_stop( ' Trying to run slchldin observation operator', & 
     1264                  &           ' but MEDUSA does not explicitly simulate dinoflagellates' ) 
     1265#elif defined key_fabm 
     1266               ! Dinoflagellate surface chlorophyll from ERSEM 
     1267               zsurfvar(:,:) = trn(:,:,1,jp_fabm_chl4) 
     1268#else 
     1269               CALL ctl_stop( ' Trying to run slchldin observation operator', & 
     1270                  &           ' but no biogeochemical model appears to have been defined' ) 
     1271#endif 
     1272               llog10 = .TRUE. 
     1273 
     1274            CASE('slchlmic') 
     1275#if defined key_hadocc 
     1276               CALL ctl_stop( ' Trying to run slchlmic observation operator', & 
     1277                  &           ' but HadOCC does not explicitly simulate microphytoplankton' ) 
     1278#elif defined key_medusa && defined key_foam_medusa 
     1279               CALL ctl_stop( ' Trying to run slchlmic observation operator', & 
     1280                  &           ' but MEDUSA does not explicitly simulate microphytoplankton' ) 
     1281#elif defined key_fabm 
     1282               ! Add diatom and dinoflagellate surface chlorophyll from ERSEM 
     1283               zsurfvar(:,:) = trn(:,:,1,jp_fabm_chl1) + trn(:,:,1,jp_fabm_chl4) 
     1284#else 
     1285               CALL ctl_stop( ' Trying to run slchlmic observation operator', & 
     1286                  &           ' but no biogeochemical model appears to have been defined' ) 
     1287#endif 
     1288               llog10 = .TRUE. 
     1289 
     1290            CASE('slchlnan') 
     1291#if defined key_hadocc 
     1292               CALL ctl_stop( ' Trying to run slchlnan observation operator', & 
     1293                  &           ' but HadOCC does not explicitly simulate nanophytoplankton' ) 
     1294#elif defined key_medusa && defined key_foam_medusa 
     1295               CALL ctl_stop( ' Trying to run slchlnan observation operator', & 
     1296                  &           ' but MEDUSA does not explicitly simulate nanophytoplankton' ) 
     1297#elif defined key_fabm 
     1298               ! Nanophytoplankton surface chlorophyll from ERSEM 
     1299               zsurfvar(:,:) = trn(:,:,1,jp_fabm_chl2) 
     1300#else 
     1301               CALL ctl_stop( ' Trying to run slchlnan observation operator', & 
     1302                  &           ' but no biogeochemical model appears to have been defined' ) 
     1303#endif 
     1304               llog10 = .TRUE. 
     1305 
     1306            CASE('slchlpic') 
     1307#if defined key_hadocc 
     1308               CALL ctl_stop( ' Trying to run slchlpic observation operator', & 
     1309                  &           ' but HadOCC does not explicitly simulate picophytoplankton' ) 
     1310#elif defined key_medusa && defined key_foam_medusa 
     1311               CALL ctl_stop( ' Trying to run slchlpic observation operator', & 
     1312                  &           ' but MEDUSA does not explicitly simulate picophytoplankton' ) 
     1313#elif defined key_fabm 
     1314               ! Picophytoplankton surface chlorophyll from ERSEM 
     1315               zsurfvar(:,:) = trn(:,:,1,jp_fabm_chl3) 
     1316#else 
     1317               CALL ctl_stop( ' Trying to run slchlpic observation operator', & 
     1318                  &           ' but no biogeochemical model appears to have been defined' ) 
     1319#endif 
     1320               llog10 = .TRUE. 
     1321 
     1322            CASE('schltot') 
     1323#if defined key_hadocc 
     1324               ! Surface chlorophyll from HadOCC 
     1325               zsurfvar(:,:) = HADOCC_CHL(:,:,1) 
     1326#elif defined key_medusa && defined key_foam_medusa 
     1327               ! Add non-diatom and diatom surface chlorophyll from MEDUSA 
     1328               zsurfvar(:,:) = trn(:,:,1,jpchn) + trn(:,:,1,jpchd) 
     1329#elif defined key_fabm 
     1330               ! Add all surface chlorophyll groups from ERSEM 
     1331               zsurfvar(:,:) = trn(:,:,1,jp_fabm_chl1) + trn(:,:,1,jp_fabm_chl2) + & 
     1332                  &            trn(:,:,1,jp_fabm_chl3) + trn(:,:,1,jp_fabm_chl4) 
     1333#else 
     1334               CALL ctl_stop( ' Trying to run schltot observation operator', & 
     1335                  &           ' but no biogeochemical model appears to have been defined' ) 
     1336#endif 
     1337 
     1338            CASE('slphytot') 
     1339#if defined key_hadocc 
     1340               ! Surface phytoplankton nitrogen from HadOCC multiplied by C:N ratio 
     1341               zsurfvar(:,:) = trn(:,:,1,jp_had_phy) * c2n_p 
     1342#elif defined key_medusa && defined key_foam_medusa 
     1343               ! Add non-diatom and diatom surface phytoplankton nitrogen from MEDUSA 
     1344               ! multiplied by C:N ratio for each 
     1345               zsurfvar(:,:) = (trn(:,:,1,jpphn) * xthetapn) + (trn(:,:,1,jpphd) * xthetapd) 
     1346#elif defined key_fabm 
     1347               ! Add all surface phytoplankton carbon groups from ERSEM 
     1348               zsurfvar(:,:) = trn(:,:,1,jp_fabm_p1c) + trn(:,:,1,jp_fabm_p2c) + & 
     1349                  &            trn(:,:,1,jp_fabm_p3c) + trn(:,:,1,jp_fabm_p4c) 
     1350#else 
     1351               CALL ctl_stop( ' Trying to run slphytot observation operator', & 
     1352                  &           ' but no biogeochemical model appears to have been defined' ) 
     1353#endif 
     1354               llog10 = .TRUE. 
     1355 
     1356            CASE('slphydia') 
     1357#if defined key_hadocc 
     1358               CALL ctl_stop( ' Trying to run slphydia observation operator', & 
     1359                  &           ' but HadOCC does not explicitly simulate diatoms' ) 
     1360#elif defined key_medusa && defined key_foam_medusa 
     1361               ! Diatom surface phytoplankton nitrogen from MEDUSA multiplied by C:N ratio 
     1362               zsurfvar(:,:) = trn(:,:,1,jpphd) * xthetapd 
     1363#elif defined key_fabm 
     1364               ! Diatom surface phytoplankton carbon from ERSEM 
     1365               zsurfvar(:,:) = trn(:,:,1,jp_fabm_p1c) 
     1366#else 
     1367               CALL ctl_stop( ' Trying to run slphydia observation operator', & 
     1368                  &           ' but no biogeochemical model appears to have been defined' ) 
     1369#endif 
     1370               llog10 = .TRUE. 
     1371 
     1372            CASE('slphynon') 
     1373#if defined key_hadocc 
     1374               CALL ctl_stop( ' Trying to run slphynon observation operator', & 
     1375                  &           ' but HadOCC does not explicitly simulate non-diatoms' ) 
     1376#elif defined key_medusa && defined key_foam_medusa 
     1377               ! Non-diatom surface phytoplankton nitrogen from MEDUSA multiplied by C:N ratio 
     1378               zsurfvar(:,:) = trn(:,:,1,jpphn) * xthetapn 
     1379#elif defined key_fabm 
     1380               ! Add all non-diatom surface phytoplankton carbon groups from ERSEM 
     1381               zsurfvar(:,:) = trn(:,:,1,jp_fabm_p2c) + & 
     1382                  &            trn(:,:,1,jp_fabm_p3c) + trn(:,:,1,jp_fabm_p4c) 
     1383#else 
     1384               CALL ctl_stop( ' Trying to run slphynon observation operator', & 
     1385                  &           ' but no biogeochemical model appears to have been defined' ) 
     1386#endif 
     1387               llog10 = .TRUE. 
     1388 
     1389            CASE('sspm') 
    8181390#if defined key_spm 
    8191391               zsurfvar(:,:) = 0.0 
     
    8221394               END DO 
    8231395#else 
    824                CALL ctl_stop( ' Trying to run spm observation operator', & 
     1396               CALL ctl_stop( ' Trying to run sspm observation operator', & 
    8251397                  &           ' but no spm model appears to have been defined' ) 
    8261398#endif 
    827             CASE('fco2') 
     1399 
     1400            CASE('sfco2') 
    8281401#if defined key_hadocc 
    8291402               zsurfvar(:,:) = HADOCC_FCO2(:,:)    ! fCO2 from HadOCC 
     
    8611434                  &            (82.0578 * (tsn(:,:,1,jp_tem)+rt0))) 
    8621435#else 
    863                CALL ctl_stop( ' Trying to run fco2 observation operator', & 
    864                   &           ' but no biogeochemical model appears to have been defined' ) 
    865 #endif 
    866             CASE('pco2') 
     1436               CALL ctl_stop( ' Trying to run sfco2 observation operator', & 
     1437                  &           ' but no biogeochemical model appears to have been defined' ) 
     1438#endif 
     1439 
     1440            CASE('spco2') 
    8671441#if defined key_hadocc 
    8681442               zsurfvar(:,:) = HADOCC_PCO2(:,:)    ! pCO2 from HadOCC 
     
    8801454               zsurfvar(:,:) = pco2_3d(:,:,1) 
    8811455#else 
    882                CALL ctl_stop( ' Trying to run pCO2 observation operator', & 
     1456               CALL ctl_stop( ' Trying to run spco2 observation operator', & 
    8831457                  &           ' but no biogeochemical model appears to have been defined' ) 
    8841458#endif 
     
    8891463 
    8901464            END SELECT 
     1465             
     1466            IF ( llog10 ) THEN 
     1467               ! Take the log10 where we can, otherwise exclude 
     1468               tiny = 1.0e-20 
     1469               WHERE(zsurfvar(:,:) > tiny .AND. zsurfvar(:,:) /= obfillflt ) 
     1470                  zsurfvar(:,:)  = LOG10(zsurfvar(:,:)) 
     1471               ELSEWHERE 
     1472                  zsurfvar(:,:)  = obfillflt 
     1473                  zsurfmask(:,:) = 0 
     1474               END WHERE 
     1475            ENDIF 
    8911476 
    8921477            CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj,       & 
     
    8981483         END DO 
    8991484 
     1485         CALL wrk_dealloc( jpi, jpj, zsurfvar ) 
     1486         CALL wrk_dealloc( jpi, jpj, zsurfmask ) 
     1487 
    9001488      ENDIF 
    901  
    902       CALL wrk_dealloc( jpi, jpj, jpk, zprofvar1 ) 
    903       CALL wrk_dealloc( jpi, jpj, jpk, zprofvar2 ) 
    904       CALL wrk_dealloc( jpi, jpj, jpk, zprofmask1 ) 
    905       CALL wrk_dealloc( jpi, jpj, jpk, zprofmask2 ) 
    906       CALL wrk_dealloc( jpi, jpj, zsurfvar ) 
    907       CALL wrk_dealloc( jpi, jpj, zsurfmask ) 
    908       CALL wrk_dealloc( jpi, jpj, zglam1 ) 
    909       CALL wrk_dealloc( jpi, jpj, zglam2 ) 
    910       CALL wrk_dealloc( jpi, jpj, zgphi1 ) 
    911       CALL wrk_dealloc( jpi, jpj, zgphi2 ) 
    9121489 
    9131490   END SUBROUTINE dia_obs 
     
    9601537                  & ) 
    9611538 
    962                CALL obs_rotvel( profdataqc(jtype), nn_2dint, zu, zv ) 
     1539               CALL obs_rotvel( profdataqc(jtype), nn_2dint_default, zu, zv ) 
    9631540 
    9641541               DO jo = 1, profdataqc(jtype)%nprof 
     
    11931770    END SUBROUTINE fin_date 
    11941771 
    1195     SUBROUTINE obs_settypefiles( ntypes, jpmaxnfiles, jtype, ctypein, & 
    1196        &                         cfilestype, ifiles, cobstypes, cfiles ) 
    1197  
    1198     INTEGER, INTENT(IN) :: ntypes      ! Total number of obs types 
    1199     INTEGER, INTENT(IN) :: jpmaxnfiles ! Maximum number of files allowed for each type 
    1200     INTEGER, INTENT(IN) :: jtype       ! Index of the current type of obs 
    1201     INTEGER, DIMENSION(ntypes), INTENT(INOUT) :: & 
    1202        &                   ifiles      ! Out appended number of files for this type 
    1203  
    1204     CHARACTER(len=6), INTENT(IN) :: ctypein  
    1205     CHARACTER(len=128), DIMENSION(jpmaxnfiles), INTENT(IN) :: & 
    1206        &                   cfilestype  ! In list of files for this obs type 
    1207     CHARACTER(len=6), DIMENSION(ntypes), INTENT(INOUT) :: & 
    1208        &                   cobstypes   ! Out appended list of obs types 
    1209     CHARACTER(len=128), DIMENSION(ntypes, jpmaxnfiles), INTENT(INOUT) :: & 
    1210        &                   cfiles      ! Out appended list of files for all types 
    1211  
    1212     !Local variables 
    1213     INTEGER :: jfile 
    1214  
    1215     cfiles(jtype,:) = cfilestype(:) 
    1216     cobstypes(jtype) = ctypein 
    1217     ifiles(jtype) = 0 
    1218     DO jfile = 1, jpmaxnfiles 
    1219        IF ( trim(cfiles(jtype,jfile)) /= '' ) & 
    1220                  ifiles(jtype) = ifiles(jtype) + 1 
    1221     END DO 
    1222  
    1223     IF ( ifiles(jtype) == 0 ) THEN 
    1224          CALL ctl_stop( 'Logical for observation type '//TRIM(ctypein)//   & 
    1225             &           ' set to true but no files available to read' ) 
    1226     ENDIF 
    1227  
    1228     IF(lwp) THEN     
    1229        WRITE(numout,*) '             '//cobstypes(jtype)//' input observation file names:' 
    1230        DO jfile = 1, ifiles(jtype) 
    1231           WRITE(numout,*) '                '//TRIM(cfiles(jtype,jfile)) 
     1772    SUBROUTINE obs_settypefiles( ntypes, jpmaxnfiles, ifiles, cobstypes, cfiles ) 
     1773 
     1774       INTEGER, INTENT(IN) :: ntypes      ! Total number of obs types 
     1775       INTEGER, INTENT(IN) :: jpmaxnfiles ! Maximum number of files allowed for each type 
     1776       INTEGER, DIMENSION(ntypes), INTENT(OUT) :: & 
     1777          &                   ifiles      ! Out number of files for each type 
     1778       CHARACTER(len=8), DIMENSION(ntypes), INTENT(IN) :: & 
     1779          &                   cobstypes   ! List of obs types 
     1780       CHARACTER(len=128), DIMENSION(ntypes, jpmaxnfiles), INTENT(IN) :: & 
     1781          &                   cfiles      ! List of files for all types 
     1782 
     1783       !Local variables 
     1784       INTEGER :: jfile 
     1785       INTEGER :: jtype 
     1786 
     1787       DO jtype = 1, ntypes 
     1788 
     1789          ifiles(jtype) = 0 
     1790          DO jfile = 1, jpmaxnfiles 
     1791             IF ( trim(cfiles(jtype,jfile)) /= '' ) & 
     1792                       ifiles(jtype) = ifiles(jtype) + 1 
     1793          END DO 
     1794 
     1795          IF ( ifiles(jtype) == 0 ) THEN 
     1796               CALL ctl_stop( 'Logical for observation type '//TRIM(cobstypes(jtype))//   & 
     1797                  &           ' set to true but no files available to read' ) 
     1798          ENDIF 
     1799 
     1800          IF(lwp) THEN     
     1801             WRITE(numout,*) '             '//cobstypes(jtype)//' input observation file names:' 
     1802             DO jfile = 1, ifiles(jtype) 
     1803                WRITE(numout,*) '                '//TRIM(cfiles(jtype,jfile)) 
     1804             END DO 
     1805          ENDIF 
     1806 
    12321807       END DO 
    1233     ENDIF 
    12341808 
    12351809    END SUBROUTINE obs_settypefiles 
     
    12421816               &                  lfpindegs, lavnight ) 
    12431817 
    1244     INTEGER, INTENT(IN)  :: ntypes             ! Total number of obs types 
    1245     INTEGER, INTENT(IN)  :: jtype              ! Index of the current type of obs 
    1246     INTEGER, INTENT(IN)  :: n2dint_default     ! Default option for interpolation type 
    1247     INTEGER, INTENT(IN)  :: n2dint_type        ! Option for interpolation type 
    1248     REAL(wp), INTENT(IN) :: & 
    1249        &                    ravglamscl_type, & !E/W diameter of obs footprint for this type 
    1250        &                    ravgphiscl_type    !N/S diameter of obs footprint for this type 
    1251     LOGICAL, INTENT(IN)  :: lfp_indegs_type    !T=> footprint in degrees, F=> in metres 
    1252     LOGICAL, INTENT(IN)  :: lavnight_type      !T=> obs represent night time average 
    1253     CHARACTER(len=6), INTENT(IN) :: ctypein  
    1254  
    1255     INTEGER, DIMENSION(ntypes), INTENT(INOUT) :: & 
    1256        &                    n2dint  
    1257     REAL(wp), DIMENSION(ntypes), INTENT(INOUT) :: & 
    1258        &                    ravglamscl, ravgphiscl 
    1259     LOGICAL, DIMENSION(ntypes), INTENT(INOUT) :: & 
    1260        &                    lfpindegs, lavnight 
    1261  
    1262     lavnight(jtype) = lavnight_type 
    1263  
    1264     IF ( (n2dint_type >= 1) .AND. (n2dint_type <= 6) ) THEN 
    1265        n2dint(jtype) = n2dint_type 
    1266     ELSE 
    1267        n2dint(jtype) = n2dint_default 
    1268     ENDIF 
    1269  
    1270     ! For averaging observation footprints set options for size of footprint  
    1271     IF ( (n2dint(jtype) > 4) .AND. (n2dint(jtype) <= 6) ) THEN 
    1272        IF ( ravglamscl_type > 0._wp ) THEN 
    1273           ravglamscl(jtype) = ravglamscl_type 
     1818       INTEGER, INTENT(IN)  :: ntypes             ! Total number of obs types 
     1819       INTEGER, INTENT(IN)  :: jtype              ! Index of the current type of obs 
     1820       INTEGER, INTENT(IN)  :: n2dint_default     ! Default option for interpolation type 
     1821       INTEGER, INTENT(IN)  :: n2dint_type        ! Option for interpolation type 
     1822       REAL(wp), INTENT(IN) :: & 
     1823          &                    ravglamscl_type, & !E/W diameter of obs footprint for this type 
     1824          &                    ravgphiscl_type    !N/S diameter of obs footprint for this type 
     1825       LOGICAL, INTENT(IN)  :: lfp_indegs_type    !T=> footprint in degrees, F=> in metres 
     1826       LOGICAL, INTENT(IN)  :: lavnight_type      !T=> obs represent night time average 
     1827       CHARACTER(len=8), INTENT(IN) :: ctypein  
     1828 
     1829       INTEGER, DIMENSION(ntypes), INTENT(INOUT) :: & 
     1830          &                    n2dint  
     1831       REAL(wp), DIMENSION(ntypes), INTENT(INOUT) :: & 
     1832          &                    ravglamscl, ravgphiscl 
     1833       LOGICAL, DIMENSION(ntypes), INTENT(INOUT) :: & 
     1834          &                    lfpindegs, lavnight 
     1835 
     1836       lavnight(jtype) = lavnight_type 
     1837 
     1838       IF ( (n2dint_type >= 0) .AND. (n2dint_type <= 6) ) THEN 
     1839          n2dint(jtype) = n2dint_type 
     1840       ELSE IF ( n2dint_type == -1 ) THEN 
     1841          n2dint(jtype) = n2dint_default 
    12741842       ELSE 
    1275           CALL ctl_stop( 'Incorrect value set for averaging footprint '// & 
    1276                          'scale (ravglamscl) for observation type '//TRIM(ctypein) )       
     1843          CALL ctl_stop(' Choice of '//TRIM(ctypein)//' horizontal (2D) interpolation method', & 
     1844            &                    ' is not available') 
    12771845       ENDIF 
    12781846 
    1279        IF ( ravgphiscl_type > 0._wp ) THEN 
    1280           ravgphiscl(jtype) = ravgphiscl_type 
    1281        ELSE 
    1282           CALL ctl_stop( 'Incorrect value set for averaging footprint '// & 
    1283                          'scale (ravgphiscl) for observation type '//TRIM(ctypein) )       
     1847       ! For averaging observation footprints set options for size of footprint  
     1848       IF ( (n2dint(jtype) > 4) .AND. (n2dint(jtype) <= 6) ) THEN 
     1849          IF ( ravglamscl_type > 0._wp ) THEN 
     1850             ravglamscl(jtype) = ravglamscl_type 
     1851          ELSE 
     1852             CALL ctl_stop( 'Incorrect value set for averaging footprint '// & 
     1853                            'scale (ravglamscl) for observation type '//TRIM(ctypein) )       
     1854          ENDIF 
     1855 
     1856          IF ( ravgphiscl_type > 0._wp ) THEN 
     1857             ravgphiscl(jtype) = ravgphiscl_type 
     1858          ELSE 
     1859             CALL ctl_stop( 'Incorrect value set for averaging footprint '// & 
     1860                            'scale (ravgphiscl) for observation type '//TRIM(ctypein) )       
     1861          ENDIF 
     1862 
     1863          lfpindegs(jtype) = lfp_indegs_type  
     1864 
    12841865       ENDIF 
    12851866 
    1286        lfpindegs(jtype) = lfp_indegs_type  
    1287  
    1288     ENDIF 
    1289  
    1290     ! Write out info  
    1291     IF(lwp) THEN 
    1292        IF ( n2dint(jtype) <= 4 ) THEN 
    1293           WRITE(numout,*) '             '//TRIM(ctypein)// & 
    1294              &            ' model counterparts will be interpolated horizontally' 
    1295        ELSE IF ( n2dint(jtype) <= 6 ) THEN 
    1296           WRITE(numout,*) '             '//TRIM(ctypein)// & 
    1297              &            ' model counterparts will be averaged horizontally' 
    1298           WRITE(numout,*) '             '//'    with E/W scale: ',ravglamscl(jtype) 
    1299           WRITE(numout,*) '             '//'    with N/S scale: ',ravgphiscl(jtype) 
    1300           IF ( lfpindegs(jtype) ) THEN 
    1301               WRITE(numout,*) '             '//'    (in degrees)' 
    1302           ELSE 
    1303               WRITE(numout,*) '             '//'    (in metres)' 
     1867       ! Write out info  
     1868       IF(lwp) THEN 
     1869          IF ( n2dint(jtype) <= 4 ) THEN 
     1870             WRITE(numout,*) '             '//TRIM(ctypein)// & 
     1871                &            ' model counterparts will be interpolated horizontally' 
     1872          ELSE IF ( n2dint(jtype) <= 6 ) THEN 
     1873             WRITE(numout,*) '             '//TRIM(ctypein)// & 
     1874                &            ' model counterparts will be averaged horizontally' 
     1875             WRITE(numout,*) '             '//'    with E/W scale: ',ravglamscl(jtype) 
     1876             WRITE(numout,*) '             '//'    with N/S scale: ',ravgphiscl(jtype) 
     1877             IF ( lfpindegs(jtype) ) THEN 
     1878                 WRITE(numout,*) '             '//'    (in degrees)' 
     1879             ELSE 
     1880                 WRITE(numout,*) '             '//'    (in metres)' 
     1881             ENDIF 
    13041882          ENDIF 
    13051883       ENDIF 
    1306     ENDIF 
    13071884 
    13081885    END SUBROUTINE obs_setinterpopts 
  • branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90

    r8653 r9306  
    6060 
    6161 
    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,           & 
     62   SUBROUTINE obs_prof_opt( prodatqc, kt, kpi, kpj, kpk, & 
     63      &                     kit000, kdaystp, kvar,       & 
     64      &                     pvar, pgdept, pgdepw,        & 
     65      &                     pmask,                       &   
     66      &                     plam, pphi,                  & 
    6767      &                     k1dint, k2dint, kdailyavtypes ) 
    6868 
     
    134134      INTEGER, INTENT(IN) :: k2dint  ! Horizontal interpolation type (see header) 
    135135      INTEGER, INTENT(IN) :: kdaystp ! Number of time steps per day 
     136      INTEGER, INTENT(IN) :: kvar    ! Number of variable in prodatqc 
    136137      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 
    137          & pvar1,    &               ! Model field 1 
    138          & pvar2,    &               ! Model field 2 
    139          & pmask1,   &               ! Land-sea mask 1 
    140          & pmask2                    ! Land-sea mask 2 
     138         & pvar,   &                 ! Model field for variable 
     139         & pmask                     ! Land-sea mask for variable 
    141140      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 
     141         & plam,   &                 ! Model longitudes for variable 
     142         & pphi                      ! Model latitudes for variable 
    146143      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &  
    147144         & pgdept, &                 ! Model array of depth T levels  
     
    166163         & idailyavtypes 
    167164      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 
    168          & igrdi1, & 
    169          & igrdi2, & 
    170          & igrdj1, & 
    171          & igrdj2 
     165         & igrdi, & 
     166         & igrdj 
    172167      INTEGER, ALLOCATABLE, DIMENSION(:) :: iv_indic 
    173168 
     
    176171      REAL(KIND=wp) :: zdaystp 
    177172      REAL(KIND=wp), DIMENSION(kpk) :: & 
    178          & zobsmask1, & 
    179          & zobsmask2, & 
    180173         & zobsk,    & 
    181174         & zobs2k 
    182175      REAL(KIND=wp), DIMENSION(2,2,1) :: & 
    183176         & zweig1, & 
    184          & zweig2, & 
    185177         & zweig 
    186178      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: & 
    187          & zmask1, & 
    188          & zmask2, & 
    189          & zint1,  & 
    190          & zint2,  & 
    191          & zinm1,  & 
    192          & zinm2,  & 
     179         & zmask,  & 
     180         & zint,   & 
     181         & zinm,   & 
    193182         & zgdept, &  
    194183         & zgdepw 
    195184      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 
    196          & zglam1, & 
    197          & zglam2, & 
    198          & zgphi1, & 
    199          & zgphi2 
    200       REAL(KIND=wp), DIMENSION(1) :: zmsk_1, zmsk_2    
     185         & zglam,  & 
     186         & zgphi 
     187      REAL(KIND=wp), DIMENSION(1) :: zmsk 
    201188      REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: interp_corner 
    202189 
     
    230217               DO jj = 1, jpj 
    231218                  DO ji = 1, jpi 
    232                      prodatqc%vdmean(ji,jj,jk,1) = 0.0 
    233                      prodatqc%vdmean(ji,jj,jk,2) = 0.0 
     219                     prodatqc%vdmean(ji,jj,jk,kvar) = 0.0 
    234220                  END DO 
    235221               END DO 
     
    240226            DO jj = 1, jpj 
    241227               DO ji = 1, jpi 
    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) 
     228                  ! Increment field for computing daily mean 
     229                  prodatqc%vdmean(ji,jj,jk,kvar) = prodatqc%vdmean(ji,jj,jk,kvar) & 
     230                     &                           + pvar(ji,jj,jk) 
    248231               END DO 
    249232            END DO 
     
    258241               DO jj = 1, jpj 
    259242                  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 
     243                     prodatqc%vdmean(ji,jj,jk,kvar) = prodatqc%vdmean(ji,jj,jk,kvar) & 
     244                        &                           * zdaystp 
    264245                  END DO 
    265246               END DO 
     
    271252      ! Get the data for interpolation 
    272253      ALLOCATE( & 
    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),   & 
     254         & igrdi(2,2,ipro),       & 
     255         & igrdj(2,2,ipro),       & 
     256         & zglam(2,2,ipro),       & 
     257         & zgphi(2,2,ipro),       & 
     258         & zmask(2,2,kpk,ipro),   & 
     259         & zint(2,2,kpk,ipro),    & 
    285260         & zgdept(2,2,kpk,ipro),  &  
    286261         & zgdepw(2,2,kpk,ipro)   &  
     
    289264      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 
    290265         iobs = jobs - prodatqc%nprofup 
    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) 
     266         igrdi(1,1,iobs) = prodatqc%mi(jobs,kvar)-1 
     267         igrdj(1,1,iobs) = prodatqc%mj(jobs,kvar)-1 
     268         igrdi(1,2,iobs) = prodatqc%mi(jobs,kvar)-1 
     269         igrdj(1,2,iobs) = prodatqc%mj(jobs,kvar) 
     270         igrdi(2,1,iobs) = prodatqc%mi(jobs,kvar) 
     271         igrdj(2,1,iobs) = prodatqc%mj(jobs,kvar)-1 
     272         igrdi(2,2,iobs) = prodatqc%mi(jobs,kvar) 
     273         igrdj(2,2,iobs) = prodatqc%mj(jobs,kvar) 
    307274      END DO 
    308275 
     
    311278      zgdepw(:,:,:,:) = 0.0 
    312279 
    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 )  
     280      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi, igrdj, plam, zglam ) 
     281      CALL obs_int_comm_2d( 2, 2, ipro, kpi, kpj, igrdi, igrdj, pphi, zgphi ) 
     282      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pmask, zmask ) 
     283      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pvar,   zint ) 
     284 
     285      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pgdept, zgdept )  
     286      CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, pgdepw, zgdepw )  
    325287 
    326288      ! At the end of the day also get interpolated means 
    327289      IF ( ld_dailyav .AND. idayend == 0 ) THEN 
    328290 
    329          ALLOCATE( & 
    330             & zinm1(2,2,kpk,ipro),  & 
    331             & zinm2(2,2,kpk,ipro)   & 
    332             & ) 
    333  
    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 ) 
     291         ALLOCATE( zinm(2,2,kpk,ipro) ) 
     292 
     293         CALL obs_int_comm_3d( 2, 2, ipro, kpi, kpj, kpk, igrdi, igrdj, & 
     294            &                  prodatqc%vdmean(:,:,:,kvar), zinm ) 
    338295 
    339296      ENDIF 
     
    370327         ! Horizontal weights  
    371328         ! Masked values are calculated later.   
    372          IF ( prodatqc%npvend(jobs,1) > 0 ) THEN 
     329         IF ( prodatqc%npvend(jobs,kvar) > 0 ) THEN 
    373330 
    374331            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 
     332               &                   zglam(:,:,iobs), zgphi(:,:,iobs), & 
     333               &                   zmask(:,:,1,iobs), zweig1, zmsk ) 
     334 
     335         ENDIF 
     336 
     337         IF ( prodatqc%npvend(jobs,kvar) > 0 ) THEN 
    389338 
    390339            zobsk(:) = obfillflt 
     
    396345 
    397346                  ! vertically interpolate all 4 corners  
    398                   ista = prodatqc%npvsta(jobs,1)  
    399                   iend = prodatqc%npvend(jobs,1)  
     347                  ista = prodatqc%npvsta(jobs,kvar)  
     348                  iend = prodatqc%npvend(jobs,kvar)  
    400349                  inum_obs = iend - ista + 1  
    401350                  ALLOCATE(interp_corner(2,2,inum_obs),iv_indic(inum_obs))  
     
    406355                        IF ( k1dint == 1 ) THEN  
    407356                           CALL obs_int_z1d_spl( kpk, &  
    408                               &     zinm1(iin,ijn,:,iobs), &  
     357                              &     zinm(iin,ijn,:,iobs), &  
    409358                              &     zobs2k, zgdept(iin,ijn,:,iobs), &  
    410                               &     zmask1(iin,ijn,:,iobs))  
     359                              &     zmask(iin,ijn,:,iobs))  
    411360                        ENDIF  
    412361        
    413362                        CALL obs_level_search(kpk, &  
    414363                           &    zgdept(iin,ijn,:,iobs), &  
    415                            &    inum_obs, prodatqc%var(1)%vdep(ista:iend), &  
     364                           &    inum_obs, prodatqc%var(kvar)%vdep(ista:iend), &  
    416365                           &    iv_indic)  
    417366 
    418367                        CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, &  
    419                            &    prodatqc%var(1)%vdep(ista:iend), &  
    420                            &    zinm1(iin,ijn,:,iobs), &  
     368                           &    prodatqc%var(kvar)%vdep(ista:iend), &  
     369                           &    zinm(iin,ijn,:,iobs), &  
    421370                           &    zobs2k, interp_corner(iin,ijn,:), &  
    422371                           &    zgdept(iin,ijn,:,iobs), &  
    423                            &    zmask1(iin,ijn,:,iobs))  
     372                           &    zmask(iin,ijn,:,iobs))  
    424373        
    425374                     ENDDO  
     
    433382      
    434383               ! vertically interpolate all 4 corners  
    435                ista = prodatqc%npvsta(jobs,1)  
    436                iend = prodatqc%npvend(jobs,1)  
     384               ista = prodatqc%npvsta(jobs,kvar)  
     385               iend = prodatqc%npvend(jobs,kvar)  
    437386               inum_obs = iend - ista + 1  
    438387               ALLOCATE(interp_corner(2,2,inum_obs), iv_indic(inum_obs))  
     
    442391                     IF ( k1dint == 1 ) THEN  
    443392                        CALL obs_int_z1d_spl( kpk, &  
    444                            &    zint1(iin,ijn,:,iobs),&  
     393                           &    zint(iin,ijn,:,iobs),&  
    445394                           &    zobs2k, zgdept(iin,ijn,:,iobs), &  
    446                            &    zmask1(iin,ijn,:,iobs))  
     395                           &    zmask(iin,ijn,:,iobs))  
    447396   
    448397                     ENDIF  
     
    450399                     CALL obs_level_search(kpk, &  
    451400                         &        zgdept(iin,ijn,:,iobs),&  
    452                          &        inum_obs, prodatqc%var(1)%vdep(ista:iend), &  
     401                         &        inum_obs, prodatqc%var(kvar)%vdep(ista:iend), &  
    453402                         &        iv_indic)  
    454403 
    455404                     CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs,     &  
    456                          &          prodatqc%var(1)%vdep(ista:iend),     &  
    457                          &          zint1(iin,ijn,:,iobs),            &  
     405                         &          prodatqc%var(kvar)%vdep(ista:iend),     &  
     406                         &          zint(iin,ijn,:,iobs),            &  
    458407                         &          zobs2k,interp_corner(iin,ijn,:), &  
    459408                         &          zgdept(iin,ijn,:,iobs),         &  
    460                          &          zmask1(iin,ijn,:,iobs) )       
     409                         &          zmask(iin,ijn,:,iobs) )       
    461410          
    462411                  ENDDO  
     
    482431                  DO ijn=1,2  
    483432      
    484                      depth_loop1: DO ik=kpk,2,-1  
    485                         IF(zmask1(iin,ijn,ik-1,iobs ) > 0.9 )THEN    
     433                     depth_loop: DO ik=kpk,2,-1  
     434                        IF(zmask(iin,ijn,ik-1,iobs ) > 0.9 )THEN    
    486435                             
    487436                           zweig(iin,ijn,1) = &   
    488437                              & zweig1(iin,ijn,1) * &  
    489438                              & MAX( SIGN(1._wp,(zgdepw(iin,ijn,ik,iobs) ) &  
    490                               &  - prodatqc%var(1)%vdep(iend)),0._wp)  
     439                              &  - prodatqc%var(kvar)%vdep(iend)),0._wp)  
    491440                             
    492                            EXIT depth_loop1  
     441                           EXIT depth_loop 
    493442 
    494443                        ENDIF  
    495444 
    496                      ENDDO depth_loop1  
     445                     ENDDO depth_loop 
    497446      
    498447                  ENDDO  
     
    500449    
    501450               CALL obs_int_h2d( 1, 1, zweig, interp_corner(:,:,ikn), &  
    502                   &              prodatqc%var(1)%vmod(iend:iend) )  
     451                  &              prodatqc%var(kvar)%vmod(iend:iend) )  
    503452 
    504453                  ! Set QC flag for any observations found below the bottom 
    505454                  ! 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 
     455               IF (sum(zweig) == 0.0_wp) prodatqc%var(kvar)%nvqc(iend:iend)=4 
    507456  
    508457            ENDDO  
     
    510459            DEALLOCATE(interp_corner,iv_indic)  
    511460           
    512          ENDIF  
    513  
    514          ! For the second variable 
    515          IF ( prodatqc%npvend(jobs,2) > 0 ) THEN 
    516  
    517             zobsk(:) = obfillflt 
    518  
    519             IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN 
    520  
    521                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 
    600                    
    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 
    634   
    635             ENDDO  
    636   
    637             DEALLOCATE(interp_corner,iv_indic)  
    638            
    639          ENDIF  
     461         ENDIF 
    640462 
    641463      ENDDO 
    642464 
    643465      ! Deallocate the data for interpolation 
    644       DEALLOCATE( & 
    645          & igrdi1, & 
    646          & igrdi2, & 
    647          & igrdj1, & 
    648          & igrdj2, & 
    649          & zglam1, & 
    650          & zglam2, & 
    651          & zgphi1, & 
    652          & zgphi2, & 
    653          & zmask1, & 
    654          & zmask2, & 
    655          & zint1,  & 
    656          & zint2,  & 
     466      DEALLOCATE(  & 
     467         & igrdi,  & 
     468         & igrdj,  & 
     469         & zglam,  & 
     470         & zgphi,  & 
     471         & zmask,  & 
     472         & zint,   & 
    657473         & zgdept, & 
    658474         & zgdepw  & 
     
    661477      ! At the end of the day also get interpolated means 
    662478      IF ( ld_dailyav .AND. idayend == 0 ) THEN 
    663          DEALLOCATE( & 
    664             & zinm1,  & 
    665             & zinm2   & 
    666             & ) 
     479         DEALLOCATE( zinm ) 
    667480      ENDIF 
    668481 
    669       prodatqc%nprofup = prodatqc%nprofup + ipro  
     482      IF ( kvar == prodatqc%nvar ) THEN 
     483         prodatqc%nprofup = prodatqc%nprofup + ipro  
     484      ENDIF 
    670485 
    671486   END SUBROUTINE obs_prof_opt 
  • branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90

    r8222 r9306  
    255255 
    256256 
    257    SUBROUTINE obs_pre_prof( profdata, prodatqc, ld_var1, ld_var2, & 
     257   SUBROUTINE obs_pre_prof( profdata, prodatqc, ld_var, & 
    258258      &                     kpi, kpj, kpk, & 
    259       &                     zmask1, pglam1, pgphi1, zmask2, pglam2, pgphi2,  & 
     259      &                     zmask, pglam, pgphi,  & 
    260260      &                     ld_nea, ld_bound_reject, kdailyavtypes,  kqc_cutoff ) 
    261261 
     
    284284      TYPE(obs_prof), INTENT(INOUT) :: profdata   ! Full set of profile data 
    285285      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 
     286      LOGICAL, DIMENSION(profdata%nvar), INTENT(IN) :: & 
     287         & ld_var                                 ! Observed variables switches 
    288288      LOGICAL, INTENT(IN) :: ld_nea               ! Switch for rejecting observation near land 
    289289      LOGICAL, INTENT(IN) :: ld_bound_reject      ! Switch for rejecting observations near the boundary 
     
    291291      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    292292         & 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 
     293      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj,kpk,profdata%nvar) :: & 
     294         & zmask 
     295      REAL(wp), INTENT(IN), DIMENSION(kpi,kpj,profdata%nvar) :: & 
     296         & pglam, & 
     297         & pgphi 
    301298      INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff   ! cut off for QC value 
    302299 
     
    309306      INTEGER :: imin0 
    310307      INTEGER :: icycle       ! Current assimilation cycle 
    311                               ! Counters for observations that are 
    312       INTEGER :: iotdobs      !  - outside time domain 
    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)       
    321       INTEGER :: igrdobs      !  - fail the grid search 
    322       INTEGER :: iuvchku      !  - reject u if v rejected and vice versa 
    323       INTEGER :: iuvchkv      ! 
    324                               ! Global counters for observations that are 
    325       INTEGER :: iotdobsmpp   !  - outside time domain 
    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)       
    334       INTEGER :: igrdobsmpp   !  - fail the grid search 
    335       INTEGER :: iuvchkumpp   !  - reject var1 if var2 rejected and vice versa 
    336       INTEGER :: iuvchkvmpp   ! 
     308                                                       ! Counters for observations that are 
     309      INTEGER                           :: iotdobs     !  - outside time domain 
     310      INTEGER, DIMENSION(profdata%nvar) :: iosdvobs    !  - outside space domain 
     311      INTEGER, DIMENSION(profdata%nvar) :: ilanvobs    !  - within a model land cell 
     312      INTEGER, DIMENSION(profdata%nvar) :: inlavobs    !  - close to land 
     313      INTEGER, DIMENSION(profdata%nvar) :: ibdyvobs    !  - boundary    
     314      INTEGER                           :: igrdobs     !  - fail the grid search 
     315      INTEGER                           :: iuvchku     !  - reject UVEL if VVEL rejected 
     316      INTEGER                           :: iuvchkv     !  - reject VVEL if UVEL rejected 
     317                                                       ! Global counters for observations that are 
     318      INTEGER                           :: iotdobsmpp  !  - outside time domain 
     319      INTEGER, DIMENSION(profdata%nvar) :: iosdvobsmpp !  - outside space domain 
     320      INTEGER, DIMENSION(profdata%nvar) :: ilanvobsmpp !  - within a model land cell 
     321      INTEGER, DIMENSION(profdata%nvar) :: inlavobsmpp !  - close to land 
     322      INTEGER, DIMENSION(profdata%nvar) :: ibdyvobsmpp !  - boundary 
     323      INTEGER :: igrdobsmpp                            !  - fail the grid search 
     324      INTEGER :: iuvchkumpp                            !  - reject UVEL if VVEL rejected 
     325      INTEGER :: iuvchkvmpp                            !  - reject VVEL if UVEL rejected 
    337326      TYPE(obs_prof_valid) ::  llvalid      ! Profile selection  
    338327      TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: & 
    339          & llvvalid           ! var1,var2 selection  
     328         & llvvalid           ! vars selection  
    340329      INTEGER :: jvar         ! Variable loop variable 
    341330      INTEGER :: jobs         ! Obs. loop variable 
    342331      INTEGER :: jstp         ! Time loop variable 
    343332      INTEGER :: inrc         ! Time index variable 
     333      CHARACTER(LEN=256) :: cout1  ! Diagnostic output line 
     334      CHARACTER(LEN=256) :: cout2  ! Diagnostic output line 
    344335 
    345336      IF(lwp) WRITE(numout,*)'obs_pre_prof: Preparing the profile data...' 
     
    355346      icycle = no     ! Assimilation cycle 
    356347 
    357       ! Diagnotics counters for various failures. 
    358  
    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 
     348      ! Diagnostics counters for various failures. 
     349 
     350      iotdobs     = 0 
     351      igrdobs     = 0 
     352      iosdvobs(:) = 0 
     353      ilanvobs(:) = 0 
     354      inlavobs(:) = 0 
     355      ibdyvobs(:) = 0 
     356      iuvchku     = 0 
     357      iuvchkv     = 0 
    371358 
    372359 
     
    401388      ! ----------------------------------------------------------------------- 
    402389 
    403       CALL obs_coo_grd( profdata%nprof,   profdata%mi(:,1), profdata%mj(:,1), & 
    404          &              profdata%nqc,     igrdobs                         ) 
    405       CALL obs_coo_grd( profdata%nprof,   profdata%mi(:,2), profdata%mj(:,2), & 
    406          &              profdata%nqc,     igrdobs                         ) 
     390      DO jvar = 1, profdata%nvar 
     391         CALL obs_coo_grd( profdata%nprof,   profdata%mi(:,jvar), profdata%mj(:,jvar), & 
     392            &              profdata%nqc,     igrdobs ) 
     393      END DO 
    407394 
    408395      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) 
     
    419406      ! ----------------------------------------------------------------------- 
    420407 
    421       ! Variable 1 
    422       CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(1),   & 
    423          &                 profdata%npvsta(:,1),  profdata%npvend(:,1), & 
    424          &                 jpi,                   jpj,                  & 
    425          &                 jpk,                                         & 
    426          &                 profdata%mi,           profdata%mj,          & 
    427          &                 profdata%var(1)%mvk,                         & 
    428          &                 profdata%rlam,         profdata%rphi,        & 
    429          &                 profdata%var(1)%vdep,                        & 
    430          &                 pglam1,                pgphi1,               & 
    431          &                 gdept_1d,              zmask1,               & 
    432          &                 profdata%nqc,          profdata%var(1)%nvqc, & 
    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 
    444       CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(2),   & 
    445          &                 profdata%npvsta(:,2),  profdata%npvend(:,2), & 
    446          &                 jpi,                   jpj,                  & 
    447          &                 jpk,                                         & 
    448          &                 profdata%mi,           profdata%mj,          &  
    449          &                 profdata%var(2)%mvk,                         & 
    450          &                 profdata%rlam,         profdata%rphi,        & 
    451          &                 profdata%var(2)%vdep,                        & 
    452          &                 pglam2,                pgphi2,               & 
    453          &                 gdept_1d,              zmask2,               & 
    454          &                 profdata%nqc,          profdata%var(2)%nvqc, & 
    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 ) 
     408      DO jvar = 1, profdata%nvar 
     409         CALL obs_coo_spc_3d( profdata%nprof,          profdata%nvprot(jvar),   & 
     410            &                 profdata%npvsta(:,jvar), profdata%npvend(:,jvar), & 
     411            &                 jpi,                     jpj,                     & 
     412            &                 jpk,                                              & 
     413            &                 profdata%mi,             profdata%mj,             & 
     414            &                 profdata%var(jvar)%mvk,                           & 
     415            &                 profdata%rlam,           profdata%rphi,           & 
     416            &                 profdata%var(jvar)%vdep,                          & 
     417            &                 pglam(:,:,jvar),         pgphi(:,:,jvar),         & 
     418            &                 gdept_1d,                zmask(:,:,:,jvar),       & 
     419            &                 profdata%nqc,            profdata%var(jvar)%nvqc, & 
     420            &                 iosdvobs(jvar),          ilanvobs(jvar),          & 
     421            &                 inlavobs(jvar),          ld_nea,                  & 
     422            &                 ibdyvobs(jvar),          ld_bound_reject,         & 
     423            &                 iqc_cutoff       ) 
     424 
     425         CALL obs_mpp_sum_integer( iosdvobs(jvar), iosdvobsmpp(jvar) ) 
     426         CALL obs_mpp_sum_integer( ilanvobs(jvar), ilanvobsmpp(jvar) ) 
     427         CALL obs_mpp_sum_integer( inlavobs(jvar), inlavobsmpp(jvar) ) 
     428         CALL obs_mpp_sum_integer( ibdyvobs(jvar), ibdyvobsmpp(jvar) ) 
     429      END DO 
    464430 
    465431      ! ----------------------------------------------------------------------- 
     
    512478       
    513479         WRITE(numout,*) 
    514          WRITE(numout,*) ' Profiles outside time domain                     = ', & 
     480         WRITE(numout,*) ' Profiles outside time domain                       = ', & 
    515481            &            iotdobsmpp 
    516          WRITE(numout,*) ' Remaining profiles that failed grid search       = ', & 
     482         WRITE(numout,*) ' Remaining profiles that failed grid search         = ', & 
    517483            &            igrdobsmpp 
    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 
    522          IF (ld_nea) THEN 
    523             WRITE(numout,*) ' Remaining '//prodatqc%cvars(1)//' data near land points (removed) = ',& 
    524                &            inlav1obsmpp 
    525          ELSE 
    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                             = ', & 
    536             &            prodatqc%nvprotmpp(1) 
    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 
    541          IF (ld_nea) THEN 
    542             WRITE(numout,*) ' Remaining '//prodatqc%cvars(2)//' data near land points (removed) = ',& 
    543                &            inlav2obsmpp 
    544          ELSE 
    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                             = ', & 
    555             &            prodatqc%nvprotmpp(2) 
     484         DO jvar = 1, profdata%nvar 
     485            WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data outside space domain       = ', & 
     486               &            iosdvobsmpp(jvar) 
     487            WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data at land points             = ', & 
     488               &            ilanvobsmpp(jvar) 
     489            IF (ld_nea) THEN 
     490               WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data near land points (removed) = ',& 
     491                  &            inlavobsmpp(jvar) 
     492            ELSE 
     493               WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data near land points (kept)    = ',& 
     494                  &            inlavobsmpp(jvar) 
     495            ENDIF 
     496            IF ( TRIM(profdata%cvars(jvar)) == 'UVEL' ) THEN 
     497               WRITE(numout,*) ' U observation rejected since V rejected     = ', & 
     498                  &            iuvchku 
     499            ELSE IF ( TRIM(profdata%cvars(jvar)) == 'VVEL' ) THEN 
     500               WRITE(numout,*) ' V observation rejected since U rejected     = ', & 
     501                  &            iuvchkv 
     502            ENDIF 
     503            WRITE(numout,*) ' Remaining '//prodatqc%cvars(jvar)//' data near open boundary (removed) = ',& 
     504                  &            ibdyvobsmpp(jvar) 
     505            WRITE(numout,*) ' '//prodatqc%cvars(jvar)//' data accepted                             = ', & 
     506               &            prodatqc%nvprotmpp(jvar) 
     507         END DO 
    556508 
    557509         WRITE(numout,*) 
    558510         WRITE(numout,*) ' Number of observations per time step :' 
    559511         WRITE(numout,*) 
    560          WRITE(numout,'(10X,A,5X,A,5X,A,A)')'Time step','Profiles', & 
    561             &                               '     '//prodatqc%cvars(1)//'     ', & 
    562             &                               '     '//prodatqc%cvars(2)//'     ' 
    563          WRITE(numout,998) 
     512         WRITE(cout1,'(10X,A9,5X,A8)') 'Time step', 'Profiles' 
     513         WRITE(cout2,'(10X,A9,5X,A8)') '---------', '--------' 
     514         DO jvar = 1, prodatqc%nvar 
     515            WRITE(cout1,'(A,5X,A11)') TRIM(cout1), TRIM(prodatqc%cvars(jvar)) 
     516            WRITE(cout2,'(A,5X,A11)') TRIM(cout2), '-----------' 
     517         END DO 
     518         WRITE(numout,*) cout1 
     519         WRITE(numout,*) cout2 
    564520      ENDIF 
    565521       
     
    588544         DO jstp = nit000 - 1, nitend 
    589545            inrc = jstp - nit000 + 2 
    590             WRITE(numout,999) jstp, prodatqc%npstpmpp(inrc), & 
    591                &                    prodatqc%nvstpmpp(inrc,1), & 
    592                &                    prodatqc%nvstpmpp(inrc,2) 
     546            WRITE(cout1,'(10X,I9,5X,I8)') jstp, prodatqc%npstpmpp(inrc) 
     547            DO jvar = 1, prodatqc%nvar 
     548               WRITE(cout1,'(A,5X,I11)') TRIM(cout1), prodatqc%nvstpmpp(inrc,jvar) 
     549            END DO 
     550            WRITE(numout,*) cout1 
    593551         END DO 
    594552      ENDIF 
    595  
    596 998   FORMAT(10X,'---------',5X,'--------',5X,'-----------',5X,'----------------') 
    597 999   FORMAT(10X,I9,5X,I8,5X,I11,5X,I8) 
    598553 
    599554   END SUBROUTINE obs_pre_prof 
  • branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90

    r7992 r9306  
    4545   SUBROUTINE obs_rea_prof( profdata, knumfiles, cdfilenames, & 
    4646      &                     kvars, kextr, kstp, ddobsini, ddobsend, & 
    47       &                     ldvar1, ldvar2, ldignmis, ldsatt, & 
     47      &                     ldvar, ldignmis, ldsatt, & 
    4848      &                     ldmod, kdailyavtypes ) 
    4949      !!--------------------------------------------------------------------- 
     
    7474      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var 
    7575      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index 
    76       LOGICAL, INTENT(IN) :: ldvar1     ! Observed variables switches 
    77       LOGICAL, INTENT(IN) :: ldvar2 
     76      LOGICAL, DIMENSION(kvars), INTENT(IN) :: ldvar     ! Observed variables switches 
    7877      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files 
    7978      LOGICAL, INTENT(IN) :: ldsatt     ! Compute salinity at all temperature points 
     
    105104      INTEGER :: iprof 
    106105      INTEGER :: iproftot 
    107       INTEGER :: ivar1t0 
    108       INTEGER :: ivar2t0 
    109       INTEGER :: ivar1t 
    110       INTEGER :: ivar2t 
     106      INTEGER, DIMENSION(kvars) :: ivart0 
     107      INTEGER, DIMENSION(kvars) :: ivart 
    111108      INTEGER :: ip3dt 
    112109      INTEGER :: ios 
    113110      INTEGER :: ioserrcount 
    114       INTEGER :: ivar1tmpp 
    115       INTEGER :: ivar2tmpp 
     111      INTEGER, DIMENSION(kvars) :: ivartmpp 
    116112      INTEGER :: ip3dtmpp 
    117113      INTEGER :: itype 
    118114      INTEGER, DIMENSION(knumfiles) :: & 
    119115         & irefdate 
    120       INTEGER, DIMENSION(ntyp1770+1) :: & 
    121          & itypvar1,    & 
    122          & itypvar1mpp, & 
    123          & itypvar2,    & 
    124          & itypvar2mpp  
     116      INTEGER, DIMENSION(ntyp1770+1,kvars) :: & 
     117         & itypvar,    & 
     118         & itypvarmpp 
     119      INTEGER, DIMENSION(:,:), ALLOCATABLE :: & 
     120         & iobsi,    & 
     121         & iobsj,    & 
     122         & iproc 
    125123      INTEGER, DIMENSION(:), ALLOCATABLE :: & 
    126          & iobsi1,    & 
    127          & iobsj1,    & 
    128          & iproc1,    & 
    129          & iobsi2,    & 
    130          & iobsj2,    & 
    131          & iproc2,    & 
    132124         & iindx,    & 
    133125         & ifileidx, & 
     
    147139      LOGICAL :: llvalprof 
    148140      LOGICAL :: lldavtimset 
     141      LOGICAL :: llcycle 
    149142      TYPE(obfbdata), POINTER, DIMENSION(:) :: & 
    150143         & inpfiles 
     
    152145      ! Local initialization 
    153146      iprof = 0 
    154       ivar1t0 = 0 
    155       ivar2t0 = 0 
     147      ivart0(:) = 0 
    156148      ip3dt = 0 
    157149 
     
    219211               &                ldgrid = .TRUE. ) 
    220212 
    221             IF ( inpfiles(jj)%nvar < 2 ) THEN 
     213            IF ( inpfiles(jj)%nvar /= kvars ) THEN 
    222214               CALL ctl_stop( 'Feedback format error: ', & 
    223                   &           ' less than 2 vars in profile file' ) 
     215                  &           ' unexpected number of vars in profile file' ) 
    224216            ENDIF 
    225217 
     
    308300            DO ji = 1, inpfiles(jj)%nobs 
    309301               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 
     302               llcycle = .TRUE. 
     303               DO jvar = 1, kvars 
     304                  IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     305                     llcycle = .FALSE. 
     306                     EXIT 
     307                  ENDIF 
     308               END DO 
     309               IF ( llcycle ) CYCLE 
    312310               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    313311                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    317315            ALLOCATE( zlam(inowin)  ) 
    318316            ALLOCATE( zphi(inowin)  ) 
    319             ALLOCATE( iobsi1(inowin) ) 
    320             ALLOCATE( iobsj1(inowin) ) 
    321             ALLOCATE( iproc1(inowin) ) 
    322             ALLOCATE( iobsi2(inowin) ) 
    323             ALLOCATE( iobsj2(inowin) ) 
    324             ALLOCATE( iproc2(inowin) ) 
     317            ALLOCATE( iobsi(inowin,kvars) ) 
     318            ALLOCATE( iobsj(inowin,kvars) ) 
     319            ALLOCATE( iproc(inowin,kvars) ) 
    325320            inowin = 0 
    326321            DO ji = 1, inpfiles(jj)%nobs 
    327322               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 
     323               llcycle = .TRUE. 
     324               DO jvar = 1, kvars 
     325                  IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     326                     llcycle = .FALSE. 
     327                     EXIT 
     328                  ENDIF 
     329               END DO 
     330               IF ( llcycle ) CYCLE 
    330331               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    331332                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    336337            END DO 
    337338 
    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' ) 
     339            ! Assume anything other than velocity is on T grid 
     340            IF ( TRIM( inpfiles(jj)%cname(1) ) == 'UVEL' ) THEN 
     341               CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,1), iobsj(:,1), & 
     342                  &                  iproc(:,1), 'U' ) 
     343               CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,2), iobsj(:,2), & 
     344                  &                  iproc(:,2), 'V' ) 
     345            ELSE 
     346               CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,1), iobsj(:,1), & 
     347                  &                  iproc(:,1), 'T' ) 
     348               IF ( kvars > 1 ) THEN 
     349                  DO jvar = 2, kvars 
     350                     iobsi(:,jvar) = iobsi(:,1) 
     351                     iobsj(:,jvar) = iobsj(:,1) 
     352                     iproc(:,jvar) = iproc(:,1) 
     353                  END DO 
     354               ENDIF 
    349355            ENDIF 
    350356 
     
    352358            DO ji = 1, inpfiles(jj)%nobs 
    353359               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 
     360               llcycle = .TRUE. 
     361               DO jvar = 1, kvars 
     362                  IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     363                     llcycle = .FALSE. 
     364                     EXIT 
     365                  ENDIF 
     366               END DO 
     367               IF ( llcycle ) CYCLE 
    356368               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    357369                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
    358370                  inowin = inowin + 1 
    359                   inpfiles(jj)%iproc(ji,1) = iproc1(inowin) 
    360                   inpfiles(jj)%iobsi(ji,1) = iobsi1(inowin) 
    361                   inpfiles(jj)%iobsj(ji,1) = iobsj1(inowin) 
    362                   inpfiles(jj)%iproc(ji,2) = iproc2(inowin) 
    363                   inpfiles(jj)%iobsi(ji,2) = iobsi2(inowin) 
    364                   inpfiles(jj)%iobsj(ji,2) = iobsj2(inowin) 
    365                   IF ( inpfiles(jj)%iproc(ji,1) /= & 
    366                      & inpfiles(jj)%iproc(ji,2) ) THEN 
    367                      CALL ctl_stop( 'Error in obs_read_prof:', & 
    368                         & 'var1 and var2 observation on different processors') 
     371                  DO jvar = 1, kvars 
     372                     inpfiles(jj)%iproc(ji,jvar) = iproc(inowin,jvar) 
     373                     inpfiles(jj)%iobsi(ji,jvar) = iobsi(inowin,jvar) 
     374                     inpfiles(jj)%iobsj(ji,jvar) = iobsj(inowin,jvar) 
     375                  END DO 
     376                  IF ( kvars > 1 ) THEN 
     377                     DO jvar = 2, kvars 
     378                        IF ( inpfiles(jj)%iproc(ji,jvar) /= & 
     379                           & inpfiles(jj)%iproc(ji,1) ) THEN 
     380                           CALL ctl_stop( 'Error in obs_read_prof:', & 
     381                              & 'observation on different processors for different vars') 
     382                        ENDIF 
     383                     END DO 
    369384                  ENDIF 
    370385               ENDIF 
    371386            END DO 
    372             DEALLOCATE( zlam, zphi, iobsi1, iobsj1, iproc1, iobsi2, iobsj2, iproc2 ) 
     387            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc ) 
    373388 
    374389            DO ji = 1, inpfiles(jj)%nobs 
    375390               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 
     391               llcycle = .TRUE. 
     392               DO jvar = 1, kvars 
     393                  IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     394                     llcycle = .FALSE. 
     395                     EXIT 
     396                  ENDIF 
     397               END DO 
     398               IF ( llcycle ) CYCLE 
    378399               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    379400                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    384405                  ENDIF 
    385406                  llvalprof = .FALSE. 
    386                   IF ( ldvar1 ) THEN 
    387                      loop_t_count : DO ij = 1,inpfiles(jj)%nlev 
    388                         IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    389                            & CYCLE 
    390                         IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
    391                            & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    392                            ivar1t0 = ivar1t0 + 1 
    393                         ENDIF 
    394                      END DO loop_t_count 
    395                   ENDIF 
    396                   IF ( ldvar2 ) THEN 
    397                      loop_s_count : DO ij = 1,inpfiles(jj)%nlev 
    398                         IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    399                            & CYCLE 
    400                         IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
    401                            & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    402                            ivar2t0 = ivar2t0 + 1 
    403                         ENDIF 
    404                      END DO loop_s_count 
    405                   ENDIF 
    406                   loop_p_count : DO ij = 1,inpfiles(jj)%nlev 
     407                  DO jvar = 1, kvars 
     408                     IF ( ldvar(jvar) ) THEN 
     409                        DO ij = 1,inpfiles(jj)%nlev 
     410                           IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
     411                              & CYCLE 
     412                           IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
     413                              & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
     414                              ivart0(jvar) = ivart0(jvar) + 1 
     415                           ENDIF 
     416                        END DO 
     417                     ENDIF 
     418                  END DO 
     419                  DO ij = 1,inpfiles(jj)%nlev 
    407420                     IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    408421                        & CYCLE 
    409                      IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
    410                         &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
    411                         &    ldvar1 ) .OR. & 
    412                         & ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
    413                         &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
    414                         &     ldvar2 ) ) THEN 
    415                         ip3dt = ip3dt + 1 
    416                         llvalprof = .TRUE. 
    417                      ENDIF 
    418                   END DO loop_p_count 
     422                     DO jvar = 1, kvars 
     423                        IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
     424                           &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
     425                           &    ldvar(jvar) ) ) THEN 
     426                           ip3dt = ip3dt + 1 
     427                           llvalprof = .TRUE. 
     428                           EXIT 
     429                        ENDIF 
     430                     END DO 
     431                  END DO 
    419432 
    420433                  IF ( llvalprof ) iprof = iprof + 1 
     
    438451         DO ji = 1, inpfiles(jj)%nobs 
    439452            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 
     453            llcycle = .TRUE. 
     454            DO jvar = 1, kvars 
     455               IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     456                  llcycle = .FALSE. 
     457                  EXIT 
     458               ENDIF 
     459            END DO 
     460            IF ( llcycle ) CYCLE 
    442461            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    443462               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    453472         DO ji = 1, inpfiles(jj)%nobs 
    454473            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 
     474            llcycle = .TRUE. 
     475            DO jvar = 1, kvars 
     476               IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     477                  llcycle = .FALSE. 
     478                  EXIT 
     479               ENDIF 
     480            END DO 
     481            IF ( llcycle ) CYCLE 
    457482            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    458483               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    470495      iv3dt(:) = -1 
    471496      IF (ldsatt) THEN 
    472          iv3dt(1) = ip3dt 
    473          iv3dt(2) = ip3dt 
     497         iv3dt(:) = ip3dt 
    474498      ELSE 
    475          iv3dt(1) = ivar1t0 
    476          iv3dt(2) = ivar2t0 
     499         iv3dt(:) = ivart0(:) 
    477500      ENDIF 
    478501      CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, & 
     
    487510 
    488511      ip3dt = 0 
    489       ivar1t = 0 
    490       ivar2t = 0 
    491       itypvar1   (:) = 0 
    492       itypvar1mpp(:) = 0 
    493  
    494       itypvar2   (:) = 0 
    495       itypvar2mpp(:) = 0 
     512      ivart(:) = 0 
     513      itypvar   (:,:) = 0 
     514      itypvarmpp(:,:) = 0 
    496515 
    497516      ioserrcount = 0 
     
    501520         ji = iprofidx(iindx(jk)) 
    502521 
    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 
     522         IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     523         llcycle = .TRUE. 
     524         DO jvar = 1, kvars 
     525            IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     526               llcycle = .FALSE. 
     527               EXIT 
     528            ENDIF 
     529         END DO 
     530         IF ( llcycle ) CYCLE 
    506531 
    507532         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  & 
     
    519544 
    520545            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 
     546            llcycle = .TRUE. 
     547            DO jvar = 1, kvars 
     548               IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 
     549                  llcycle = .FALSE. 
     550                  EXIT 
     551               ENDIF 
     552            END DO 
     553            IF ( llcycle ) CYCLE 
    523554 
    524555            loop_prof : DO ij = 1, inpfiles(jj)%nlev 
     
    527558                  & CYCLE 
    528559 
    529                IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
    530                   & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    531  
    532                   llvalprof = .TRUE.  
    533                   EXIT loop_prof 
    534  
    535                ENDIF 
    536  
    537                IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
    538                   & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    539  
    540                   llvalprof = .TRUE.  
    541                   EXIT loop_prof 
    542  
    543                ENDIF 
     560               DO jvar = 1, kvars 
     561                  IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
     562                     & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
     563 
     564                     llvalprof = .TRUE.  
     565                     EXIT loop_prof 
     566 
     567                  ENDIF 
     568               END DO 
    544569 
    545570            END DO loop_prof 
     
    573598 
    574599               ! Coordinate search parameters 
    575                profdata%mi  (iprof,1) = inpfiles(jj)%iobsi(ji,1) 
    576                profdata%mj  (iprof,1) = inpfiles(jj)%iobsj(ji,1) 
    577                profdata%mi  (iprof,2) = inpfiles(jj)%iobsi(ji,2) 
    578                profdata%mj  (iprof,2) = inpfiles(jj)%iobsj(ji,2) 
     600               DO jvar = 1, kvars 
     601                  profdata%mi  (iprof,jvar) = inpfiles(jj)%iobsi(ji,jvar) 
     602                  profdata%mj  (iprof,jvar) = inpfiles(jj)%iobsj(ji,jvar) 
     603               END DO 
    579604 
    580605               ! Profile WMO number 
     
    616641                  IF (ldsatt) THEN 
    617642 
    618                      IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
    619                         &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
    620                         &    ldvar1 ) .OR. & 
    621                         & ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
    622                         &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
    623                         &   ldvar2 ) ) THEN 
    624                         ip3dt = ip3dt + 1 
    625                      ELSE 
    626                         CYCLE 
     643                     DO jvar = 1, kvars 
     644                        IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
     645                           &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
     646                           &    ldvar(jvar) ) ) THEN 
     647                           ip3dt = ip3dt + 1 
     648                           EXIT 
     649                        ELSE IF ( jvar == kvars ) THEN 
     650                           CYCLE loop_p 
     651                        ENDIF 
     652                     END DO 
     653 
     654                  ENDIF 
     655 
     656                  DO jvar = 1, kvars 
     657                   
     658                     IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
     659                       &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
     660                       &    ldvar(jvar) ) .OR. ldsatt ) THEN 
     661 
     662                        IF (ldsatt) THEN 
     663 
     664                           ivart(jvar) = ip3dt 
     665 
     666                        ELSE 
     667 
     668                           ivart(jvar) = ivart(jvar) + 1 
     669 
     670                        ENDIF 
     671 
     672                        ! Depth of jvar observation 
     673                        profdata%var(jvar)%vdep(ivart(jvar)) = & 
     674                           &                inpfiles(jj)%pdep(ij,ji) 
     675 
     676                        ! Depth of jvar observation QC 
     677                        profdata%var(jvar)%idqc(ivart(jvar)) = & 
     678                           &                inpfiles(jj)%idqc(ij,ji) 
     679 
     680                        ! Depth of jvar observation QC flags 
     681                        profdata%var(jvar)%idqcf(:,ivart(jvar)) = & 
     682                           &                inpfiles(jj)%idqcf(:,ij,ji) 
     683 
     684                        ! Profile index 
     685                        profdata%var(jvar)%nvpidx(ivart(jvar)) = iprof 
     686 
     687                        ! Vertical index in original profile 
     688                        profdata%var(jvar)%nvlidx(ivart(jvar)) = ij 
     689 
     690                        ! Profile jvar value 
     691                        IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 
     692                           & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
     693                           profdata%var(jvar)%vobs(ivart(jvar)) = & 
     694                              &                inpfiles(jj)%pob(ij,ji,jvar) 
     695                           IF ( ldmod ) THEN 
     696                              profdata%var(jvar)%vmod(ivart(jvar)) = & 
     697                                 &                inpfiles(jj)%padd(ij,ji,1,jvar) 
     698                           ENDIF 
     699                           ! Count number of profile var1 data as function of type 
     700                           itypvar( profdata%ntyp(iprof) + 1, jvar ) = & 
     701                              & itypvar( profdata%ntyp(iprof) + 1, jvar ) + 1 
     702                        ELSE 
     703                           profdata%var(jvar)%vobs(ivart(jvar)) = fbrmdi 
     704                        ENDIF 
     705 
     706                        ! Profile jvar qc 
     707                        profdata%var(jvar)%nvqc(ivart(jvar)) = & 
     708                           & inpfiles(jj)%ivlqc(ij,ji,jvar) 
     709 
     710                        ! Profile jvar qc flags 
     711                        profdata%var(jvar)%nvqcf(:,ivart(jvar)) = & 
     712                           & inpfiles(jj)%ivlqcf(:,ij,ji,jvar) 
     713 
     714                        ! Profile insitu T value 
     715                        IF ( TRIM( inpfiles(jj)%cname(jvar) ) == 'POTM' ) THEN 
     716                           profdata%var(jvar)%vext(ivart(jvar),1) = & 
     717                              &                inpfiles(jj)%pext(ij,ji,1) 
     718                        ENDIF 
     719 
    627720                     ENDIF 
    628  
    629                   ENDIF 
    630  
    631                   IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
    632                     &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
    633                     &    ldvar1 ) .OR. ldsatt ) THEN 
    634  
    635                      IF (ldsatt) THEN 
    636  
    637                         ivar1t = ip3dt 
    638  
    639                      ELSE 
    640  
    641                         ivar1t = ivar1t + 1 
    642  
    643                      ENDIF 
    644  
    645                      ! Depth of var1 observation 
    646                      profdata%var(1)%vdep(ivar1t) = & 
    647                         &                inpfiles(jj)%pdep(ij,ji) 
    648  
    649                      ! Depth of var1 observation QC 
    650                      profdata%var(1)%idqc(ivar1t) = & 
    651                         &                inpfiles(jj)%idqc(ij,ji) 
    652  
    653                      ! Depth of var1 observation QC flags 
    654                      profdata%var(1)%idqcf(:,ivar1t) = & 
    655                         &                inpfiles(jj)%idqcf(:,ij,ji) 
    656  
    657                      ! Profile index 
    658                      profdata%var(1)%nvpidx(ivar1t) = iprof 
    659  
    660                      ! Vertical index in original profile 
    661                      profdata%var(1)%nvlidx(ivar1t) = ij 
    662  
    663                      ! Profile var1 value 
    664                      IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
    665                         & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    666                         profdata%var(1)%vobs(ivar1t) = & 
    667                            &                inpfiles(jj)%pob(ij,ji,1) 
    668                         IF ( ldmod ) THEN 
    669                            profdata%var(1)%vmod(ivar1t) = & 
    670                               &                inpfiles(jj)%padd(ij,ji,1,1) 
    671                         ENDIF 
    672                         ! Count number of profile var1 data as function of type 
    673                         itypvar1( profdata%ntyp(iprof) + 1 ) = & 
    674                            & itypvar1( profdata%ntyp(iprof) + 1 ) + 1 
    675                      ELSE 
    676                         profdata%var(1)%vobs(ivar1t) = fbrmdi 
    677                      ENDIF 
    678  
    679                      ! Profile var1 qc 
    680                      profdata%var(1)%nvqc(ivar1t) = & 
    681                         & inpfiles(jj)%ivlqc(ij,ji,1) 
    682  
    683                      ! Profile var1 qc flags 
    684                      profdata%var(1)%nvqcf(:,ivar1t) = & 
    685                         & inpfiles(jj)%ivlqcf(:,ij,ji,1) 
    686  
    687                      ! Profile insitu T value 
    688                      IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN 
    689                         profdata%var(1)%vext(ivar1t,1) = & 
    690                            &                inpfiles(jj)%pext(ij,ji,1) 
    691                      ENDIF 
    692  
    693                   ENDIF 
    694  
    695                   IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
    696                      &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2)    .AND. & 
    697                      &   ldvar2 ) .OR. ldsatt ) THEN 
    698  
    699                      IF (ldsatt) THEN 
    700  
    701                         ivar2t = ip3dt 
    702  
    703                      ELSE 
    704  
    705                         ivar2t = ivar2t + 1 
    706  
    707                      ENDIF 
    708  
    709                      ! Depth of var2 observation 
    710                      profdata%var(2)%vdep(ivar2t) = & 
    711                         &                inpfiles(jj)%pdep(ij,ji) 
    712  
    713                      ! Depth of var2 observation QC 
    714                      profdata%var(2)%idqc(ivar2t) = & 
    715                         &                inpfiles(jj)%idqc(ij,ji) 
    716  
    717                      ! Depth of var2 observation QC flags 
    718                      profdata%var(2)%idqcf(:,ivar2t) = & 
    719                         &                inpfiles(jj)%idqcf(:,ij,ji) 
    720  
    721                      ! Profile index 
    722                      profdata%var(2)%nvpidx(ivar2t) = iprof 
    723  
    724                      ! Vertical index in original profile 
    725                      profdata%var(2)%nvlidx(ivar2t) = ij 
    726  
    727                      ! Profile var2 value 
    728                   IF (  ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) ) .AND. & 
    729                     &   ( .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2)    )  ) THEN 
    730                         profdata%var(2)%vobs(ivar2t) = & 
    731                            &                inpfiles(jj)%pob(ij,ji,2) 
    732                         IF ( ldmod ) THEN 
    733                            profdata%var(2)%vmod(ivar2t) = & 
    734                               &                inpfiles(jj)%padd(ij,ji,1,2) 
    735                         ENDIF 
    736                         ! Count number of profile var2 data as function of type 
    737                         itypvar2( profdata%ntyp(iprof) + 1 ) = & 
    738                            & itypvar2( profdata%ntyp(iprof) + 1 ) + 1 
    739                      ELSE 
    740                         profdata%var(2)%vobs(ivar2t) = fbrmdi 
    741                      ENDIF 
    742  
    743                      ! Profile var2 qc 
    744                      profdata%var(2)%nvqc(ivar2t) = & 
    745                         & inpfiles(jj)%ivlqc(ij,ji,2) 
    746  
    747                      ! Profile var2 qc flags 
    748                      profdata%var(2)%nvqcf(:,ivar2t) = & 
    749                         & inpfiles(jj)%ivlqcf(:,ij,ji,2) 
    750  
    751                   ENDIF 
     721                   
     722                  END DO 
    752723 
    753724               END DO loop_p 
     
    763734      !----------------------------------------------------------------------- 
    764735 
    765       CALL obs_mpp_sum_integer ( ivar1t0, ivar1tmpp ) 
    766       CALL obs_mpp_sum_integer ( ivar2t0, ivar2tmpp ) 
     736      DO jvar = 1, kvars 
     737         CALL obs_mpp_sum_integer ( ivart0(jvar), ivartmpp(jvar) ) 
     738      END DO 
    767739      CALL obs_mpp_sum_integer ( ip3dt,   ip3dtmpp  ) 
    768740 
    769       CALL obs_mpp_sum_integers( itypvar1, itypvar1mpp, ntyp1770 + 1 ) 
    770       CALL obs_mpp_sum_integers( itypvar2, itypvar2mpp, ntyp1770 + 1 ) 
     741      DO jvar = 1, kvars 
     742         CALL obs_mpp_sum_integers( itypvar(:,jvar), itypvarmpp(:,jvar), ntyp1770 + 1 ) 
     743      END DO 
    771744 
    772745      !----------------------------------------------------------------------- 
     
    778751         WRITE(numout,'(1X,A)') '------------' 
    779752         WRITE(numout,*)  
    780          WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(1) ) 
    781          WRITE(numout,'(1X,A)') '------------------------' 
    782          DO ji = 0, ntyp1770 
    783             IF ( itypvar1mpp(ji+1) > 0 ) THEN 
    784                WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 
    785                   & cwmonam1770(ji)(1:52),' = ', & 
    786                   & itypvar1mpp(ji+1) 
    787             ENDIF 
     753         DO jvar = 1, kvars 
     754            WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(jvar) ) 
     755            WRITE(numout,'(1X,A)') '------------------------' 
     756            DO ji = 0, ntyp1770 
     757               IF ( itypvarmpp(ji+1,jvar) > 0 ) THEN 
     758                  WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 
     759                     & cwmonam1770(ji)(1:52),' = ', & 
     760                     & itypvarmpp(ji+1,jvar) 
     761               ENDIF 
     762            END DO 
     763            WRITE(numout,'(1X,A)') & 
     764               & '---------------------------------------------------------------' 
     765            WRITE(numout,'(1X,A55,I8)') & 
     766               & 'Total profile data for variable '//TRIM( profdata%cvars(jvar) )// & 
     767               & '             = ', ivartmpp(jvar) 
     768            WRITE(numout,'(1X,A)') & 
     769               & '---------------------------------------------------------------' 
     770            WRITE(numout,*)  
    788771         END DO 
    789          WRITE(numout,'(1X,A)') & 
    790             & '---------------------------------------------------------------' 
    791          WRITE(numout,'(1X,A55,I8)') & 
    792             & 'Total profile data for variable '//TRIM( profdata%cvars(1) )// & 
    793             & '             = ', ivar1tmpp 
    794          WRITE(numout,'(1X,A)') & 
    795             & '---------------------------------------------------------------' 
    796          WRITE(numout,*)  
    797          WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(2) ) 
    798          WRITE(numout,'(1X,A)') '------------------------' 
    799          DO ji = 0, ntyp1770 
    800             IF ( itypvar2mpp(ji+1) > 0 ) THEN 
    801                WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 
    802                   & cwmonam1770(ji)(1:52),' = ', & 
    803                   & itypvar2mpp(ji+1) 
    804             ENDIF 
     772      ENDIF 
     773 
     774      IF (ldsatt) THEN 
     775         profdata%nvprot(:)    = ip3dt 
     776         profdata%nvprotmpp(:) = ip3dtmpp 
     777      ELSE 
     778         DO jvar = 1, kvars 
     779            profdata%nvprot(jvar)    = ivart(jvar) 
     780            profdata%nvprotmpp(jvar) = ivartmpp(jvar) 
    805781         END DO 
    806          WRITE(numout,'(1X,A)') & 
    807             & '---------------------------------------------------------------' 
    808          WRITE(numout,'(1X,A55,I8)') & 
    809             & 'Total profile data for variable '//TRIM( profdata%cvars(2) )// & 
    810             & '             = ', ivar2tmpp 
    811          WRITE(numout,'(1X,A)') & 
    812             & '---------------------------------------------------------------' 
    813          WRITE(numout,*)  
    814       ENDIF 
    815  
    816       IF (ldsatt) THEN 
    817          profdata%nvprot(1)    = ip3dt 
    818          profdata%nvprot(2)    = ip3dt 
    819          profdata%nvprotmpp(1) = ip3dtmpp 
    820          profdata%nvprotmpp(2) = ip3dtmpp 
    821       ELSE 
    822          profdata%nvprot(1)    = ivar1t 
    823          profdata%nvprot(2)    = ivar2t 
    824          profdata%nvprotmpp(1) = ivar1tmpp 
    825          profdata%nvprotmpp(2) = ivar2tmpp 
    826782      ENDIF 
    827783      profdata%nprof        = iprof 
     
    830786      ! Model level search 
    831787      !----------------------------------------------------------------------- 
    832       IF ( ldvar1 ) THEN 
    833          CALL obs_level_search( jpk, gdept_1d, & 
    834             & profdata%nvprot(1), profdata%var(1)%vdep, & 
    835             & profdata%var(1)%mvk ) 
    836       ENDIF 
    837       IF ( ldvar2 ) THEN 
    838          CALL obs_level_search( jpk, gdept_1d, & 
    839             & profdata%nvprot(2), profdata%var(2)%vdep, & 
    840             & profdata%var(2)%mvk ) 
    841       ENDIF 
     788      DO jvar = 1, kvars 
     789         IF ( ldvar(jvar) ) THEN 
     790            CALL obs_level_search( jpk, gdept_1d, & 
     791               & profdata%nvprot(jvar), profdata%var(jvar)%vdep, & 
     792               & profdata%var(jvar)%mvk ) 
     793         ENDIF 
     794      END DO 
    842795 
    843796      !----------------------------------------------------------------------- 
  • branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90

    r8223 r9306  
    8484      CHARACTER(LEN=40) :: clfname 
    8585      CHARACTER(LEN=10) :: clfiletype 
     86      CHARACTER(LEN=ilenlong) :: cllongname  ! Long name of variable 
     87      CHARACTER(LEN=ilenunit) :: clunits     ! Units of variable 
     88      CHARACTER(LEN=ilengrid) :: clgrid      ! Grid of variable 
    8689      INTEGER :: ilevel 
    8790      INTEGER :: jvar 
     
    111114      ! Find maximum level 
    112115      ilevel = 0 
    113       DO jvar = 1, 2 
     116      DO jvar = 1, profdata%nvar 
    114117         ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) ) 
    115118      END DO 
     
    175178         END DO 
    176179 
     180      CASE('PLCHLTOT') 
     181 
     182         clfiletype = 'plchltotfb' 
     183         cllongname = 'log10(chlorophyll concentration)' 
     184         clunits    = 'log10(mg/m3)' 
     185         clgrid     = 'T' 
     186 
     187      CASE('PCHLTOT') 
     188 
     189         clfiletype = 'pchltotfb' 
     190         cllongname = 'chlorophyll concentration' 
     191         clunits    = 'mg/m3' 
     192         clgrid     = 'T' 
     193 
     194      CASE('PNO3') 
     195 
     196         clfiletype = 'pno3fb' 
     197         cllongname = 'nitrate' 
     198         clunits    = 'mmol/m3' 
     199         clgrid     = 'T' 
     200 
     201      CASE('PSI4') 
     202 
     203         clfiletype = 'psi4fb' 
     204         cllongname = 'silicate' 
     205         clunits    = 'mmol/m3' 
     206         clgrid     = 'T' 
     207 
     208      CASE('PPO4') 
     209 
     210         clfiletype = 'ppo4fb' 
     211         cllongname = 'phosphate' 
     212         clunits    = 'mmol/m3' 
     213         clgrid     = 'T' 
     214 
     215      CASE('PDIC') 
     216 
     217         clfiletype = 'pdicfb' 
     218         cllongname = 'dissolved inorganic carbon' 
     219         clunits    = 'mmol/m3' 
     220         clgrid     = 'T' 
     221 
     222      CASE('PALK') 
     223 
     224         clfiletype = 'palkfb' 
     225         cllongname = 'alkalinity' 
     226         clunits    = 'meq/m3' 
     227         clgrid     = 'T' 
     228 
     229      CASE('PPH') 
     230 
     231         clfiletype = 'pphfb' 
     232         cllongname = 'pH' 
     233         clunits    = '-' 
     234         clgrid     = 'T' 
     235 
     236      CASE('PO2') 
     237 
     238         clfiletype = 'po2fb' 
     239         cllongname = 'dissolved oxygen' 
     240         clunits    = 'mmol/m3' 
     241         clgrid     = 'T' 
     242 
    177243      END SELECT 
     244       
     245      IF ( ( TRIM(profdata%cvars(1)) /= 'POTM' ) .AND. & 
     246         & ( TRIM(profdata%cvars(1)) /= 'UVEL' ) ) THEN 
     247         CALL alloc_obfbdata( fbdata, 1, profdata%nprof, ilevel, & 
     248            &                 1 + iadd, iext, .TRUE. ) 
     249         fbdata%cname(1)      = profdata%cvars(1) 
     250         fbdata%coblong(1)    = cllongname 
     251         fbdata%cobunit(1)    = clunits 
     252         fbdata%caddlong(1,1) = 'Model interpolated ' // TRIM(cllongname) 
     253         fbdata%caddunit(1,1) = clunits 
     254         fbdata%cgrid(:)      = clgrid 
     255         DO je = 1, iext 
     256            fbdata%cextname(je) = pext%cdname(je) 
     257            fbdata%cextlong(je) = pext%cdlong(je,1) 
     258            fbdata%cextunit(je) = pext%cdunit(je,1) 
     259         END DO 
     260         DO ja = 1, iadd 
     261            fbdata%caddname(1+ja) = padd%cdname(ja) 
     262            fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1) 
     263            fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1) 
     264         END DO 
     265      ENDIF 
    178266 
    179267      fbdata%caddname(1)   = 'Hx' 
     
    228316            &           krefdate = 19500101 ) 
    229317         ! Reform the profiles arrays for output 
    230          DO jvar = 1, 2 
     318         DO jvar = 1, profdata%nvar 
    231319            DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar) 
    232320               ik = profdata%var(jvar)%nvlidx(jk) 
     
    322410      CHARACTER(LEN=10) :: clfiletype 
    323411      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_surf' 
     412      CHARACTER(LEN=ilenlong) :: cllongname  ! Long name of variable 
     413      CHARACTER(LEN=ilenunit) :: clunits     ! Units of variable 
     414      CHARACTER(LEN=ilengrid) :: clgrid      ! Grid of variable 
    324415      INTEGER :: jo 
    325416      INTEGER :: ja 
     
    344435      SELECT CASE ( TRIM(surfdata%cvars(1)) ) 
    345436      CASE('SLA') 
     437 
     438         ! SLA needs special treatment because of MDT, so is all done here 
     439         ! Other variables are done more generically 
    346440 
    347441         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
     
    374468      CASE('SST') 
    375469 
     470         clfiletype = 'sstfb' 
     471         cllongname = 'Sea surface temperature' 
     472         clunits    = 'Degree centigrade' 
     473         clgrid     = 'T' 
     474 
     475      CASE('ICECONC') 
     476 
     477         clfiletype = 'sicfb' 
     478         cllongname = 'Sea ice' 
     479         clunits    = 'Fraction' 
     480         clgrid     = 'T' 
     481 
     482      CASE('SSS') 
     483 
     484         clfiletype = 'sssfb' 
     485         cllongname = 'Sea surface salinity' 
     486         clunits    = 'psu' 
     487         clgrid     = 'T' 
     488 
     489      CASE('SLCHLTOT','LOGCHL','LogChl','logchl') 
     490 
     491         clfiletype = 'slchltotfb' 
     492         cllongname = 'Surface total log10(chlorophyll)' 
     493         clunits    = 'log10(mg/m3)' 
     494         clgrid     = 'T' 
     495 
     496      CASE('SLCHLDIA') 
     497 
     498         clfiletype = 'slchldiafb' 
     499         cllongname = 'Surface diatom log10(chlorophyll)' 
     500         clunits    = 'log10(mg/m3)' 
     501         clgrid     = 'T' 
     502 
     503      CASE('SLCHLNON') 
     504 
     505         clfiletype = 'slchlnonfb' 
     506         cllongname = 'Surface non-diatom log10(chlorophyll)' 
     507         clunits    = 'log10(mg/m3)' 
     508         clgrid     = 'T' 
     509 
     510      CASE('SLCHLDIN') 
     511 
     512         clfiletype = 'slchldinfb' 
     513         cllongname = 'Surface dinoflagellate log10(chlorophyll)' 
     514         clunits    = 'log10(mg/m3)' 
     515         clgrid     = 'T' 
     516 
     517      CASE('SLCHLMIC') 
     518 
     519         clfiletype = 'slchlmicfb' 
     520         cllongname = 'Surface microphytoplankton log10(chlorophyll)' 
     521         clunits    = 'log10(mg/m3)' 
     522         clgrid     = 'T' 
     523 
     524      CASE('SLCHLNAN') 
     525 
     526         clfiletype = 'slchlnanfb' 
     527         cllongname = 'Surface nanophytoplankton log10(chlorophyll)' 
     528         clunits    = 'log10(mg/m3)' 
     529         clgrid     = 'T' 
     530 
     531      CASE('SLCHLPIC') 
     532 
     533         clfiletype = 'slchlpicfb' 
     534         cllongname = 'Surface picophytoplankton log10(chlorophyll)' 
     535         clunits    = 'log10(mg/m3)' 
     536         clgrid     = 'T' 
     537 
     538      CASE('SCHLTOT') 
     539 
     540         clfiletype = 'schltotfb' 
     541         cllongname = 'Surface total chlorophyll' 
     542         clunits    = 'mg/m3' 
     543         clgrid     = 'T' 
     544 
     545      CASE('SLPHYTOT') 
     546 
     547         clfiletype = 'slphytotfb' 
     548         cllongname = 'Surface total log10(phytoplankton carbon)' 
     549         clunits    = 'log10(mmolC/m3)' 
     550         clgrid     = 'T' 
     551 
     552      CASE('SLPHYDIA') 
     553 
     554         clfiletype = 'slphydiafb' 
     555         cllongname = 'Surface diatom log10(phytoplankton carbon)' 
     556         clunits    = 'log10(mmolC/m3)' 
     557         clgrid     = 'T' 
     558 
     559      CASE('SLPHYNON') 
     560 
     561         clfiletype = 'slphynonfb' 
     562         cllongname = 'Surface non-diatom log10(phytoplankton carbon)' 
     563         clunits    = 'log10(mmolC/m3)' 
     564         clgrid     = 'T' 
     565 
     566      CASE('SSPM') 
     567 
     568         clfiletype = 'sspmfb' 
     569         cllongname = 'Surface suspended particulate matter' 
     570         clunits    = 'g/m3' 
     571         clgrid     = 'T' 
     572 
     573      CASE('SFCO2','FCO2','fCO2','fco2') 
     574 
     575         clfiletype = 'sfco2fb' 
     576         cllongname = 'Surface fugacity of carbon dioxide' 
     577         clunits    = 'uatm' 
     578         clgrid     = 'T' 
     579 
     580      CASE('SPCO2') 
     581 
     582         clfiletype = 'spco2fb' 
     583         cllongname = 'Surface partial pressure of carbon dioxide' 
     584         clunits    = 'uatm' 
     585         clgrid     = 'T' 
     586 
     587      CASE DEFAULT 
     588 
     589         CALL ctl_stop( 'Unknown observation type '//TRIM(surfdata%cvars(1))//' in obs_wri_surf' ) 
     590 
     591      END SELECT 
     592 
     593      ! SLA needs special treatment because of MDT, so is done above 
     594      ! Remaining variables treated more generically 
     595 
     596      IF ( TRIM(surfdata%cvars(1)) /= 'SLA' ) THEN 
     597       
    376598         CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 
    377599            &                 1 + iadd, iext, .TRUE. ) 
    378600 
    379          clfiletype = 'sstfb' 
    380601         fbdata%cname(1)      = surfdata%cvars(1) 
    381          fbdata%coblong(1)    = 'Sea surface temperature' 
    382          fbdata%cobunit(1)    = 'Degree centigrade' 
     602         fbdata%coblong(1)    = cllongname 
     603         fbdata%cobunit(1)    = clunits 
    383604         DO je = 1, iext 
    384605            fbdata%cextname(je) = pext%cdname(je) 
     
    386607            fbdata%cextunit(je) = pext%cdunit(je,1) 
    387608         END DO 
    388          fbdata%caddlong(1,1) = 'Model interpolated SST' 
    389          fbdata%caddunit(1,1) = 'Degree centigrade' 
    390          fbdata%cgrid(1)      = 'T' 
     609         IF ( TRIM(surfdata%cvars(1)) == 'ICECONC' ) THEN 
     610            fbdata%caddlong(1,1) = 'Model interpolated ICE' 
     611         ELSE 
     612            fbdata%caddlong(1,1) = 'Model interpolated ' // TRIM(surfdata%cvars(1)) 
     613         ENDIF 
     614         fbdata%caddunit(1,1) = clunits 
     615         fbdata%cgrid(1)      = clgrid 
    391616         DO ja = 1, iadd 
    392617            fbdata%caddname(1+ja) = padd%cdname(ja) 
     
    395620         END DO 
    396621 
    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  
     622      ENDIF 
     623       
    541624      fbdata%caddname(1)   = 'Hx' 
    542625 
Note: See TracChangeset for help on using the changeset viewer.