Changeset 7841


Ignore:
Timestamp:
2017-03-29T12:14:30+02:00 (4 years ago)
Author:
jwhile
Message:

Added "Do not Assimlate" funtionality to OBS code

Location:
branches/UKMO/dev_rev5518_OBS_DoNotAssim
Files:
1 added
8 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_rev5518_OBS_DoNotAssim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90

    r4292 r7841  
    5252 
    5353   SUBROUTINE obs_pre_pro( profdata, prodatqc, ld_t3d, ld_s3d, ld_nea, & 
    54       &                    kdailyavtypes ) 
     54      &                    kdailyavtypes, kqc_cutoff ) 
    5555      !!---------------------------------------------------------------------- 
    5656      !!                    ***  ROUTINE obs_pre_pro  *** 
     
    8686      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    8787         & kdailyavtypes! Types for daily averages 
     88      INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff   ! cut off for QC value 
    8889      !! * Local declarations    
     90      INTEGER :: iqc_cutoff = 255   ! cut off for QC value 
    8991      INTEGER :: iyea0         ! Initial date 
    9092      INTEGER :: imon0         !  - (year, month, day, hour, minute) 
     
    141143      inlasobs = 0 
    142144 
     145      ! Set QC cutoff to optional value if provided 
     146      IF ( PRESENT(kqc_cutoff) ) iqc_cutoff=kqc_cutoff 
     147 
    143148      ! ----------------------------------------------------------------------- 
    144149      ! Find time coordinate for profiles 
     
    151156            &                profdata%nday,    profdata%nhou, profdata%nmin, & 
    152157            &                profdata%ntyp,    profdata%nqc,  profdata%mstp, & 
    153             &                iotdobs, kdailyavtypes = kdailyavtypes        ) 
     158            &                iotdobs, kdailyavtypes = kdailyavtypes,         & 
     159            &                kqc_cutoff = iqc_cutoff        ) 
    154160      ELSE 
    155161         CALL obs_coo_tim_prof( icycle, & 
     
    158164            &                profdata%nday,    profdata%nhou, profdata%nmin, & 
    159165            &                profdata%ntyp,    profdata%nqc,  profdata%mstp, & 
    160             &                iotdobs ) 
     166            &                iotdobs, kqc_cutoff = iqc_cutoff ) 
    161167      ENDIF 
    162168      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 
     
    172178 
    173179      ! ----------------------------------------------------------------------- 
    174       ! Reject all observations for profiles with nqc > 10 
    175       ! ----------------------------------------------------------------------- 
    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 ) 
    178184 
    179185      ! ----------------------------------------------------------------------- 
     
    196202         &                 profdata%nqc,          profdata%var(1)%nvqc, & 
    197203         &                 iosdtobs,              ilantobs,             & 
    198          &                 inlatobs,              ld_nea                ) 
     204         &                 inlatobs,              ld_nea,               & 
     205         &                 iqc_cutoff                                   ) 
    199206 
    200207      CALL obs_mpp_sum_integer( iosdtobs, iosdtobsmpp ) 
     
    216223         &                 profdata%nqc,          profdata%var(2)%nvqc, & 
    217224         &                 iosdsobs,              ilansobs,             & 
    218          &                 inlasobs,              ld_nea                ) 
     225         &                 inlasobs,              ld_nea,               & 
     226         &                 iqc_cutoff                                   ) 
    219227 
    220228      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
     
    234242      END DO 
    235243 
    236       ! We want all data which has qc flags <= 10 
    237  
    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 ) 
    239247      DO jvar = 1,profdata%nvar 
    240          llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= 10 ) 
     248         llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= iqc_cutoff ) 
    241249      END DO 
    242250 
     
    337345   END SUBROUTINE obs_pre_pro 
    338346 
    339    SUBROUTINE obs_pre_sla( sladata, sladatqc, ld_sla, ld_nea ) 
     347   SUBROUTINE obs_pre_sla( sladata, sladatqc, ld_sla, ld_nea, kqc_cutoff ) 
    340348      !!---------------------------------------------------------------------- 
    341349      !!                    ***  ROUTINE obs_pre_sla  *** 
     
    366374      LOGICAL, INTENT(IN) :: ld_sla         ! Switch for SLA data 
    367375      LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land 
     376      INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff   ! cut off for QC value 
    368377      !! * Local declarations 
     378      INTEGER :: iqc_cutoff = 255   ! cut off for QC value 
    369379      INTEGER :: iyea0        ! Initial date 
    370380      INTEGER :: imon0        !  - (year, month, day, hour, minute) 
     
    410420      inlasobs = 0 
    411421 
     422      ! Set QC cutoff to optional value if provided 
     423 
     424      IF ( PRESENT(kqc_cutoff) ) iqc_cutoff=kqc_cutoff 
     425 
    412426      ! ----------------------------------------------------------------------- 
    413427      ! Find time coordinate for SLA data 
     
    442456         &                 tmask(:,:,1), sladata%nqc,  & 
    443457         &                 iosdsobs,     ilansobs,     & 
    444          &                 inlasobs,     ld_nea        ) 
     458         &                 inlasobs,     ld_nea,       & 
     459         &                 iqc_cutoff                  ) 
    445460 
    446461      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
     
    457472      ALLOCATE( llvalid(sladata%nsurf) ) 
    458473       
    459       ! We want all data which has qc flags <= 10 
    460  
    461       llvalid(:)  = ( sladata%nqc(:)  <= 10 ) 
     474      ! We want all data which has qc flags <= iqc_cutoff 
     475 
     476      llvalid(:)  = ( sladata%nqc(:)  <= iqc_cutoff ) 
    462477 
    463478      ! The actual copying 
     
    526541   END SUBROUTINE obs_pre_sla 
    527542 
    528    SUBROUTINE obs_pre_sst( sstdata, sstdatqc, ld_sst, ld_nea ) 
     543   SUBROUTINE obs_pre_sst( sstdata, sstdatqc, ld_sst, ld_nea, kqc_cutoff ) 
    529544      !!---------------------------------------------------------------------- 
    530545      !!                    ***  ROUTINE obs_pre_sst  *** 
     
    554569      LOGICAL :: ld_sst             ! Switch for SST data 
    555570      LOGICAL :: ld_nea             ! Switch for rejecting observation near land 
     571      INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff   ! cut off for QC value 
    556572      !! * Local declarations 
     573      INTEGER :: iqc_cutoff = 255   ! cut off for QC value 
    557574      INTEGER :: iyea0        ! Initial date 
    558575      INTEGER :: imon0        !  - (year, month, day, hour, minute) 
     
    598615      inlasobs = 0 
    599616 
     617      ! Set QC cutoff to optional value if provided 
     618 
     619      IF ( PRESENT(kqc_cutoff) ) iqc_cutoff=kqc_cutoff 
     620 
    600621      ! ----------------------------------------------------------------------- 
    601622      ! Find time coordinate for SST data 
     
    627648         &                 tmask(:,:,1), sstdata%nqc,  & 
    628649         &                 iosdsobs,     ilansobs,     & 
    629          &                 inlasobs,     ld_nea        ) 
     650         &                 inlasobs,     ld_nea,       & 
     651         &                 iqc_cutoff                  ) 
    630652 
    631653      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
     
    642664      ALLOCATE( llvalid(sstdata%nsurf) ) 
    643665       
    644       ! We want all data which has qc flags <= 0 
    645  
    646       llvalid(:)  = ( sstdata%nqc(:)  <= 10 ) 
     666      ! We want all data which has qc flags <= iqc_cutoff 
     667 
     668      llvalid(:)  = ( sstdata%nqc(:)  <= iqc_cutoff ) 
    647669 
    648670      ! The actual copying 
     
    711733   END SUBROUTINE obs_pre_sst 
    712734 
    713    SUBROUTINE obs_pre_seaice( seaicedata, seaicedatqc, ld_seaice, ld_nea ) 
     735   SUBROUTINE obs_pre_seaice( seaicedata, seaicedatqc, ld_seaice, ld_nea, kqc_cutoff ) 
    714736      !!---------------------------------------------------------------------- 
    715737      !!                    ***  ROUTINE obs_pre_seaice  *** 
     
    739761      LOGICAL :: ld_seaice     ! Switch for sea ice data 
    740762      LOGICAL :: ld_nea        ! Switch for rejecting observation near land 
     763      INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff   ! cut off for QC value 
    741764      !! * Local declarations 
     765      INTEGER :: iqc_cutoff = 255   ! cut off for QC value 
    742766      INTEGER :: iyea0         ! Initial date 
    743767      INTEGER :: imon0         !  - (year, month, day, hour, minute) 
     
    783807      inlasobs = 0 
    784808 
     809      ! Set QC cutoff to optional value if provided 
     810 
     811      IF ( PRESENT(kqc_cutoff) ) iqc_cutoff=kqc_cutoff 
     812 
    785813      ! ----------------------------------------------------------------------- 
    786814      ! Find time coordinate for sea ice data 
     
    812840         &                 tmask(:,:,1),    seaicedata%nqc,  & 
    813841         &                 iosdsobs,        ilansobs,        & 
    814          &                 inlasobs,        ld_nea           ) 
     842         &                 inlasobs,        ld_nea,          & 
     843         &                 iqc_cutoff                        ) 
    815844 
    816845      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
     
    827856      ALLOCATE( llvalid(seaicedata%nsurf) ) 
    828857       
    829       ! We want all data which has qc flags <= 0 
    830  
    831       llvalid(:)  = ( seaicedata%nqc(:)  <= 10 ) 
     858      ! We want all data which has qc flags <= iqc_cutoff 
     859 
     860      llvalid(:)  = ( seaicedata%nqc(:)  <= iqc_cutoff ) 
    832861 
    833862      ! The actual copying 
     
    896925   END SUBROUTINE obs_pre_seaice 
    897926 
    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 ) 
    899928      !!---------------------------------------------------------------------- 
    900929      !!                    ***  ROUTINE obs_pre_taovel  *** 
     
    925954      LOGICAL, INTENT(IN) :: ld_nea        ! Switch for rejecting observation near land 
    926955      LOGICAL, INTENT(IN) :: ld_dailyav    ! Switch for daily average data 
     956      INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff   ! cut off for QC value 
    927957      !! * Local declarations 
     958      INTEGER :: iqc_cutoff = 255   ! cut off for QC value 
    928959      INTEGER :: iyea0        ! Initial date 
    929960      INTEGER :: imon0        !  - (year, month, day, hour, minute) 
     
    9861017      iuvchkv = 0 
    9871018 
     1019      ! Set QC cutoff to optional value if provided 
     1020 
     1021      IF ( PRESENT(kqc_cutoff) ) iqc_cutoff=kqc_cutoff 
     1022 
    9881023      ! ----------------------------------------------------------------------- 
    9891024      ! Find time coordinate for profiles 
     
    9951030         &              profdata%nday,    profdata%nhou, profdata%nmin, & 
    9961031         &              profdata%ntyp,    profdata%nqc,  profdata%mstp, & 
    997          &              iotdobs, ld_dailyav = ld_dailyav        ) 
     1032         &              iotdobs, ld_dailyav = ld_dailyav,               & 
     1033         &              kqc_cutoff=kqc_cutoff ) 
    9981034     
    9991035      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 
     
    10141050      ! ----------------------------------------------------------------------- 
    10151051 
    1016       CALL obs_pro_rej( profdata ) 
     1052      CALL obs_pro_rej( profdata, iqc_cutoff ) 
    10171053 
    10181054      ! ----------------------------------------------------------------------- 
     
    10351071         &                 profdata%nqc,          profdata%var(1)%nvqc, & 
    10361072         &                 iosduobs,              ilanuobs,             & 
    1037          &                 inlauobs,              ld_nea                ) 
     1073         &                 inlauobs,              ld_nea,               & 
     1074         &                 iqc_cutoff                                   ) 
    10381075 
    10391076      CALL obs_mpp_sum_integer( iosduobs, iosduobsmpp ) 
     
    10551092         &                 profdata%nqc,          profdata%var(2)%nvqc, & 
    10561093         &                 iosdvobs,              ilanvobs,             & 
    1057          &                 inlavobs,              ld_nea                ) 
     1094         &                 inlavobs,              ld_nea,               & 
     1095         &                 iqc_cutoff                                   ) 
    10581096 
    10591097      CALL obs_mpp_sum_integer( iosdvobs, iosdvobsmpp ) 
     
    10651103      ! ----------------------------------------------------------------------- 
    10661104 
    1067       CALL obs_uv_rej( profdata, iuvchku, iuvchkv ) 
     1105      CALL obs_uv_rej( profdata, iuvchku, iuvchkviqc_cutoff ) 
    10681106      CALL obs_mpp_sum_integer( iuvchku, iuvchkumpp ) 
    10691107      CALL obs_mpp_sum_integer( iuvchkv, iuvchkvmpp ) 
     
    10811119      END DO 
    10821120 
    1083       ! We want all data which has qc flags = 0 
    1084  
    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 ) 
    10861124      DO jvar = 1,profdata%nvar 
    1087          llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= 10 ) 
     1125         llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= iqc_cutoff ) 
    10881126      END DO 
    10891127 
     
    13891427      &                    kobsyea, kobsmon, kobsday, kobshou, kobsmin,   & 
    13901428      &                    ktyp,    kobsqc,  kobsstp, kotdobs, kdailyavtypes, & 
    1391       &                    ld_dailyav ) 
     1429      &                    ld_dailyav, kqc_cutoff ) 
    13921430      !!---------------------------------------------------------------------- 
    13931431      !!                    ***  ROUTINE obs_coo_tim *** 
     
    14341472         & kdailyavtypes    ! Types for daily averages 
    14351473      LOGICAL, OPTIONAL :: ld_dailyav    ! All types are daily averages 
     1474      INTEGER, OPTIONAL, INTENT(IN) :: kqc_cutoff           ! QC cutoff value 
    14361475      !! * Local declarations 
    14371476      INTEGER :: jobs 
     1477      INTEGER :: iqc_cutoff=255 
    14381478 
    14391479      !----------------------------------------------------------------------- 
     
    14541494         DO jobs = 1, kobsno 
    14551495             
    1456             IF ( kobsqc(jobs) <= 10 ) THEN 
     1496            IF ( kobsqc(jobs) <= iqc_cutoff ) THEN 
    14571497                
    14581498               IF ( ( kobsstp(jobs) == (nit000 - 1) ).AND.& 
    14591499                  & ( ANY (kdailyavtypes(:) == ktyp(jobs)) ) ) THEN 
    1460                   kobsqc(jobs) = kobsqc(jobs) + 14 
     1500                  kobsqc(jobs) = IBSET(kobsqc(jobs),13) 
    14611501                  kotdobs      = kotdobs + 1 
    14621502                  CYCLE 
     
    14751515            DO jobs = 1, kobsno 
    14761516                
    1477                IF ( kobsqc(jobs) <= 10 ) THEN 
     1517               IF ( kobsqc(jobs) <= iqc_cutoff ) THEN 
    14781518                   
    14791519                  IF ( kobsstp(jobs) == (nit000 - 1) ) THEN 
    1480                      kobsqc(jobs) = kobsqc(jobs) + 14 
     1520                     kobsqc(jobs) = IBSET(kobsqc(jobs),13) 
    14811521                     kotdobs      = kotdobs + 1 
    14821522                     CYCLE 
     
    15211561      DO jobs = 1, kobsno 
    15221562         IF ( ( kobsi(jobs) <= 0 ) .AND. ( kobsj(jobs) <= 0 ) ) THEN 
    1523             kobsqc(jobs) = kobsqc(jobs) + 18 
     1563            kobsqc(jobs) = IBSET(kobsqc(jobs),12) 
    15241564            kgrdobs = kgrdobs + 1 
    15251565         ENDIF 
     
    15321572      &                       plam,   pphi,    pmask,            & 
    15331573      &                       kobsqc, kosdobs, klanobs,          & 
    1534       &                       knlaobs,ld_nea                     ) 
     1574      &                       knlaobs,ld_nea, kqc_cutoff         ) 
    15351575      !!---------------------------------------------------------------------- 
    15361576      !!                    ***  ROUTINE obs_coo_spc_2d  *** 
     
    15691609      INTEGER, INTENT(INOUT) :: knlaobs   ! Observations near land 
    15701610      LOGICAL, INTENT(IN) :: ld_nea       ! Flag observations near land 
     1611      INTEGER, INTENT(IN) :: kqc_cutoff       ! Cutoff QC value 
    15711612      !! * Local declarations 
    15721613      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
     
    15881629         ! For invalid points use 2,2 
    15891630 
    1590          IF ( kobsqc(jobs) >= 10 ) THEN 
     1631         IF ( kobsqc(jobs) >= kqc_cutoff ) THEN 
    15911632 
    15921633            igrdi(1,1,jobs) = 1 
     
    16211662 
    16221663         ! Skip bad observations 
    1623          IF ( kobsqc(jobs) >= 10 ) CYCLE 
     1664         IF ( kobsqc(jobs) >= kqc_cutoff ) CYCLE 
    16241665 
    16251666         ! Flag if the observation falls outside the model spatial domain 
     
    16281669            &  .OR. ( pobsphi(jobs) <  -90. ) & 
    16291670            &  .OR. ( pobsphi(jobs) >   90. ) ) THEN 
    1630             kobsqc(jobs) = kobsqc(jobs) + 11 
     1671            kobsqc(jobs) = IBSET(kobsqc(jobs),11) 
    16311672            kosdobs = kosdobs + 1 
    16321673            CYCLE 
     
    16351676         ! Flag if the observation falls with a model land cell 
    16361677         IF ( SUM( zgmsk(1:2,1:2,jobs) ) == 0.0_wp ) THEN 
    1637             kobsqc(jobs) = kobsqc(jobs)  + 12 
     1678            kobsqc(jobs) = IBSET(kobsqc(jobs),10) 
    16381679            klanobs = klanobs + 1 
    16391680            CYCLE 
     
    16631704         IF (lgridobs) THEN 
    16641705            IF (zgmsk(iig,ijg,jobs) == 0.0_wp ) THEN 
    1665                kobsqc(jobs) = kobsqc(jobs) + 12 
     1706               kobsqc(jobs) = IBSET(kobsqc(jobs),10) 
    16661707               klanobs = klanobs + 1 
    16671708               CYCLE 
     
    16711712         ! Flag if the observation falls is close to land 
    16721713         IF ( MINVAL( zgmsk(1:2,1:2,jobs) ) == 0.0_wp) THEN 
    1673             IF (ld_nea) kobsqc(jobs) = kobsqc(jobs) + 14 
     1714            IF (ld_nea) kobsqc(jobs) = IBSET(kobsqc(jobs),9) 
    16741715            knlaobs = knlaobs + 1 
    16751716            CYCLE 
     
    16861727      &                       plam,    pphi,    pdep,    pmask, & 
    16871728      &                       kpobsqc, kobsqc,  kosdobs,        & 
    1688       &                       klanobs, knlaobs, ld_nea          ) 
     1729      &                       klanobs, knlaobs, ld_nea,         & 
     1730      &                       kqc_cutoff                        ) 
    16891731      !!---------------------------------------------------------------------- 
    16901732      !!                    ***  ROUTINE obs_coo_spc_3d  *** 
     
    17441786      INTEGER, INTENT(INOUT) :: knlaobs     ! Observations near land 
    17451787      LOGICAL, INTENT(IN) :: ld_nea         ! Flag observations near land 
     1788      INTEGER, INTENT(IN) :: kqc_cutoff     ! Cutoff QC value 
    17461789      !! * Local declarations 
    17471790      REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: & 
     
    17631806         ! For invalid points use 2,2 
    17641807 
    1765          IF ( kpobsqc(jobs) >= 10 ) THEN 
     1808         IF ( kpobsqc(jobs) >= kqc_cutoff ) THEN 
    17661809             
    17671810            igrdi(1,1,jobs) = 1 
     
    17961839 
    17971840         ! Skip bad profiles 
    1798          IF ( kpobsqc(jobs) >= 10 ) CYCLE 
     1841         IF ( kpobsqc(jobs) >= kqc_cutoff ) CYCLE 
    17991842 
    18001843         ! Check if this observation is on a grid point 
     
    18271870               &  .OR. ( pobsdep(jobsp) < 0.0          )       & 
    18281871               &  .OR. ( pobsdep(jobsp) > gdepw_1d(kpk)) ) THEN 
    1829                kobsqc(jobsp) = kobsqc(jobsp) + 11 
     1872               kobsqc(jobsp) = IBSET(kobsqc(jobsp),11) 
    18301873               kosdobs = kosdobs + 1 
    18311874               CYCLE 
     
    18351878            IF ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) & 
    18361879               &  == 0.0_wp ) THEN 
    1837                kobsqc(jobsp) = kobsqc(jobsp) + 12 
     1880               kobsqc(jobsp) = IBSET(kobsqc(jobsp),10) 
    18381881               klanobs = klanobs + 1 
    18391882               CYCLE 
     
    18451888            IF (lgridobs) THEN 
    18461889               IF (zgmsk(iig,ijg,kobsk(jobsp)-1,jobs) == 0.0_wp ) THEN 
    1847                   kobsqc(jobsp) = kobsqc(jobsp) + 12 
     1890                  kobsqc(jobsp) = IBSET(kobsqc(jobsp),9) 
    18481891                  klanobs = klanobs + 1 
    18491892                  CYCLE 
     
    18541897            IF ( MINVAL( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) == & 
    18551898               &  0.0_wp) THEN 
    1856                IF (ld_nea) kobsqc(jobsp) = kobsqc(jobsp) + 14 
     1899               IF (ld_nea) kobsqc(jobsp) = IBSET(kobsqc(jobsp),10) 
    18571900               knlaobs = knlaobs + 1 
    18581901            ENDIF 
     
    18681911   END SUBROUTINE obs_coo_spc_3d 
    18691912 
    1870    SUBROUTINE obs_pro_rej( profdata ) 
     1913   SUBROUTINE obs_pro_rej( profdata, kqc_cutoff ) 
    18711914      !!---------------------------------------------------------------------- 
    18721915      !!                    ***  ROUTINE obs_pro_rej *** 
     
    18861929      !! * Arguments 
    18871930      TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Profile data 
     1931      INTEGER, INTENT(IN) :: kqc_cutoff             ! QC cutoff value 
    18881932      !! * Local declarations 
    18891933      INTEGER :: jprof 
     
    18951939      DO jprof = 1, profdata%nprof 
    18961940 
    1897          IF ( profdata%nqc(jprof) > 10 ) THEN 
     1941         IF ( profdata%nqc(jprof) >  kqc_cutoff ) THEN 
    18981942             
    18991943            DO jvar = 1, profdata%nvar 
     
    19031947                   
    19041948                  profdata%var(jvar)%nvqc(jobs) = & 
    1905                      & profdata%var(jvar)%nvqc(jobs) + 26 
     1949                     & IBSET(profdata%var(jvar)%nvqc(jobs),14) 
    19061950 
    19071951               END DO 
     
    19151959   END SUBROUTINE obs_pro_rej 
    19161960 
    1917    SUBROUTINE obs_uv_rej( profdata, knumu, knumv ) 
     1961   SUBROUTINE obs_uv_rej( profdata, knumu, knumv, kqc_cutoff ) 
    19181962      !!---------------------------------------------------------------------- 
    19191963      !!                    ***  ROUTINE obs_uv_rej *** 
     
    19351979      INTEGER, INTENT(INOUT) :: knumu             ! Number of u rejected 
    19361980      INTEGER, INTENT(INOUT) :: knumv             ! Number of v rejected 
     1981      INTEGER, INTENT(IN) :: kqc_cutoff           ! QC cutoff value 
    19371982      !! * Local declarations 
    19381983      INTEGER :: jprof 
     
    19541999         DO jobs = profdata%npvsta(jprof,1), profdata%npvend(jprof,1) 
    19552000             
    1956             IF ( ( profdata%var(1)%nvqc(jobs) > 10 ) .AND. & 
    1957                & ( profdata%var(2)%nvqc(jobs) <= 10) ) THEN 
     2001            IF ( ( profdata%var(1)%nvqc(jobs) > kqc_cutoff ) .AND. & 
     2002               & ( profdata%var(2)%nvqc(jobs) <= kqc_cutoff) ) THEN 
    19582003               profdata%var(2)%nvqc(jobs) = profdata%var(2)%nvqc(jobs) + 42 
    19592004               knumv = knumv + 1 
    19602005            ENDIF 
    1961             IF ( ( profdata%var(2)%nvqc(jobs) > 10 ) .AND. & 
    1962                & ( profdata%var(1)%nvqc(jobs) <= 10) ) THEN 
    1963                profdata%var(1)%nvqc(jobs) = profdata%var(1)%nvqc(jobs) + 42 
     2006            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) 
    19642009               knumu = knumu + 1 
    19652010            ENDIF 
  • branches/UKMO/dev_rev5518_OBS_DoNotAssim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90

    r4990 r7841  
    308308            inowin = 0 
    309309            DO ji = 1, inpfiles(jj)%nobs 
    310                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    311                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    312                   & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     310               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 
    313313               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    314314                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    323323            inowin = 0 
    324324            DO ji = 1, inpfiles(jj)%nobs 
    325                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    326                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    327                   & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     325               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 
    328328               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    329329                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    338338            inowin = 0 
    339339            DO ji = 1, inpfiles(jj)%nobs 
    340                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    341                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    342                   & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     340               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 
    343343               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    344344                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    352352 
    353353            DO ji = 1, inpfiles(jj)%nobs 
    354                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    355                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    356                   & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     354               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 
    357357               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    358358                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    367367                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    368368                           & CYCLE 
    369                         IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    370                            & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
     369                        IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
     370                           & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    371371                           it3dt0 = it3dt0 + 1 
    372372                        ENDIF 
     
    377377                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    378378                           & CYCLE 
    379                         IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    380                            & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
     379                        IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
     380                           & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    381381                           is3dt0 = is3dt0 + 1 
    382382                        ENDIF 
     
    386386                     IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    387387                        & CYCLE 
    388                      IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    389                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    390                         &     ldt3d ) .OR. & 
    391                         & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    392                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    393                         &     lds3d ) ) THEN 
     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 
    394394                        ip3dt = ip3dt + 1 
    395395                        llvalprof = .TRUE. 
     
    416416      DO jj = 1, inobf 
    417417         DO ji = 1, inpfiles(jj)%nobs 
    418             IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    419             IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    420                & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     418            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 
    421421            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    422422               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    431431      DO jj = 1, inobf 
    432432         DO ji = 1, inpfiles(jj)%nobs 
    433             IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    434             IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    435                & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     433            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 
    436436            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    437437               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    480480         ji = iprofidx(iindx(jk)) 
    481481 
    482          IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    483          IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    484             & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     482         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 
    485485 
    486486         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  & 
     
    495495            llvalprof = .FALSE. 
    496496 
    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 
    501500 
    502501            loop_prof : DO ij = 1, inpfiles(jj)%nlev 
     
    505504                  & CYCLE 
    506505                
    507                IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    508                   & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
     506               IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
     507                  & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    509508                   
    510509                  llvalprof = .TRUE.  
     
    513512               ENDIF 
    514513                
    515                IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    516                   & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
     514               IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
     515                  & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    517516                   
    518517                  llvalprof = .TRUE.  
     
    592591                  IF (ldsatt) THEN 
    593592 
    594                      IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    595                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    596                         &     ldt3d ) .OR. & 
    597                         & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    598                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    599                         &     lds3d ) ) THEN 
     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 
    600599                        ip3dt = ip3dt + 1 
    601600                     ELSE 
     
    605604                  ENDIF 
    606605 
    607                   IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    608                      &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    609                      &       ldt3d ) .OR. ldsatt ) THEN 
     606                  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 
    610609                      
    611610                     IF (ldsatt) THEN 
     
    667666                  ENDIF 
    668667                   
    669                   IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    670                      &   ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    671                      &   lds3d ) .OR. ldsatt ) THEN 
     668                  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 
    672671                      
    673672                     IF (ldsatt) THEN 
  • branches/UKMO/dev_rev5518_OBS_DoNotAssim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_seaice.F90

    r4990 r7841  
    282282                  ENDIF 
    283283                  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 
    286285                     iobs = iobs + 1 
    287286                  ENDIF 
     
    355354            ! Set observation information 
    356355             
    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 
    359357 
    360358               iobs = iobs + 1 
  • branches/UKMO/dev_rev5518_OBS_DoNotAssim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sla.F90

    r4990 r7841  
    269269            inowin = 0 
    270270            DO ji = 1, inpfiles(jj)%nobs 
    271                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    272                IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 
     271               IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     272               IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 
    273273               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    274274                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    283283            inowin = 0 
    284284            DO ji = 1, inpfiles(jj)%nobs 
    285                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    286                IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 
     285               IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     286               IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 
    287287               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    288288                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    297297            inowin = 0 
    298298            DO ji = 1, inpfiles(jj)%nobs 
    299                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    300                IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 
     299               IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     300               IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 
    301301               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    302302                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    310310 
    311311            DO ji = 1, inpfiles(jj)%nobs 
    312                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    313                IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 
     312               IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     313               IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 
    314314               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    315315                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    320320                  ENDIF 
    321321                  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 
    324323                     iobs = iobs + 1 
    325324                  ENDIF 
     
    364363      DO jj = 1, inobf 
    365364         DO ji = 1, inpfiles(jj)%nobs 
    366             IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    367             IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 
     365            IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     366            IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 
    368367            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    369368               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    378377      DO jj = 1, inobf 
    379378         DO ji = 1, inpfiles(jj)%nobs 
    380             IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    381             IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 
     379            IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     380            IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 
    382381            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    383382               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    409408         ji = islaidx(iindx(jk)) 
    410409 
    411          IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    412          IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE 
     410         IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     411         IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) ) CYCLE 
    413412 
    414413         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  & 
     
    423422            ! Set observation information 
    424423             
    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 
    427425 
    428426               iobs = iobs + 1 
  • branches/UKMO/dev_rev5518_OBS_DoNotAssim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sst.F90

    r4990 r7841  
    282282                  ENDIF 
    283283                  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 
    286285                     iobs = iobs + 1 
    287286                  ENDIF 
     
    354353            ! Set observation information 
    355354             
    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 
    358356 
    359357               iobs = iobs + 1 
  • branches/UKMO/dev_rev5518_OBS_DoNotAssim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_vel.F90

    r4990 r7841  
    326326                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    327327                           & 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 ) ) THEN 
     328                        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 
    331331                           iuv3dt = iuv3dt + 1 
    332332                           llvalprof = .TRUE. 
     
    413413                  & CYCLE 
    414414                
    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 ) ) THEN 
     415               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 
    418418 
    419419                  llvalprof = .TRUE. 
     
    492492                     & CYCLE 
    493493 
    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 ) ) THEN 
     494                  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 
    497497                     iuv3dt = iuv3dt + 1 
    498498                  ELSE 
  • branches/UKMO/dev_rev5518_OBS_DoNotAssim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90

    r3294 r7841  
    155155 
    156156! mark any masked data with a QC flag 
    157             IF( zobsmask(1) == 0 )   sladata(jslano)%nqc(jobs) = 11 
     157            IF( zobsmask(1) == 0 )   sladata(jslano)%nqc(jobs) = IBSET(sladata(jslano)%nqc(jobs),15) 
    158158 
    159159         END DO 
  • branches/UKMO/dev_rev5518_OBS_DoNotAssim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90

    r4990 r7841  
    173173         fbdata%ivqc(jo,:)    = profdata%ivqc(jo,:) 
    174174         fbdata%ivqcf(:,jo,:) = profdata%ivqcf(:,jo,:) 
    175          IF ( profdata%nqc(jo) > 10 ) THEN 
    176             fbdata%ioqc(jo)    = 4 
     175         IF ( profdata%nqc(jo) > 255 ) THEN 
     176            fbdata%ioqc(jo)    = IBSET(profdata%nqc(jo),2) 
    177177            fbdata%ioqcf(1,jo) = profdata%nqcf(1,jo) 
    178             fbdata%ioqcf(2,jo) = profdata%nqc(jo) - 10 
     178            fbdata%ioqcf(2,jo) = profdata%nqc(jo) 
    179179         ELSE 
    180180            fbdata%ioqc(jo)    = profdata%nqc(jo) 
     
    213213               fbdata%idqc(ik,jo)        = profdata%var(jvar)%idqc(jk) 
    214214               fbdata%idqcf(:,ik,jo)     = profdata%var(jvar)%idqcf(:,jk) 
    215                IF ( profdata%var(jvar)%nvqc(jk) > 10 ) THEN 
    216                   fbdata%ivlqc(ik,jo,jvar) = 4 
     215               IF ( profdata%var(jvar)%nvqc(jk) > 255 ) THEN 
     216                  fbdata%ivlqc(ik,jo,jvar) = IBSET(profdata%var(jvar)%nvqc(jk),2) 
    217217                  fbdata%ivlqcf(1,ik,jo,jvar) = profdata%var(jvar)%nvqcf(1,jk) 
    218                   fbdata%ivlqcf(2,ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) - 10 
     218                  fbdata%ivlqcf(2,ik,jo,jvar) = IAND(profdata%var(jvar)%nvqc(jk),b'0000 0000 1111 1111') 
    219219               ELSE 
    220220                  fbdata%ivlqc(ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) 
     
    360360         fbdata%ivqc(jo,:)    = 0 
    361361         fbdata%ivqcf(:,jo,:) = 0 
    362          IF ( sladata%nqc(jo) > 10 ) THEN 
     362         IF ( sladata%nqc(jo) > 255 ) THEN 
    363363            fbdata%ioqc(jo)    = 4 
    364364            fbdata%ioqcf(1,jo) = 0 
    365             fbdata%ioqcf(2,jo) = sladata%nqc(jo) - 10 
     365            fbdata%ioqcf(2,jo) =  IAND(sladata%nqc(jo),b'0000 0000 1111 1111') 
    366366         ELSE 
    367367            fbdata%ioqc(jo)    = sladata%nqc(jo) 
     
    395395         fbdata%idqc(1,jo)     = 0 
    396396         fbdata%idqcf(:,1,jo)  = 0 
    397          IF ( sladata%nqc(jo) > 10 ) THEN 
     397         IF ( sladata%nqc(jo) > 255 ) THEN 
    398398            fbdata%ivqc(jo,1)       = 4 
    399399            fbdata%ivlqc(1,jo,1)    = 4 
    400400            fbdata%ivlqcf(1,1,jo,1) = 0 
    401             fbdata%ivlqcf(2,1,jo,1) = sladata%nqc(jo) - 10 
     401            fbdata%ivlqcf(2,1,jo,1) =  IAND(sladata%nqc(jo),b'0000 0000 1111 1111') 
    402402         ELSE 
    403403            fbdata%ivqc(jo,1)       = sladata%nqc(jo) 
     
    514514         fbdata%ivqc(jo,:)    = 0 
    515515         fbdata%ivqcf(:,jo,:) = 0 
    516          IF ( sstdata%nqc(jo) > 10 ) THEN 
     516         IF ( sstdata%nqc(jo) > 255 ) THEN 
    517517            fbdata%ioqc(jo)    = 4 
    518518            fbdata%ioqcf(1,jo) = 0 
    519             fbdata%ioqcf(2,jo) = sstdata%nqc(jo) - 10 
     519            fbdata%ioqcf(2,jo) = IAND(sstdata%nqc(jo), b'0000 0000 1111 1111') 
    520520         ELSE 
    521521            fbdata%ioqc(jo)    = MAX(sstdata%nqc(jo),1) 
     
    548548         fbdata%idqc(1,jo)     = 0 
    549549         fbdata%idqcf(:,1,jo)  = 0 
    550          IF ( sstdata%nqc(jo) > 10 ) THEN 
     550         IF ( sstdata%nqc(jo) > 255 ) THEN 
    551551            fbdata%ivqc(jo,1)       = 4 
    552552            fbdata%ivlqc(1,jo,1)    = 4 
    553553            fbdata%ivlqcf(1,1,jo,1) = 0 
    554             fbdata%ivlqcf(2,1,jo,1) = sstdata%nqc(jo) - 10 
     554            fbdata%ivlqcf(2,1,jo,1) = IAND(sstdata%nqc(jo), b'0000 0000 1111 1111') 
    555555         ELSE 
    556556            fbdata%ivqc(jo,1)       = MAX(sstdata%nqc(jo),1) 
     
    670670         fbdata%ivqc(jo,:)    = 0 
    671671         fbdata%ivqcf(:,jo,:) = 0 
    672          IF ( seaicedata%nqc(jo) > 10 ) THEN 
     672         IF ( seaicedata%nqc(jo) > 255 ) THEN 
    673673            fbdata%ioqc(jo)    = 4 
    674674            fbdata%ioqcf(1,jo) = 0 
    675             fbdata%ioqcf(2,jo) = seaicedata%nqc(jo) - 10 
     675            fbdata%ioqcf(2,jo) = IAND(seaicedata%nqc(jo),b'0000 0000 1111 1111') 
    676676         ELSE 
    677677            fbdata%ioqc(jo)    = MAX(seaicedata%nqc(jo),1) 
     
    704704         fbdata%idqc(1,jo)     = 0 
    705705         fbdata%idqcf(:,1,jo)  = 0 
    706          IF ( seaicedata%nqc(jo) > 10 ) THEN 
     706         IF ( seaicedata%nqc(jo) > 255 ) THEN 
    707707            fbdata%ivlqc(1,jo,1) = 4 
    708708            fbdata%ivlqcf(1,1,jo,1) = 0 
    709             fbdata%ivlqcf(2,1,jo,1) = seaicedata%nqc(jo) - 10 
     709            fbdata%ivlqcf(2,1,jo,1) = IAND(seaicedata%nqc(jo),b'0000 0000 1111 1111') 
    710710         ELSE 
    711711            fbdata%ivlqc(1,jo,1) = MAX(seaicedata%nqc(jo),1) 
     
    849849         fbdata%ivqc(jo,:)    = profdata%ivqc(jo,:) 
    850850         fbdata%ivqcf(:,jo,:) = profdata%ivqcf(:,jo,:) 
    851          IF ( profdata%nqc(jo) > 10 ) THEN 
     851         IF ( profdata%nqc(jo) > 255 ) THEN 
    852852            fbdata%ioqc(jo)    = 4 
    853853            fbdata%ioqcf(1,jo) = profdata%nqcf(1,jo) 
    854             fbdata%ioqcf(2,jo) = profdata%nqc(jo) - 10 
     854            fbdata%ioqcf(2,jo) = IAND(profdata%nqc(jo), b'0000 0000 1111 1111') 
    855855         ELSE 
    856856            fbdata%ioqc(jo)    = profdata%nqc(jo) 
     
    894894               fbdata%idqc(ik,jo)        = profdata%var(jvar)%idqc(jk) 
    895895               fbdata%idqcf(:,ik,jo)     = profdata%var(jvar)%idqcf(:,jk) 
    896                IF ( profdata%var(jvar)%nvqc(jk) > 10 ) THEN 
     896               IF ( profdata%var(jvar)%nvqc(jk) > 255 ) THEN 
    897897                  fbdata%ivlqc(ik,jo,jvar) = 4 
    898898                  fbdata%ivlqcf(1,ik,jo,jvar) = profdata%var(jvar)%nvqcf(1,jk) 
    899                   fbdata%ivlqcf(2,ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) - 10 
     899                  fbdata%ivlqcf(2,ik,jo,jvar) = IAND(profdata%nqc(jo), b'0000 0000 1111 1111') 
    900900               ELSE 
    901901                  fbdata%ivlqc(ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) 
Note: See TracChangeset for help on using the changeset viewer.