- Timestamp:
- 2018-02-05T16:07:40+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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
Note: See TracChangeset
for help on using the changeset viewer.
