Changeset 9306
- Timestamp:
- 2018-02-05T16:07:40+01:00 (6 years ago)
- Location:
- branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM
- Files:
-
- 6 edited
-
CONFIG/SHARED/namelist_ref (modified) (2 diffs)
-
NEMO/OPA_SRC/OBS/diaobs.F90 (modified) (32 diffs)
-
NEMO/OPA_SRC/OBS/obs_oper.F90 (modified) (20 diffs)
-
NEMO/OPA_SRC/OBS/obs_prep.F90 (modified) (9 diffs)
-
NEMO/OPA_SRC/OBS/obs_read_prof.F90 (modified) (23 diffs)
-
NEMO/OPA_SRC/OBS/obs_write.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/CONFIG/SHARED/namelist_ref
r7992 r9306 1201 1201 ln_vel3d = .false. ! Logical switch for velocity observations 1202 1202 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 1207 1226 ln_altbias = .false. ! Logical switch for altimeter bias correction 1208 1227 ln_sstbias = .false. ! Logical switch for SST bias correction … … 1213 1232 ln_s_at_t = .false. ! Logical switch for computing model S at T obs if not there 1214 1233 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 1216 1236 ln_sst_fp_indegs = .true. 1217 1237 ln_sss_fp_indegs = .true. 1218 1238 ln_sic_fp_indegs = .true. 1219 1239 ! 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 1248 1293 1249 1294 / -
branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r8653 r9306 45 45 !! * Module variables 46 46 LOGICAL, PUBLIC :: & 47 & lk_diaobs = .TRUE. !: Include this for backwards compatibility at NEMO 3.6. 48 LOGICAL :: ln_diaobs !: Logical switch for the obs operator 49 LOGICAL :: ln_sstnight !: Logical switch for night mean SST obs 50 LOGICAL :: ln_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) 70 73 71 74 INTEGER, DIMENSION(imaxavtypes) :: & … … 95 98 & profdataqc !: Profile data after quality control 96 99 97 CHARACTER(len= 6), PUBLIC, DIMENSION(:), ALLOCATABLE :: &100 CHARACTER(len=8), PUBLIC, DIMENSION(:), ALLOCATABLE :: & 98 101 & cobstypesprof, & !: Profile obs types 99 102 & cobstypessurf !: Surface obs types … … 141 144 INTEGER :: jfile ! Counter for files 142 145 INTEGER :: jnumsstbias ! Number of SST bias files to read and apply 146 INTEGER :: n2dint_type ! Local version of nn_2dint* 143 147 144 148 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 155 178 & cn_sstbiasfiles ! SST bias input filenames 156 179 … … 166 189 LOGICAL :: ln_sss ! Logical switch for sea surface salinity obs 167 190 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 172 214 LOGICAL :: ln_nea ! Logical switch to remove obs near land 173 215 LOGICAL :: ln_altbias ! Logical switch for altimeter bias … … 180 222 REAL(dp) :: rn_dobsend ! Obs window end date YYYYMMDD.HHMMSS 181 223 224 REAL(wp) :: ztype_avglamscl ! Local version of rn_*_avglamscl 225 REAL(wp) :: ztype_avgphiscl ! Local version of rn_*_avgphiscl 226 182 227 CHARACTER(len=128), DIMENSION(:,:), ALLOCATABLE :: & 183 228 & clproffiles, & ! Profile filenames 184 229 & clsurffiles ! Surface filenames 185 230 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 195 235 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 198 241 199 242 200 243 NAMELIST/namobs/ln_diaobs, ln_t3d, ln_s3d, ln_sla, & 201 244 & 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, & 203 253 & ln_altbias, ln_sstbias, ln_nea, & 204 254 & ln_grid_global, ln_grid_search_lookup, & 205 255 & ln_ignmis, ln_s_at_t, ln_bound_reject, & 206 & ln_sstnight, 256 & ln_sstnight, ln_default_fp_indegs, & 207 257 & ln_sla_fp_indegs, ln_sst_fp_indegs, & 208 258 & ln_sss_fp_indegs, ln_sic_fp_indegs, & … … 210 260 & cn_sstfbfiles, cn_sicfbfiles, & 211 261 & 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, & 214 273 & cn_sstbiasfiles, cn_altbiasfile, & 215 274 & cn_gridsearchfile, rn_gridsearchres, & 216 275 & rn_dobsini, rn_dobsend, & 276 & rn_default_avglamscl, rn_default_avgphiscl, & 217 277 & rn_sla_avglamscl, rn_sla_avgphiscl, & 218 278 & rn_sst_avglamscl, rn_sst_avgphiscl, & 219 279 & rn_sss_avglamscl, rn_sss_avgphiscl, & 220 280 & rn_sic_avglamscl, rn_sic_avgphiscl, & 221 & nn_1dint, nn_2dint ,&281 & nn_1dint, nn_2dint_default, & 222 282 & nn_2dint_sla, nn_2dint_sst, & 223 283 & nn_2dint_sss, nn_2dint_sic, & … … 225 285 & nn_profdavtypes 226 286 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 234 287 !----------------------------------------------------------------------- 235 288 ! Read namelist parameters … … 237 290 238 291 ! 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 251 323 252 324 CALL ini_date( rn_dobsini ) … … 286 358 WRITE(numout,*) ' Logical switch for velocity observations ln_vel3d = ', ln_vel3d 287 359 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 292 383 WRITE(numout,*) ' Global distribution of observations ln_grid_global = ', ln_grid_global 293 384 WRITE(numout,*) ' Logical switch for obs grid search lookup ln_grid_search_lookup = ', ln_grid_search_lookup … … 297 388 WRITE(numout,*) ' Final date in window YYYYMMDD.HHMMSS rn_dobsend = ', rn_dobsend 298 389 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 300 407 WRITE(numout,*) ' Rejection of observations near land switch ln_nea = ', ln_nea 301 408 WRITE(numout,*) ' Rejection of obs near open bdys ln_bound_reject = ', ln_bound_reject … … 314 421 !----------------------------------------------------------------------- 315 422 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 /) ) 319 431 320 432 IF ( nproftypes == 0 .AND. nsurftypes == 0 ) THEN … … 337 449 IF (ln_t3d .OR. ln_s3d) THEN 338 450 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 341 453 ENDIF 342 454 IF (ln_vel3d) THEN 343 455 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 ) 347 506 348 507 ENDIF … … 363 522 IF (ln_sla) THEN 364 523 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 373 526 ENDIF 374 527 IF (ln_sst) THEN 375 528 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 386 532 IF (ln_sic) THEN 387 533 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 398 537 IF (ln_sss) THEN 399 538 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, & 417 670 & 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 449 673 450 674 ENDIF … … 467 691 ENDIF 468 692 469 IF ( ( nn_2dint < 0 ) .OR. ( nn_2dint > 6 ) ) THEN470 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', & 471 695 & ' is not available') 472 696 ENDIF … … 491 715 DO jtype = 1, nproftypes 492 716 493 nvarsprof(jtype) = 2494 717 IF ( TRIM(cobstypesprof(jtype)) == 'prof' ) THEN 718 nvarsprof(jtype) = 2 495 719 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 506 734 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(:,:,:) 515 758 ENDIF 516 759 … … 519 762 & clproffiles(jtype,1:ifilesprof(jtype)), & 520 763 & nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, & 521 & rn_dobsini, rn_dobsend, llvar 1, llvar2, &764 & rn_dobsini, rn_dobsend, llvar, & 522 765 & ln_ignmis, ln_s_at_t, .FALSE., & 523 766 & kdailyavtypes = nn_profdavtypes ) … … 528 771 529 772 CALL obs_pre_prof( profdata(jtype), profdataqc(jtype), & 530 & llvar 1, llvar2, &773 & llvar, & 531 774 & jpi, jpj, jpk, & 532 & zmask 1, zglam1, zgphi1, zmask2, zglam2, zgphi2, &775 & zmask, zglam, zgphi, & 533 776 & ln_nea, ln_bound_reject, & 534 777 & kdailyavtypes = nn_profdavtypes ) 778 779 DEALLOCATE( llvar ) 780 CALL wrk_dealloc( jpi, jpj, nvarsprof(jtype), zglam ) 781 CALL wrk_dealloc( jpi, jpj, nvarsprof(jtype), zgphi ) 782 CALL wrk_dealloc( jpi, jpj, jpk, nvarsprof(jtype), zmask ) 535 783 536 784 END DO … … 587 835 588 836 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 )596 837 597 838 END SUBROUTINE dia_obs_init … … 639 880 #endif 640 881 #if defined key_hadocc 641 USE trc, ONLY : & ! HadOCC chlorophyll, fCO2 and pCO2 882 USE trc, ONLY : & ! HadOCC variables 883 & trn, & 642 884 & HADOCC_CHL, & 643 885 & HADOCC_FCO2, & 644 886 & HADOCC_PCO2, & 645 887 & 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 648 892 & trn 649 USE par_medusa, ONLY: & 650 & jpchn, & 651 & jpchd 893 USE par_medusa 894 USE sms_medusa, ONLY: & 895 & xthetapn, & 896 & xthetapd 652 897 #if defined key_roam 653 898 USE sms_medusa, ONLY: & 654 899 & f2_pco2w, & 655 & f2_fco2w 900 & f2_fco2w, & 901 & f3_pH 656 902 #endif 657 903 #elif defined key_fabm … … 674 920 INTEGER :: jtype ! Data loop variable 675 921 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 684 928 REAL(wp), POINTER, DIMENSION(:,:) :: & 685 929 & zsurfvar, & ! Model values equivalent to surface ob. 686 930 & 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 705 936 706 937 IF(lwp) THEN … … 721 952 DO jtype = 1, nproftypes 722 953 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 723 967 SELECT CASE ( TRIM(cobstypesprof(jtype)) ) 968 724 969 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 733 973 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 742 1142 CASE DEFAULT 743 1143 CALL ctl_stop( 'Unknown profile observation type '//TRIM(cobstypesprof(jtype))//' in dia_obs' ) 1144 744 1145 END SELECT 745 1146 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 ) 754 1162 755 1163 END DO … … 758 1166 759 1167 IF ( nsurftypes > 0 ) THEN 1168 1169 !Allocate local work arrays 1170 CALL wrk_alloc( jpi, jpj, zsurfvar ) 1171 CALL wrk_alloc( jpi, jpj, zsurfmask ) 760 1172 761 1173 DO jtype = 1, nsurftypes … … 763 1175 !Defaults which might be changed 764 1176 zsurfmask(:,:) = tmask(:,:,1) 1177 llog10 = .FALSE. 765 1178 766 1179 SELECT CASE ( TRIM(cobstypessurf(jtype)) ) … … 793 1206 ENDIF 794 1207 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) 798 1212 #elif defined key_medusa && defined key_foam_medusa 799 1213 ! Add non-diatom and diatom surface chlorophyll from MEDUSA 800 1214 zsurfvar(:,:) = trn(:,:,1,jpchn) + trn(:,:,1,jpchd) 801 1215 #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') 818 1390 #if defined key_spm 819 1391 zsurfvar(:,:) = 0.0 … … 822 1394 END DO 823 1395 #else 824 CALL ctl_stop( ' Trying to run s pm observation operator', &1396 CALL ctl_stop( ' Trying to run sspm observation operator', & 825 1397 & ' but no spm model appears to have been defined' ) 826 1398 #endif 827 CASE('fco2') 1399 1400 CASE('sfco2') 828 1401 #if defined key_hadocc 829 1402 zsurfvar(:,:) = HADOCC_FCO2(:,:) ! fCO2 from HadOCC … … 861 1434 & (82.0578 * (tsn(:,:,1,jp_tem)+rt0))) 862 1435 #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') 867 1441 #if defined key_hadocc 868 1442 zsurfvar(:,:) = HADOCC_PCO2(:,:) ! pCO2 from HadOCC … … 880 1454 zsurfvar(:,:) = pco2_3d(:,:,1) 881 1455 #else 882 CALL ctl_stop( ' Trying to run pCO2 observation operator', &1456 CALL ctl_stop( ' Trying to run spco2 observation operator', & 883 1457 & ' but no biogeochemical model appears to have been defined' ) 884 1458 #endif … … 889 1463 890 1464 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 891 1476 892 1477 CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj, & … … 898 1483 END DO 899 1484 1485 CALL wrk_dealloc( jpi, jpj, zsurfvar ) 1486 CALL wrk_dealloc( jpi, jpj, zsurfmask ) 1487 900 1488 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 )912 1489 913 1490 END SUBROUTINE dia_obs … … 960 1537 & ) 961 1538 962 CALL obs_rotvel( profdataqc(jtype), nn_2dint , zu, zv )1539 CALL obs_rotvel( profdataqc(jtype), nn_2dint_default, zu, zv ) 963 1540 964 1541 DO jo = 1, profdataqc(jtype)%nprof … … 1193 1770 END SUBROUTINE fin_date 1194 1771 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 1232 1807 END DO 1233 ENDIF1234 1808 1235 1809 END SUBROUTINE obs_settypefiles … … 1242 1816 & lfpindegs, lavnight ) 1243 1817 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 1274 1842 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') 1277 1845 ENDIF 1278 1846 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 1284 1865 ENDIF 1285 1866 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 1304 1882 ENDIF 1305 1883 ENDIF 1306 ENDIF1307 1884 1308 1885 END SUBROUTINE obs_setinterpopts -
branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90
r8653 r9306 60 60 61 61 62 SUBROUTINE obs_prof_opt( prodatqc, kt, kpi, kpj, kpk, 63 & kit000, kdaystp, 64 & pvar 1, pvar2, pgdept, pgdepw,&65 & pmask 1, pmask2, &66 & plam 1, 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, & 67 67 & k1dint, k2dint, kdailyavtypes ) 68 68 … … 134 134 INTEGER, INTENT(IN) :: k2dint ! Horizontal interpolation type (see header) 135 135 INTEGER, INTENT(IN) :: kdaystp ! Number of time steps per day 136 INTEGER, INTENT(IN) :: kvar ! Number of variable in prodatqc 136 137 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 141 140 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 146 143 REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 147 144 & pgdept, & ! Model array of depth T levels … … 166 163 & idailyavtypes 167 164 INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: & 168 & igrdi1, & 169 & igrdi2, & 170 & igrdj1, & 171 & igrdj2 165 & igrdi, & 166 & igrdj 172 167 INTEGER, ALLOCATABLE, DIMENSION(:) :: iv_indic 173 168 … … 176 171 REAL(KIND=wp) :: zdaystp 177 172 REAL(KIND=wp), DIMENSION(kpk) :: & 178 & zobsmask1, &179 & zobsmask2, &180 173 & zobsk, & 181 174 & zobs2k 182 175 REAL(KIND=wp), DIMENSION(2,2,1) :: & 183 176 & zweig1, & 184 & zweig2, &185 177 & zweig 186 178 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: & 187 & zmask1, & 188 & zmask2, & 189 & zint1, & 190 & zint2, & 191 & zinm1, & 192 & zinm2, & 179 & zmask, & 180 & zint, & 181 & zinm, & 193 182 & zgdept, & 194 183 & zgdepw 195 184 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 201 188 REAL(KIND=wp), DIMENSION(:,:,:), ALLOCATABLE :: interp_corner 202 189 … … 230 217 DO jj = 1, jpj 231 218 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 234 220 END DO 235 221 END DO … … 240 226 DO jj = 1, jpj 241 227 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) 248 231 END DO 249 232 END DO … … 258 241 DO jj = 1, jpj 259 242 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 264 245 END DO 265 246 END DO … … 271 252 ! Get the data for interpolation 272 253 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), & 285 260 & zgdept(2,2,kpk,ipro), & 286 261 & zgdepw(2,2,kpk,ipro) & … … 289 264 DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro 290 265 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) 307 274 END DO 308 275 … … 311 278 zgdepw(:,:,:,:) = 0.0 312 279 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 ) 325 287 326 288 ! At the end of the day also get interpolated means 327 289 IF ( ld_dailyav .AND. idayend == 0 ) THEN 328 290 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 ) 338 295 339 296 ENDIF … … 370 327 ! Horizontal weights 371 328 ! Masked values are calculated later. 372 IF ( prodatqc%npvend(jobs, 1) > 0 ) THEN329 IF ( prodatqc%npvend(jobs,kvar) > 0 ) THEN 373 330 374 331 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 389 338 390 339 zobsk(:) = obfillflt … … 396 345 397 346 ! 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) 400 349 inum_obs = iend - ista + 1 401 350 ALLOCATE(interp_corner(2,2,inum_obs),iv_indic(inum_obs)) … … 406 355 IF ( k1dint == 1 ) THEN 407 356 CALL obs_int_z1d_spl( kpk, & 408 & zinm 1(iin,ijn,:,iobs), &357 & zinm(iin,ijn,:,iobs), & 409 358 & zobs2k, zgdept(iin,ijn,:,iobs), & 410 & zmask 1(iin,ijn,:,iobs))359 & zmask(iin,ijn,:,iobs)) 411 360 ENDIF 412 361 413 362 CALL obs_level_search(kpk, & 414 363 & zgdept(iin,ijn,:,iobs), & 415 & inum_obs, prodatqc%var( 1)%vdep(ista:iend), &364 & inum_obs, prodatqc%var(kvar)%vdep(ista:iend), & 416 365 & iv_indic) 417 366 418 367 CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, & 419 & prodatqc%var( 1)%vdep(ista:iend), &420 & zinm 1(iin,ijn,:,iobs), &368 & prodatqc%var(kvar)%vdep(ista:iend), & 369 & zinm(iin,ijn,:,iobs), & 421 370 & zobs2k, interp_corner(iin,ijn,:), & 422 371 & zgdept(iin,ijn,:,iobs), & 423 & zmask 1(iin,ijn,:,iobs))372 & zmask(iin,ijn,:,iobs)) 424 373 425 374 ENDDO … … 433 382 434 383 ! 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) 437 386 inum_obs = iend - ista + 1 438 387 ALLOCATE(interp_corner(2,2,inum_obs), iv_indic(inum_obs)) … … 442 391 IF ( k1dint == 1 ) THEN 443 392 CALL obs_int_z1d_spl( kpk, & 444 & zint 1(iin,ijn,:,iobs),&393 & zint(iin,ijn,:,iobs),& 445 394 & zobs2k, zgdept(iin,ijn,:,iobs), & 446 & zmask 1(iin,ijn,:,iobs))395 & zmask(iin,ijn,:,iobs)) 447 396 448 397 ENDIF … … 450 399 CALL obs_level_search(kpk, & 451 400 & zgdept(iin,ijn,:,iobs),& 452 & inum_obs, prodatqc%var( 1)%vdep(ista:iend), &401 & inum_obs, prodatqc%var(kvar)%vdep(ista:iend), & 453 402 & iv_indic) 454 403 455 404 CALL obs_int_z1d(kpk, iv_indic, k1dint, inum_obs, & 456 & prodatqc%var( 1)%vdep(ista:iend), &457 & zint 1(iin,ijn,:,iobs), &405 & prodatqc%var(kvar)%vdep(ista:iend), & 406 & zint(iin,ijn,:,iobs), & 458 407 & zobs2k,interp_corner(iin,ijn,:), & 459 408 & zgdept(iin,ijn,:,iobs), & 460 & zmask 1(iin,ijn,:,iobs) )409 & zmask(iin,ijn,:,iobs) ) 461 410 462 411 ENDDO … … 482 431 DO ijn=1,2 483 432 484 depth_loop 1: DO ik=kpk,2,-1485 IF(zmask 1(iin,ijn,ik-1,iobs ) > 0.9 )THEN433 depth_loop: DO ik=kpk,2,-1 434 IF(zmask(iin,ijn,ik-1,iobs ) > 0.9 )THEN 486 435 487 436 zweig(iin,ijn,1) = & 488 437 & zweig1(iin,ijn,1) * & 489 438 & 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) 491 440 492 EXIT depth_loop 1441 EXIT depth_loop 493 442 494 443 ENDIF 495 444 496 ENDDO depth_loop 1445 ENDDO depth_loop 497 446 498 447 ENDDO … … 500 449 501 450 CALL obs_int_h2d( 1, 1, zweig, interp_corner(:,:,ikn), & 502 & prodatqc%var( 1)%vmod(iend:iend) )451 & prodatqc%var(kvar)%vmod(iend:iend) ) 503 452 504 453 ! Set QC flag for any observations found below the bottom 505 454 ! 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)=4455 IF (sum(zweig) == 0.0_wp) prodatqc%var(kvar)%nvqc(iend:iend)=4 507 456 508 457 ENDDO … … 510 459 DEALLOCATE(interp_corner,iv_indic) 511 460 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 640 462 641 463 ENDDO 642 464 643 465 ! 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, & 657 473 & zgdept, & 658 474 & zgdepw & … … 661 477 ! At the end of the day also get interpolated means 662 478 IF ( ld_dailyav .AND. idayend == 0 ) THEN 663 DEALLOCATE( & 664 & zinm1, & 665 & zinm2 & 666 & ) 479 DEALLOCATE( zinm ) 667 480 ENDIF 668 481 669 prodatqc%nprofup = prodatqc%nprofup + ipro 482 IF ( kvar == prodatqc%nvar ) THEN 483 prodatqc%nprofup = prodatqc%nprofup + ipro 484 ENDIF 670 485 671 486 END SUBROUTINE obs_prof_opt -
branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90
r8222 r9306 255 255 256 256 257 SUBROUTINE obs_pre_prof( profdata, prodatqc, ld_var 1, ld_var2, &257 SUBROUTINE obs_pre_prof( profdata, prodatqc, ld_var, & 258 258 & kpi, kpj, kpk, & 259 & zmask 1, pglam1, pgphi1, zmask2, pglam2, pgphi2, &259 & zmask, pglam, pgphi, & 260 260 & ld_nea, ld_bound_reject, kdailyavtypes, kqc_cutoff ) 261 261 … … 284 284 TYPE(obs_prof), INTENT(INOUT) :: profdata ! Full set of profile data 285 285 TYPE(obs_prof), INTENT(INOUT) :: prodatqc ! Subset of profile data not failing screening 286 LOGICAL, INTENT(IN) :: ld_var1 ! Observed variables switches287 LOGICAL, INTENT(IN) :: ld_var2286 LOGICAL, DIMENSION(profdata%nvar), INTENT(IN) :: & 287 & ld_var ! Observed variables switches 288 288 LOGICAL, INTENT(IN) :: ld_nea ! Switch for rejecting observation near land 289 289 LOGICAL, INTENT(IN) :: ld_bound_reject ! Switch for rejecting observations near the boundary … … 291 291 INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 292 292 & kdailyavtypes ! Types for daily averages 293 REAL(wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 294 & zmask1, & 295 & zmask2 296 REAL(wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 297 & pglam1, & 298 & pglam2, & 299 & pgphi1, & 300 & pgphi2 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 301 298 INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff ! cut off for QC value 302 299 … … 309 306 INTEGER :: imin0 310 307 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 337 326 TYPE(obs_prof_valid) :: llvalid ! Profile selection 338 327 TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: & 339 & llvvalid ! var 1,var2selection328 & llvvalid ! vars selection 340 329 INTEGER :: jvar ! Variable loop variable 341 330 INTEGER :: jobs ! Obs. loop variable 342 331 INTEGER :: jstp ! Time loop variable 343 332 INTEGER :: inrc ! Time index variable 333 CHARACTER(LEN=256) :: cout1 ! Diagnostic output line 334 CHARACTER(LEN=256) :: cout2 ! Diagnostic output line 344 335 345 336 IF(lwp) WRITE(numout,*)'obs_pre_prof: Preparing the profile data...' … … 355 346 icycle = no ! Assimilation cycle 356 347 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 371 358 372 359 … … 401 388 ! ----------------------------------------------------------------------- 402 389 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 407 394 408 395 CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp ) … … 419 406 ! ----------------------------------------------------------------------- 420 407 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 464 430 465 431 ! ----------------------------------------------------------------------- … … 512 478 513 479 WRITE(numout,*) 514 WRITE(numout,*) ' Profiles outside time domain = ', &480 WRITE(numout,*) ' Profiles outside time domain = ', & 515 481 & iotdobsmpp 516 WRITE(numout,*) ' Remaining profiles that failed grid search = ', &482 WRITE(numout,*) ' Remaining profiles that failed grid search = ', & 517 483 & 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 556 508 557 509 WRITE(numout,*) 558 510 WRITE(numout,*) ' Number of observations per time step :' 559 511 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 564 520 ENDIF 565 521 … … 588 544 DO jstp = nit000 - 1, nitend 589 545 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 593 551 END DO 594 552 ENDIF 595 596 998 FORMAT(10X,'---------',5X,'--------',5X,'-----------',5X,'----------------')597 999 FORMAT(10X,I9,5X,I8,5X,I11,5X,I8)598 553 599 554 END SUBROUTINE obs_pre_prof -
branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
r7992 r9306 45 45 SUBROUTINE obs_rea_prof( profdata, knumfiles, cdfilenames, & 46 46 & kvars, kextr, kstp, ddobsini, ddobsend, & 47 & ldvar 1, ldvar2, ldignmis, ldsatt, &47 & ldvar, ldignmis, ldsatt, & 48 48 & ldmod, kdailyavtypes ) 49 49 !!--------------------------------------------------------------------- … … 74 74 INTEGER, INTENT(IN) :: kextr ! Number of extra fields for each var 75 75 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 78 77 LOGICAL, INTENT(IN) :: ldignmis ! Ignore missing files 79 78 LOGICAL, INTENT(IN) :: ldsatt ! Compute salinity at all temperature points … … 105 104 INTEGER :: iprof 106 105 INTEGER :: iproftot 107 INTEGER :: ivar1t0 108 INTEGER :: ivar2t0 109 INTEGER :: ivar1t 110 INTEGER :: ivar2t 106 INTEGER, DIMENSION(kvars) :: ivart0 107 INTEGER, DIMENSION(kvars) :: ivart 111 108 INTEGER :: ip3dt 112 109 INTEGER :: ios 113 110 INTEGER :: ioserrcount 114 INTEGER :: ivar1tmpp 115 INTEGER :: ivar2tmpp 111 INTEGER, DIMENSION(kvars) :: ivartmpp 116 112 INTEGER :: ip3dtmpp 117 113 INTEGER :: itype 118 114 INTEGER, DIMENSION(knumfiles) :: & 119 115 & 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 125 123 INTEGER, DIMENSION(:), ALLOCATABLE :: & 126 & iobsi1, &127 & iobsj1, &128 & iproc1, &129 & iobsi2, &130 & iobsj2, &131 & iproc2, &132 124 & iindx, & 133 125 & ifileidx, & … … 147 139 LOGICAL :: llvalprof 148 140 LOGICAL :: lldavtimset 141 LOGICAL :: llcycle 149 142 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 150 143 & inpfiles … … 152 145 ! Local initialization 153 146 iprof = 0 154 ivar1t0 = 0 155 ivar2t0 = 0 147 ivart0(:) = 0 156 148 ip3dt = 0 157 149 … … 219 211 & ldgrid = .TRUE. ) 220 212 221 IF ( inpfiles(jj)%nvar < 2) THEN213 IF ( inpfiles(jj)%nvar /= kvars ) THEN 222 214 CALL ctl_stop( 'Feedback format error: ', & 223 & ' less than 2vars in profile file' )215 & ' unexpected number of vars in profile file' ) 224 216 ENDIF 225 217 … … 308 300 DO ji = 1, inpfiles(jj)%nobs 309 301 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 312 310 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 313 311 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 317 315 ALLOCATE( zlam(inowin) ) 318 316 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) ) 325 320 inowin = 0 326 321 DO ji = 1, inpfiles(jj)%nobs 327 322 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 330 331 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 331 332 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 336 337 END DO 337 338 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 349 355 ENDIF 350 356 … … 352 358 DO ji = 1, inpfiles(jj)%nobs 353 359 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 356 368 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 357 369 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN 358 370 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 369 384 ENDIF 370 385 ENDIF 371 386 END DO 372 DEALLOCATE( zlam, zphi, iobsi 1, iobsj1, iproc1, iobsi2, iobsj2, iproc2)387 DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc ) 373 388 374 389 DO ji = 1, inpfiles(jj)%nobs 375 390 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 378 399 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 379 400 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 384 405 ENDIF 385 406 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 407 420 IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 408 421 & 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 ) ) THEN415 ip3dt = ip3dt + 1416 llvalprof = .TRUE.417 END IF418 END DO loop_p_count422 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 419 432 420 433 IF ( llvalprof ) iprof = iprof + 1 … … 438 451 DO ji = 1, inpfiles(jj)%nobs 439 452 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 442 461 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 443 462 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 453 472 DO ji = 1, inpfiles(jj)%nobs 454 473 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 457 482 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 458 483 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 470 495 iv3dt(:) = -1 471 496 IF (ldsatt) THEN 472 iv3dt(1) = ip3dt 473 iv3dt(2) = ip3dt 497 iv3dt(:) = ip3dt 474 498 ELSE 475 iv3dt(1) = ivar1t0 476 iv3dt(2) = ivar2t0 499 iv3dt(:) = ivart0(:) 477 500 ENDIF 478 501 CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, & … … 487 510 488 511 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 496 515 497 516 ioserrcount = 0 … … 501 520 ji = iprofidx(iindx(jk)) 502 521 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 506 531 507 532 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & … … 519 544 520 545 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 523 554 524 555 loop_prof : DO ij = 1, inpfiles(jj)%nlev … … 527 558 & CYCLE 528 559 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 544 569 545 570 END DO loop_prof … … 573 598 574 599 ! 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 579 604 580 605 ! Profile WMO number … … 616 641 IF (ldsatt) THEN 617 642 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 627 720 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 752 723 753 724 END DO loop_p … … 763 734 !----------------------------------------------------------------------- 764 735 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 767 739 CALL obs_mpp_sum_integer ( ip3dt, ip3dtmpp ) 768 740 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 771 744 772 745 !----------------------------------------------------------------------- … … 778 751 WRITE(numout,'(1X,A)') '------------' 779 752 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,*) 788 771 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) 805 781 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 & ' = ', ivar2tmpp811 WRITE(numout,'(1X,A)') &812 & '---------------------------------------------------------------'813 WRITE(numout,*)814 ENDIF815 816 IF (ldsatt) THEN817 profdata%nvprot(1) = ip3dt818 profdata%nvprot(2) = ip3dt819 profdata%nvprotmpp(1) = ip3dtmpp820 profdata%nvprotmpp(2) = ip3dtmpp821 ELSE822 profdata%nvprot(1) = ivar1t823 profdata%nvprot(2) = ivar2t824 profdata%nvprotmpp(1) = ivar1tmpp825 profdata%nvprotmpp(2) = ivar2tmpp826 782 ENDIF 827 783 profdata%nprof = iprof … … 830 786 ! Model level search 831 787 !----------------------------------------------------------------------- 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 842 795 843 796 !----------------------------------------------------------------------- -
branches/UKMO/dev_r5518_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
r8223 r9306 84 84 CHARACTER(LEN=40) :: clfname 85 85 CHARACTER(LEN=10) :: clfiletype 86 CHARACTER(LEN=ilenlong) :: cllongname ! Long name of variable 87 CHARACTER(LEN=ilenunit) :: clunits ! Units of variable 88 CHARACTER(LEN=ilengrid) :: clgrid ! Grid of variable 86 89 INTEGER :: ilevel 87 90 INTEGER :: jvar … … 111 114 ! Find maximum level 112 115 ilevel = 0 113 DO jvar = 1, 2116 DO jvar = 1, profdata%nvar 114 117 ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) ) 115 118 END DO … … 175 178 END DO 176 179 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 177 243 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 178 266 179 267 fbdata%caddname(1) = 'Hx' … … 228 316 & krefdate = 19500101 ) 229 317 ! Reform the profiles arrays for output 230 DO jvar = 1, 2318 DO jvar = 1, profdata%nvar 231 319 DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar) 232 320 ik = profdata%var(jvar)%nvlidx(jk) … … 322 410 CHARACTER(LEN=10) :: clfiletype 323 411 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 324 415 INTEGER :: jo 325 416 INTEGER :: ja … … 344 435 SELECT CASE ( TRIM(surfdata%cvars(1)) ) 345 436 CASE('SLA') 437 438 ! SLA needs special treatment because of MDT, so is all done here 439 ! Other variables are done more generically 346 440 347 441 CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & … … 374 468 CASE('SST') 375 469 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 376 598 CALL alloc_obfbdata( fbdata, 1, surfdata%nsurf, 1, & 377 599 & 1 + iadd, iext, .TRUE. ) 378 600 379 clfiletype = 'sstfb'380 601 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 383 604 DO je = 1, iext 384 605 fbdata%cextname(je) = pext%cdname(je) … … 386 607 fbdata%cextunit(je) = pext%cdunit(je,1) 387 608 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 391 616 DO ja = 1, iadd 392 617 fbdata%caddname(1+ja) = padd%cdname(ja) … … 395 620 END DO 396 621 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 541 624 fbdata%caddname(1) = 'Hx' 542 625
Note: See TracChangeset
for help on using the changeset viewer.
