- Timestamp:
- 2017-03-29T12:14:30+02:00 (7 years ago)
- Location:
- branches/UKMO/dev_rev5518_OBS_DoNotAssim
- Files:
-
- 1 added
- 8 edited
-
.project (added)
-
NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90 (modified) (61 diffs)
-
NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90 (modified) (16 diffs)
-
NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_seaice.F90 (modified) (2 diffs)
-
NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sla.F90 (modified) (9 diffs)
-
NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sst.F90 (modified) (2 diffs)
-
NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_vel.F90 (modified) (3 diffs)
-
NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90 (modified) (1 diff)
-
NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_rev5518_OBS_DoNotAssim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90
r4292 r7841 52 52 53 53 SUBROUTINE obs_pre_pro( profdata, prodatqc, ld_t3d, ld_s3d, ld_nea, & 54 & kdailyavtypes )54 & kdailyavtypes, kqc_cutoff ) 55 55 !!---------------------------------------------------------------------- 56 56 !! *** ROUTINE obs_pre_pro *** … … 86 86 INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 87 87 & kdailyavtypes! Types for daily averages 88 INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff ! cut off for QC value 88 89 !! * Local declarations 90 INTEGER :: iqc_cutoff = 255 ! cut off for QC value 89 91 INTEGER :: iyea0 ! Initial date 90 92 INTEGER :: imon0 ! - (year, month, day, hour, minute) … … 141 143 inlasobs = 0 142 144 145 ! Set QC cutoff to optional value if provided 146 IF ( PRESENT(kqc_cutoff) ) iqc_cutoff=kqc_cutoff 147 143 148 ! ----------------------------------------------------------------------- 144 149 ! Find time coordinate for profiles … … 151 156 & profdata%nday, profdata%nhou, profdata%nmin, & 152 157 & profdata%ntyp, profdata%nqc, profdata%mstp, & 153 & iotdobs, kdailyavtypes = kdailyavtypes ) 158 & iotdobs, kdailyavtypes = kdailyavtypes, & 159 & kqc_cutoff = iqc_cutoff ) 154 160 ELSE 155 161 CALL obs_coo_tim_prof( icycle, & … … 158 164 & profdata%nday, profdata%nhou, profdata%nmin, & 159 165 & profdata%ntyp, profdata%nqc, profdata%mstp, & 160 & iotdobs )166 & iotdobs, kqc_cutoff = iqc_cutoff ) 161 167 ENDIF 162 168 CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) … … 172 178 173 179 ! ----------------------------------------------------------------------- 174 ! Reject all observations for profiles with nqc > 10175 ! ----------------------------------------------------------------------- 176 177 CALL obs_pro_rej( profdata )180 ! Reject all observations for profiles with nqc > iqc_cutoff 181 ! ----------------------------------------------------------------------- 182 183 CALL obs_pro_rej( profdata, iqc_cutoff ) 178 184 179 185 ! ----------------------------------------------------------------------- … … 196 202 & profdata%nqc, profdata%var(1)%nvqc, & 197 203 & iosdtobs, ilantobs, & 198 & inlatobs, ld_nea ) 204 & inlatobs, ld_nea, & 205 & iqc_cutoff ) 199 206 200 207 CALL obs_mpp_sum_integer( iosdtobs, iosdtobsmpp ) … … 216 223 & profdata%nqc, profdata%var(2)%nvqc, & 217 224 & iosdsobs, ilansobs, & 218 & inlasobs, ld_nea ) 225 & inlasobs, ld_nea, & 226 & iqc_cutoff ) 219 227 220 228 CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) … … 234 242 END DO 235 243 236 ! We want all data which has qc flags <= 10237 238 llvalid%luse(:) = ( profdata%nqc(:) <= 10)244 ! We want all data which has qc flags <= iqc_cutoff 245 246 llvalid%luse(:) = ( profdata%nqc(:) <= iqc_cutoff ) 239 247 DO jvar = 1,profdata%nvar 240 llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= 10)248 llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= iqc_cutoff ) 241 249 END DO 242 250 … … 337 345 END SUBROUTINE obs_pre_pro 338 346 339 SUBROUTINE obs_pre_sla( sladata, sladatqc, ld_sla, ld_nea )347 SUBROUTINE obs_pre_sla( sladata, sladatqc, ld_sla, ld_nea, kqc_cutoff ) 340 348 !!---------------------------------------------------------------------- 341 349 !! *** ROUTINE obs_pre_sla *** … … 366 374 LOGICAL, INTENT(IN) :: ld_sla ! Switch for SLA data 367 375 LOGICAL, INTENT(IN) :: ld_nea ! Switch for rejecting observation near land 376 INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff ! cut off for QC value 368 377 !! * Local declarations 378 INTEGER :: iqc_cutoff = 255 ! cut off for QC value 369 379 INTEGER :: iyea0 ! Initial date 370 380 INTEGER :: imon0 ! - (year, month, day, hour, minute) … … 410 420 inlasobs = 0 411 421 422 ! Set QC cutoff to optional value if provided 423 424 IF ( PRESENT(kqc_cutoff) ) iqc_cutoff=kqc_cutoff 425 412 426 ! ----------------------------------------------------------------------- 413 427 ! Find time coordinate for SLA data … … 442 456 & tmask(:,:,1), sladata%nqc, & 443 457 & iosdsobs, ilansobs, & 444 & inlasobs, ld_nea ) 458 & inlasobs, ld_nea, & 459 & iqc_cutoff ) 445 460 446 461 CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) … … 457 472 ALLOCATE( llvalid(sladata%nsurf) ) 458 473 459 ! We want all data which has qc flags <= 10460 461 llvalid(:) = ( sladata%nqc(:) <= 10)474 ! We want all data which has qc flags <= iqc_cutoff 475 476 llvalid(:) = ( sladata%nqc(:) <= iqc_cutoff ) 462 477 463 478 ! The actual copying … … 526 541 END SUBROUTINE obs_pre_sla 527 542 528 SUBROUTINE obs_pre_sst( sstdata, sstdatqc, ld_sst, ld_nea )543 SUBROUTINE obs_pre_sst( sstdata, sstdatqc, ld_sst, ld_nea, kqc_cutoff ) 529 544 !!---------------------------------------------------------------------- 530 545 !! *** ROUTINE obs_pre_sst *** … … 554 569 LOGICAL :: ld_sst ! Switch for SST data 555 570 LOGICAL :: ld_nea ! Switch for rejecting observation near land 571 INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff ! cut off for QC value 556 572 !! * Local declarations 573 INTEGER :: iqc_cutoff = 255 ! cut off for QC value 557 574 INTEGER :: iyea0 ! Initial date 558 575 INTEGER :: imon0 ! - (year, month, day, hour, minute) … … 598 615 inlasobs = 0 599 616 617 ! Set QC cutoff to optional value if provided 618 619 IF ( PRESENT(kqc_cutoff) ) iqc_cutoff=kqc_cutoff 620 600 621 ! ----------------------------------------------------------------------- 601 622 ! Find time coordinate for SST data … … 627 648 & tmask(:,:,1), sstdata%nqc, & 628 649 & iosdsobs, ilansobs, & 629 & inlasobs, ld_nea ) 650 & inlasobs, ld_nea, & 651 & iqc_cutoff ) 630 652 631 653 CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) … … 642 664 ALLOCATE( llvalid(sstdata%nsurf) ) 643 665 644 ! We want all data which has qc flags <= 0645 646 llvalid(:) = ( sstdata%nqc(:) <= 10)666 ! We want all data which has qc flags <= iqc_cutoff 667 668 llvalid(:) = ( sstdata%nqc(:) <= iqc_cutoff ) 647 669 648 670 ! The actual copying … … 711 733 END SUBROUTINE obs_pre_sst 712 734 713 SUBROUTINE obs_pre_seaice( seaicedata, seaicedatqc, ld_seaice, ld_nea )735 SUBROUTINE obs_pre_seaice( seaicedata, seaicedatqc, ld_seaice, ld_nea, kqc_cutoff ) 714 736 !!---------------------------------------------------------------------- 715 737 !! *** ROUTINE obs_pre_seaice *** … … 739 761 LOGICAL :: ld_seaice ! Switch for sea ice data 740 762 LOGICAL :: ld_nea ! Switch for rejecting observation near land 763 INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff ! cut off for QC value 741 764 !! * Local declarations 765 INTEGER :: iqc_cutoff = 255 ! cut off for QC value 742 766 INTEGER :: iyea0 ! Initial date 743 767 INTEGER :: imon0 ! - (year, month, day, hour, minute) … … 783 807 inlasobs = 0 784 808 809 ! Set QC cutoff to optional value if provided 810 811 IF ( PRESENT(kqc_cutoff) ) iqc_cutoff=kqc_cutoff 812 785 813 ! ----------------------------------------------------------------------- 786 814 ! Find time coordinate for sea ice data … … 812 840 & tmask(:,:,1), seaicedata%nqc, & 813 841 & iosdsobs, ilansobs, & 814 & inlasobs, ld_nea ) 842 & inlasobs, ld_nea, & 843 & iqc_cutoff ) 815 844 816 845 CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) … … 827 856 ALLOCATE( llvalid(seaicedata%nsurf) ) 828 857 829 ! We want all data which has qc flags <= 0830 831 llvalid(:) = ( seaicedata%nqc(:) <= 10)858 ! We want all data which has qc flags <= iqc_cutoff 859 860 llvalid(:) = ( seaicedata%nqc(:) <= iqc_cutoff ) 832 861 833 862 ! The actual copying … … 896 925 END SUBROUTINE obs_pre_seaice 897 926 898 SUBROUTINE obs_pre_vel( profdata, prodatqc, ld_vel3d, ld_nea, ld_dailyav )927 SUBROUTINE obs_pre_vel( profdata, prodatqc, ld_vel3d, ld_nea, ld_dailyav, kqc_cutoff ) 899 928 !!---------------------------------------------------------------------- 900 929 !! *** ROUTINE obs_pre_taovel *** … … 925 954 LOGICAL, INTENT(IN) :: ld_nea ! Switch for rejecting observation near land 926 955 LOGICAL, INTENT(IN) :: ld_dailyav ! Switch for daily average data 956 INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff ! cut off for QC value 927 957 !! * Local declarations 958 INTEGER :: iqc_cutoff = 255 ! cut off for QC value 928 959 INTEGER :: iyea0 ! Initial date 929 960 INTEGER :: imon0 ! - (year, month, day, hour, minute) … … 986 1017 iuvchkv = 0 987 1018 1019 ! Set QC cutoff to optional value if provided 1020 1021 IF ( PRESENT(kqc_cutoff) ) iqc_cutoff=kqc_cutoff 1022 988 1023 ! ----------------------------------------------------------------------- 989 1024 ! Find time coordinate for profiles … … 995 1030 & profdata%nday, profdata%nhou, profdata%nmin, & 996 1031 & profdata%ntyp, profdata%nqc, profdata%mstp, & 997 & iotdobs, ld_dailyav = ld_dailyav ) 1032 & iotdobs, ld_dailyav = ld_dailyav, & 1033 & kqc_cutoff=kqc_cutoff ) 998 1034 999 1035 CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) … … 1014 1050 ! ----------------------------------------------------------------------- 1015 1051 1016 CALL obs_pro_rej( profdata )1052 CALL obs_pro_rej( profdata, iqc_cutoff ) 1017 1053 1018 1054 ! ----------------------------------------------------------------------- … … 1035 1071 & profdata%nqc, profdata%var(1)%nvqc, & 1036 1072 & iosduobs, ilanuobs, & 1037 & inlauobs, ld_nea ) 1073 & inlauobs, ld_nea, & 1074 & iqc_cutoff ) 1038 1075 1039 1076 CALL obs_mpp_sum_integer( iosduobs, iosduobsmpp ) … … 1055 1092 & profdata%nqc, profdata%var(2)%nvqc, & 1056 1093 & iosdvobs, ilanvobs, & 1057 & inlavobs, ld_nea ) 1094 & inlavobs, ld_nea, & 1095 & iqc_cutoff ) 1058 1096 1059 1097 CALL obs_mpp_sum_integer( iosdvobs, iosdvobsmpp ) … … 1065 1103 ! ----------------------------------------------------------------------- 1066 1104 1067 CALL obs_uv_rej( profdata, iuvchku, iuvchkv )1105 CALL obs_uv_rej( profdata, iuvchku, iuvchkviqc_cutoff ) 1068 1106 CALL obs_mpp_sum_integer( iuvchku, iuvchkumpp ) 1069 1107 CALL obs_mpp_sum_integer( iuvchkv, iuvchkvmpp ) … … 1081 1119 END DO 1082 1120 1083 ! We want all data which has qc flags = 01084 1085 llvalid%luse(:) = ( profdata%nqc(:) <= 10)1121 ! We want all data which has qc flags <= iqc_cutoff 1122 1123 llvalid%luse(:) = ( profdata%nqc(:) <= iqc_cutoff ) 1086 1124 DO jvar = 1,profdata%nvar 1087 llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= 10)1125 llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= iqc_cutoff ) 1088 1126 END DO 1089 1127 … … 1389 1427 & kobsyea, kobsmon, kobsday, kobshou, kobsmin, & 1390 1428 & ktyp, kobsqc, kobsstp, kotdobs, kdailyavtypes, & 1391 & ld_dailyav )1429 & ld_dailyav, kqc_cutoff ) 1392 1430 !!---------------------------------------------------------------------- 1393 1431 !! *** ROUTINE obs_coo_tim *** … … 1434 1472 & kdailyavtypes ! Types for daily averages 1435 1473 LOGICAL, OPTIONAL :: ld_dailyav ! All types are daily averages 1474 INTEGER, OPTIONAL, INTENT(IN) :: kqc_cutoff ! QC cutoff value 1436 1475 !! * Local declarations 1437 1476 INTEGER :: jobs 1477 INTEGER :: iqc_cutoff=255 1438 1478 1439 1479 !----------------------------------------------------------------------- … … 1454 1494 DO jobs = 1, kobsno 1455 1495 1456 IF ( kobsqc(jobs) <= 10) THEN1496 IF ( kobsqc(jobs) <= iqc_cutoff ) THEN 1457 1497 1458 1498 IF ( ( kobsstp(jobs) == (nit000 - 1) ).AND.& 1459 1499 & ( ANY (kdailyavtypes(:) == ktyp(jobs)) ) ) THEN 1460 kobsqc(jobs) = kobsqc(jobs) + 141500 kobsqc(jobs) = IBSET(kobsqc(jobs),13) 1461 1501 kotdobs = kotdobs + 1 1462 1502 CYCLE … … 1475 1515 DO jobs = 1, kobsno 1476 1516 1477 IF ( kobsqc(jobs) <= 10) THEN1517 IF ( kobsqc(jobs) <= iqc_cutoff ) THEN 1478 1518 1479 1519 IF ( kobsstp(jobs) == (nit000 - 1) ) THEN 1480 kobsqc(jobs) = kobsqc(jobs) + 141520 kobsqc(jobs) = IBSET(kobsqc(jobs),13) 1481 1521 kotdobs = kotdobs + 1 1482 1522 CYCLE … … 1521 1561 DO jobs = 1, kobsno 1522 1562 IF ( ( kobsi(jobs) <= 0 ) .AND. ( kobsj(jobs) <= 0 ) ) THEN 1523 kobsqc(jobs) = kobsqc(jobs) + 181563 kobsqc(jobs) = IBSET(kobsqc(jobs),12) 1524 1564 kgrdobs = kgrdobs + 1 1525 1565 ENDIF … … 1532 1572 & plam, pphi, pmask, & 1533 1573 & kobsqc, kosdobs, klanobs, & 1534 & knlaobs,ld_nea 1574 & knlaobs,ld_nea, kqc_cutoff ) 1535 1575 !!---------------------------------------------------------------------- 1536 1576 !! *** ROUTINE obs_coo_spc_2d *** … … 1569 1609 INTEGER, INTENT(INOUT) :: knlaobs ! Observations near land 1570 1610 LOGICAL, INTENT(IN) :: ld_nea ! Flag observations near land 1611 INTEGER, INTENT(IN) :: kqc_cutoff ! Cutoff QC value 1571 1612 !! * Local declarations 1572 1613 REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & … … 1588 1629 ! For invalid points use 2,2 1589 1630 1590 IF ( kobsqc(jobs) >= 10) THEN1631 IF ( kobsqc(jobs) >= kqc_cutoff ) THEN 1591 1632 1592 1633 igrdi(1,1,jobs) = 1 … … 1621 1662 1622 1663 ! Skip bad observations 1623 IF ( kobsqc(jobs) >= 10) CYCLE1664 IF ( kobsqc(jobs) >= kqc_cutoff ) CYCLE 1624 1665 1625 1666 ! Flag if the observation falls outside the model spatial domain … … 1628 1669 & .OR. ( pobsphi(jobs) < -90. ) & 1629 1670 & .OR. ( pobsphi(jobs) > 90. ) ) THEN 1630 kobsqc(jobs) = kobsqc(jobs) + 111671 kobsqc(jobs) = IBSET(kobsqc(jobs),11) 1631 1672 kosdobs = kosdobs + 1 1632 1673 CYCLE … … 1635 1676 ! Flag if the observation falls with a model land cell 1636 1677 IF ( SUM( zgmsk(1:2,1:2,jobs) ) == 0.0_wp ) THEN 1637 kobsqc(jobs) = kobsqc(jobs) + 121678 kobsqc(jobs) = IBSET(kobsqc(jobs),10) 1638 1679 klanobs = klanobs + 1 1639 1680 CYCLE … … 1663 1704 IF (lgridobs) THEN 1664 1705 IF (zgmsk(iig,ijg,jobs) == 0.0_wp ) THEN 1665 kobsqc(jobs) = kobsqc(jobs) + 121706 kobsqc(jobs) = IBSET(kobsqc(jobs),10) 1666 1707 klanobs = klanobs + 1 1667 1708 CYCLE … … 1671 1712 ! Flag if the observation falls is close to land 1672 1713 IF ( MINVAL( zgmsk(1:2,1:2,jobs) ) == 0.0_wp) THEN 1673 IF (ld_nea) kobsqc(jobs) = kobsqc(jobs) + 141714 IF (ld_nea) kobsqc(jobs) = IBSET(kobsqc(jobs),9) 1674 1715 knlaobs = knlaobs + 1 1675 1716 CYCLE … … 1686 1727 & plam, pphi, pdep, pmask, & 1687 1728 & kpobsqc, kobsqc, kosdobs, & 1688 & klanobs, knlaobs, ld_nea ) 1729 & klanobs, knlaobs, ld_nea, & 1730 & kqc_cutoff ) 1689 1731 !!---------------------------------------------------------------------- 1690 1732 !! *** ROUTINE obs_coo_spc_3d *** … … 1744 1786 INTEGER, INTENT(INOUT) :: knlaobs ! Observations near land 1745 1787 LOGICAL, INTENT(IN) :: ld_nea ! Flag observations near land 1788 INTEGER, INTENT(IN) :: kqc_cutoff ! Cutoff QC value 1746 1789 !! * Local declarations 1747 1790 REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: & … … 1763 1806 ! For invalid points use 2,2 1764 1807 1765 IF ( kpobsqc(jobs) >= 10) THEN1808 IF ( kpobsqc(jobs) >= kqc_cutoff ) THEN 1766 1809 1767 1810 igrdi(1,1,jobs) = 1 … … 1796 1839 1797 1840 ! Skip bad profiles 1798 IF ( kpobsqc(jobs) >= 10) CYCLE1841 IF ( kpobsqc(jobs) >= kqc_cutoff ) CYCLE 1799 1842 1800 1843 ! Check if this observation is on a grid point … … 1827 1870 & .OR. ( pobsdep(jobsp) < 0.0 ) & 1828 1871 & .OR. ( pobsdep(jobsp) > gdepw_1d(kpk)) ) THEN 1829 kobsqc(jobsp) = kobsqc(jobsp) + 111872 kobsqc(jobsp) = IBSET(kobsqc(jobsp),11) 1830 1873 kosdobs = kosdobs + 1 1831 1874 CYCLE … … 1835 1878 IF ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) & 1836 1879 & == 0.0_wp ) THEN 1837 kobsqc(jobsp) = kobsqc(jobsp) + 121880 kobsqc(jobsp) = IBSET(kobsqc(jobsp),10) 1838 1881 klanobs = klanobs + 1 1839 1882 CYCLE … … 1845 1888 IF (lgridobs) THEN 1846 1889 IF (zgmsk(iig,ijg,kobsk(jobsp)-1,jobs) == 0.0_wp ) THEN 1847 kobsqc(jobsp) = kobsqc(jobsp) + 121890 kobsqc(jobsp) = IBSET(kobsqc(jobsp),9) 1848 1891 klanobs = klanobs + 1 1849 1892 CYCLE … … 1854 1897 IF ( MINVAL( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) == & 1855 1898 & 0.0_wp) THEN 1856 IF (ld_nea) kobsqc(jobsp) = kobsqc(jobsp) + 141899 IF (ld_nea) kobsqc(jobsp) = IBSET(kobsqc(jobsp),10) 1857 1900 knlaobs = knlaobs + 1 1858 1901 ENDIF … … 1868 1911 END SUBROUTINE obs_coo_spc_3d 1869 1912 1870 SUBROUTINE obs_pro_rej( profdata )1913 SUBROUTINE obs_pro_rej( profdata, kqc_cutoff ) 1871 1914 !!---------------------------------------------------------------------- 1872 1915 !! *** ROUTINE obs_pro_rej *** … … 1886 1929 !! * Arguments 1887 1930 TYPE(obs_prof), INTENT(INOUT) :: profdata ! Profile data 1931 INTEGER, INTENT(IN) :: kqc_cutoff ! QC cutoff value 1888 1932 !! * Local declarations 1889 1933 INTEGER :: jprof … … 1895 1939 DO jprof = 1, profdata%nprof 1896 1940 1897 IF ( profdata%nqc(jprof) > 10) THEN1941 IF ( profdata%nqc(jprof) > kqc_cutoff ) THEN 1898 1942 1899 1943 DO jvar = 1, profdata%nvar … … 1903 1947 1904 1948 profdata%var(jvar)%nvqc(jobs) = & 1905 & profdata%var(jvar)%nvqc(jobs) + 261949 & IBSET(profdata%var(jvar)%nvqc(jobs),14) 1906 1950 1907 1951 END DO … … 1915 1959 END SUBROUTINE obs_pro_rej 1916 1960 1917 SUBROUTINE obs_uv_rej( profdata, knumu, knumv )1961 SUBROUTINE obs_uv_rej( profdata, knumu, knumv, kqc_cutoff ) 1918 1962 !!---------------------------------------------------------------------- 1919 1963 !! *** ROUTINE obs_uv_rej *** … … 1935 1979 INTEGER, INTENT(INOUT) :: knumu ! Number of u rejected 1936 1980 INTEGER, INTENT(INOUT) :: knumv ! Number of v rejected 1981 INTEGER, INTENT(IN) :: kqc_cutoff ! QC cutoff value 1937 1982 !! * Local declarations 1938 1983 INTEGER :: jprof … … 1954 1999 DO jobs = profdata%npvsta(jprof,1), profdata%npvend(jprof,1) 1955 2000 1956 IF ( ( profdata%var(1)%nvqc(jobs) > 10) .AND. &1957 & ( profdata%var(2)%nvqc(jobs) <= 10) ) THEN2001 IF ( ( profdata%var(1)%nvqc(jobs) > kqc_cutoff ) .AND. & 2002 & ( profdata%var(2)%nvqc(jobs) <= kqc_cutoff) ) THEN 1958 2003 profdata%var(2)%nvqc(jobs) = profdata%var(2)%nvqc(jobs) + 42 1959 2004 knumv = knumv + 1 1960 2005 ENDIF 1961 IF ( ( profdata%var(2)%nvqc(jobs) > 10) .AND. &1962 & ( profdata%var(1)%nvqc(jobs) <= 10) ) THEN1963 profdata%var(1)%nvqc(jobs) = profdata%var(1)%nvqc(jobs) + 422006 IF ( ( profdata%var(2)%nvqc(jobs) > kqc_cutoff ) .AND. & 2007 & ( profdata%var(1)%nvqc(jobs) <= kqc_cutoff) ) THEN 2008 profdata%var(1)%nvqc(jobs) = IBSET(profdata%var(1)%nvqc(jobs),15) 1964 2009 knumu = knumu + 1 1965 2010 ENDIF -
branches/UKMO/dev_rev5518_OBS_DoNotAssim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
r4990 r7841 308 308 inowin = 0 309 309 DO ji = 1, inpfiles(jj)%nobs 310 IF ( inpfiles(jj)%ioqc(ji) > 2) CYCLE311 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2) .AND. &312 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE310 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 311 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 312 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 313 313 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 314 314 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 323 323 inowin = 0 324 324 DO ji = 1, inpfiles(jj)%nobs 325 IF ( inpfiles(jj)%ioqc(ji) > 2) CYCLE326 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2) .AND. &327 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE325 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 326 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 327 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 328 328 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 329 329 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 338 338 inowin = 0 339 339 DO ji = 1, inpfiles(jj)%nobs 340 IF ( inpfiles(jj)%ioqc(ji) > 2) CYCLE341 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2) .AND. &342 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE340 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 341 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 342 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 343 343 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 344 344 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 352 352 353 353 DO ji = 1, inpfiles(jj)%nobs 354 IF ( inpfiles(jj)%ioqc(ji) > 2) CYCLE355 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2) .AND. &356 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE354 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 355 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 356 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 357 357 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 358 358 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 367 367 IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 368 368 & CYCLE 369 IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2) .AND. &370 & ( inpfiles(jj)%idqc(ij,ji) <= 2) ) THEN369 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 370 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 371 371 it3dt0 = it3dt0 + 1 372 372 ENDIF … … 377 377 IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 378 378 & CYCLE 379 IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2) .AND. &380 & ( inpfiles(jj)%idqc(ij,ji) <= 2) ) THEN379 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 380 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 381 381 is3dt0 = is3dt0 + 1 382 382 ENDIF … … 386 386 IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 387 387 & CYCLE 388 IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2) .AND. &389 & ( inpfiles(jj)%idqc(ij,ji) <= 2 )) .AND. &390 & 391 & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2) .AND. &392 & ( inpfiles(jj)%idqc(ij,ji) <= 2 )) .AND. &393 & 388 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 389 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 390 & ldt3d ) .OR. & 391 & ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 392 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 393 & lds3d ) ) THEN 394 394 ip3dt = ip3dt + 1 395 395 llvalprof = .TRUE. … … 416 416 DO jj = 1, inobf 417 417 DO ji = 1, inpfiles(jj)%nobs 418 IF ( inpfiles(jj)%ioqc(ji) > 2) CYCLE419 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2) .AND. &420 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE418 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 419 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 420 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 421 421 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 422 422 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 431 431 DO jj = 1, inobf 432 432 DO ji = 1, inpfiles(jj)%nobs 433 IF ( inpfiles(jj)%ioqc(ji) > 2) CYCLE434 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2) .AND. &435 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE433 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 434 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 435 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 436 436 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 437 437 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 480 480 ji = iprofidx(iindx(jk)) 481 481 482 IF ( inpfiles(jj)%ioqc(ji) > 2) CYCLE483 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2) .AND. &484 & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE482 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 483 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 484 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 485 485 486 486 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & … … 495 495 llvalprof = .FALSE. 496 496 497 IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 498 499 IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 500 & ( inpfiles(jj)%ivqc(ji,2) > 2 ) ) CYCLE 497 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 498 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 499 & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 501 500 502 501 loop_prof : DO ij = 1, inpfiles(jj)%nlev … … 505 504 & CYCLE 506 505 507 IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2) .AND. &508 & ( inpfiles(jj)%idqc(ij,ji) <= 2) ) THEN506 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 507 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 509 508 510 509 llvalprof = .TRUE. … … 513 512 ENDIF 514 513 515 IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2) .AND. &516 & ( inpfiles(jj)%idqc(ij,ji) <= 2) ) THEN514 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 515 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 517 516 518 517 llvalprof = .TRUE. … … 592 591 IF (ldsatt) THEN 593 592 594 IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2) .AND. &595 & ( inpfiles(jj)%idqc(ij,ji) <= 2 )) .AND. &596 & 597 & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2) .AND. &598 & ( inpfiles(jj)%idqc(ij,ji) <= 2 )) .AND. &599 & 593 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 594 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 595 & ldt3d ) .OR. & 596 & ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 597 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 598 & lds3d ) ) THEN 600 599 ip3dt = ip3dt + 1 601 600 ELSE … … 605 604 ENDIF 606 605 607 IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2) .AND. &608 & ( inpfiles(jj)%idqc(ij,ji) <= 2 )) .AND. &609 &ldt3d ) .OR. ldsatt ) THEN606 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 607 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 608 & ldt3d ) .OR. ldsatt ) THEN 610 609 611 610 IF (ldsatt) THEN … … 667 666 ENDIF 668 667 669 IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2) .AND. &670 & ( inpfiles(jj)%idqc(ij,ji) <= 2 )) .AND. &671 & lds3d ) .OR. ldsatt ) THEN668 IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 669 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 670 & ldt3d ) .OR. ldsatt ) THEN 672 671 673 672 IF (ldsatt) THEN -
branches/UKMO/dev_rev5518_OBS_DoNotAssim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_seaice.F90
r4990 r7841 282 282 ENDIF 283 283 llvalprof = .FALSE. 284 IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. & 285 & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN 284 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(1,ji,1),2) ) THEN 286 285 iobs = iobs + 1 287 286 ENDIF … … 355 354 ! Set observation information 356 355 357 IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. & 358 & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN 356 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(1,ji,1),2) ) THEN 359 357 360 358 iobs = iobs + 1 -
branches/UKMO/dev_rev5518_OBS_DoNotAssim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sla.F90
r4990 r7841 269 269 inowin = 0 270 270 DO ji = 1, inpfiles(jj)%nobs 271 IF ( inpfiles(jj)%ioqc(ji) > 2) CYCLE272 IF ( inpfiles(jj)%ivqc(ji,1) > 2) CYCLE271 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 272 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 273 273 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 274 274 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 283 283 inowin = 0 284 284 DO ji = 1, inpfiles(jj)%nobs 285 IF ( inpfiles(jj)%ioqc(ji) > 2) CYCLE286 IF ( inpfiles(jj)%ivqc(ji,1) > 2) CYCLE285 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 286 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 287 287 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 288 288 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 297 297 inowin = 0 298 298 DO ji = 1, inpfiles(jj)%nobs 299 IF ( inpfiles(jj)%ioqc(ji) > 2) CYCLE300 IF ( inpfiles(jj)%ivqc(ji,1) > 2) CYCLE299 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 300 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 301 301 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 302 302 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 310 310 311 311 DO ji = 1, inpfiles(jj)%nobs 312 IF ( inpfiles(jj)%ioqc(ji) > 2) CYCLE313 IF ( inpfiles(jj)%ivqc(ji,1) > 2) CYCLE312 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 313 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 314 314 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 315 315 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 320 320 ENDIF 321 321 llvalprof = .FALSE. 322 IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. & 323 & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN 322 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(1,ji,1),2) ) THEN 324 323 iobs = iobs + 1 325 324 ENDIF … … 364 363 DO jj = 1, inobf 365 364 DO ji = 1, inpfiles(jj)%nobs 366 IF ( inpfiles(jj)%ioqc(ji) > 2) CYCLE367 IF ( inpfiles(jj)%ivqc(ji,1) > 2) CYCLE365 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 366 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 368 367 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 369 368 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 378 377 DO jj = 1, inobf 379 378 DO ji = 1, inpfiles(jj)%nobs 380 IF ( inpfiles(jj)%ioqc(ji) > 2) CYCLE381 IF ( inpfiles(jj)%ivqc(ji,1) > 2) CYCLE379 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 380 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 382 381 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & 383 382 & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN … … 409 408 ji = islaidx(iindx(jk)) 410 409 411 IF ( inpfiles(jj)%ioqc(ji) > 2) CYCLE412 IF ( inpfiles(jj)%ivqc(ji,1) > 2) CYCLE410 IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 411 IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 413 412 414 413 IF ( ( inpfiles(jj)%ptim(ji) > djulini(jj) ) .AND. & … … 423 422 ! Set observation information 424 423 425 IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. & 426 & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN 424 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(1,ji,1),2) ) THEN 427 425 428 426 iobs = iobs + 1 -
branches/UKMO/dev_rev5518_OBS_DoNotAssim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sst.F90
r4990 r7841 282 282 ENDIF 283 283 llvalprof = .FALSE. 284 IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. & 285 & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN 284 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(1,ji,1),2) ) THEN 286 285 iobs = iobs + 1 287 286 ENDIF … … 354 353 ! Set observation information 355 354 356 IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. & 357 & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN 355 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(1,ji,1),2) ) THEN 358 356 359 357 iobs = iobs + 1 -
branches/UKMO/dev_rev5518_OBS_DoNotAssim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_vel.F90
r4990 r7841 326 326 IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 327 327 & CYCLE 328 IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2) .AND. &329 & ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2) .AND. &330 & ( inpfiles(jj)%idqc(ij,ji) <= 2) ) THEN328 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 329 & .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 330 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 331 331 iuv3dt = iuv3dt + 1 332 332 llvalprof = .TRUE. … … 413 413 & CYCLE 414 414 415 IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2) .AND. &416 & ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2) .AND. &417 & ( inpfiles(jj)%idqc(ij,ji) <= 2) ) THEN415 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 416 & .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 417 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 418 418 419 419 llvalprof = .TRUE. … … 492 492 & CYCLE 493 493 494 IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2) .AND. &495 & ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2) .AND. &496 & ( inpfiles(jj)%idqc(ij,ji) <= 2) ) THEN494 IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 495 & .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 496 & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 497 497 iuv3dt = iuv3dt + 1 498 498 ELSE -
branches/UKMO/dev_rev5518_OBS_DoNotAssim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
r3294 r7841 155 155 156 156 ! mark any masked data with a QC flag 157 IF( zobsmask(1) == 0 ) sladata(jslano)%nqc(jobs) = 11157 IF( zobsmask(1) == 0 ) sladata(jslano)%nqc(jobs) = IBSET(sladata(jslano)%nqc(jobs),15) 158 158 159 159 END DO -
branches/UKMO/dev_rev5518_OBS_DoNotAssim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
r4990 r7841 173 173 fbdata%ivqc(jo,:) = profdata%ivqc(jo,:) 174 174 fbdata%ivqcf(:,jo,:) = profdata%ivqcf(:,jo,:) 175 IF ( profdata%nqc(jo) > 10) THEN176 fbdata%ioqc(jo) = 4175 IF ( profdata%nqc(jo) > 255 ) THEN 176 fbdata%ioqc(jo) = IBSET(profdata%nqc(jo),2) 177 177 fbdata%ioqcf(1,jo) = profdata%nqcf(1,jo) 178 fbdata%ioqcf(2,jo) = profdata%nqc(jo) - 10178 fbdata%ioqcf(2,jo) = profdata%nqc(jo) 179 179 ELSE 180 180 fbdata%ioqc(jo) = profdata%nqc(jo) … … 213 213 fbdata%idqc(ik,jo) = profdata%var(jvar)%idqc(jk) 214 214 fbdata%idqcf(:,ik,jo) = profdata%var(jvar)%idqcf(:,jk) 215 IF ( profdata%var(jvar)%nvqc(jk) > 10) THEN216 fbdata%ivlqc(ik,jo,jvar) = 4215 IF ( profdata%var(jvar)%nvqc(jk) > 255 ) THEN 216 fbdata%ivlqc(ik,jo,jvar) = IBSET(profdata%var(jvar)%nvqc(jk),2) 217 217 fbdata%ivlqcf(1,ik,jo,jvar) = profdata%var(jvar)%nvqcf(1,jk) 218 fbdata%ivlqcf(2,ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) - 10218 fbdata%ivlqcf(2,ik,jo,jvar) = IAND(profdata%var(jvar)%nvqc(jk),b'0000 0000 1111 1111') 219 219 ELSE 220 220 fbdata%ivlqc(ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) … … 360 360 fbdata%ivqc(jo,:) = 0 361 361 fbdata%ivqcf(:,jo,:) = 0 362 IF ( sladata%nqc(jo) > 10) THEN362 IF ( sladata%nqc(jo) > 255 ) THEN 363 363 fbdata%ioqc(jo) = 4 364 364 fbdata%ioqcf(1,jo) = 0 365 fbdata%ioqcf(2,jo) = sladata%nqc(jo) - 10365 fbdata%ioqcf(2,jo) = IAND(sladata%nqc(jo),b'0000 0000 1111 1111') 366 366 ELSE 367 367 fbdata%ioqc(jo) = sladata%nqc(jo) … … 395 395 fbdata%idqc(1,jo) = 0 396 396 fbdata%idqcf(:,1,jo) = 0 397 IF ( sladata%nqc(jo) > 10) THEN397 IF ( sladata%nqc(jo) > 255 ) THEN 398 398 fbdata%ivqc(jo,1) = 4 399 399 fbdata%ivlqc(1,jo,1) = 4 400 400 fbdata%ivlqcf(1,1,jo,1) = 0 401 fbdata%ivlqcf(2,1,jo,1) = sladata%nqc(jo) - 10401 fbdata%ivlqcf(2,1,jo,1) = IAND(sladata%nqc(jo),b'0000 0000 1111 1111') 402 402 ELSE 403 403 fbdata%ivqc(jo,1) = sladata%nqc(jo) … … 514 514 fbdata%ivqc(jo,:) = 0 515 515 fbdata%ivqcf(:,jo,:) = 0 516 IF ( sstdata%nqc(jo) > 10) THEN516 IF ( sstdata%nqc(jo) > 255 ) THEN 517 517 fbdata%ioqc(jo) = 4 518 518 fbdata%ioqcf(1,jo) = 0 519 fbdata%ioqcf(2,jo) = sstdata%nqc(jo) - 10519 fbdata%ioqcf(2,jo) = IAND(sstdata%nqc(jo), b'0000 0000 1111 1111') 520 520 ELSE 521 521 fbdata%ioqc(jo) = MAX(sstdata%nqc(jo),1) … … 548 548 fbdata%idqc(1,jo) = 0 549 549 fbdata%idqcf(:,1,jo) = 0 550 IF ( sstdata%nqc(jo) > 10) THEN550 IF ( sstdata%nqc(jo) > 255 ) THEN 551 551 fbdata%ivqc(jo,1) = 4 552 552 fbdata%ivlqc(1,jo,1) = 4 553 553 fbdata%ivlqcf(1,1,jo,1) = 0 554 fbdata%ivlqcf(2,1,jo,1) = sstdata%nqc(jo) - 10554 fbdata%ivlqcf(2,1,jo,1) = IAND(sstdata%nqc(jo), b'0000 0000 1111 1111') 555 555 ELSE 556 556 fbdata%ivqc(jo,1) = MAX(sstdata%nqc(jo),1) … … 670 670 fbdata%ivqc(jo,:) = 0 671 671 fbdata%ivqcf(:,jo,:) = 0 672 IF ( seaicedata%nqc(jo) > 10) THEN672 IF ( seaicedata%nqc(jo) > 255 ) THEN 673 673 fbdata%ioqc(jo) = 4 674 674 fbdata%ioqcf(1,jo) = 0 675 fbdata%ioqcf(2,jo) = seaicedata%nqc(jo) - 10675 fbdata%ioqcf(2,jo) = IAND(seaicedata%nqc(jo),b'0000 0000 1111 1111') 676 676 ELSE 677 677 fbdata%ioqc(jo) = MAX(seaicedata%nqc(jo),1) … … 704 704 fbdata%idqc(1,jo) = 0 705 705 fbdata%idqcf(:,1,jo) = 0 706 IF ( seaicedata%nqc(jo) > 10) THEN706 IF ( seaicedata%nqc(jo) > 255 ) THEN 707 707 fbdata%ivlqc(1,jo,1) = 4 708 708 fbdata%ivlqcf(1,1,jo,1) = 0 709 fbdata%ivlqcf(2,1,jo,1) = seaicedata%nqc(jo) - 10709 fbdata%ivlqcf(2,1,jo,1) = IAND(seaicedata%nqc(jo),b'0000 0000 1111 1111') 710 710 ELSE 711 711 fbdata%ivlqc(1,jo,1) = MAX(seaicedata%nqc(jo),1) … … 849 849 fbdata%ivqc(jo,:) = profdata%ivqc(jo,:) 850 850 fbdata%ivqcf(:,jo,:) = profdata%ivqcf(:,jo,:) 851 IF ( profdata%nqc(jo) > 10) THEN851 IF ( profdata%nqc(jo) > 255 ) THEN 852 852 fbdata%ioqc(jo) = 4 853 853 fbdata%ioqcf(1,jo) = profdata%nqcf(1,jo) 854 fbdata%ioqcf(2,jo) = profdata%nqc(jo) - 10854 fbdata%ioqcf(2,jo) = IAND(profdata%nqc(jo), b'0000 0000 1111 1111') 855 855 ELSE 856 856 fbdata%ioqc(jo) = profdata%nqc(jo) … … 894 894 fbdata%idqc(ik,jo) = profdata%var(jvar)%idqc(jk) 895 895 fbdata%idqcf(:,ik,jo) = profdata%var(jvar)%idqcf(:,jk) 896 IF ( profdata%var(jvar)%nvqc(jk) > 10) THEN896 IF ( profdata%var(jvar)%nvqc(jk) > 255 ) THEN 897 897 fbdata%ivlqc(ik,jo,jvar) = 4 898 898 fbdata%ivlqcf(1,ik,jo,jvar) = profdata%var(jvar)%nvqcf(1,jk) 899 fbdata%ivlqcf(2,ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) - 10899 fbdata%ivlqcf(2,ik,jo,jvar) = IAND(profdata%nqc(jo), b'0000 0000 1111 1111') 900 900 ELSE 901 901 fbdata%ivlqc(ik,jo,jvar) = profdata%var(jvar)%nvqc(jk)
Note: See TracChangeset
for help on using the changeset viewer.
