- Timestamp:
- 2017-03-31T12:05:33+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r7837 r7858 48 48 LOGICAL :: ln_diaobs !: Logical switch for the obs operator 49 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) 50 63 51 64 INTEGER :: nn_1dint !: Vertical interpolation method 52 INTEGER :: nn_2dint !: Horizontal 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 70 53 71 INTEGER, DIMENSION(imaxavtypes) :: & 54 72 & nn_profdavtypes !: Profile data types representing a daily average … … 61 79 & nextrprof, & !: Number of profile extra variables 62 80 & nextrsurf !: Number of surface extra variables 81 INTEGER, DIMENSION(:), ALLOCATABLE :: & 82 & n2dintsurf !: Interpolation option for surface variables 83 REAL(wp), DIMENSION(:), ALLOCATABLE :: & 84 & ravglamscl, & !: E/W diameter of averaging footprint for surface variables 85 & ravgphiscl !: N/S diameter of averaging footprint for surface variables 86 LOGICAL, DIMENSION(:), ALLOCATABLE :: & 87 & lfpindegs, & !: T=> surface obs footprint size specified in degrees, F=> in metres 88 & llnightav !: Logical for calculating night-time averages 63 89 64 90 TYPE(obs_surf), PUBLIC, POINTER, DIMENSION(:) :: & … … 132 158 & cn_altbiasfile ! Altimeter bias input filename 133 159 134 CHARACTER(len=128), DIMENSION(:,:), ALLOCATABLE :: &135 & clproffiles, & ! Profile filenames136 & clsurffiles ! Surface filenames137 160 138 161 LOGICAL :: ln_t3d ! Logical switch for temperature profiles … … 153 176 LOGICAL :: ln_s_at_t ! Logical switch to compute model S at T obs 154 177 LOGICAL :: ln_bound_reject ! Logical switch for rejecting obs near the boundary 178 179 REAL(dp) :: rn_dobsini ! Obs window start date YYYYMMDD.HHMMSS 180 REAL(dp) :: rn_dobsend ! Obs window end date YYYYMMDD.HHMMSS 181 182 CHARACTER(len=128), DIMENSION(:,:), ALLOCATABLE :: & 183 & clproffiles, & ! Profile filenames 184 & clsurffiles ! Surface filenames 185 155 186 LOGICAL :: llvar1 ! Logical for profile variable 1 156 187 LOGICAL :: llvar2 ! Logical for profile variable 1 157 LOGICAL :: llnightav ! Logical for calculating night-time averages 158 159 REAL(dp) :: rn_dobsini ! Obs window start date YYYYMMDD.HHMMSS 160 REAL(dp) :: rn_dobsend ! Obs window end date YYYYMMDD.HHMMSS 188 161 189 REAL(wp), POINTER, DIMENSION(:,:) :: & 162 190 & zglam1, & ! Model longitudes for profile variable 1 … … 169 197 & zmask2 ! Model land/sea mask associated with variable 2 170 198 199 171 200 NAMELIST/namobs/ln_diaobs, ln_t3d, ln_s3d, ln_sla, & 172 201 & ln_sst, ln_sic, ln_sss, ln_vel3d, & … … 176 205 & ln_ignmis, ln_s_at_t, ln_bound_reject, & 177 206 & ln_sstnight, & 207 & ln_sla_fp_indegs, ln_sst_fp_indegs, & 208 & ln_sss_fp_indegs, ln_sic_fp_indegs, & 178 209 & cn_profbfiles, cn_slafbfiles, & 179 210 & cn_sstfbfiles, cn_sicfbfiles, & … … 183 214 & cn_sstbiasfiles, cn_altbiasfile, & 184 215 & cn_gridsearchfile, rn_gridsearchres, & 185 & rn_dobsini, rn_dobsend, nn_1dint, nn_2dint, & 216 & rn_dobsini, rn_dobsend, & 217 & rn_sla_avglamscl, rn_sla_avgphiscl, & 218 & rn_sst_avglamscl, rn_sst_avgphiscl, & 219 & rn_sss_avglamscl, rn_sss_avgphiscl, & 220 & rn_sic_avglamscl, rn_sic_avgphiscl, & 221 & nn_1dint, nn_2dint, & 222 & nn_2dint_sla, nn_2dint_sst, & 223 & nn_2dint_sss, nn_2dint_sic, & 186 224 & nn_msshc, rn_mdtcorr, rn_mdtcutoff, & 187 225 & nn_profdavtypes … … 236 274 ENDIF 237 275 238 239 !-----------------------------------------------------------------------240 ! Set up list of observation types to be used241 ! and the files associated with each type242 !-----------------------------------------------------------------------243 244 nproftypes = COUNT( (/ln_t3d .OR. ln_s3d, ln_vel3d /) )245 nsurftypes = COUNT( (/ln_sla, ln_sst, ln_sic, ln_sss, &246 & ln_logchl, ln_spm, ln_fco2, ln_pco2 /) )247 248 IF ( nproftypes == 0 .AND. nsurftypes == 0 ) THEN249 IF(lwp) WRITE(numout,cform_war)250 IF(lwp) WRITE(numout,*) ' ln_diaobs is set to true, but all obs operator logical flags', &251 & ' are set to .FALSE. so turning off calls to dia_obs'252 nwarn = nwarn + 1253 lk_diaobs = .FALSE.254 RETURN255 ENDIF256 257 IF ( nproftypes > 0 ) THEN258 259 ALLOCATE( cobstypesprof(nproftypes) )260 ALLOCATE( ifilesprof(nproftypes) )261 ALLOCATE( clproffiles(nproftypes,jpmaxnfiles) )262 263 jtype = 0264 IF (ln_t3d .OR. ln_s3d) THEN265 jtype = jtype + 1266 CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'prof ', &267 & cn_profbfiles, ifilesprof, cobstypesprof, clproffiles )268 ENDIF269 IF (ln_vel3d) THEN270 jtype = jtype + 1271 CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'vel ', &272 & cn_velfbfiles, ifilesprof, cobstypesprof, clproffiles )273 ENDIF274 275 ENDIF276 277 IF ( nsurftypes > 0 ) THEN278 279 ALLOCATE( cobstypessurf(nsurftypes) )280 ALLOCATE( ifilessurf(nsurftypes) )281 ALLOCATE( clsurffiles(nsurftypes, jpmaxnfiles) )282 283 jtype = 0284 IF (ln_sla) THEN285 jtype = jtype + 1286 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sla ', &287 & cn_slafbfiles, ifilessurf, cobstypessurf, clsurffiles )288 ENDIF289 IF (ln_sst) THEN290 jtype = jtype + 1291 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sst ', &292 & cn_sstfbfiles, ifilessurf, cobstypessurf, clsurffiles )293 ENDIF294 #if defined key_lim2 || defined key_lim3 || defined key_cice295 IF (ln_sic) THEN296 jtype = jtype + 1297 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sic ', &298 & cn_sicfbfiles, ifilessurf, cobstypessurf, clsurffiles )299 ENDIF300 #endif301 IF (ln_sss) THEN302 jtype = jtype + 1303 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sss ', &304 & cn_sssfbfiles, ifilessurf, cobstypessurf, clsurffiles )305 ENDIF306 307 IF (ln_logchl) THEN308 jtype = jtype + 1309 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'logchl', &310 & cn_logchlfbfiles, ifilessurf, cobstypessurf, clsurffiles )311 ENDIF312 313 IF (ln_spm) THEN314 jtype = jtype + 1315 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'spm ', &316 & cn_spmfbfiles, ifilessurf, cobstypessurf, clsurffiles )317 ENDIF318 319 IF (ln_fco2) THEN320 jtype = jtype + 1321 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'fco2 ', &322 & cn_fco2fbfiles, ifilessurf, cobstypessurf, clsurffiles )323 ENDIF324 325 IF (ln_pco2) THEN326 jtype = jtype + 1327 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'pco2 ', &328 & cn_pco2fbfiles, ifilessurf, cobstypessurf, clsurffiles )329 ENDIF330 331 ENDIF332 333 !Write namelist settings to stdout334 276 IF(lwp) THEN 335 277 WRITE(numout,*) … … 348 290 WRITE(numout,*) ' Logical switch for FCO2 observations ln_fco2 = ', ln_fco2 349 291 WRITE(numout,*) ' Logical switch for PCO2 observations ln_pco2 = ', ln_pco2 350 WRITE(numout,*) ' Global distribution of observations ln_grid_global = ', ln_grid_global351 WRITE(numout,*) ' Logical switch for obs grid search lookup ln_grid_search_lookup = ', ln_grid_search_lookup292 WRITE(numout,*) ' Global distribution of observations ln_grid_global = ', ln_grid_global 293 WRITE(numout,*) ' Logical switch for obs grid search lookup ln_grid_search_lookup = ', ln_grid_search_lookup 352 294 IF (ln_grid_search_lookup) & 353 295 WRITE(numout,*) ' Grid search lookup file header cn_gridsearchfile = ', cn_gridsearchfile … … 366 308 WRITE(numout,*) ' Daily average types nn_profdavtypes = ', nn_profdavtypes 367 309 WRITE(numout,*) ' Logical switch for night-time SST obs ln_sstnight = ', ln_sstnight 368 WRITE(numout,*) ' Number of profile obs types: ',nproftypes 369 370 IF ( nproftypes > 0 ) THEN 371 DO jtype = 1, nproftypes 372 DO jfile = 1, ifilesprof(jtype) 373 WRITE(numout,'(1X,2A)') ' '//cobstypesprof(jtype)//' input observation file names = ', & 374 TRIM(clproffiles(jtype,jfile)) 375 END DO 376 END DO 310 ENDIF 311 !----------------------------------------------------------------------- 312 ! Set up list of observation types to be used 313 ! and the files associated with each type 314 !----------------------------------------------------------------------- 315 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 /) ) 319 320 IF ( nproftypes == 0 .AND. nsurftypes == 0 ) THEN 321 IF(lwp) WRITE(numout,cform_war) 322 IF(lwp) WRITE(numout,*) ' ln_diaobs is set to true, but all obs operator logical flags', & 323 & ' are set to .FALSE. so turning off calls to dia_obs' 324 nwarn = nwarn + 1 325 lk_diaobs = .FALSE. 326 RETURN 327 ENDIF 328 329 IF(lwp) WRITE(numout,*) ' Number of profile obs types: ',nproftypes 330 IF ( nproftypes > 0 ) THEN 331 332 ALLOCATE( cobstypesprof(nproftypes) ) 333 ALLOCATE( ifilesprof(nproftypes) ) 334 ALLOCATE( clproffiles(nproftypes,jpmaxnfiles) ) 335 336 jtype = 0 337 IF (ln_t3d .OR. ln_s3d) THEN 338 jtype = jtype + 1 339 CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'prof ', & 340 & cn_profbfiles, ifilesprof, cobstypesprof, clproffiles ) 377 341 ENDIF 378 379 WRITE(numout,*)' Number of surface obs types: ',nsurftypes 380 IF ( nsurftypes > 0 ) THEN 381 DO jtype = 1, nsurftypes 382 DO jfile = 1, ifilessurf(jtype) 383 WRITE(numout,'(1X,2A)') ' '//cobstypessurf(jtype)//' input observation file names = ', & 384 TRIM(clsurffiles(jtype,jfile)) 385 END DO 386 END DO 342 IF (ln_vel3d) THEN 343 jtype = jtype + 1 344 CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'vel ', & 345 & cn_velfbfiles, ifilesprof, cobstypesprof, clproffiles ) 387 346 ENDIF 388 WRITE(numout,*) '~~~~~~~~~~~~' 389 390 ENDIF 347 348 ENDIF 349 350 IF(lwp) WRITE(numout,*)' Number of surface obs types: ',nsurftypes 351 IF ( nsurftypes > 0 ) THEN 352 353 ALLOCATE( cobstypessurf(nsurftypes) ) 354 ALLOCATE( ifilessurf(nsurftypes) ) 355 ALLOCATE( clsurffiles(nsurftypes, jpmaxnfiles) ) 356 ALLOCATE(n2dintsurf(nsurftypes)) 357 ALLOCATE(ravglamscl(nsurftypes)) 358 ALLOCATE(ravgphiscl(nsurftypes)) 359 ALLOCATE(lfpindegs(nsurftypes)) 360 ALLOCATE(llnightav(nsurftypes)) 361 362 jtype = 0 363 IF (ln_sla) THEN 364 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 ) 373 ENDIF 374 IF (ln_sst) THEN 375 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 386 IF (ln_sic) THEN 387 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 398 IF (ln_sss) THEN 399 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, & 417 & 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 449 450 ENDIF 451 452 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 453 391 454 392 455 !----------------------------------------------------------------------- … … 404 467 ENDIF 405 468 406 IF ( ( nn_2dint < 0 ) .OR. ( nn_2dint > 4) ) THEN469 IF ( ( nn_2dint < 0 ) .OR. ( nn_2dint > 6 ) ) THEN 407 470 CALL ctl_stop(' Choice of horizontal (2D) interpolation method', & 408 471 & ' is not available') … … 488 551 nvarssurf(jtype) = 1 489 552 nextrsurf(jtype) = 0 490 llnightav = .FALSE.491 553 IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) nextrsurf(jtype) = 2 492 IF ( TRIM(cobstypessurf(jtype)) == 'sst' ) llnightav = ln_sstnight493 554 494 555 !Read in surface obs types … … 496 557 & clsurffiles(jtype,1:ifilessurf(jtype)), & 497 558 & nvarssurf(jtype), nextrsurf(jtype), nitend-nit000+2, & 498 & rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav )559 & rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav(jtype) ) 499 560 500 561 CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea, ln_bound_reject ) 501 562 502 563 IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN 503 CALL obs_rea_mdt( surfdataqc(jtype), nn_2dint ) 504 IF ( ln_altbias ) CALL obs_rea_altbias ( surfdataqc(jtype), nn_2dint, cn_altbiasfile ) 564 CALL obs_rea_mdt( surfdataqc(jtype), n2dintsurf(jtype) ) 565 IF ( ln_altbias ) & 566 & CALL obs_rea_altbias ( surfdataqc(jtype), n2dintsurf(jtype), cn_altbiasfile ) 505 567 ENDIF 506 568 … … 515 577 ENDIF 516 578 517 CALL obs_app_sstbias( surfdataqc(jtype), n n_2dint, &579 CALL obs_app_sstbias( surfdataqc(jtype), n2dintsurf(jtype), & 518 580 & jnumsstbias, cn_sstbiasfiles(1:jnumsstbias) ) 519 581 … … 623 685 & zgphi1, & ! Model latitudes for prof variable 1 624 686 & zgphi2 ! Model latitudes for prof variable 2 625 LOGICAL :: llnightav ! Logical for calculating night-time average626 687 627 688 … … 697 758 !Defaults which might be changed 698 759 zsurfmask(:,:) = tmask(:,:,1) 699 llnightav = .FALSE.700 760 701 761 SELECT CASE ( TRIM(cobstypessurf(jtype)) ) 702 762 CASE('sst') 703 763 zsurfvar(:,:) = tsn(:,:,1,jp_tem) 704 llnightav = ln_sstnight705 764 CASE('sla') 706 765 zsurfvar(:,:) = sshn(:,:) … … 741 800 & ' but no biogeochemical model appears to have been defined' ) 742 801 #endif 743 llnightav = .FALSE.744 802 zsurfmask(:,:) = tmask(:,:,1) ! create a special mask to exclude certain things 745 803 ! Take the log10 where we can, otherwise exclude … … 846 904 CALL obs_surf_opt( surfdataqc(jtype), kstp, jpi, jpj, & 847 905 & nit000, idaystp, zsurfvar, zsurfmask, & 848 & nn_2dint, llnightav ) 906 & n2dintsurf(jtype), llnightav(jtype), & 907 & ravglamscl(jtype), ravgphiscl(jtype), & 908 & lfpindegs(jtype) ) 849 909 850 910 END DO … … 978 1038 979 1039 IF ( nsurftypes > 0 ) & 980 & DEALLOCATE( cobstypessurf, surfdata, surfdataqc, nvarssurf, nextrsurf ) 1040 & DEALLOCATE( cobstypessurf, surfdata, surfdataqc, nvarssurf, nextrsurf, & 1041 & n2dintsurf, ravglamscl, ravgphiscl, lfpindegs, llnightav ) 981 1042 982 1043 END SUBROUTINE dia_obs_dealloc … … 1177 1238 ENDIF 1178 1239 1240 IF(lwp) THEN 1241 WRITE(numout,*) ' '//cobstypes(jtype)//' input observation file names:' 1242 DO jfile = 1, ifiles(jtype) 1243 WRITE(numout,*) ' '//TRIM(cfiles(jtype,jfile)) 1244 END DO 1245 ENDIF 1246 1179 1247 END SUBROUTINE obs_settypefiles 1180 1248 1249 SUBROUTINE obs_setinterpopts( ntypes, jtype, ctypein, & 1250 & n2dint_default, n2dint_type, & 1251 & ravglamscl_type, ravgphiscl_type, & 1252 & lfp_indegs_type, lavnight_type, & 1253 & n2dint, ravglamscl, ravgphiscl, & 1254 & lfpindegs, lavnight ) 1255 1256 INTEGER, INTENT(IN) :: ntypes ! Total number of obs types 1257 INTEGER, INTENT(IN) :: jtype ! Index of the current type of obs 1258 INTEGER, INTENT(IN) :: n2dint_default ! Default option for interpolation type 1259 INTEGER, INTENT(IN) :: n2dint_type ! Option for interpolation type 1260 REAL(wp), INTENT(IN) :: & 1261 & ravglamscl_type, & !E/W diameter of obs footprint for this type 1262 & ravgphiscl_type !N/S diameter of obs footprint for this type 1263 LOGICAL, INTENT(IN) :: lfp_indegs_type !T=> footprint in degrees, F=> in metres 1264 LOGICAL, INTENT(IN) :: lavnight_type !T=> obs represent night time average 1265 CHARACTER(len=6), INTENT(IN) :: ctypein 1266 1267 INTEGER, DIMENSION(ntypes), INTENT(INOUT) :: & 1268 & n2dint 1269 REAL(wp), DIMENSION(ntypes), INTENT(INOUT) :: & 1270 & ravglamscl, ravgphiscl 1271 LOGICAL, DIMENSION(ntypes), INTENT(INOUT) :: & 1272 & lfpindegs, lavnight 1273 1274 lavnight(jtype) = lavnight_type 1275 1276 IF ( (n2dint_type >= 1) .AND. (n2dint_type <= 6) ) THEN 1277 n2dint(jtype) = n2dint_type 1278 ELSE 1279 n2dint(jtype) = n2dint_default 1280 ENDIF 1281 1282 ! For averaging observation footprints set options for size of footprint 1283 IF ( (n2dint(jtype) > 4) .AND. (n2dint(jtype) <= 6) ) THEN 1284 IF ( ravglamscl_type > 0._wp ) THEN 1285 ravglamscl(jtype) = ravglamscl_type 1286 ELSE 1287 CALL ctl_stop( 'Incorrect value set for averaging footprint '// & 1288 'scale (ravglamscl) for observation type '//TRIM(ctypein) ) 1289 ENDIF 1290 1291 IF ( ravgphiscl_type > 0._wp ) THEN 1292 ravgphiscl(jtype) = ravgphiscl_type 1293 ELSE 1294 CALL ctl_stop( 'Incorrect value set for averaging footprint '// & 1295 'scale (ravgphiscl) for observation type '//TRIM(ctypein) ) 1296 ENDIF 1297 1298 lfpindegs(jtype) = lfp_indegs_type 1299 1300 ENDIF 1301 1302 ! Write out info 1303 IF(lwp) THEN 1304 IF ( n2dint(jtype) <= 4 ) THEN 1305 WRITE(numout,*) ' '//TRIM(ctypein)// & 1306 & ' model counterparts will be interpolated horizontally' 1307 ELSE IF ( n2dint(jtype) <= 6 ) THEN 1308 WRITE(numout,*) TRIM(ctypein)// & 1309 & ' model counterparts will be averaged horizontally' 1310 WRITE(numout,*) ' '//' with E/W scale: ',ravglamscl(jtype) 1311 WRITE(numout,*) ' '//' with N/S scale: ',ravgphiscl(jtype) 1312 IF ( lfpindegs(jtype) ) THEN 1313 WRITE(numout,*) ' '//' (in degrees)' 1314 ELSE 1315 WRITE(numout,*) ' '//' (in metres)' 1316 ENDIF 1317 ENDIF 1318 ENDIF 1319 1320 END SUBROUTINE obs_setinterpopts 1321 1181 1322 END MODULE diaobs
Note: See TracChangeset
for help on using the changeset viewer.