Changeset 14056 for NEMO/trunk/src/OCE/OBS/obs_read_prof.F90
- Timestamp:
- 2020-12-03T15:08:29+01:00 (4 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/OCE/OBS/obs_read_prof.F90 (modified) (27 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/OBS/obs_read_prof.F90
r13226 r14056 45 45 SUBROUTINE obs_rea_prof( profdata, knumfiles, cdfilenames, & 46 46 & kvars, kextr, kstp, ddobsini, ddobsend, & 47 & ldvar 1, ldvar2, ldignmis, ldsatt, &48 & ldmod, kdailyavtypes )47 & ldvar, ldignmis, ldsatt, & 48 & ldmod, cdvars, kdailyavtypes ) 49 49 !!--------------------------------------------------------------------- 50 50 !! … … 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 … … 81 80 REAL(dp), INTENT(IN) :: ddobsini ! Obs. ini time in YYYYMMDD.HHMMSS 82 81 REAL(dp), INTENT(IN) :: ddobsend ! Obs. end time in YYYYMMDD.HHMMSS 82 CHARACTER(len=8), DIMENSION(kvars), INTENT(IN) :: cdvars 83 83 INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 84 84 & kdailyavtypes ! Types of daily average observations … … 87 87 CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_prof' 88 88 CHARACTER(len=8) :: clrefdate 89 CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: clvars 89 CHARACTER(len=8), DIMENSION(:), ALLOCATABLE :: clvarsin 90 90 INTEGER :: jvar 91 91 INTEGER :: ji … … 105 105 INTEGER :: iprof 106 106 INTEGER :: iproftot 107 INTEGER :: ivar1t0 108 INTEGER :: ivar2t0 109 INTEGER :: ivar1t 110 INTEGER :: ivar2t 107 INTEGER, DIMENSION(kvars) :: ivart0 108 INTEGER, DIMENSION(kvars) :: ivart 111 109 INTEGER :: ip3dt 112 110 INTEGER :: ios 113 111 INTEGER :: ioserrcount 114 INTEGER :: ivar1tmpp 115 INTEGER :: ivar2tmpp 112 INTEGER, DIMENSION(kvars) :: ivartmpp 116 113 INTEGER :: ip3dtmpp 117 114 INTEGER :: itype 118 115 INTEGER, DIMENSION(knumfiles) :: & 119 116 & irefdate 120 INTEGER, DIMENSION(ntyp1770+1) :: & 121 & itypvar1, & 122 & itypvar1mpp, & 123 & itypvar2, & 124 & itypvar2mpp 117 INTEGER, DIMENSION(ntyp1770+1,kvars) :: & 118 & itypvar, & 119 & itypvarmpp 120 INTEGER, DIMENSION(:,:), ALLOCATABLE :: & 121 & iobsi, & 122 & iobsj, & 123 & iproc 125 124 INTEGER, DIMENSION(:), ALLOCATABLE :: & 126 & iobsi1, &127 & iobsj1, &128 & iproc1, &129 & iobsi2, &130 & iobsj2, &131 & iproc2, &132 125 & iindx, & 133 126 & ifileidx, & … … 147 140 LOGICAL :: llvalprof 148 141 LOGICAL :: lldavtimset 142 LOGICAL :: llcycle 149 143 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 150 144 & inpfiles … … 152 146 ! Local initialization 153 147 iprof = 0 154 ivar1t0 = 0 155 ivar2t0 = 0 148 ivart0(:) = 0 156 149 ip3dt = 0 157 150 … … 219 212 & ldgrid = .TRUE. ) 220 213 221 IF ( inpfiles(jj)%nvar < 2) THEN214 IF ( inpfiles(jj)%nvar /= kvars ) THEN 222 215 CALL ctl_stop( 'Feedback format error: ', & 223 & ' less than 2vars in profile file' )216 & ' unexpected number of vars in profile file' ) 224 217 ENDIF 225 218 … … 229 222 230 223 IF ( jj == 1 ) THEN 231 ALLOCATE( clvars ( inpfiles(jj)%nvar ) )224 ALLOCATE( clvarsin( inpfiles(jj)%nvar ) ) 232 225 DO ji = 1, inpfiles(jj)%nvar 233 clvars(ji) = inpfiles(jj)%cname(ji) 226 clvarsin(ji) = inpfiles(jj)%cname(ji) 227 IF ( clvarsin(ji) /= cdvars(ji) ) THEN 228 CALL ctl_stop( 'Feedback file variables do not match', & 229 & ' expected variable names for this type' ) 230 ENDIF 234 231 END DO 235 232 ELSE 236 233 DO ji = 1, inpfiles(jj)%nvar 237 IF ( inpfiles(jj)%cname(ji) /= clvars (ji) ) THEN234 IF ( inpfiles(jj)%cname(ji) /= clvarsin(ji) ) THEN 238 235 CALL ctl_stop( 'Feedback file variables not consistent', & 239 236 & ' with previous files for this type' ) … … 308 305 DO ji = 1, inpfiles(jj)%nobs 309 306 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 307 llcycle = .TRUE. 308 DO jvar = 1, kvars 309 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 310 llcycle = .FALSE. 311 EXIT 312 ENDIF 313 END DO 314 IF ( llcycle ) CYCLE 312 315 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 313 316 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 317 320 ALLOCATE( zlam(inowin) ) 318 321 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) ) 322 ALLOCATE( iobsi(inowin,kvars) ) 323 ALLOCATE( iobsj(inowin,kvars) ) 324 ALLOCATE( iproc(inowin,kvars) ) 325 325 inowin = 0 326 326 DO ji = 1, inpfiles(jj)%nobs 327 327 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 328 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 329 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 328 llcycle = .TRUE. 329 DO jvar = 1, kvars 330 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 331 llcycle = .FALSE. 332 EXIT 333 ENDIF 334 END DO 335 IF ( llcycle ) CYCLE 330 336 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 331 337 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 336 342 END DO 337 343 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' ) 344 ! Assume anything other than velocity is on T grid 345 IF ( TRIM( inpfiles(jj)%cname(1) ) == 'UVEL' ) THEN 346 CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,1), iobsj(:,1), & 347 & iproc(:,1), 'U' ) 348 CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,2), iobsj(:,2), & 349 & iproc(:,2), 'V' ) 350 ELSE 351 CALL obs_grid_search( inowin, zlam, zphi, iobsi(:,1), iobsj(:,1), & 352 & iproc(:,1), 'T' ) 353 IF ( kvars > 1 ) THEN 354 DO jvar = 2, kvars 355 iobsi(:,jvar) = iobsi(:,1) 356 iobsj(:,jvar) = iobsj(:,1) 357 iproc(:,jvar) = iproc(:,1) 358 END DO 359 ENDIF 349 360 ENDIF 350 361 … … 352 363 DO ji = 1, inpfiles(jj)%nobs 353 364 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 354 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 355 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 365 llcycle = .TRUE. 366 DO jvar = 1, kvars 367 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 368 llcycle = .FALSE. 369 EXIT 370 ENDIF 371 END DO 372 IF ( llcycle ) CYCLE 356 373 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 357 374 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN 358 375 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') 376 DO jvar = 1, kvars 377 inpfiles(jj)%iproc(ji,jvar) = iproc(inowin,jvar) 378 inpfiles(jj)%iobsi(ji,jvar) = iobsi(inowin,jvar) 379 inpfiles(jj)%iobsj(ji,jvar) = iobsj(inowin,jvar) 380 END DO 381 IF ( kvars > 1 ) THEN 382 DO jvar = 2, kvars 383 IF ( inpfiles(jj)%iproc(ji,jvar) /= & 384 & inpfiles(jj)%iproc(ji,1) ) THEN 385 CALL ctl_stop( 'Error in obs_read_prof:', & 386 & 'observation on different processors for different vars') 387 ENDIF 388 END DO 369 389 ENDIF 370 390 ENDIF 371 391 END DO 372 DEALLOCATE( zlam, zphi, iobsi 1, iobsj1, iproc1, iobsi2, iobsj2, iproc2)392 DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc ) 373 393 374 394 DO ji = 1, inpfiles(jj)%nobs 375 395 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 376 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 377 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 396 llcycle = .TRUE. 397 DO jvar = 1, kvars 398 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 399 llcycle = .FALSE. 400 EXIT 401 ENDIF 402 END DO 403 IF ( llcycle ) CYCLE 378 404 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 379 405 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 384 410 ENDIF 385 411 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 ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 391 & .NOT. BTEST(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 ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 401 & .NOT. BTEST(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 412 DO jvar = 1, kvars 413 IF ( ldvar(jvar) ) THEN 414 DO ij = 1,inpfiles(jj)%nlev 415 IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 416 & CYCLE 417 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 418 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 419 ivart0(jvar) = ivart0(jvar) + 1 420 ENDIF 421 END DO 422 ENDIF 423 END DO 424 DO ij = 1,inpfiles(jj)%nlev 407 425 IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 408 426 & CYCLE 409 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. &410 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. &411 & ldvar1 ) .OR. &412 & ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. &413 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. &414 & ldvar2 ) ) THEN415 ip3dt = ip3dt + 1416 llvalprof = .TRUE.417 END IF418 END DO loop_p_count427 DO jvar = 1, kvars 428 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 429 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 430 & ldvar(jvar) ) ) THEN 431 ip3dt = ip3dt + 1 432 llvalprof = .TRUE. 433 EXIT 434 ENDIF 435 END DO 436 END DO 419 437 420 438 IF ( llvalprof ) iprof = iprof + 1 … … 438 456 DO ji = 1, inpfiles(jj)%nobs 439 457 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 440 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 441 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 458 llcycle = .TRUE. 459 DO jvar = 1, kvars 460 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 461 llcycle = .FALSE. 462 EXIT 463 ENDIF 464 END DO 465 IF ( llcycle ) CYCLE 442 466 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 443 467 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 453 477 DO ji = 1, inpfiles(jj)%nobs 454 478 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 455 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 456 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 479 llcycle = .TRUE. 480 DO jvar = 1, kvars 481 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 482 llcycle = .FALSE. 483 EXIT 484 ENDIF 485 END DO 486 IF ( llcycle ) CYCLE 457 487 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 458 488 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 470 500 iv3dt(:) = -1 471 501 IF (ldsatt) THEN 472 iv3dt(1) = ip3dt 473 iv3dt(2) = ip3dt 502 iv3dt(:) = ip3dt 474 503 ELSE 475 iv3dt(1) = ivar1t0 476 iv3dt(2) = ivar2t0 504 iv3dt(:) = ivart0(:) 477 505 ENDIF 478 506 CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, & … … 483 511 profdata%nprof = 0 484 512 profdata%nvprot(:) = 0 485 profdata%cvars(:) = clvars (:)513 profdata%cvars(:) = clvarsin(:) 486 514 iprof = 0 487 515 488 516 ip3dt = 0 489 ivar1t = 0 490 ivar2t = 0 491 itypvar1 (:) = 0 492 itypvar1mpp(:) = 0 493 494 itypvar2 (:) = 0 495 itypvar2mpp(:) = 0 517 ivart(:) = 0 518 itypvar (:,:) = 0 519 itypvarmpp(:,:) = 0 496 520 497 521 ioserrcount = 0 … … 501 525 ji = iprofidx(iindx(jk)) 502 526 503 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 504 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 505 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 527 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 528 llcycle = .TRUE. 529 DO jvar = 1, kvars 530 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 531 llcycle = .FALSE. 532 EXIT 533 ENDIF 534 END DO 535 IF ( llcycle ) CYCLE 506 536 507 537 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & … … 519 549 520 550 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 521 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 522 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 551 llcycle = .TRUE. 552 DO jvar = 1, kvars 553 IF ( .NOT. ( BTEST(inpfiles(jj)%ivqc(ji,jvar),2) ) ) THEN 554 llcycle = .FALSE. 555 EXIT 556 ENDIF 557 END DO 558 IF ( llcycle ) CYCLE 523 559 524 560 loop_prof : DO ij = 1, inpfiles(jj)%nlev … … 527 563 & CYCLE 528 564 529 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 530 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 531 532 llvalprof = .TRUE. 533 EXIT loop_prof 534 535 ENDIF 536 537 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 538 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 539 540 llvalprof = .TRUE. 541 EXIT loop_prof 542 543 ENDIF 565 DO jvar = 1, kvars 566 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 567 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 568 569 llvalprof = .TRUE. 570 EXIT loop_prof 571 572 ENDIF 573 END DO 544 574 545 575 END DO loop_prof … … 573 603 574 604 ! Coordinate search parameters 575 profdata%mi (iprof,1) = inpfiles(jj)%iobsi(ji,1)576 profdata%mj (iprof,1) = inpfiles(jj)%iobsj(ji,1)577 profdata%mi (iprof,2) = inpfiles(jj)%iobsi(ji,2)578 profdata%mj (iprof,2) = inpfiles(jj)%iobsj(ji,2)605 DO jvar = 1, kvars 606 profdata%mi (iprof,jvar) = inpfiles(jj)%iobsi(ji,jvar) 607 profdata%mj (iprof,jvar) = inpfiles(jj)%iobsj(ji,jvar) 608 END DO 579 609 580 610 ! Profile WMO number … … 616 646 IF (ldsatt) THEN 617 647 618 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 619 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 620 & ldvar1 ) .OR. & 621 & ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 622 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 623 & ldvar2 ) ) THEN 624 ip3dt = ip3dt + 1 625 ELSE 626 CYCLE 648 DO jvar = 1, kvars 649 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 650 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 651 & ldvar(jvar) ) ) THEN 652 ip3dt = ip3dt + 1 653 EXIT 654 ELSE IF ( jvar == kvars ) THEN 655 CYCLE loop_p 656 ENDIF 657 END DO 658 659 ENDIF 660 661 DO jvar = 1, kvars 662 663 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 664 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 665 & ldvar(jvar) ) .OR. ldsatt ) THEN 666 667 IF (ldsatt) THEN 668 669 ivart(jvar) = ip3dt 670 671 ELSE 672 673 ivart(jvar) = ivart(jvar) + 1 674 675 ENDIF 676 677 ! Depth of jvar observation 678 profdata%var(jvar)%vdep(ivart(jvar)) = & 679 & inpfiles(jj)%pdep(ij,ji) 680 681 ! Depth of jvar observation QC 682 profdata%var(jvar)%idqc(ivart(jvar)) = & 683 & inpfiles(jj)%idqc(ij,ji) 684 685 ! Depth of jvar observation QC flags 686 profdata%var(jvar)%idqcf(:,ivart(jvar)) = & 687 & inpfiles(jj)%idqcf(:,ij,ji) 688 689 ! Profile index 690 profdata%var(jvar)%nvpidx(ivart(jvar)) = iprof 691 692 ! Vertical index in original profile 693 profdata%var(jvar)%nvlidx(ivart(jvar)) = ij 694 695 ! Profile jvar value 696 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,jvar),2) .AND. & 697 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 698 profdata%var(jvar)%vobs(ivart(jvar)) = & 699 & inpfiles(jj)%pob(ij,ji,jvar) 700 IF ( ldmod ) THEN 701 profdata%var(jvar)%vmod(ivart(jvar)) = & 702 & inpfiles(jj)%padd(ij,ji,1,jvar) 703 ENDIF 704 ! Count number of profile var1 data as function of type 705 itypvar( profdata%ntyp(iprof) + 1, jvar ) = & 706 & itypvar( profdata%ntyp(iprof) + 1, jvar ) + 1 707 ELSE 708 profdata%var(jvar)%vobs(ivart(jvar)) = fbrmdi 709 ENDIF 710 711 ! Profile jvar qc 712 profdata%var(jvar)%nvqc(ivart(jvar)) = & 713 & inpfiles(jj)%ivlqc(ij,ji,jvar) 714 715 ! Profile jvar qc flags 716 profdata%var(jvar)%nvqcf(:,ivart(jvar)) = & 717 & inpfiles(jj)%ivlqcf(:,ij,ji,jvar) 718 719 ! Profile insitu T value 720 IF ( TRIM( inpfiles(jj)%cname(jvar) ) == 'POTM' ) THEN 721 profdata%var(jvar)%vext(ivart(jvar),1) = & 722 & inpfiles(jj)%pext(ij,ji,1) 723 ENDIF 724 627 725 ENDIF 628 629 ENDIF 630 631 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 632 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 633 & ldvar1 ) .OR. ldsatt ) THEN 634 635 IF (ldsatt) THEN 636 637 ivar1t = ip3dt 638 639 ELSE 640 641 ivar1t = ivar1t + 1 642 643 ENDIF 644 645 ! Depth of var1 observation 646 profdata%var(1)%vdep(ivar1t) = & 647 & inpfiles(jj)%pdep(ij,ji) 648 649 ! Depth of var1 observation QC 650 profdata%var(1)%idqc(ivar1t) = & 651 & inpfiles(jj)%idqc(ij,ji) 652 653 ! Depth of var1 observation QC flags 654 profdata%var(1)%idqcf(:,ivar1t) = & 655 & inpfiles(jj)%idqcf(:,ij,ji) 656 657 ! Profile index 658 profdata%var(1)%nvpidx(ivar1t) = iprof 659 660 ! Vertical index in original profile 661 profdata%var(1)%nvlidx(ivar1t) = ij 662 663 ! Profile var1 value 664 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 665 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 666 profdata%var(1)%vobs(ivar1t) = & 667 & inpfiles(jj)%pob(ij,ji,1) 668 IF ( ldmod ) THEN 669 profdata%var(1)%vmod(ivar1t) = & 670 & inpfiles(jj)%padd(ij,ji,1,1) 671 ENDIF 672 ! Count number of profile var1 data as function of type 673 itypvar1( profdata%ntyp(iprof) + 1 ) = & 674 & itypvar1( profdata%ntyp(iprof) + 1 ) + 1 675 ELSE 676 profdata%var(1)%vobs(ivar1t) = fbrmdi 677 ENDIF 678 679 ! Profile var1 qc 680 profdata%var(1)%nvqc(ivar1t) = & 681 & inpfiles(jj)%ivlqc(ij,ji,1) 682 683 ! Profile var1 qc flags 684 profdata%var(1)%nvqcf(:,ivar1t) = & 685 & inpfiles(jj)%ivlqcf(:,ij,ji,1) 686 687 ! Profile insitu T value 688 IF ( TRIM( inpfiles(jj)%cname(1) ) == 'POTM' ) THEN 689 profdata%var(1)%vext(ivar1t,1) = & 690 & inpfiles(jj)%pext(ij,ji,1) 691 ENDIF 692 693 ENDIF 694 695 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 696 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 697 & ldvar2 ) .OR. ldsatt ) THEN 698 699 IF (ldsatt) THEN 700 701 ivar2t = ip3dt 702 703 ELSE 704 705 ivar2t = ivar2t + 1 706 707 ENDIF 708 709 ! Depth of var2 observation 710 profdata%var(2)%vdep(ivar2t) = & 711 & inpfiles(jj)%pdep(ij,ji) 712 713 ! Depth of var2 observation QC 714 profdata%var(2)%idqc(ivar2t) = & 715 & inpfiles(jj)%idqc(ij,ji) 716 717 ! Depth of var2 observation QC flags 718 profdata%var(2)%idqcf(:,ivar2t) = & 719 & inpfiles(jj)%idqcf(:,ij,ji) 720 721 ! Profile index 722 profdata%var(2)%nvpidx(ivar2t) = iprof 723 724 ! Vertical index in original profile 725 profdata%var(2)%nvlidx(ivar2t) = ij 726 727 ! Profile var2 value 728 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) ) .AND. & 729 & ( .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) ) THEN 730 profdata%var(2)%vobs(ivar2t) = & 731 & inpfiles(jj)%pob(ij,ji,2) 732 IF ( ldmod ) THEN 733 profdata%var(2)%vmod(ivar2t) = & 734 & inpfiles(jj)%padd(ij,ji,1,2) 735 ENDIF 736 ! Count number of profile var2 data as function of type 737 itypvar2( profdata%ntyp(iprof) + 1 ) = & 738 & itypvar2( profdata%ntyp(iprof) + 1 ) + 1 739 ELSE 740 profdata%var(2)%vobs(ivar2t) = fbrmdi 741 ENDIF 742 743 ! Profile var2 qc 744 profdata%var(2)%nvqc(ivar2t) = & 745 & inpfiles(jj)%ivlqc(ij,ji,2) 746 747 ! Profile var2 qc flags 748 profdata%var(2)%nvqcf(:,ivar2t) = & 749 & inpfiles(jj)%ivlqcf(:,ij,ji,2) 750 751 ENDIF 726 727 END DO 752 728 753 729 END DO loop_p … … 763 739 !----------------------------------------------------------------------- 764 740 765 CALL obs_mpp_sum_integer ( ivar1t0, ivar1tmpp ) 766 CALL obs_mpp_sum_integer ( ivar2t0, ivar2tmpp ) 741 DO jvar = 1, kvars 742 CALL obs_mpp_sum_integer ( ivart0(jvar), ivartmpp(jvar) ) 743 END DO 767 744 CALL obs_mpp_sum_integer ( ip3dt, ip3dtmpp ) 768 745 769 CALL obs_mpp_sum_integers( itypvar1, itypvar1mpp, ntyp1770 + 1 ) 770 CALL obs_mpp_sum_integers( itypvar2, itypvar2mpp, ntyp1770 + 1 ) 746 DO jvar = 1, kvars 747 CALL obs_mpp_sum_integers( itypvar(:,jvar), itypvarmpp(:,jvar), ntyp1770 + 1 ) 748 END DO 771 749 772 750 !----------------------------------------------------------------------- … … 778 756 WRITE(numout,'(1X,A)') '------------' 779 757 WRITE(numout,*) 780 WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(1) ) 781 WRITE(numout,'(1X,A)') '------------------------' 782 DO ji = 0, ntyp1770 783 IF ( itypvar1mpp(ji+1) > 0 ) THEN 784 WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 785 & cwmonam1770(ji)(1:52),' = ', & 786 & itypvar1mpp(ji+1) 787 ENDIF 758 DO jvar = 1, kvars 759 WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(jvar) ) 760 WRITE(numout,'(1X,A)') '------------------------' 761 DO ji = 0, ntyp1770 762 IF ( itypvarmpp(ji+1,jvar) > 0 ) THEN 763 WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 764 & cwmonam1770(ji)(1:52),' = ', & 765 & itypvarmpp(ji+1,jvar) 766 ENDIF 767 END DO 768 WRITE(numout,'(1X,A)') & 769 & '---------------------------------------------------------------' 770 WRITE(numout,'(1X,A55,I8)') & 771 & 'Total profile data for variable '//TRIM( profdata%cvars(jvar) )// & 772 & ' = ', ivartmpp(jvar) 773 WRITE(numout,'(1X,A)') & 774 & '---------------------------------------------------------------' 775 WRITE(numout,*) 788 776 END DO 789 WRITE(numout,'(1X,A)') & 790 & '---------------------------------------------------------------' 791 WRITE(numout,'(1X,A55,I8)') & 792 & 'Total profile data for variable '//TRIM( profdata%cvars(1) )// & 793 & ' = ', ivar1tmpp 794 WRITE(numout,'(1X,A)') & 795 & '---------------------------------------------------------------' 796 WRITE(numout,*) 797 WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(2) ) 798 WRITE(numout,'(1X,A)') '------------------------' 799 DO ji = 0, ntyp1770 800 IF ( itypvar2mpp(ji+1) > 0 ) THEN 801 WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 802 & cwmonam1770(ji)(1:52),' = ', & 803 & itypvar2mpp(ji+1) 804 ENDIF 777 ENDIF 778 779 IF (ldsatt) THEN 780 profdata%nvprot(:) = ip3dt 781 profdata%nvprotmpp(:) = ip3dtmpp 782 ELSE 783 DO jvar = 1, kvars 784 profdata%nvprot(jvar) = ivart(jvar) 785 profdata%nvprotmpp(jvar) = ivartmpp(jvar) 805 786 END DO 806 WRITE(numout,'(1X,A)') &807 & '---------------------------------------------------------------'808 WRITE(numout,'(1X,A55,I8)') &809 & 'Total profile data for variable '//TRIM( profdata%cvars(2) )// &810 & ' = ', ivar2tmpp811 WRITE(numout,'(1X,A)') &812 & '---------------------------------------------------------------'813 WRITE(numout,*)814 ENDIF815 816 IF (ldsatt) THEN817 profdata%nvprot(1) = ip3dt818 profdata%nvprot(2) = ip3dt819 profdata%nvprotmpp(1) = ip3dtmpp820 profdata%nvprotmpp(2) = ip3dtmpp821 ELSE822 profdata%nvprot(1) = ivar1t823 profdata%nvprot(2) = ivar2t824 profdata%nvprotmpp(1) = ivar1tmpp825 profdata%nvprotmpp(2) = ivar2tmpp826 787 ENDIF 827 788 profdata%nprof = iprof … … 830 791 ! Model level search 831 792 !----------------------------------------------------------------------- 832 IF ( ldvar1 ) THEN 833 CALL obs_level_search( jpk, gdept_1d, & 834 & profdata%nvprot(1), profdata%var(1)%vdep, & 835 & profdata%var(1)%mvk ) 836 ENDIF 837 IF ( ldvar2 ) THEN 838 CALL obs_level_search( jpk, gdept_1d, & 839 & profdata%nvprot(2), profdata%var(2)%vdep, & 840 & profdata%var(2)%mvk ) 841 ENDIF 793 DO jvar = 1, kvars 794 IF ( ldvar(jvar) ) THEN 795 CALL obs_level_search( jpk, gdept_1d, & 796 & profdata%nvprot(jvar), profdata%var(jvar)%vdep, & 797 & profdata%var(jvar)%mvk ) 798 ENDIF 799 END DO 842 800 843 801 !----------------------------------------------------------------------- … … 852 810 ! Deallocate temporary data 853 811 !----------------------------------------------------------------------- 854 DEALLOCATE( ifileidx, iprofidx, zdat, clvars )812 DEALLOCATE( ifileidx, iprofidx, zdat, clvarsin ) 855 813 856 814 !-----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
