Changeset 9202
- Timestamp:
- 2018-01-09T19:12:50+01:00 (6 years ago)
- Location:
- branches/UKMO/dev_r5518_obs_oper_update_bgc3d/NEMOGCM/NEMO/OPA_SRC/OBS
- Files:
-
- 2 edited
-
diaobs.F90 (modified) (6 diffs)
-
obs_read_prof.F90 (modified) (24 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update_bgc3d/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r9192 r9202 223 223 & clsurffiles ! Surface filenames 224 224 225 LOGICAL :: llvar1 ! Logical for profile variable 1 226 LOGICAL :: llvar2 ! Logical for profile variable 1 225 LOGICAL, DIMENSION(:), ALLOCATABLE :: llvar ! Logical for profile variable read 227 226 LOGICAL :: ltype_fp_indegs ! Local version of ln_*_fp_indegs 228 227 LOGICAL :: ltype_night ! Local version of ln_sstnight (false for other variables) … … 699 698 nvarsprof(jtype) = 2 700 699 nextrprof(jtype) = 1 701 llvar1 = ln_t3d 702 llvar2 = ln_s3d 700 ALLOCATE(llvar(nvarsprof(jtype))) 701 llvar(1) = ln_t3d 702 llvar(2) = ln_s3d 703 703 zglam1 = glamt 704 704 zgphi1 = gphit … … 710 710 nvarsprof(jtype) = 2 711 711 nextrprof(jtype) = 2 712 llvar1 = ln_vel3d 713 llvar2 = ln_vel3d 712 ALLOCATE(llvar(nvarsprof(jtype))) 713 llvar(1) = ln_vel3d 714 llvar(2) = ln_vel3d 714 715 zglam1 = glamu 715 716 zgphi1 = gphiu … … 721 722 nvarsprof(jtype) = 1 722 723 nextrprof(jtype) = 0 723 llvar1 = .TRUE.724 llvar 2 = .FALSE.724 ALLOCATE(llvar(nvarsprof(jtype))) 725 llvar(1) = .TRUE. 725 726 zglam1 = glamt 726 727 zgphi1 = gphit … … 735 736 & clproffiles(jtype,1:ifilesprof(jtype)), & 736 737 & nvarsprof(jtype), nextrprof(jtype), nitend-nit000+2, & 737 & rn_dobsini, rn_dobsend, llvar 1, llvar2, &738 & rn_dobsini, rn_dobsend, llvar, & 738 739 & ln_ignmis, ln_s_at_t, .FALSE., & 739 740 & kdailyavtypes = nn_profdavtypes ) … … 744 745 745 746 CALL obs_pre_prof( profdata(jtype), profdataqc(jtype), & 746 & llvar 1, llvar2, &747 & llvar(1), llvar(2), & 747 748 & jpi, jpj, jpk, & 748 749 & zmask1, zglam1, zgphi1, zmask2, zglam2, zgphi2, & 749 750 & ln_nea, ln_bound_reject, & 750 751 & kdailyavtypes = nn_profdavtypes ) 752 753 ! Is allocating and deallocating repeatedly in a loop good practice? 754 DEALLOCATE(llvar) 751 755 752 756 END DO -
branches/UKMO/dev_r5518_obs_oper_update_bgc3d/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
r9186 r9202 45 45 SUBROUTINE obs_rea_prof( profdata, knumfiles, cdfilenames, & 46 46 & kvars, kextr, kstp, ddobsini, ddobsend, & 47 & ldvar 1, ldvar2, ldignmis, ldsatt, &47 & ldvar, ldignmis, ldsatt, & 48 48 & ldmod, kdailyavtypes ) 49 49 !!--------------------------------------------------------------------- … … 74 74 INTEGER, INTENT(IN) :: kextr ! Number of extra fields for each var 75 75 INTEGER, INTENT(IN) :: kstp ! Ocean time-step index 76 LOGICAL, INTENT(IN) :: ldvar1 ! Observed variables switches 77 LOGICAL, INTENT(IN) :: ldvar2 76 LOGICAL, DIMENSION(kvars), INTENT(IN) :: ldvar ! Observed variables switches 78 77 LOGICAL, INTENT(IN) :: ldignmis ! Ignore missing files 79 78 LOGICAL, INTENT(IN) :: ldsatt ! Compute salinity at all temperature points … … 105 104 INTEGER :: iprof 106 105 INTEGER :: iproftot 107 INTEGER :: ivar1t0 108 INTEGER :: ivar2t0 109 INTEGER :: ivar1t 110 INTEGER :: ivar2t 106 INTEGER, DIMENSION(kvars) :: ivart0 107 INTEGER, DIMENSION(kvars) :: ivart 111 108 INTEGER :: ip3dt 112 109 INTEGER :: ios 113 110 INTEGER :: ioserrcount 114 INTEGER :: ivar1tmpp 115 INTEGER :: ivar2tmpp 111 INTEGER, DIMENSION(kvars) :: ivartmpp 116 112 INTEGER :: ip3dtmpp 117 113 INTEGER :: itype 118 114 INTEGER, DIMENSION(knumfiles) :: & 119 115 & irefdate 120 INTEGER, DIMENSION(ntyp1770+1) :: & 121 & itypvar1, & 122 & itypvar1mpp, & 123 & itypvar2, & 124 & itypvar2mpp 116 INTEGER, DIMENSION(ntyp1770+1,kvars) :: & 117 & itypvar, & 118 & itypvarmpp 119 INTEGER, DIMENSION(:,:), ALLOCATABLE :: & 120 & iobsi, & 121 & iobsj, & 122 & iproc 125 123 INTEGER, DIMENSION(:), ALLOCATABLE :: & 126 & iobsi1, &127 & iobsj1, &128 & iproc1, &129 & iobsi2, &130 & iobsj2, &131 & iproc2, &132 124 & iindx, & 133 125 & ifileidx, & … … 147 139 LOGICAL :: llvalprof 148 140 LOGICAL :: lldavtimset 141 LOGICAL :: llcycle 149 142 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 150 143 & inpfiles … … 152 145 ! Local initialization 153 146 iprof = 0 154 ivar1t0 = 0 155 ivar2t0 = 0 147 ivart0(:) = 0 156 148 ip3dt = 0 157 149 … … 308 300 DO ji = 1, inpfiles(jj)%nobs 309 301 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 310 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 311 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 302 llcycle = .TRUE. 303 DO jvar = 1, kvars 304 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 305 llcycle = .FALSE. 306 EXIT 307 ENDIF 308 END DO 309 IF ( llcycle ) CYCLE 312 310 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 313 311 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 317 315 ALLOCATE( zlam(inowin) ) 318 316 ALLOCATE( zphi(inowin) ) 319 ALLOCATE( iobsi1(inowin) ) 320 ALLOCATE( iobsj1(inowin) ) 321 ALLOCATE( iproc1(inowin) ) 322 IF ( kvars == 2 ) THEN 323 ALLOCATE( iobsi2(inowin) ) 324 ALLOCATE( iobsj2(inowin) ) 325 ALLOCATE( iproc2(inowin) ) 326 ENDIF 317 ALLOCATE( iobsi(inowin,kvars) ) 318 ALLOCATE( iobsj(inowin,kvars) ) 319 ALLOCATE( iproc(inowin,kvars) ) 327 320 inowin = 0 328 321 DO ji = 1, inpfiles(jj)%nobs 329 322 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 330 IF ( kvars == 2 ) THEN 331 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 332 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 333 ELSE 334 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 335 ENDIF 323 llcycle = .TRUE. 324 DO jvar = 1, kvars 325 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 326 llcycle = .FALSE. 327 EXIT 328 ENDIF 329 END DO 330 IF ( llcycle ) CYCLE 336 331 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 337 332 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 342 337 END DO 343 338 344 IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN 345 CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, & 346 & iproc1, 'T' ) 347 iobsi2(:) = iobsi1(:) 348 iobsj2(:) = iobsj1(:) 349 iproc2(:) = iproc1(:) 350 ELSEIF ( TRIM( inpfiles(jj)%cname(1) ) == 'UVEL' ) THEN 351 CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, & 352 & iproc1, 'U' ) 353 CALL obs_grid_search( inowin, zlam, zphi, iobsi2, iobsj2, & 354 & iproc2, 'V' ) 339 ! Assume anything other than velocity is on T grid 340 IF ( TRIM( inpfiles(jj)%cname(1) ) == 'UVEL' ) THEN 341 CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,1), iobsj(:,1), & 342 & iproc(:,1), 'U' ) 343 CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,2), iobsj(:,2), & 344 & iproc(:,2), 'V' ) 355 345 ELSE 356 CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, & 357 & iproc1, 'T' ) 346 CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,1), iobsj(:,1), & 347 & iproc(:,1), 'T' ) 348 IF ( kvars > 1 ) THEN 349 DO jvar = 2, kvars 350 iobsi(:,jvar) = iobsi(:,1) 351 iobsj(:,jvar) = iobsj(:,1) 352 iproc(:,jvar) = iproc(:,1) 353 END DO 354 ENDIF 358 355 ENDIF 359 356 … … 361 358 DO ji = 1, inpfiles(jj)%nobs 362 359 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 363 IF ( kvars == 2 ) THEN 364 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 365 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 366 ELSE 367 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 368 ENDIF 360 llcycle = .TRUE. 361 DO jvar = 1, kvars 362 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 363 llcycle = .FALSE. 364 EXIT 365 ENDIF 366 END DO 367 IF ( llcycle ) CYCLE 369 368 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 370 369 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN 371 370 inowin = inowin + 1 372 inpfiles(jj)%iproc(ji,1) = iproc1(inowin) 373 inpfiles(jj)%iobsi(ji,1) = iobsi1(inowin) 374 inpfiles(jj)%iobsj(ji,1) = iobsj1(inowin) 375 IF ( kvars == 2 ) THEN 376 inpfiles(jj)%iproc(ji,2) = iproc2(inowin) 377 inpfiles(jj)%iobsi(ji,2) = iobsi2(inowin) 378 inpfiles(jj)%iobsj(ji,2) = iobsj2(inowin) 379 IF ( inpfiles(jj)%iproc(ji,1) /= & 380 & inpfiles(jj)%iproc(ji,2) ) THEN 381 CALL ctl_stop( 'Error in obs_read_prof:', & 382 & 'var1 and var2 observation on different processors') 383 ENDIF 371 DO jvar = 1, kvars 372 inpfiles(jj)%iproc(ji,jvar) = iproc(inowin,jvar) 373 inpfiles(jj)%iobsi(ji,jvar) = iobsi(inowin,jvar) 374 inpfiles(jj)%iobsj(ji,jvar) = iobsj(inowin,jvar) 375 END DO 376 IF ( kvars > 1 ) THEN 377 DO jvar = 2, kvars 378 IF ( inpfiles(jj)%iproc(ji,jvar) /= & 379 & inpfiles(jj)%iproc(ji,1) ) THEN 380 CALL ctl_stop( 'Error in obs_read_prof:', & 381 & 'observation on different processors for different vars') 382 ENDIF 383 END DO 384 384 ENDIF 385 385 ENDIF 386 386 END DO 387 DEALLOCATE( zlam, zphi, iobsi1, iobsj1, iproc1 ) 388 IF ( kvars == 2 ) THEN 389 DEALLOCATE( iobsi2, iobsj2, iproc2 ) 390 ENDIF 387 DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc ) 391 388 392 389 DO ji = 1, inpfiles(jj)%nobs 393 390 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 394 IF ( kvars == 2 ) THEN 395 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 396 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 397 ELSE 398 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 399 ENDIF 391 llcycle = .TRUE. 392 DO jvar = 1, kvars 393 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 394 llcycle = .FALSE. 395 EXIT 396 ENDIF 397 END DO 398 IF ( llcycle ) CYCLE 400 399 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 401 400 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 406 405 ENDIF 407 406 llvalprof = .FALSE. 408 IF ( ldvar1 ) THEN 409 loop_t_count : DO ij = 1,inpfiles(jj)%nlev 410 IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 411 & CYCLE 412 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 413 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 414 ivar1t0 = ivar1t0 + 1 415 ENDIF 416 END DO loop_t_count 417 ENDIF 418 IF ( ldvar2 ) THEN 419 loop_s_count : DO ij = 1,inpfiles(jj)%nlev 420 IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 421 & CYCLE 422 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 423 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 424 ivar2t0 = ivar2t0 + 1 425 ENDIF 426 END DO loop_s_count 427 ENDIF 428 loop_p_count : DO ij = 1,inpfiles(jj)%nlev 407 DO jvar = 1, kvars 408 IF ( ldvar(jvar) ) THEN 409 DO ij = 1,inpfiles(jj)%nlev 410 IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 411 & CYCLE 412 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 413 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 414 ivart0(jvar) = ivart0(jvar) + 1 415 ENDIF 416 END DO 417 ENDIF 418 END DO 419 DO ij = 1,inpfiles(jj)%nlev 429 420 IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 430 421 & CYCLE 431 IF ( kvars == 2 ) THEN432 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji, 1),2) .AND. &422 DO jvar = 1, kvars 423 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 433 424 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 434 & ldvar1 ) .OR. & 435 & ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 436 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 437 & ldvar2 ) ) THEN 425 & ldvar(jvar) ) ) THEN 438 426 ip3dt = ip3dt + 1 439 427 llvalprof = .TRUE. 428 EXIT 440 429 ENDIF 441 ELSE 442 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 443 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 444 & ldvar1 ) ) THEN 445 ip3dt = ip3dt + 1 446 llvalprof = .TRUE. 447 ENDIF 448 ENDIF 449 END DO loop_p_count 430 END DO 431 END DO 450 432 451 433 IF ( llvalprof ) iprof = iprof + 1 … … 469 451 DO ji = 1, inpfiles(jj)%nobs 470 452 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 471 IF ( kvars == 2 ) THEN 472 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 473 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 474 ELSE 475 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 476 ENDIF 453 llcycle = .TRUE. 454 DO jvar = 1, kvars 455 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 456 llcycle = .FALSE. 457 EXIT 458 ENDIF 459 END DO 460 IF ( llcycle ) CYCLE 477 461 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 478 462 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 488 472 DO ji = 1, inpfiles(jj)%nobs 489 473 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 490 IF ( kvars == 2 ) THEN 491 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 492 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 493 ELSE 494 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 495 ENDIF 474 llcycle = .TRUE. 475 DO jvar = 1, kvars 476 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 477 llcycle = .FALSE. 478 EXIT 479 ENDIF 480 END DO 481 IF ( llcycle ) CYCLE 496 482 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 497 483 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 509 495 iv3dt(:) = -1 510 496 IF (ldsatt) THEN 511 iv3dt(1) = ip3dt 512 iv3dt(2) = ip3dt 497 iv3dt(:) = ip3dt 513 498 ELSE 514 iv3dt(1) = ivar1t0 515 iv3dt(2) = ivar2t0 499 iv3dt(:) = ivart0(:) 516 500 ENDIF 517 501 CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, & … … 526 510 527 511 ip3dt = 0 528 ivar1t = 0 529 ivar2t = 0 530 itypvar1 (:) = 0 531 itypvar1mpp(:) = 0 532 533 itypvar2 (:) = 0 534 itypvar2mpp(:) = 0 512 ivart(:) = 0 513 itypvar (:,:) = 0 514 itypvarmpp(:,:) = 0 535 515 536 516 ioserrcount = 0 … … 541 521 542 522 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 543 IF ( kvars == 2 ) THEN 544 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 545 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 546 ELSE 547 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 548 ENDIF 523 llcycle = .TRUE. 524 DO jvar = 1, kvars 525 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 526 llcycle = .FALSE. 527 EXIT 528 ENDIF 529 END DO 530 IF ( llcycle ) CYCLE 549 531 550 532 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & … … 562 544 563 545 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 564 IF ( kvars == 2 ) THEN 565 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 566 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 567 ELSE 568 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 569 ENDIF 546 llcycle = .TRUE. 547 DO jvar = 1, kvars 548 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 549 llcycle = .FALSE. 550 EXIT 551 ENDIF 552 END DO 553 IF ( llcycle ) CYCLE 570 554 571 555 loop_prof : DO ij = 1, inpfiles(jj)%nlev … … 574 558 & CYCLE 575 559 576 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 577 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 578 579 llvalprof = .TRUE. 580 EXIT loop_prof 581 582 ENDIF 583 584 IF ( kvars == 2 ) THEN 585 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 560 DO jvar = 1, kvars 561 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 586 562 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 587 563 … … 590 566 591 567 ENDIF 592 END IF568 END DO 593 569 594 570 END DO loop_prof … … 622 598 623 599 ! Coordinate search parameters 624 profdata%mi (iprof,1) = inpfiles(jj)%iobsi(ji,1) 625 profdata%mj (iprof,1) = inpfiles(jj)%iobsj(ji,1) 626 IF ( kvars == 2 ) THEN 627 profdata%mi (iprof,2) = inpfiles(jj)%iobsi(ji,2) 628 profdata%mj (iprof,2) = inpfiles(jj)%iobsj(ji,2) 629 ENDIF 600 DO jvar = 1, kvars 601 profdata%mi (iprof,jvar) = inpfiles(jj)%iobsi(ji,jvar) 602 profdata%mj (iprof,jvar) = inpfiles(jj)%iobsj(ji,jvar) 603 END DO 630 604 631 605 ! Profile WMO number … … 667 641 IF (ldsatt) THEN 668 642 669 IF ( kvars == 2 ) THEN670 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji, 1),2) .AND. &643 DO jvar = 1, kvars 644 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 671 645 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 672 & ldvar1 ) .OR. & 673 & ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 674 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 675 & ldvar2 ) ) THEN 646 & ldvar(jvar) ) ) THEN 676 647 ip3dt = ip3dt + 1 648 EXIT 649 ELSE IF ( jvar == kvars ) THEN 650 CYCLE loop_p 651 ENDIF 652 END DO 653 654 ENDIF 655 656 DO jvar = 1, kvars 657 658 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 659 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 660 & ldvar(jvar) ) .OR. ldsatt ) THEN 661 662 IF (ldsatt) THEN 663 664 ivart(jvar) = ip3dt 665 677 666 ELSE 678 CYCLE 667 668 ivart(jvar) = ivart(jvar) + 1 669 679 670 ENDIF 680 ELSE 681 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 682 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 683 & ldvar1 ) ) THEN 684 ip3dt = ip3dt + 1 671 672 ! Depth of jvar observation 673 profdata%var(jvar)%vdep(ivart(jvar)) = & 674 & inpfiles(jj)%pdep(ij,ji) 675 676 ! Depth of jvar observation QC 677 profdata%var(jvar)%idqc(ivart(jvar)) = & 678 & inpfiles(jj)%idqc(ij,ji) 679 680 ! Depth of jvar observation QC flags 681 profdata%var(jvar)%idqcf(:,ivart(jvar)) = & 682 & inpfiles(jj)%idqcf(:,ij,ji) 683 684 ! Profile index 685 profdata%var(jvar)%nvpidx(ivart(jvar)) = iprof 686 687 ! Vertical index in original profile 688 profdata%var(jvar)%nvlidx(ivart(jvar)) = ij 689 690 ! Profile jvar value 691 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 692 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 693 profdata%var(jvar)%vobs(ivart(jvar)) = & 694 & inpfiles(jj)%pob(ij,ji,1) 695 IF ( ldmod ) THEN 696 profdata%var(jvar)%vmod(ivart(jvar)) = & 697 & inpfiles(jj)%padd(ij,ji,1,1) 698 ENDIF 699 ! Count number of profile var1 data as function of type 700 itypvar( profdata%ntyp(iprof) + 1, jvar ) = & 701 & itypvar( profdata%ntyp(iprof) + 1, jvar ) + 1 685 702 ELSE 686 CYCLE703 profdata%var(jvar)%vobs(ivart(jvar)) = fbrmdi 687 704 ENDIF 705 706 ! Profile jvar qc 707 profdata%var(jvar)%nvqc(ivart(jvar)) = & 708 & inpfiles(jj)%ivlqc(ij,ji,1) 709 710 ! Profile jvar qc flags 711 profdata%var(jvar)%nvqcf(:,ivart(jvar)) = & 712 & inpfiles(jj)%ivlqcf(:,ij,ji,1) 713 714 ! Profile insitu T value 715 IF ( TRIM( inpfiles(jj)%cname(jvar) ) == 'POTM' ) THEN 716 profdata%var(jvar)%vext(ivart(jvar),1) = & 717 & inpfiles(jj)%pext(ij,ji,1) 718 ENDIF 719 688 720 ENDIF 689 690 ENDIF 691 692 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 693 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 694 & ldvar1 ) .OR. ldsatt ) THEN 695 696 IF (ldsatt) THEN 697 698 ivar1t = ip3dt 699 700 ELSE 701 702 ivar1t = ivar1t + 1 703 704 ENDIF 705 706 ! Depth of var1 observation 707 profdata%var(1)%vdep(ivar1t) = & 708 & inpfiles(jj)%pdep(ij,ji) 709 710 ! Depth of var1 observation QC 711 profdata%var(1)%idqc(ivar1t) = & 712 & inpfiles(jj)%idqc(ij,ji) 713 714 ! Depth of var1 observation QC flags 715 profdata%var(1)%idqcf(:,ivar1t) = & 716 & inpfiles(jj)%idqcf(:,ij,ji) 717 718 ! Profile index 719 profdata%var(1)%nvpidx(ivar1t) = iprof 720 721 ! Vertical index in original profile 722 profdata%var(1)%nvlidx(ivar1t) = ij 723 724 ! Profile var1 value 725 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 726 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 727 profdata%var(1)%vobs(ivar1t) = & 728 & inpfiles(jj)%pob(ij,ji,1) 729 IF ( ldmod ) THEN 730 profdata%var(1)%vmod(ivar1t) = & 731 & inpfiles(jj)%padd(ij,ji,1,1) 732 ENDIF 733 ! Count number of profile var1 data as function of type 734 itypvar1( profdata%ntyp(iprof) + 1 ) = & 735 & itypvar1( profdata%ntyp(iprof) + 1 ) + 1 736 ELSE 737 profdata%var(1)%vobs(ivar1t) = fbrmdi 738 ENDIF 739 740 ! Profile var1 qc 741 profdata%var(1)%nvqc(ivar1t) = & 742 & inpfiles(jj)%ivlqc(ij,ji,1) 743 744 ! Profile var1 qc flags 745 profdata%var(1)%nvqcf(:,ivar1t) = & 746 & inpfiles(jj)%ivlqcf(:,ij,ji,1) 747 748 ! Profile insitu T value 749 IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN 750 profdata%var(1)%vext(ivar1t,1) = & 751 & inpfiles(jj)%pext(ij,ji,1) 752 ENDIF 753 754 ENDIF 755 756 IF ( kvars == 2 ) THEN 757 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 758 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 759 & ldvar2 ) .OR. ldsatt ) THEN 760 761 IF (ldsatt) THEN 762 763 ivar2t = ip3dt 764 765 ELSE 766 767 ivar2t = ivar2t + 1 768 769 ENDIF 770 771 ! Depth of var2 observation 772 profdata%var(2)%vdep(ivar2t) = & 773 & inpfiles(jj)%pdep(ij,ji) 774 775 ! Depth of var2 observation QC 776 profdata%var(2)%idqc(ivar2t) = & 777 & inpfiles(jj)%idqc(ij,ji) 778 779 ! Depth of var2 observation QC flags 780 profdata%var(2)%idqcf(:,ivar2t) = & 781 & inpfiles(jj)%idqcf(:,ij,ji) 782 783 ! Profile index 784 profdata%var(2)%nvpidx(ivar2t) = iprof 785 786 ! Vertical index in original profile 787 profdata%var(2)%nvlidx(ivar2t) = ij 788 789 ! Profile var2 value 790 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) ) .AND. & 791 & ( .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) ) THEN 792 profdata%var(2)%vobs(ivar2t) = & 793 & inpfiles(jj)%pob(ij,ji,2) 794 IF ( ldmod ) THEN 795 profdata%var(2)%vmod(ivar2t) = & 796 & inpfiles(jj)%padd(ij,ji,1,2) 797 ENDIF 798 ! Count number of profile var2 data as function of type 799 itypvar2( profdata%ntyp(iprof) + 1 ) = & 800 & itypvar2( profdata%ntyp(iprof) + 1 ) + 1 801 ELSE 802 profdata%var(2)%vobs(ivar2t) = fbrmdi 803 ENDIF 804 805 ! Profile var2 qc 806 profdata%var(2)%nvqc(ivar2t) = & 807 & inpfiles(jj)%ivlqc(ij,ji,2) 808 809 ! Profile var2 qc flags 810 profdata%var(2)%nvqcf(:,ivar2t) = & 811 & inpfiles(jj)%ivlqcf(:,ij,ji,2) 812 813 ENDIF 814 ENDIF 721 722 END DO 815 723 816 724 END DO loop_p … … 826 734 !----------------------------------------------------------------------- 827 735 828 CALL obs_mpp_sum_integer ( ivar1t0, ivar1tmpp ) 829 IF ( kvars == 2 ) THEN 830 CALL obs_mpp_sum_integer ( ivar2t0, ivar2tmpp ) 831 ENDIF 736 DO jvar = 1, kvars 737 CALL obs_mpp_sum_integer ( ivart0(jvar), ivartmpp(jvar) ) 738 END DO 832 739 CALL obs_mpp_sum_integer ( ip3dt, ip3dtmpp ) 833 740 834 CALL obs_mpp_sum_integers( itypvar1, itypvar1mpp, ntyp1770 + 1 ) 835 IF ( kvars == 2 ) THEN 836 CALL obs_mpp_sum_integers( itypvar2, itypvar2mpp, ntyp1770 + 1 ) 837 ENDIF 741 DO jvar = 1, kvars 742 CALL obs_mpp_sum_integers( itypvar(:,jvar), itypvarmpp(:,jvar), ntyp1770 + 1 ) 743 END DO 838 744 839 745 !----------------------------------------------------------------------- … … 845 751 WRITE(numout,'(1X,A)') '------------' 846 752 WRITE(numout,*) 847 WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(1) ) 848 WRITE(numout,'(1X,A)') '------------------------' 849 DO ji = 0, ntyp1770 850 IF ( itypvar1mpp(ji+1) > 0 ) THEN 851 WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 852 & cwmonam1770(ji)(1:52),' = ', & 853 & itypvar1mpp(ji+1) 854 ENDIF 855 END DO 856 WRITE(numout,'(1X,A)') & 857 & '---------------------------------------------------------------' 858 WRITE(numout,'(1X,A55,I8)') & 859 & 'Total profile data for variable '//TRIM( profdata%cvars(1) )// & 860 & ' = ', ivar1tmpp 861 WRITE(numout,'(1X,A)') & 862 & '---------------------------------------------------------------' 863 WRITE(numout,*) 864 IF ( kvars == 2 ) THEN 865 WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(2) ) 753 DO jvar = 1, kvars 754 WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(jvar) ) 866 755 WRITE(numout,'(1X,A)') '------------------------' 867 756 DO ji = 0, ntyp1770 868 IF ( itypvar 2mpp(ji+1) > 0 ) THEN757 IF ( itypvarmpp(ji+1,jvar) > 0 ) THEN 869 758 WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 870 759 & cwmonam1770(ji)(1:52),' = ', & 871 & itypvar 2mpp(ji+1)760 & itypvarmpp(ji+1,jvar) 872 761 ENDIF 873 762 END DO … … 875 764 & '---------------------------------------------------------------' 876 765 WRITE(numout,'(1X,A55,I8)') & 877 & 'Total profile data for variable '//TRIM( profdata%cvars( 2) )// &878 & ' = ', ivar 2tmpp766 & 'Total profile data for variable '//TRIM( profdata%cvars(jvar) )// & 767 & ' = ', ivartmpp(jvar) 879 768 WRITE(numout,'(1X,A)') & 880 769 & '---------------------------------------------------------------' 881 770 WRITE(numout,*) 882 END IF771 END DO 883 772 ENDIF 884 773 885 774 IF (ldsatt) THEN 886 profdata%nvprot(1) = ip3dt 887 profdata%nvprotmpp(1) = ip3dtmpp 888 IF ( kvars == 2 ) THEN 889 profdata%nvprot(2) = ip3dt 890 profdata%nvprotmpp(2) = ip3dtmpp 891 ENDIF 775 profdata%nvprot(:) = ip3dt 776 profdata%nvprotmpp(:) = ip3dtmpp 892 777 ELSE 893 profdata%nvprot(1) = ivar1t 894 profdata%nvprotmpp(1) = ivar1tmpp 895 IF ( kvars == 2 ) THEN 896 profdata%nvprot(2) = ivar2t 897 profdata%nvprotmpp(2) = ivar2tmpp 898 ENDIF 778 DO jvar = 1, kvars 779 profdata%nvprot(jvar) = ivart(jvar) 780 profdata%nvprotmpp(jvar) = ivartmpp(jvar) 781 END DO 899 782 ENDIF 900 783 profdata%nprof = iprof … … 903 786 ! Model level search 904 787 !----------------------------------------------------------------------- 905 IF ( ldvar1 ) THEN 906 CALL obs_level_search( jpk, gdept_1d, & 907 & profdata%nvprot(1), profdata%var(1)%vdep, & 908 & profdata%var(1)%mvk ) 909 ENDIF 910 IF ( ldvar2 ) THEN 911 CALL obs_level_search( jpk, gdept_1d, & 912 & profdata%nvprot(2), profdata%var(2)%vdep, & 913 & profdata%var(2)%mvk ) 914 ENDIF 788 DO jvar = 1, kvars 789 IF ( ldvar(jvar) ) THEN 790 CALL obs_level_search( jpk, gdept_1d, & 791 & profdata%nvprot(jvar), profdata%var(jvar)%vdep, & 792 & profdata%var(jvar)%mvk ) 793 ENDIF 794 END DO 915 795 916 796 !-----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
