Changeset 9186 for branches/UKMO/dev_r5518_obs_oper_update_bgc3d/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
- Timestamp:
- 2018-01-05T14:29:29+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update_bgc3d/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
r7992 r9186 219 219 & ldgrid = .TRUE. ) 220 220 221 IF ( inpfiles(jj)%nvar < 2) THEN221 IF ( inpfiles(jj)%nvar /= kvars ) THEN 222 222 CALL ctl_stop( 'Feedback format error: ', & 223 & ' less than 2vars in profile file' )223 & ' unexpected number of vars in profile file' ) 224 224 ENDIF 225 225 … … 320 320 ALLOCATE( iobsj1(inowin) ) 321 321 ALLOCATE( iproc1(inowin) ) 322 ALLOCATE( iobsi2(inowin) ) 323 ALLOCATE( iobsj2(inowin) ) 324 ALLOCATE( iproc2(inowin) ) 322 IF ( kvars == 2 ) THEN 323 ALLOCATE( iobsi2(inowin) ) 324 ALLOCATE( iobsj2(inowin) ) 325 ALLOCATE( iproc2(inowin) ) 326 ENDIF 325 327 inowin = 0 326 328 DO ji = 1, inpfiles(jj)%nobs 327 329 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 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 330 336 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 331 337 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 347 353 CALL obs_grid_search( inowin, zlam, zphi, iobsi2, iobsj2, & 348 354 & iproc2, 'V' ) 355 ELSE 356 CALL obs_grid_search( inowin, zlam, zphi, iobsi1, iobsj1, & 357 & iproc1, 'T' ) 349 358 ENDIF 350 359 … … 352 361 DO ji = 1, inpfiles(jj)%nobs 353 362 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 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 356 369 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 357 370 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 360 373 inpfiles(jj)%iobsi(ji,1) = iobsi1(inowin) 361 374 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') 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 369 384 ENDIF 370 385 ENDIF 371 386 END DO 372 DEALLOCATE( zlam, zphi, iobsi1, iobsj1, iproc1, iobsi2, iobsj2, iproc2 ) 387 DEALLOCATE( zlam, zphi, iobsi1, iobsj1, iproc1 ) 388 IF ( kvars == 2 ) THEN 389 DEALLOCATE( iobsi2, iobsj2, iproc2 ) 390 ENDIF 373 391 374 392 DO ji = 1, inpfiles(jj)%nobs 375 393 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 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 378 400 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 379 401 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 407 429 IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 408 430 & 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 ) ) THEN 415 ip3dt = ip3dt + 1 416 llvalprof = .TRUE. 431 IF ( kvars == 2 ) THEN 432 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 433 & .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 438 ip3dt = ip3dt + 1 439 llvalprof = .TRUE. 440 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 417 448 ENDIF 418 449 END DO loop_p_count … … 438 469 DO ji = 1, inpfiles(jj)%nobs 439 470 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 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 442 477 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 443 478 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 453 488 DO ji = 1, inpfiles(jj)%nobs 454 489 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 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 457 496 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 458 497 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 501 540 ji = iprofidx(iindx(jk)) 502 541 503 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 542 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 543 IF ( kvars == 2 ) THEN 504 544 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 505 545 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 546 ELSE 547 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 548 ENDIF 506 549 507 550 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & … … 519 562 520 563 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 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 523 570 524 571 loop_prof : DO ij = 1, inpfiles(jj)%nlev … … 535 582 ENDIF 536 583 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 584 IF ( kvars == 2 ) THEN 585 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 586 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 587 588 llvalprof = .TRUE. 589 EXIT loop_prof 590 591 ENDIF 543 592 ENDIF 544 593 … … 575 624 profdata%mi (iprof,1) = inpfiles(jj)%iobsi(ji,1) 576 625 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) 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 579 630 580 631 ! Profile WMO number … … 616 667 IF (ldsatt) THEN 617 668 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 669 IF ( kvars == 2 ) THEN 670 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 671 & .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 676 ip3dt = ip3dt + 1 677 ELSE 678 CYCLE 679 ENDIF 625 680 ELSE 626 CYCLE 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 685 ELSE 686 CYCLE 687 ENDIF 627 688 ENDIF 628 689 … … 693 754 ENDIF 694 755 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 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) 706 812 707 813 ENDIF 708 709 ! Depth of var2 observation710 profdata%var(2)%vdep(ivar2t) = &711 & inpfiles(jj)%pdep(ij,ji)712 713 ! Depth of var2 observation QC714 profdata%var(2)%idqc(ivar2t) = &715 & inpfiles(jj)%idqc(ij,ji)716 717 ! Depth of var2 observation QC flags718 profdata%var(2)%idqcf(:,ivar2t) = &719 & inpfiles(jj)%idqcf(:,ij,ji)720 721 ! Profile index722 profdata%var(2)%nvpidx(ivar2t) = iprof723 724 ! Vertical index in original profile725 profdata%var(2)%nvlidx(ivar2t) = ij726 727 ! Profile var2 value728 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) ) .AND. &729 & ( .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) ) THEN730 profdata%var(2)%vobs(ivar2t) = &731 & inpfiles(jj)%pob(ij,ji,2)732 IF ( ldmod ) THEN733 profdata%var(2)%vmod(ivar2t) = &734 & inpfiles(jj)%padd(ij,ji,1,2)735 ENDIF736 ! Count number of profile var2 data as function of type737 itypvar2( profdata%ntyp(iprof) + 1 ) = &738 & itypvar2( profdata%ntyp(iprof) + 1 ) + 1739 ELSE740 profdata%var(2)%vobs(ivar2t) = fbrmdi741 ENDIF742 743 ! Profile var2 qc744 profdata%var(2)%nvqc(ivar2t) = &745 & inpfiles(jj)%ivlqc(ij,ji,2)746 747 ! Profile var2 qc flags748 profdata%var(2)%nvqcf(:,ivar2t) = &749 & inpfiles(jj)%ivlqcf(:,ij,ji,2)750 751 814 ENDIF 752 815 … … 764 827 765 828 CALL obs_mpp_sum_integer ( ivar1t0, ivar1tmpp ) 766 CALL obs_mpp_sum_integer ( ivar2t0, ivar2tmpp ) 829 IF ( kvars == 2 ) THEN 830 CALL obs_mpp_sum_integer ( ivar2t0, ivar2tmpp ) 831 ENDIF 767 832 CALL obs_mpp_sum_integer ( ip3dt, ip3dtmpp ) 768 833 769 834 CALL obs_mpp_sum_integers( itypvar1, itypvar1mpp, ntyp1770 + 1 ) 770 CALL obs_mpp_sum_integers( itypvar2, itypvar2mpp, ntyp1770 + 1 ) 835 IF ( kvars == 2 ) THEN 836 CALL obs_mpp_sum_integers( itypvar2, itypvar2mpp, ntyp1770 + 1 ) 837 ENDIF 771 838 772 839 !----------------------------------------------------------------------- … … 795 862 & '---------------------------------------------------------------' 796 863 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 805 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 & ' = ', ivar2tmpp 811 WRITE(numout,'(1X,A)') & 812 & '---------------------------------------------------------------' 813 WRITE(numout,*) 864 IF ( kvars == 2 ) THEN 865 WRITE(numout,'(1X,A)') 'Profile data, '//TRIM( profdata%cvars(2) ) 866 WRITE(numout,'(1X,A)') '------------------------' 867 DO ji = 0, ntyp1770 868 IF ( itypvar2mpp(ji+1) > 0 ) THEN 869 WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), & 870 & cwmonam1770(ji)(1:52),' = ', & 871 & itypvar2mpp(ji+1) 872 ENDIF 873 END DO 874 WRITE(numout,'(1X,A)') & 875 & '---------------------------------------------------------------' 876 WRITE(numout,'(1X,A55,I8)') & 877 & 'Total profile data for variable '//TRIM( profdata%cvars(2) )// & 878 & ' = ', ivar2tmpp 879 WRITE(numout,'(1X,A)') & 880 & '---------------------------------------------------------------' 881 WRITE(numout,*) 882 ENDIF 814 883 ENDIF 815 884 816 885 IF (ldsatt) THEN 817 886 profdata%nvprot(1) = ip3dt 818 profdata%nvprot(2) = ip3dt819 887 profdata%nvprotmpp(1) = ip3dtmpp 820 profdata%nvprotmpp(2) = ip3dtmpp 888 IF ( kvars == 2 ) THEN 889 profdata%nvprot(2) = ip3dt 890 profdata%nvprotmpp(2) = ip3dtmpp 891 ENDIF 821 892 ELSE 822 893 profdata%nvprot(1) = ivar1t 823 profdata%nvprot(2) = ivar2t824 894 profdata%nvprotmpp(1) = ivar1tmpp 825 profdata%nvprotmpp(2) = ivar2tmpp 895 IF ( kvars == 2 ) THEN 896 profdata%nvprot(2) = ivar2t 897 profdata%nvprotmpp(2) = ivar2tmpp 898 ENDIF 826 899 ENDIF 827 900 profdata%nprof = iprof
Note: See TracChangeset
for help on using the changeset viewer.
