Changeset 11361 for NEMO/branches/UKMO/r8395_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
- Timestamp:
- 2019-07-29T11:26:23+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/r8395_obs_oper_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
r11350 r11361 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 … … 87 86 CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_prof' 88 87 CHARACTER(len=8) :: clrefdate 89 CHARACTER(len= 6), DIMENSION(:), ALLOCATABLE :: clvars88 CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: clvars 90 89 INTEGER :: jvar 91 90 INTEGER :: ji … … 105 104 INTEGER :: iprof 106 105 INTEGER :: iproftot 107 INTEGER :: ivar1t0 108 INTEGER :: ivar2t0 109 INTEGER :: ivar1t 110 INTEGER :: ivar2t 106 INTEGER, DIMENSION(kvars) :: ivart0 107 INTEGER, DIMENSION(kvars) :: ivart 111 108 INTEGER :: ip3dt 112 109 INTEGER :: ios 113 110 INTEGER :: ioserrcount 114 INTEGER :: ivar1tmpp 115 INTEGER :: ivar2tmpp 111 INTEGER, DIMENSION(kvars) :: ivartmpp 116 112 INTEGER :: ip3dtmpp 117 113 INTEGER :: itype 118 114 INTEGER, DIMENSION(knumfiles) :: & 119 115 & irefdate 120 INTEGER, DIMENSION(ntyp1770+1) :: & 121 & itypvar1, & 122 & itypvar1mpp, & 123 & itypvar2, & 124 & itypvar2mpp 116 INTEGER, DIMENSION(ntyp1770+1,kvars) :: & 117 & itypvar, & 118 & itypvarmpp 119 INTEGER, DIMENSION(:,:), ALLOCATABLE :: & 120 & iobsi, & 121 & iobsj, & 122 & iproc 125 123 INTEGER, DIMENSION(:), ALLOCATABLE :: & 126 & iobsi1, &127 & iobsj1, &128 & iproc1, &129 & iobsi2, &130 & iobsj2, &131 & iproc2, &132 124 & iindx, & 133 125 & ifileidx, & … … 147 139 LOGICAL :: llvalprof 148 140 LOGICAL :: lldavtimset 141 LOGICAL :: llcycle 149 142 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 150 143 & inpfiles … … 152 145 ! Local initialization 153 146 iprof = 0 154 ivar1t0 = 0 155 ivar2t0 = 0 147 ivart0(:) = 0 156 148 ip3dt = 0 157 149 … … 219 211 & ldgrid = .TRUE. ) 220 212 221 IF ( inpfiles(jj)%nvar < 2) THEN213 IF ( inpfiles(jj)%nvar /= kvars ) THEN 222 214 CALL ctl_stop( 'Feedback format error: ', & 223 & ' less than 2vars in profile file' )215 & ' unexpected number of vars in profile file' ) 224 216 ENDIF 225 217 … … 307 299 inowin = 0 308 300 DO ji = 1, inpfiles(jj)%nobs 309 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 310 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 311 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 301 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 302 llcycle = .TRUE. 303 DO jvar = 1, kvars 304 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 305 llcycle = .FALSE. 306 EXIT 307 ENDIF 308 END DO 309 IF ( llcycle ) CYCLE 312 310 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 313 311 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 317 315 ALLOCATE( zlam(inowin) ) 318 316 ALLOCATE( zphi(inowin) ) 319 ALLOCATE( iobsi1(inowin) ) 320 ALLOCATE( iobsj1(inowin) ) 321 ALLOCATE( iproc1(inowin) ) 322 ALLOCATE( iobsi2(inowin) ) 323 ALLOCATE( iobsj2(inowin) ) 324 ALLOCATE( iproc2(inowin) ) 317 ALLOCATE( iobsi(inowin,kvars) ) 318 ALLOCATE( iobsj(inowin,kvars) ) 319 ALLOCATE( iproc(inowin,kvars) ) 325 320 inowin = 0 326 321 DO ji = 1, inpfiles(jj)%nobs 327 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 328 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 329 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 322 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 323 llcycle = .TRUE. 324 DO jvar = 1, kvars 325 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 326 llcycle = .FALSE. 327 EXIT 328 ENDIF 329 END DO 330 IF ( llcycle ) CYCLE 330 331 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 331 332 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 336 337 END DO 337 338 338 IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN 339 CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, & 340 & iproc1, 'T' ) 341 iobsi2(:) = iobsi1(:) 342 iobsj2(:) = iobsj1(:) 343 iproc2(:) = iproc1(:) 344 ELSEIF ( TRIM( inpfiles(jj)%cname(1) ) == 'UVEL' ) THEN 345 CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, & 346 & iproc1, 'U' ) 347 CALL obs_grid_search( inowin, zlam, zphi, iobsi2, iobsj2, & 348 & iproc2, 'V' ) 339 ! Assume anything other than velocity is on T grid 340 IF ( TRIM( inpfiles(jj)%cname(1) ) == 'UVEL' ) THEN 341 CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,1), iobsj(:,1), & 342 & iproc(:,1), 'U' ) 343 CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,2), iobsj(:,2), & 344 & iproc(:,2), 'V' ) 345 ELSE 346 CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,1), iobsj(:,1), & 347 & iproc(:,1), 'T' ) 348 IF ( kvars > 1 ) THEN 349 DO jvar = 2, kvars 350 iobsi(:,jvar) = iobsi(:,1) 351 iobsj(:,jvar) = iobsj(:,1) 352 iproc(:,jvar) = iproc(:,1) 353 END DO 354 ENDIF 349 355 ENDIF 350 356 351 357 inowin = 0 352 358 DO ji = 1, inpfiles(jj)%nobs 353 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 354 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 355 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 359 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 360 llcycle = .TRUE. 361 DO jvar = 1, kvars 362 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 363 llcycle = .FALSE. 364 EXIT 365 ENDIF 366 END DO 367 IF ( llcycle ) CYCLE 356 368 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 357 369 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN 358 370 inowin = inowin + 1 359 inpfiles(jj)%iproc(ji,1) = iproc1(inowin) 360 inpfiles(jj)%iobsi(ji,1) = iobsi1(inowin) 361 inpfiles(jj)%iobsj(ji,1) = iobsj1(inowin) 362 inpfiles(jj)%iproc(ji,2) = iproc2(inowin) 363 inpfiles(jj)%iobsi(ji,2) = iobsi2(inowin) 364 inpfiles(jj)%iobsj(ji,2) = iobsj2(inowin) 365 IF ( inpfiles(jj)%iproc(ji,1) /= & 366 & inpfiles(jj)%iproc(ji,2) ) THEN 367 CALL ctl_stop( 'Error in obs_read_prof:', & 368 & 'var1 and var2 observation on different processors') 371 DO jvar = 1, kvars 372 inpfiles(jj)%iproc(ji,jvar) = iproc(inowin,jvar) 373 inpfiles(jj)%iobsi(ji,jvar) = iobsi(inowin,jvar) 374 inpfiles(jj)%iobsj(ji,jvar) = iobsj(inowin,jvar) 375 END DO 376 IF ( kvars > 1 ) THEN 377 DO jvar = 2, kvars 378 IF ( inpfiles(jj)%iproc(ji,jvar) /= & 379 & inpfiles(jj)%iproc(ji,1) ) THEN 380 CALL ctl_stop( 'Error in obs_read_prof:', & 381 & 'observation on different processors for different vars') 382 ENDIF 383 END DO 369 384 ENDIF 370 385 ENDIF 371 386 END DO 372 DEALLOCATE( zlam, zphi, iobsi 1, iobsj1, iproc1, iobsi2, iobsj2, iproc2)387 DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc ) 373 388 374 389 DO ji = 1, inpfiles(jj)%nobs 375 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 376 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 377 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 390 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 391 llcycle = .TRUE. 392 DO jvar = 1, kvars 393 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 394 llcycle = .FALSE. 395 EXIT 396 ENDIF 397 END DO 398 IF ( llcycle ) CYCLE 378 399 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 379 400 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 384 405 ENDIF 385 406 llvalprof = .FALSE. 386 IF ( ldvar1 ) THEN 387 loop_t_count : DO ij = 1,inpfiles(jj)%nlev 388 IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 389 & CYCLE 390 IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 391 & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 392 ivar1t0 = ivar1t0 + 1 393 ENDIF 394 END DO loop_t_count 395 ENDIF 396 IF ( ldvar2 ) THEN 397 loop_s_count : DO ij = 1,inpfiles(jj)%nlev 398 IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 399 & CYCLE 400 IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 401 & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 402 ivar2t0 = ivar2t0 + 1 403 ENDIF 404 END DO loop_s_count 405 ENDIF 406 loop_p_count : DO ij = 1,inpfiles(jj)%nlev 407 DO jvar = 1, kvars 408 IF ( ldvar(jvar) ) THEN 409 DO ij = 1,inpfiles(jj)%nlev 410 IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 411 & CYCLE 412 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 413 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 414 ivart0(jvar) = ivart0(jvar) + 1 415 ENDIF 416 END DO 417 ENDIF 418 END DO 419 DO ij = 1,inpfiles(jj)%nlev 407 420 IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 408 421 & CYCLE 409 IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &410 & ( inpfiles(jj)%idqc(ij,ji) <= 2 )) .AND. &411 & ldvar1 ) .OR. &412 & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &413 & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &414 & ldvar2 ) ) THEN415 ip3dt = ip3dt + 1416 llvalprof = .TRUE.417 END IF418 END DO loop_p_count422 DO jvar = 1, kvars 423 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 424 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 425 & ldvar(jvar) ) ) THEN 426 ip3dt = ip3dt + 1 427 llvalprof = .TRUE. 428 EXIT 429 ENDIF 430 END DO 431 END DO 419 432 420 433 IF ( llvalprof ) iprof = iprof + 1 … … 437 450 DO jj = 1, inobf 438 451 DO ji = 1, inpfiles(jj)%nobs 439 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 440 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 441 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 452 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 453 llcycle = .TRUE. 454 DO jvar = 1, kvars 455 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 456 llcycle = .FALSE. 457 EXIT 458 ENDIF 459 END DO 460 IF ( llcycle ) CYCLE 442 461 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 443 462 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 452 471 DO jj = 1, inobf 453 472 DO ji = 1, inpfiles(jj)%nobs 454 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 455 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 456 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 473 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 474 llcycle = .TRUE. 475 DO jvar = 1, kvars 476 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 477 llcycle = .FALSE. 478 EXIT 479 ENDIF 480 END DO 481 IF ( llcycle ) CYCLE 457 482 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 458 483 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 470 495 iv3dt(:) = -1 471 496 IF (ldsatt) THEN 472 iv3dt(1) = ip3dt 473 iv3dt(2) = ip3dt 497 iv3dt(:) = ip3dt 474 498 ELSE 475 iv3dt(1) = ivar1t0 476 iv3dt(2) = ivar2t0 499 iv3dt(:) = ivart0(:) 477 500 ENDIF 478 501 CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, & … … 487 510 488 511 ip3dt = 0 489 ivar1t = 0 490 ivar2t = 0 491 itypvar1 (:) = 0 492 itypvar1mpp(:) = 0 493 494 itypvar2 (:) = 0 495 itypvar2mpp(:) = 0 512 ivart(:) = 0 513 itypvar (:,:) = 0 514 itypvarmpp(:,:) = 0 496 515 497 516 ioserrcount = 0 … … 501 520 ji = iprofidx(iindx(jk)) 502 521 503 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 504 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 505 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 522 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 523 llcycle = .TRUE. 524 DO jvar = 1, kvars 525 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 526 llcycle = .FALSE. 527 EXIT 528 ENDIF 529 END DO 530 IF ( llcycle ) CYCLE 506 531 507 532 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & … … 518 543 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 519 544 520 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 521 & ( inpfiles(jj)%ivqc(ji,2) > 2 ) ) CYCLE 545 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 546 llcycle = .TRUE. 547 DO jvar = 1, kvars 548 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 549 llcycle = .FALSE. 550 EXIT 551 ENDIF 552 END DO 553 IF ( llcycle ) CYCLE 522 554 523 555 loop_prof : DO ij = 1, inpfiles(jj)%nlev … … 526 558 & CYCLE 527 559 528 IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 529 & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 530 531 llvalprof = .TRUE. 532 EXIT loop_prof 533 534 ENDIF 535 536 IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 537 & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 538 539 llvalprof = .TRUE. 540 EXIT loop_prof 541 542 ENDIF 560 DO jvar = 1, kvars 561 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 562 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 563 564 llvalprof = .TRUE. 565 EXIT loop_prof 566 567 ENDIF 568 END DO 543 569 544 570 END DO loop_prof … … 572 598 573 599 ! Coordinate search parameters 574 profdata%mi (iprof,1) = inpfiles(jj)%iobsi(ji,1)575 profdata%mj (iprof,1) = inpfiles(jj)%iobsj(ji,1)576 profdata%mi (iprof,2) = inpfiles(jj)%iobsi(ji,2)577 profdata%mj (iprof,2) = inpfiles(jj)%iobsj(ji,2)600 DO jvar = 1, kvars 601 profdata%mi (iprof,jvar) = inpfiles(jj)%iobsi(ji,jvar) 602 profdata%mj (iprof,jvar) = inpfiles(jj)%iobsj(ji,jvar) 603 END DO 578 604 579 605 ! Profile WMO number … … 615 641 IF (ldsatt) THEN 616 642 617 IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 618 & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 619 & ldvar1 ) .OR. & 620 & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 621 & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 622 & ldvar2 ) ) THEN 623 ip3dt = ip3dt + 1 624 ELSE 625 CYCLE 643 DO jvar = 1, kvars 644 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 645 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 646 & ldvar(jvar) ) ) THEN 647 ip3dt = ip3dt + 1 648 EXIT 649 ELSE IF ( jvar == kvars ) THEN 650 CYCLE loop_p 651 ENDIF 652 END DO 653 654 ENDIF 655 656 DO jvar = 1, kvars 657 658 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 659 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 660 & ldvar(jvar) ) .OR. ldsatt ) THEN 661 662 IF (ldsatt) THEN 663 664 ivart(jvar) = ip3dt 665 666 ELSE 667 668 ivart(jvar) = ivart(jvar) + 1 669 670 ENDIF 671 672 ! Depth of jvar observation 673 profdata%var(jvar)%vdep(ivart(jvar)) = & 674 & inpfiles(jj)%pdep(ij,ji) 675 676 ! Depth of jvar observation QC 677 profdata%var(jvar)%idqc(ivart(jvar)) = & 678 & inpfiles(jj)%idqc(ij,ji) 679 680 ! Depth of jvar observation QC flags 681 profdata%var(jvar)%idqcf(:,ivart(jvar)) = & 682 & inpfiles(jj)%idqcf(:,ij,ji) 683 684 ! Profile index 685 profdata%var(jvar)%nvpidx(ivart(jvar)) = iprof 686 687 ! Vertical index in original profile 688 profdata%var(jvar)%nvlidx(ivart(jvar)) = ij 689 690 ! Profile jvar value 691 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 692 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 693 profdata%var(jvar)%vobs(ivart(jvar)) = & 694 & inpfiles(jj)%pob(ij,ji,jvar) 695 IF ( ldmod ) THEN 696 profdata%var(jvar)%vmod(ivart(jvar)) = & 697 & inpfiles(jj)%padd(ij,ji,1,jvar) 698 ENDIF 699 ! Count number of profile var1 data as function of type 700 itypvar( profdata%ntyp(iprof) + 1, jvar ) = & 701 & itypvar( profdata%ntyp(iprof) + 1, jvar ) + 1 702 ELSE 703 profdata%var(jvar)%vobs(ivart(jvar)) = fbrmdi 704 ENDIF 705 706 ! Profile jvar qc 707 profdata%var(jvar)%nvqc(ivart(jvar)) = & 708 & inpfiles(jj)%ivlqc(ij,ji,jvar) 709 710 ! Profile jvar qc flags 711 profdata%var(jvar)%nvqcf(:,ivart(jvar)) = & 712 & inpfiles(jj)%ivlqcf(:,ij,ji,jvar) 713 714 ! Profile insitu T value 715 IF ( TRIM( inpfiles(jj)%cname(jvar) ) == 'POTM' ) THEN 716 profdata%var(jvar)%vext(ivart(jvar),1) = & 717 & inpfiles(jj)%pext(ij,ji,1) 718 ENDIF 719 626 720 ENDIF 627 628 ENDIF 629 630 IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 631 & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 632 & ldvar1 ) .OR. ldsatt ) THEN 633 634 IF (ldsatt) THEN 635 636 ivar1t = ip3dt 637 638 ELSE 639 640 ivar1t = ivar1t + 1 641 642 ENDIF 643 644 ! Depth of var1 observation 645 profdata%var(1)%vdep(ivar1t) = & 646 & inpfiles(jj)%pdep(ij,ji) 647 648 ! Depth of var1 observation QC 649 profdata%var(1)%idqc(ivar1t) = & 650 & inpfiles(jj)%idqc(ij,ji) 651 652 ! Depth of var1 observation QC flags 653 profdata%var(1)%idqcf(:,ivar1t) = & 654 & inpfiles(jj)%idqcf(:,ij,ji) 655 656 ! Profile index 657 profdata%var(1)%nvpidx(ivar1t) = iprof 658 659 ! Vertical index in original profile 660 profdata%var(1)%nvlidx(ivar1t) = ij 661 662 ! Profile var1 value 663 IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 664 & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 665 profdata%var(1)%vobs(ivar1t) = & 666 & inpfiles(jj)%pob(ij,ji,1) 667 IF ( ldmod ) THEN 668 profdata%var(1)%vmod(ivar1t) = & 669 & inpfiles(jj)%padd(ij,ji,1,1) 670 ENDIF 671 ! Count number of profile var1 data as function of type 672 itypvar1( profdata%ntyp(iprof) + 1 ) = & 673 & itypvar1( profdata%ntyp(iprof) + 1 ) + 1 674 ELSE 675 profdata%var(1)%vobs(ivar1t) = fbrmdi 676 ENDIF 677 678 ! Profile var1 qc 679 profdata%var(1)%nvqc(ivar1t) = & 680 & inpfiles(jj)%ivlqc(ij,ji,1) 681 682 ! Profile var1 qc flags 683 profdata%var(1)%nvqcf(:,ivar1t) = & 684 & inpfiles(jj)%ivlqcf(:,ij,ji,1) 685 686 ! Profile insitu T value 687 IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN 688 profdata%var(1)%vext(ivar1t,1) = & 689 & inpfiles(jj)%pext(ij,ji,1) 690 ENDIF 691 692 ENDIF 693 694 IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 695 & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 696 & ldvar2 ) .OR. ldsatt ) THEN 697 698 IF (ldsatt) THEN 699 700 ivar2t = ip3dt 701 702 ELSE 703 704 ivar2t = ivar2t + 1 705 706 ENDIF 707 708 ! Depth of var2 observation 709 profdata%var(2)%vdep(ivar2t) = & 710 & inpfiles(jj)%pdep(ij,ji) 711 712 ! Depth of var2 observation QC 713 profdata%var(2)%idqc(ivar2t) = & 714 & inpfiles(jj)%idqc(ij,ji) 715 716 ! Depth of var2 observation QC flags 717 profdata%var(2)%idqcf(:,ivar2t) = & 718 & inpfiles(jj)%idqcf(:,ij,ji) 719 720 ! Profile index 721 profdata%var(2)%nvpidx(ivar2t) = iprof 722 723 ! Vertical index in original profile 724 profdata%var(2)%nvlidx(ivar2t) = ij 725 726 ! Profile var2 value 727 IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 728 & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 729 profdata%var(2)%vobs(ivar2t) = & 730 & inpfiles(jj)%pob(ij,ji,2) 731 IF ( ldmod ) THEN 732 profdata%var(2)%vmod(ivar2t) = & 733 & inpfiles(jj)%padd(ij,ji,1,2) 734 ENDIF 735 ! Count number of profile var2 data as function of type 736 itypvar2( profdata%ntyp(iprof) + 1 ) = & 737 & itypvar2( profdata%ntyp(iprof) + 1 ) + 1 738 ELSE 739 profdata%var(2)%vobs(ivar2t) = fbrmdi 740 ENDIF 741 742 ! Profile var2 qc 743 profdata%var(2)%nvqc(ivar2t) = & 744 & inpfiles(jj)%ivlqc(ij,ji,2) 745 746 ! Profile var2 qc flags 747 profdata%var(2)%nvqcf(:,ivar2t) = & 748 & inpfiles(jj)%ivlqcf(:,ij,ji,2) 749 750 ENDIF 721 722 END DO 751 723 752 724 END DO loop_p … … 762 734 !----------------------------------------------------------------------- 763 735 764 CALL obs_mpp_sum_integer ( ivar1t0, ivar1tmpp ) 765 CALL obs_mpp_sum_integer ( ivar2t0, ivar2tmpp ) 736 DO jvar = 1, kvars 737 CALL obs_mpp_sum_integer ( ivart0(jvar), ivartmpp(jvar) ) 738 END DO 766 739 CALL obs_mpp_sum_integer ( ip3dt, ip3dtmpp ) 767 740 768 CALL obs_mpp_sum_integers( itypvar1, itypvar1mpp, ntyp1770 + 1 ) 769 CALL obs_mpp_sum_integers( itypvar2, itypvar2mpp, ntyp1770 + 1 ) 741 DO jvar = 1, kvars 742 CALL obs_mpp_sum_integers( itypvar(:,jvar), itypvarmpp(:,jvar), ntyp1770 + 1 ) 743 END DO 770 744 771 745 !----------------------------------------------------------------------- … … 777 751 WRITE(numout,'(1X,A)') '------------' 778 752 WRITE(numout,*) 779 WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(1) ) 780 WRITE(numout,'(1X,A)') '------------------------' 781 DO ji = 0, ntyp1770 782 IF ( itypvar1mpp(ji+1) > 0 ) THEN 783 WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 784 & cwmonam1770(ji)(1:52),' = ', & 785 & itypvar1mpp(ji+1) 786 ENDIF 753 DO jvar = 1, kvars 754 WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(jvar) ) 755 WRITE(numout,'(1X,A)') '------------------------' 756 DO ji = 0, ntyp1770 757 IF ( itypvarmpp(ji+1,jvar) > 0 ) THEN 758 WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 759 & cwmonam1770(ji)(1:52),' = ', & 760 & itypvarmpp(ji+1,jvar) 761 ENDIF 762 END DO 763 WRITE(numout,'(1X,A)') & 764 & '---------------------------------------------------------------' 765 WRITE(numout,'(1X,A55,I8)') & 766 & 'Total profile data for variable '//TRIM( profdata%cvars(jvar) )// & 767 & ' = ', ivartmpp(jvar) 768 WRITE(numout,'(1X,A)') & 769 & '---------------------------------------------------------------' 770 WRITE(numout,*) 787 771 END DO 788 WRITE(numout,'(1X,A)') & 789 & '---------------------------------------------------------------' 790 WRITE(numout,'(1X,A55,I8)') & 791 & 'Total profile data for variable '//TRIM( profdata%cvars(1) )// & 792 & ' = ', ivar1tmpp 793 WRITE(numout,'(1X,A)') & 794 & '---------------------------------------------------------------' 795 WRITE(numout,*) 796 WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(2) ) 797 WRITE(numout,'(1X,A)') '------------------------' 798 DO ji = 0, ntyp1770 799 IF ( itypvar2mpp(ji+1) > 0 ) THEN 800 WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 801 & cwmonam1770(ji)(1:52),' = ', & 802 & itypvar2mpp(ji+1) 803 ENDIF 772 ENDIF 773 774 IF (ldsatt) THEN 775 profdata%nvprot(:) = ip3dt 776 profdata%nvprotmpp(:) = ip3dtmpp 777 ELSE 778 DO jvar = 1, kvars 779 profdata%nvprot(jvar) = ivart(jvar) 780 profdata%nvprotmpp(jvar) = ivartmpp(jvar) 804 781 END DO 805 WRITE(numout,'(1X,A)') &806 & '---------------------------------------------------------------'807 WRITE(numout,'(1X,A55,I8)') &808 & 'Total profile data for variable '//TRIM( profdata%cvars(2) )// &809 & ' = ', ivar2tmpp810 WRITE(numout,'(1X,A)') &811 & '---------------------------------------------------------------'812 WRITE(numout,*)813 ENDIF814 815 IF (ldsatt) THEN816 profdata%nvprot(1) = ip3dt817 profdata%nvprot(2) = ip3dt818 profdata%nvprotmpp(1) = ip3dtmpp819 profdata%nvprotmpp(2) = ip3dtmpp820 ELSE821 profdata%nvprot(1) = ivar1t822 profdata%nvprot(2) = ivar2t823 profdata%nvprotmpp(1) = ivar1tmpp824 profdata%nvprotmpp(2) = ivar2tmpp825 782 ENDIF 826 783 profdata%nprof = iprof … … 829 786 ! Model level search 830 787 !----------------------------------------------------------------------- 831 IF ( ldvar1 ) THEN 832 CALL obs_level_search( jpk, gdept_1d, & 833 & profdata%nvprot(1), profdata%var(1)%vdep, & 834 & profdata%var(1)%mvk ) 835 ENDIF 836 IF ( ldvar2 ) THEN 837 CALL obs_level_search( jpk, gdept_1d, & 838 & profdata%nvprot(2), profdata%var(2)%vdep, & 839 & profdata%var(2)%mvk ) 840 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 841 795 842 796 !-----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.