Changeset 14062 for NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/OBS/diaobs.F90
- Timestamp:
- 2020-12-03T17:39:30+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/OBS/diaobs.F90
r13216 r14062 57 57 PUBLIC calc_date ! Compute the date of a timestep 58 58 59 LOGICAL, PUBLIC :: ln_diaobs !: Logical switch for the obs operator 60 LOGICAL :: ln_sstnight ! Logical switch for night mean SST obs 61 LOGICAL :: ln_sla_fp_indegs ! T=> SLA obs footprint size specified in degrees, F=> in metres 62 LOGICAL :: ln_sst_fp_indegs ! T=> SST obs footprint size specified in degrees, F=> in metres 63 LOGICAL :: ln_sss_fp_indegs ! T=> SSS obs footprint size specified in degrees, F=> in metres 64 LOGICAL :: ln_sic_fp_indegs ! T=> sea-ice obs footprint size specified in degrees, F=> in metres 65 66 REAL(wp) :: rn_sla_avglamscl ! E/W diameter of SLA observation footprint (metres) 67 REAL(wp) :: rn_sla_avgphiscl ! N/S diameter of SLA observation footprint (metres) 68 REAL(wp) :: rn_sst_avglamscl ! E/W diameter of SST observation footprint (metres) 69 REAL(wp) :: rn_sst_avgphiscl ! N/S diameter of SST observation footprint (metres) 70 REAL(wp) :: rn_sss_avglamscl ! E/W diameter of SSS observation footprint (metres) 71 REAL(wp) :: rn_sss_avgphiscl ! N/S diameter of SSS observation footprint (metres) 72 REAL(wp) :: rn_sic_avglamscl ! E/W diameter of sea-ice observation footprint (metres) 73 REAL(wp) :: rn_sic_avgphiscl ! N/S diameter of sea-ice observation footprint (metres) 74 75 INTEGER :: nn_1dint ! Vertical interpolation method 76 INTEGER :: nn_2dint ! Default horizontal interpolation method 77 INTEGER :: nn_2dint_sla ! SLA horizontal interpolation method 78 INTEGER :: nn_2dint_sst ! SST horizontal interpolation method 79 INTEGER :: nn_2dint_sss ! SSS horizontal interpolation method 80 INTEGER :: nn_2dint_sic ! Seaice horizontal interpolation method 59 LOGICAL, PUBLIC :: ln_diaobs !: Logical switch for the obs operator 60 LOGICAL :: ln_sstnight ! Logical switch for night mean SST obs 61 LOGICAL :: ln_default_fp_indegs ! T=> Default obs footprint size specified in degrees, F=> in metres 62 LOGICAL :: ln_sla_fp_indegs ! T=> SLA obs footprint size specified in degrees, F=> in metres 63 LOGICAL :: ln_sst_fp_indegs ! T=> SST obs footprint size specified in degrees, F=> in metres 64 LOGICAL :: ln_sss_fp_indegs ! T=> SSS obs footprint size specified in degrees, F=> in metres 65 LOGICAL :: ln_sic_fp_indegs ! T=> sea-ice obs footprint size specified in degrees, F=> in metres 66 67 REAL(wp) :: rn_default_avglamscl ! E/W diameter of SLA observation footprint (metres) 68 REAL(wp) :: rn_default_avgphiscl ! N/S diameter of SLA observation footprint (metre 69 REAL(wp) :: rn_sla_avglamscl ! E/W diameter of SLA observation footprint (metres) 70 REAL(wp) :: rn_sla_avgphiscl ! N/S diameter of SLA observation footprint (metres) 71 REAL(wp) :: rn_sst_avglamscl ! E/W diameter of SST observation footprint (metres) 72 REAL(wp) :: rn_sst_avgphiscl ! N/S diameter of SST observation footprint (metres) 73 REAL(wp) :: rn_sss_avglamscl ! E/W diameter of SSS observation footprint (metres) 74 REAL(wp) :: rn_sss_avgphiscl ! N/S diameter of SSS observation footprint (metres) 75 REAL(wp) :: rn_sic_avglamscl ! E/W diameter of sea-ice observation footprint (metres) 76 REAL(wp) :: rn_sic_avgphiscl ! N/S diameter of sea-ice observation footprint (metres) 77 78 INTEGER :: nn_1dint ! Vertical interpolation method 79 INTEGER :: nn_2dint_default ! Default horizontal interpolation method 80 INTEGER :: nn_2dint_sla ! SLA horizontal interpolation method 81 INTEGER :: nn_2dint_sst ! SST horizontal interpolation method 82 INTEGER :: nn_2dint_sss ! SSS horizontal interpolation method 83 INTEGER :: nn_2dint_sic ! Seaice horizontal interpolation method 81 84 INTEGER, DIMENSION(imaxavtypes) :: nn_profdavtypes ! Profile data types representing a daily average 82 85 INTEGER :: nproftypes ! Number of profile obs types … … 94 97 TYPE(obs_prof), PUBLIC, POINTER, DIMENSION(:) :: profdataqc !: Profile data after quality control 95 98 96 CHARACTER(len= lca), PUBLIC, DIMENSION(:), ALLOCATABLE :: cobstypesprof, cobstypessurf !: Profile & surface obs types99 CHARACTER(len=8), PUBLIC, DIMENSION(:), ALLOCATABLE :: cobstypesprof, cobstypessurf !: Profile & surface obs types 97 100 98 101 !!---------------------------------------------------------------------- … … 121 124 INTEGER :: jvar ! Counter for variables 122 125 INTEGER :: jfile ! Counter for files 123 INTEGER :: jnumsstbias 126 INTEGER :: jnumsstbias ! Number of SST bias files to read and apply 127 INTEGER :: n2dint_type ! Local version of nn_2dint* 124 128 ! 125 129 CHARACTER(len=128), DIMENSION(jpmaxnfiles) :: & … … 130 134 & cn_sicfbfiles, & ! Seaice concentration input filenames 131 135 & cn_velfbfiles, & ! Velocity profile input filenames 132 & cn_sstbiasfiles ! SST bias input filenames136 & cn_sstbiasfiles ! SST bias input filenames 133 137 CHARACTER(LEN=128) :: & 134 138 & cn_altbiasfile ! Altimeter bias input filename … … 136 140 & clproffiles, & ! Profile filenames 137 141 & clsurffiles ! Surface filenames 142 CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: & 143 & clvars ! Expected variable names 138 144 ! 139 145 LOGICAL :: ln_t3d ! Logical switch for temperature profiles … … 150 156 LOGICAL :: ln_s_at_t ! Logical switch to compute model S at T obs 151 157 LOGICAL :: ln_bound_reject ! Logical to remove obs near boundaries in LAMs. 152 LOGICAL :: llvar1 ! Logical for profile variable 1 153 LOGICAL :: llvar2 ! Logical for profile variable 1 158 LOGICAL :: ltype_fp_indegs ! Local version of ln_*_fp_indegs 159 LOGICAL :: ltype_night ! Local version of ln_sstnight (false for other variables) 160 LOGICAL, DIMENSION(:), ALLOCATABLE :: llvar ! Logical for profile variable read 154 161 LOGICAL, DIMENSION(jpmaxnfiles) :: lmask ! Used for finding number of sstbias files 155 162 ! 156 REAL(dp) :: rn_dobsini ! Obs window start date YYYYMMDD.HHMMSS 157 REAL(dp) :: rn_dobsend ! Obs window end date YYYYMMDD.HHMMSS 158 REAL(wp), DIMENSION(jpi,jpj) :: zglam1, zglam2 ! Model longitudes for profile variable 1 & 2 159 REAL(wp), DIMENSION(jpi,jpj) :: zgphi1, zgphi2 ! Model latitudes for profile variable 1 & 2 160 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask1, zmask2 ! Model land/sea mask associated with variable 1 & 2 163 REAL(dp) :: rn_dobsini ! Obs window start date YYYYMMDD.HHMMSS 164 REAL(dp) :: rn_dobsend ! Obs window end date YYYYMMDD.HHMMSS 165 REAL(wp) :: ztype_avglamscl ! Local version of rn_*_avglamscl 166 REAL(wp) :: ztype_avgphiscl ! Local version of rn_*_avgphiscl 167 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zglam ! Model longitudes for profile variables 168 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zgphi ! Model latitudes for profile variables 169 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zmask ! Model land/sea mask associated with variables 161 170 !! 162 171 NAMELIST/namobs/ln_diaobs, ln_t3d, ln_s3d, ln_sla, & … … 165 174 & ln_grid_global, ln_grid_search_lookup, & 166 175 & ln_ignmis, ln_s_at_t, ln_bound_reject, & 167 & ln_sstnight, 176 & ln_sstnight, ln_default_fp_indegs, & 168 177 & ln_sla_fp_indegs, ln_sst_fp_indegs, & 169 178 & ln_sss_fp_indegs, ln_sic_fp_indegs, & … … 174 183 & cn_gridsearchfile, rn_gridsearchres, & 175 184 & rn_dobsini, rn_dobsend, & 185 & rn_default_avglamscl, rn_default_avgphiscl, & 176 186 & rn_sla_avglamscl, rn_sla_avgphiscl, & 177 187 & rn_sst_avglamscl, rn_sst_avgphiscl, & 178 188 & rn_sss_avglamscl, rn_sss_avgphiscl, & 179 189 & rn_sic_avglamscl, rn_sic_avgphiscl, & 180 & nn_1dint, nn_2dint ,&190 & nn_1dint, nn_2dint_default, & 181 191 & nn_2dint_sla, nn_2dint_sst, & 182 192 & nn_2dint_sss, nn_2dint_sic, & … … 234 244 WRITE(numout,*) ' Final date in window YYYYMMDD.HHMMSS rn_dobsend = ', rn_dobsend 235 245 WRITE(numout,*) ' Type of vertical interpolation method nn_1dint = ', nn_1dint 236 WRITE(numout,*) ' Type of horizontal interpolation method nn_2dint = ', nn_2dint 246 WRITE(numout,*) ' Default horizontal interpolation method nn_2dint_default = ', nn_2dint_default 247 WRITE(numout,*) ' Type of horizontal interpolation method for SLA nn_2dint_sla = ', nn_2dint_sla 248 WRITE(numout,*) ' Type of horizontal interpolation method for SST nn_2dint_sst = ', nn_2dint_sst 249 WRITE(numout,*) ' Type of horizontal interpolation method for SSS nn_2dint_sss = ', nn_2dint_sss 250 WRITE(numout,*) ' Type of horizontal interpolation method for SIC nn_2dint_sic = ', nn_2dint_sic 251 WRITE(numout,*) ' Default E/W diameter of obs footprint rn_default_avglamscl = ', rn_default_avglamscl 252 WRITE(numout,*) ' Default N/S diameter of obs footprint rn_default_avgphiscl = ', rn_default_avgphiscl 253 WRITE(numout,*) ' Default obs footprint in deg [T] or m [F] ln_default_fp_indegs = ', ln_default_fp_indegs 254 WRITE(numout,*) ' SLA E/W diameter of obs footprint rn_sla_avglamscl = ', rn_sla_avglamscl 255 WRITE(numout,*) ' SLA N/S diameter of obs footprint rn_sla_avgphiscl = ', rn_sla_avgphiscl 256 WRITE(numout,*) ' SLA obs footprint in deg [T] or m [F] ln_sla_fp_indegs = ', ln_sla_fp_indegs 257 WRITE(numout,*) ' SST E/W diameter of obs footprint rn_sst_avglamscl = ', rn_sst_avglamscl 258 WRITE(numout,*) ' SST N/S diameter of obs footprint rn_sst_avgphiscl = ', rn_sst_avgphiscl 259 WRITE(numout,*) ' SST obs footprint in deg [T] or m [F] ln_sst_fp_indegs = ', ln_sst_fp_indegs 260 WRITE(numout,*) ' SIC E/W diameter of obs footprint rn_sic_avglamscl = ', rn_sic_avglamscl 261 WRITE(numout,*) ' SIC N/S diameter of obs footprint rn_sic_avgphiscl = ', rn_sic_avgphiscl 262 WRITE(numout,*) ' SIC obs footprint in deg [T] or m [F] ln_sic_fp_indegs = ', ln_sic_fp_indegs 237 263 WRITE(numout,*) ' Rejection of observations near land switch ln_nea = ', ln_nea 238 264 WRITE(numout,*) ' Rejection of obs near open bdys ln_bound_reject = ', ln_bound_reject … … 278 304 IF( ln_t3d .OR. ln_s3d ) THEN 279 305 jtype = jtype + 1 280 CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'prof ', &281 & cn_profbfiles, ifilesprof, cobstypesprof, clproffiles )306 cobstypesprof(jtype) = 'prof' 307 clproffiles(jtype,:) = cn_profbfiles 282 308 ENDIF 283 309 IF( ln_vel3d ) THEN 284 310 jtype = jtype + 1 285 CALL obs_settypefiles( nproftypes, jpmaxnfiles, jtype, 'vel ', &286 & cn_velfbfiles, ifilesprof, cobstypesprof, clproffiles )311 cobstypesprof(jtype) = 'vel' 312 clproffiles(jtype,:) = cn_velfbfiles 287 313 ENDIF 314 ! 315 CALL obs_settypefiles( nproftypes, jpmaxnfiles, ifilesprof, cobstypesprof, clproffiles ) 288 316 ! 289 317 ENDIF … … 303 331 IF( ln_sla ) THEN 304 332 jtype = jtype + 1 305 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sla ', & 306 & cn_slafbfiles, ifilessurf, cobstypessurf, clsurffiles ) 307 CALL obs_setinterpopts( nsurftypes, jtype, 'sla ', & 308 & nn_2dint, nn_2dint_sla, & 309 & rn_sla_avglamscl, rn_sla_avgphiscl, & 310 & ln_sla_fp_indegs, .FALSE., & 311 & n2dintsurf, zavglamscl, zavgphiscl, & 312 & lfpindegs, llnightav ) 333 cobstypessurf(jtype) = 'sla' 334 clsurffiles(jtype,:) = cn_slafbfiles 313 335 ENDIF 314 336 IF( ln_sst ) THEN 315 337 jtype = jtype + 1 316 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sst ', & 317 & cn_sstfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 318 CALL obs_setinterpopts( nsurftypes, jtype, 'sst ', & 319 & nn_2dint, nn_2dint_sst, & 320 & rn_sst_avglamscl, rn_sst_avgphiscl, & 321 & ln_sst_fp_indegs, ln_sstnight, & 322 & n2dintsurf, zavglamscl, zavgphiscl, & 323 & lfpindegs, llnightav ) 338 cobstypessurf(jtype) = 'sst' 339 clsurffiles(jtype,:) = cn_sstfbfiles 324 340 ENDIF 325 341 #if defined key_si3 || defined key_cice 326 342 IF( ln_sic ) THEN 327 343 jtype = jtype + 1 328 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sic ', & 329 & cn_sicfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 330 CALL obs_setinterpopts( nsurftypes, jtype, 'sic ', & 331 & nn_2dint, nn_2dint_sic, & 332 & rn_sic_avglamscl, rn_sic_avgphiscl, & 333 & ln_sic_fp_indegs, .FALSE., & 334 & n2dintsurf, zavglamscl, zavgphiscl, & 335 & lfpindegs, llnightav ) 344 cobstypessurf(jtype) = 'sic' 345 clsurffiles(jtype,:) = cn_sicfbfiles 336 346 ENDIF 337 347 #endif 338 348 IF( ln_sss ) THEN 339 349 jtype = jtype + 1 340 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, jtype, 'sss ', & 341 & cn_sssfbfiles, ifilessurf, cobstypessurf, clsurffiles ) 342 CALL obs_setinterpopts( nsurftypes, jtype, 'sss ', & 343 & nn_2dint, nn_2dint_sss, & 344 & rn_sss_avglamscl, rn_sss_avgphiscl, & 345 & ln_sss_fp_indegs, .FALSE., & 346 & n2dintsurf, zavglamscl, zavgphiscl, & 347 & lfpindegs, llnightav ) 350 cobstypessurf(jtype) = 'sss' 351 clsurffiles(jtype,:) = cn_sssfbfiles 348 352 ENDIF 353 ! 354 CALL obs_settypefiles( nsurftypes, jpmaxnfiles, ifilessurf, cobstypessurf, clsurffiles ) 355 356 DO jtype = 1, nsurftypes 357 358 IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN 359 IF ( nn_2dint_sla == -1 ) THEN 360 n2dint_type = nn_2dint_default 361 ELSE 362 n2dint_type = nn_2dint_sla 363 ENDIF 364 ztype_avglamscl = rn_sla_avglamscl 365 ztype_avgphiscl = rn_sla_avgphiscl 366 ltype_fp_indegs = ln_sla_fp_indegs 367 ltype_night = .FALSE. 368 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sst' ) THEN 369 IF ( nn_2dint_sst == -1 ) THEN 370 n2dint_type = nn_2dint_default 371 ELSE 372 n2dint_type = nn_2dint_sst 373 ENDIF 374 ztype_avglamscl = rn_sst_avglamscl 375 ztype_avgphiscl = rn_sst_avgphiscl 376 ltype_fp_indegs = ln_sst_fp_indegs 377 ltype_night = ln_sstnight 378 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sic' ) THEN 379 IF ( nn_2dint_sic == -1 ) THEN 380 n2dint_type = nn_2dint_default 381 ELSE 382 n2dint_type = nn_2dint_sic 383 ENDIF 384 ztype_avglamscl = rn_sic_avglamscl 385 ztype_avgphiscl = rn_sic_avgphiscl 386 ltype_fp_indegs = ln_sic_fp_indegs 387 ltype_night = .FALSE. 388 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sss' ) THEN 389 IF ( nn_2dint_sss == -1 ) THEN 390 n2dint_type = nn_2dint_default 391 ELSE 392 n2dint_type = nn_2dint_sss 393 ENDIF 394 ztype_avglamscl = rn_sss_avglamscl 395 ztype_avgphiscl = rn_sss_avgphiscl 396 ltype_fp_indegs = ln_sss_fp_indegs 397 ltype_night = .FALSE. 398 ELSE 399 n2dint_type = nn_2dint_default 400 ztype_avglamscl = rn_default_avglamscl 401 ztype_avgphiscl = rn_default_avgphiscl 402 ltype_fp_indegs = ln_default_fp_indegs 403 ltype_night = .FALSE. 404 ENDIF 405 406 CALL obs_setinterpopts( nsurftypes, jtype, TRIM(cobstypessurf(jtype)), & 407 & nn_2dint_default, n2dint_type, & 408 & ztype_avglamscl, ztype_avgphiscl, & 409 & ltype_fp_indegs, ltype_night, & 410 & n2dintsurf, zavglamscl, zavgphiscl, & 411 & lfpindegs, llnightav ) 412 413 END DO 349 414 ! 350 415 ENDIF … … 368 433 ENDIF 369 434 ! 370 IF( nn_2dint < 0 .OR. nn_2dint > 6 ) THEN371 CALL ctl_stop('dia_obs_init: Choice of horizontal (2D) interpolation method is not available')435 IF( nn_2dint_default < 0 .OR. nn_2dint_default > 6 ) THEN 436 CALL ctl_stop('dia_obs_init: Choice of default horizontal (2D) interpolation method is not available') 372 437 ENDIF 373 438 ! … … 388 453 DO jtype = 1, nproftypes 389 454 ! 390 nvarsprof(jtype) = 2391 455 IF ( TRIM(cobstypesprof(jtype)) == 'prof' ) THEN 392 nextrprof(jtype) = 1 393 llvar1 = ln_t3d 394 llvar2 = ln_s3d 395 zglam1 = glamt 396 zgphi1 = gphit 397 zmask1 = tmask 398 zglam2 = glamt 399 zgphi2 = gphit 400 zmask2 = tmask 401 ENDIF 402 IF ( TRIM(cobstypesprof(jtype)) == 'vel' ) THEN 456 nvarsprof(jtype) = 2 457 nextrprof(jtype) = 1 458 ALLOCATE( llvar (nvarsprof(jtype)) ) 459 ALLOCATE( clvars(nvarsprof(jtype)) ) 460 ALLOCATE( zglam(jpi, jpj, nvarsprof(jtype)) ) 461 ALLOCATE( zgphi(jpi, jpj, nvarsprof(jtype)) ) 462 ALLOCATE( zmask(jpi, jpj, jpk, nvarsprof(jtype)) ) 463 llvar(1) = ln_t3d 464 llvar(2) = ln_s3d 465 clvars(1) = 'POTM' 466 clvars(2) = 'PSAL' 467 zglam(:,:,1) = glamt(:,:) 468 zglam(:,:,2) = glamt(:,:) 469 zgphi(:,:,1) = gphit(:,:) 470 zgphi(:,:,2) = gphit(:,:) 471 zmask(:,:,:,1) = tmask(:,:,:) 472 zmask(:,:,:,2) = tmask(:,:,:) 473 ELSE IF ( TRIM(cobstypesprof(jtype)) == 'vel' ) THEN 474 nvarsprof(jtype) = 2 403 475 nextrprof(jtype) = 2 404 llvar1 = ln_vel3d 405 llvar2 = ln_vel3d 406 zglam1 = glamu 407 zgphi1 = gphiu 408 zmask1 = umask 409 zglam2 = glamv 410 zgphi2 = gphiv 411 zmask2 = vmask 476 ALLOCATE( llvar (nvarsprof(jtype)) ) 477 ALLOCATE( clvars(nvarsprof(jtype)) ) 478 ALLOCATE( zglam(jpi, jpj, nvarsprof(jtype)) ) 479 ALLOCATE( zgphi(jpi, jpj, nvarsprof(jtype)) ) 480 ALLOCATE( zmask(jpi, jpj, jpk, nvarsprof(jtype)) ) 481 llvar(1) = ln_vel3d 482 llvar(2) = ln_vel3d 483 clvars(1) = 'UVEL' 484 clvars(2) = 'VVEL' 485 zglam(:,:,1) = glamu(:,:) 486 zglam(:,:,2) = glamv(:,:) 487 zgphi(:,:,1) = gphiu(:,:) 488 zgphi(:,:,2) = gphiv(:,:) 489 zmask(:,:,:,1) = umask(:,:,:) 490 zmask(:,:,:,2) = vmask(:,:,:) 491 ELSE 492 nvarsprof(jtype) = 1 493 nextrprof(jtype) = 0 494 ALLOCATE( llvar (nvarsprof(jtype)) ) 495 ALLOCATE( clvars(nvarsprof(jtype)) ) 496 ALLOCATE( zglam(jpi, jpj, nvarsprof(jtype)) ) 497 ALLOCATE( zgphi(jpi, jpj, nvarsprof(jtype)) ) 498 ALLOCATE( zmask(jpi, jpj, jpk, nvarsprof(jtype)) ) 499 llvar(1) = .TRUE. 500 zglam(:,:,1) = glamt(:,:) 501 zgphi(:,:,1) = gphit(:,:) 502 zmask(:,:,:,1) = tmask(:,:,:) 412 503 ENDIF 413 504 ! … … 416 507 & clproffiles(jtype,1:ifilesprof(jtype)), & 417 508 & nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, & 418 & rn_dobsini, rn_dobsend, llvar 1, llvar2, &419 & ln_ignmis, ln_s_at_t, .FALSE., &509 & rn_dobsini, rn_dobsend, llvar, & 510 & ln_ignmis, ln_s_at_t, .FALSE., clvars, & 420 511 & kdailyavtypes = nn_profdavtypes ) 421 512 ! … … 425 516 ! 426 517 CALL obs_pre_prof( profdata(jtype), profdataqc(jtype), & 427 & llvar 1, llvar2, &518 & llvar, & 428 519 & jpi, jpj, jpk, & 429 & zmask 1, zglam1, zgphi1, zmask2, zglam2, zgphi2,&520 & zmask, zglam, zgphi, & 430 521 & ln_nea, ln_bound_reject, Kmm, & 431 522 & kdailyavtypes = nn_profdavtypes ) 523 ! 524 DEALLOCATE( llvar, clvars, zglam, zgphi, zmask ) 525 ! 432 526 END DO 433 527 ! … … 449 543 IF( TRIM(cobstypessurf(jtype)) == 'sst' ) llnightav(jtype) = ln_sstnight 450 544 ! 545 ALLOCATE( clvars( nvarssurf(jtype) ) ) 546 IF ( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN 547 clvars(1) = 'SLA' 548 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sst' ) THEN 549 clvars(1) = 'SST' 550 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sic' ) THEN 551 clvars(1) = 'ICECONC' 552 ELSE IF ( TRIM(cobstypessurf(jtype)) == 'sss' ) THEN 553 clvars(1) = 'SSS' 554 ENDIF 555 ! 451 556 ! Read in surface obs types 452 557 CALL obs_rea_surf( surfdata(jtype), ifilessurf(jtype), & 453 558 & clsurffiles(jtype,1:ifilessurf(jtype)), & 454 559 & nvarssurf(jtype), nextrsurf(jtype), nitend-nit000+2, & 455 & rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav(jtype) ) 560 & rn_dobsini, rn_dobsend, ln_ignmis, .FALSE., llnightav(jtype), & 561 & clvars ) 456 562 ! 457 563 CALL obs_pre_surf( surfdata(jtype), surfdataqc(jtype), ln_nea, ln_bound_reject ) … … 473 579 & jnumsstbias , cn_sstbiasfiles(1:jnumsstbias) ) 474 580 ENDIF 581 ! 582 DEALLOCATE( clvars ) 475 583 END DO 476 584 ! … … 516 624 INTEGER :: jvar ! Variable number 517 625 INTEGER :: ji, jj ! Loop counters 518 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 519 & zprofvar1, & ! Model values for 1st variable in a prof ob 520 & zprofvar2 ! Model values for 2nd variable in a prof ob 521 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 522 & zprofmask1, & ! Mask associated with zprofvar1 523 & zprofmask2 ! Mask associated with zprofvar2 626 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: & 627 & zprofvar ! Model values for variables in a prof ob 628 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: & 629 & zprofmask ! Mask associated with zprofvar 524 630 REAL(wp), DIMENSION(jpi,jpj) :: & 525 631 & zsurfvar, & ! Model values equivalent to surface ob. 526 632 & zsurfmask ! Mask associated with surface variable 527 REAL(wp), DIMENSION(jpi,jpj) :: & 528 & zglam1, & ! Model longitudes for prof variable 1 529 & zglam2, & ! Model longitudes for prof variable 2 530 & zgphi1, & ! Model latitudes for prof variable 1 531 & zgphi2 ! Model latitudes for prof variable 2 633 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: & 634 & zglam, & ! Model longitudes for prof variables 635 & zgphi ! Model latitudes for prof variables 532 636 533 637 !----------------------------------------------------------------------- … … 549 653 DO jtype = 1, nproftypes 550 654 655 ! Allocate local work arrays 656 ALLOCATE( zprofvar (jpi, jpj, jpk, profdataqc(jtype)%nvar) ) 657 ALLOCATE( zprofmask(jpi, jpj, jpk, profdataqc(jtype)%nvar) ) 658 ALLOCATE( zglam (jpi, jpj, profdataqc(jtype)%nvar) ) 659 ALLOCATE( zgphi (jpi, jpj, profdataqc(jtype)%nvar) ) 660 661 ! Defaults which might change 662 DO jvar = 1, profdataqc(jtype)%nvar 663 zprofmask(:,:,:,jvar) = tmask(:,:,:) 664 zglam(:,:,jvar) = glamt(:,:) 665 zgphi(:,:,jvar) = gphit(:,:) 666 END DO 667 551 668 SELECT CASE ( TRIM(cobstypesprof(jtype)) ) 552 669 CASE('prof') 553 zprofvar1(:,:,:) = ts(:,:,:,jp_tem,Kmm) 554 zprofvar2(:,:,:) = ts(:,:,:,jp_sal,Kmm) 555 zprofmask1(:,:,:) = tmask(:,:,:) 556 zprofmask2(:,:,:) = tmask(:,:,:) 557 zglam1(:,:) = glamt(:,:) 558 zglam2(:,:) = glamt(:,:) 559 zgphi1(:,:) = gphit(:,:) 560 zgphi2(:,:) = gphit(:,:) 670 zprofvar(:,:,:,1) = ts(:,:,:,jp_tem,Kmm) 671 zprofvar(:,:,:,2) = ts(:,:,:,jp_sal,Kmm) 561 672 CASE('vel') 562 zprofvar 1(:,:,:) = uu(:,:,:,Kmm)563 zprofvar 2(:,:,:) = vv(:,:,:,Kmm)564 zprofmask 1(:,:,:) = umask(:,:,:)565 zprofmask 2(:,:,:) = vmask(:,:,:)566 zglam 1(:,:) = glamu(:,:)567 zglam 2(:,:) = glamv(:,:)568 zgphi 1(:,:) = gphiu(:,:)569 zgphi 2(:,:) = gphiv(:,:)673 zprofvar(:,:,:,1) = uu(:,:,:,Kmm) 674 zprofvar(:,:,:,2) = vv(:,:,:,Kmm) 675 zprofmask(:,:,:,1) = umask(:,:,:) 676 zprofmask(:,:,:,2) = vmask(:,:,:) 677 zglam(:,:,1) = glamu(:,:) 678 zglam(:,:,2) = glamv(:,:) 679 zgphi(:,:,1) = gphiu(:,:) 680 zgphi(:,:,2) = gphiv(:,:) 570 681 CASE DEFAULT 571 682 CALL ctl_stop( 'Unknown profile observation type '//TRIM(cobstypesprof(jtype))//' in dia_obs' ) 572 683 END SELECT 573 684 574 CALL obs_prof_opt( profdataqc(jtype), kstp, jpi, jpj, jpk, & 575 & nit000, idaystp, & 576 & zprofvar1, zprofvar2, & 577 & gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm), & 578 & zprofmask1, zprofmask2, & 579 & zglam1, zglam2, zgphi1, zgphi2, & 580 & nn_1dint, nn_2dint, & 581 & kdailyavtypes = nn_profdavtypes ) 685 DO jvar = 1, profdataqc(jtype)%nvar 686 CALL obs_prof_opt( profdataqc(jtype), kstp, jpi, jpj, jpk, & 687 & nit000, idaystp, jvar, & 688 & zprofvar(:,:,:,jvar), & 689 & gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm), & 690 & zprofmask(:,:,:,jvar), & 691 & zglam(:,:,jvar), zgphi(:,:,jvar), & 692 & nn_1dint, nn_2dint_default, & 693 & kdailyavtypes = nn_profdavtypes ) 694 END DO 695 696 DEALLOCATE( zprofvar, zprofmask, zglam, zgphi ) 582 697 583 698 END DO … … 680 795 & ) 681 796 682 CALL obs_rotvel( profdataqc(jtype), nn_2dint , zu, zv )797 CALL obs_rotvel( profdataqc(jtype), nn_2dint_default, zu, zv ) 683 798 684 799 DO jo = 1, profdataqc(jtype)%nprof … … 896 1011 END SUBROUTINE fin_date 897 1012 898 SUBROUTINE obs_settypefiles( ntypes, jpmaxnfiles, jtype, ctypein, &899 & cfilestype, ifiles, cobstypes, cfiles ) 900 901 INTEGER, INTENT(IN) :: ntypes ! Total number of obs types902 INTEGER, INTENT(IN) :: jpmaxnfiles ! Maximum number of files allowed for each type903 INTEGER, INTENT(IN) :: jtype ! Index of the current type of obs904 INTEGER, DIMENSION(ntypes), INTENT(INOUT) :: &905 & ifiles ! Out appended number of files for this type906 907 CHARACTER(len=6), INTENT(IN) :: ctypein908 CHARACTER(len=128), DIMENSION(jpmaxnfiles), INTENT(IN) :: & 909 & cfilestype ! In list of files for this obs type910 CHARACTER(len=6), DIMENSION(ntypes), INTENT(INOUT) :: &911 & cobstypes ! Out appended list of obs types912 CHARACTER(len=128), DIMENSION(ntypes, jpmaxnfiles), INTENT(INOUT) :: & 913 & cfiles ! Out appended list of files for alltypes914 915 !Local variables916 INTEGER :: jfile917 918 cfiles(jtype,:) = cfilestype(:)919 cobstypes(jtype) = ctypein920 ifiles(jtype) = 0 921 DO jfile = 1, jpmaxnfiles922 IF ( trim(cfiles(jtype,jfile)) /= '' )&923 ifiles(jtype) = ifiles(jtype) + 1924 END DO925 926 IF ( ifiles(jtype) == 0 ) THEN927 CALL ctl_stop( 'Logical for observation type '//TRIM(ctypein)// &928 & ' set to true but no files available to read')929 ENDIF930 931 IF(lwp) THEN932 WRITE(numout,*) ' '//cobstypes(jtype)//' input observation file names:' 933 DO jfile = 1, ifiles(jtype)934 WRITE(numout,*) ' '//TRIM(cfiles(jtype,jfile)) 935 END DO936 ENDIF 937 938 END SUBROUTINE obs_settypefiles939 940 SUBROUTINE obs_setinterpopts( ntypes, jtype, ctypein,&941 & n2dint_default, n2dint_type,&942 & zavglamscl_type, zavgphiscl_type, &943 & lfp_indegs_type, lavnight_type, & 944 & n2dint, zavglamscl, zavgphiscl, &945 & lfpindegs, lavnight )946 947 INTEGER, INTENT(IN) :: ntypes ! Total number of obs types948 INTEGER, INTENT(IN) :: jtype ! Index of the current type of obs949 INTEGER, INTENT(IN) :: n2dint_default ! Default option for interpolationtype950 INTEGER, INTENT(IN) :: n2dint_type ! Option for interpolationtype951 REAL(wp), INTENT(IN) :: &952 & zavglamscl_type, & !E/W diameter of obs footprint for this type953 & zavgphiscl_type !N/S diameter of obs footprint for this type954 LOGICAL, INTENT(IN) :: lfp_indegs_type !T=> footprint in degrees, F=> in metres 955 LOGICAL, INTENT(IN) :: lavnight_type !T=> obs represent night time average956 CHARACTER(len=6), INTENT(IN) :: ctypein957 958 INTEGER, DIMENSION(ntypes), INTENT(INOUT) :: &959 & n2dint960 REAL(wp), DIMENSION(ntypes), INTENT(INOUT) :: &961 & zavglamscl, zavgphiscl 962 LOGICAL, DIMENSION(ntypes), INTENT(INOUT) :: &963 & lfpindegs, lavnight 964 965 lavnight(jtype) = lavnight_type966 967 IF ( (n2dint_type >= 1) .AND. (n2dint_type <= 6) ) THEN968 n2dint(jtype) = n2dint_type969 ELSE970 n2dint(jtype) = n2dint_default971 ENDIF972 973 ! For averaging observation footprints set options for size of footprint974 IF ( (n2dint(jtype) > 4) .AND. (n2dint(jtype) <= 6) ) THEN975 IF ( zavglamscl_type > 0._wp ) THEN976 zavglamscl(jtype) = zavglamscl_type977 ELSE978 CALL ctl_stop( 'Incorrect value set for averaging footprint '// &979 'scale (zavglamscl) for observation type '//TRIM(ctypein) )980 ENDIF981 982 IF ( zavgphiscl_type > 0._wp ) THEN983 zavgphiscl(jtype) = zavgphiscl_type984 ELSE985 CALL ctl_stop( 'Incorrect value set for averaging footprint '// &986 'scale (zavgphiscl) for observation type '//TRIM(ctypein) )987 ENDIF988 989 lfpindegs(jtype) = lfp_indegs_type990 991 ENDIF992 993 ! Write out info994 IF(lwp) THEN995 IF ( n2dint(jtype) <= 4 ) THEN996 WRITE(numout,*) ' '//TRIM(ctypein)// &997 & ' model counterparts will be interpolated horizontally'998 ELSE IF ( n2dint(jtype) <= 6 ) THEN999 WRITE(numout,*) ' '//TRIM(ctypein)// &1000 & ' model counterparts will be averaged horizontally'1001 WRITE(numout,*) ' '//' with E/W scale: ',zavglamscl(jtype)1002 WRITE(numout,*) ' '//' with N/S scale: ',zavgphiscl(jtype)1003 IF ( lfpindegs(jtype) ) THEN1004 WRITE(numout,*) ' '//' (in degrees)'1005 ELSE1006 WRITE(numout,*) ' '//' (in metres)'1007 ENDIF1008 ENDIF1009 ENDIF1010 1011 1013 SUBROUTINE obs_settypefiles( ntypes, jpmaxnfiles, ifiles, cobstypes, cfiles ) 1014 1015 INTEGER, INTENT(IN) :: ntypes ! Total number of obs types 1016 INTEGER, INTENT(IN) :: jpmaxnfiles ! Maximum number of files allowed for each type 1017 INTEGER, DIMENSION(ntypes), INTENT(OUT) :: & 1018 & ifiles ! Out number of files for each type 1019 CHARACTER(len=8), DIMENSION(ntypes), INTENT(IN) :: & 1020 & cobstypes ! List of obs types 1021 CHARACTER(len=128), DIMENSION(ntypes, jpmaxnfiles), INTENT(IN) :: & 1022 & cfiles ! List of files for all types 1023 1024 !Local variables 1025 INTEGER :: jfile 1026 INTEGER :: jtype 1027 1028 DO jtype = 1, ntypes 1029 1030 ifiles(jtype) = 0 1031 DO jfile = 1, jpmaxnfiles 1032 IF ( trim(cfiles(jtype,jfile)) /= '' ) & 1033 ifiles(jtype) = ifiles(jtype) + 1 1034 END DO 1035 1036 IF ( ifiles(jtype) == 0 ) THEN 1037 CALL ctl_stop( 'Logical for observation type '//TRIM(cobstypes(jtype))// & 1038 & ' set to true but no files available to read' ) 1039 ENDIF 1040 1041 IF(lwp) THEN 1042 WRITE(numout,*) ' '//cobstypes(jtype)//' input observation file names:' 1043 DO jfile = 1, ifiles(jtype) 1044 WRITE(numout,*) ' '//TRIM(cfiles(jtype,jfile)) 1045 END DO 1046 ENDIF 1047 1048 END DO 1049 1050 END SUBROUTINE obs_settypefiles 1051 1052 SUBROUTINE obs_setinterpopts( ntypes, jtype, ctypein, & 1053 & n2dint_default, n2dint_type, & 1054 & ravglamscl_type, ravgphiscl_type, & 1055 & lfp_indegs_type, lavnight_type, & 1056 & n2dint, ravglamscl, ravgphiscl, & 1057 & lfpindegs, lavnight ) 1058 1059 INTEGER, INTENT(IN) :: ntypes ! Total number of obs types 1060 INTEGER, INTENT(IN) :: jtype ! Index of the current type of obs 1061 INTEGER, INTENT(IN) :: n2dint_default ! Default option for interpolation type 1062 INTEGER, INTENT(IN) :: n2dint_type ! Option for interpolation type 1063 REAL(wp), INTENT(IN) :: & 1064 & ravglamscl_type, & !E/W diameter of obs footprint for this type 1065 & ravgphiscl_type !N/S diameter of obs footprint for this type 1066 LOGICAL, INTENT(IN) :: lfp_indegs_type !T=> footprint in degrees, F=> in metres 1067 LOGICAL, INTENT(IN) :: lavnight_type !T=> obs represent night time average 1068 CHARACTER(len=8), INTENT(IN) :: ctypein 1069 1070 INTEGER, DIMENSION(ntypes), INTENT(INOUT) :: & 1071 & n2dint 1072 REAL(wp), DIMENSION(ntypes), INTENT(INOUT) :: & 1073 & ravglamscl, ravgphiscl 1074 LOGICAL, DIMENSION(ntypes), INTENT(INOUT) :: & 1075 & lfpindegs, lavnight 1076 1077 lavnight(jtype) = lavnight_type 1078 1079 IF ( (n2dint_type >= 0) .AND. (n2dint_type <= 6) ) THEN 1080 n2dint(jtype) = n2dint_type 1081 ELSE IF ( n2dint_type == -1 ) THEN 1082 n2dint(jtype) = n2dint_default 1083 ELSE 1084 CALL ctl_stop(' Choice of '//TRIM(ctypein)//' horizontal (2D) interpolation method', & 1085 & ' is not available') 1086 ENDIF 1087 1088 ! For averaging observation footprints set options for size of footprint 1089 IF ( (n2dint(jtype) > 4) .AND. (n2dint(jtype) <= 6) ) THEN 1090 IF ( ravglamscl_type > 0._wp ) THEN 1091 ravglamscl(jtype) = ravglamscl_type 1092 ELSE 1093 CALL ctl_stop( 'Incorrect value set for averaging footprint '// & 1094 'scale (ravglamscl) for observation type '//TRIM(ctypein) ) 1095 ENDIF 1096 1097 IF ( ravgphiscl_type > 0._wp ) THEN 1098 ravgphiscl(jtype) = ravgphiscl_type 1099 ELSE 1100 CALL ctl_stop( 'Incorrect value set for averaging footprint '// & 1101 'scale (ravgphiscl) for observation type '//TRIM(ctypein) ) 1102 ENDIF 1103 1104 lfpindegs(jtype) = lfp_indegs_type 1105 1106 ENDIF 1107 1108 ! Write out info 1109 IF(lwp) THEN 1110 IF ( n2dint(jtype) <= 4 ) THEN 1111 WRITE(numout,*) ' '//TRIM(ctypein)// & 1112 & ' model counterparts will be interpolated horizontally' 1113 ELSE IF ( n2dint(jtype) <= 6 ) THEN 1114 WRITE(numout,*) ' '//TRIM(ctypein)// & 1115 & ' model counterparts will be averaged horizontally' 1116 WRITE(numout,*) ' '//' with E/W scale: ',ravglamscl(jtype) 1117 WRITE(numout,*) ' '//' with N/S scale: ',ravgphiscl(jtype) 1118 IF ( lfpindegs(jtype) ) THEN 1119 WRITE(numout,*) ' '//' (in degrees)' 1120 ELSE 1121 WRITE(numout,*) ' '//' (in metres)' 1122 ENDIF 1123 ENDIF 1124 ENDIF 1125 1126 END SUBROUTINE obs_setinterpopts 1012 1127 1013 1128 END MODULE diaobs
Note: See TracChangeset
for help on using the changeset viewer.
