- Timestamp:
- 2017-03-29T12:14:30+02:00 (7 years ago)
- File:
-
- 1 edited
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
Note: See TracChangeset
for help on using the changeset viewer.