New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 7915 – NEMO

Changeset 7915


Ignore:
Timestamp:
2017-04-18T10:24:44+02:00 (8 years ago)
Author:
jwhile
Message:

Added code for 'Do not assimilate flags'

Location:
branches/UKMO/obs_oper_do_not_assim_update/NEMOGCM/NEMO/OPA_SRC/OBS
Files:
5 edited

Legend:

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

    r7837 r7915  
    5252CONTAINS 
    5353 
    54    SUBROUTINE obs_pre_surf( surfdata, surfdataqc, ld_nea, ld_bound_reject ) 
     54   SUBROUTINE obs_pre_surf( surfdata, surfdataqc, ld_nea, ld_bound_reject, & 
     55                            kqc_cutoff ) 
    5556      !!---------------------------------------------------------------------- 
    5657      !!                    ***  ROUTINE obs_pre_sla  *** 
     
    8283      LOGICAL, INTENT(IN) :: ld_nea                ! Switch for rejecting observation near land 
    8384      LOGICAL, INTENT(IN) :: ld_bound_reject       ! Switch for rejecting obs near the boundary 
     85      INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff   ! cut off for QC value 
    8486      !! * Local declarations 
     87      INTEGER :: iqc_cutoff = 255   ! cut off for QC value 
    8588      INTEGER :: iyea0        ! Initial date 
    8689      INTEGER :: imon0        !  - (year, month, day, hour, minute) 
     
    130133      ibdysobs = 0  
    131134 
     135      ! Set QC cutoff to optional value if provided 
     136      IF ( PRESENT(kqc_cutoff) ) iqc_cutoff=kqc_cutoff 
     137 
    132138      ! ----------------------------------------------------------------------- 
    133139      ! Find time coordinate for surface data 
     
    138144         &              surfdata%nsurf,   surfdata%nyea, surfdata%nmon, & 
    139145         &              surfdata%nday,    surfdata%nhou, surfdata%nmin, & 
    140          &              surfdata%nqc,     surfdata%mstp, iotdobs        ) 
     146         &              surfdata%nqc,     surfdata%mstp, iotdobs,       & 
     147         &              kqc_cutoff = iqc_cutoff  ) 
    141148 
    142149      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp ) 
     
    179186      ALLOCATE( llvalid(surfdata%nsurf) ) 
    180187       
    181       ! We want all data which has qc flags <= 10 
    182  
    183       llvalid(:)  = ( surfdata%nqc(:)  <= 10 ) 
     188      ! We want all data which has qc flags <= iqc_cutoff 
     189 
     190      llvalid(:)  = ( surfdata%nqc(:)  <= iqc_cutoff ) 
    184191 
    185192      ! The actual copying 
     
    251258      &                     kpi, kpj, kpk, & 
    252259      &                     zmask1, pglam1, pgphi1, zmask2, pglam2, pgphi2,  & 
    253       &                     ld_nea, ld_bound_reject, kdailyavtypes ) 
     260      &                     ld_nea, ld_bound_reject, kdailyavtypes,  kqc_cutoff ) 
    254261 
    255262!!---------------------------------------------------------------------- 
     
    292299         & pgphi1, & 
    293300         & pgphi2 
     301      INTEGER, INTENT(IN), OPTIONAL :: kqc_cutoff   ! cut off for QC value 
    294302 
    295303      !! * Local declarations 
     304      INTEGER :: iqc_cutoff = 255   ! cut off for QC value 
    296305      INTEGER :: iyea0        ! Initial date 
    297306      INTEGER :: imon0        !  - (year, month, day, hour, minute) 
     
    361370      iuvchkv   = 0 
    362371 
     372 
     373      ! Set QC cutoff to optional value if provided 
     374      IF ( PRESENT(kqc_cutoff) ) iqc_cutoff=kqc_cutoff 
     375 
    363376      ! ----------------------------------------------------------------------- 
    364377      ! Find time coordinate for profiles 
     
    371384            &              profdata%nday,    profdata%nhou, profdata%nmin, & 
    372385            &              profdata%ntyp,    profdata%nqc,  profdata%mstp, & 
    373             &              iotdobs, kdailyavtypes = kdailyavtypes ) 
     386            &              iotdobs, kdailyavtypes = kdailyavtypes,         & 
     387            &              kqc_cutoff = iqc_cutoff ) 
    374388      ELSE 
    375389         CALL obs_coo_tim_prof( icycle, & 
     
    378392            &              profdata%nday,    profdata%nhou, profdata%nmin, & 
    379393            &              profdata%ntyp,    profdata%nqc,  profdata%mstp, & 
    380             &              iotdobs ) 
     394            &              iotdobs,          kqc_cutoff = iqc_cutoff ) 
    381395      ENDIF 
    382396 
     
    395409 
    396410      ! ----------------------------------------------------------------------- 
    397       ! Reject all observations for profiles with nqc > 10 
    398       ! ----------------------------------------------------------------------- 
    399  
    400       CALL obs_pro_rej( profdata ) 
     411      ! Reject all observations for profiles with nqc > iqc_cutoff 
     412      ! ----------------------------------------------------------------------- 
     413 
     414      CALL obs_pro_rej( profdata, kqc_cutoff = iqc_cutoff ) 
    401415 
    402416      ! ----------------------------------------------------------------------- 
     
    419433         &                 iosdv1obs,             ilanv1obs,            & 
    420434         &                 inlav1obs,             ld_nea,               & 
    421          &                 ibdyv1obs,             ld_bound_reject       ) 
     435         &                 ibdyv1obs,             ld_bound_reject,      & 
     436         &                 iqc_cutoff       ) 
    422437 
    423438      CALL obs_mpp_sum_integer( iosdv1obs, iosdv1obsmpp ) 
     
    440455         &                 iosdv2obs,             ilanv2obs,            & 
    441456         &                 inlav2obs,             ld_nea,               & 
    442          &                 ibdyv2obs,             ld_bound_reject       ) 
     457         &                 ibdyv2obs,             ld_bound_reject,      & 
     458         &                 iqc_cutoff       ) 
    443459 
    444460      CALL obs_mpp_sum_integer( iosdv2obs, iosdv2obsmpp ) 
     
    452468 
    453469      IF ( TRIM(profdata%cvars(1)) == 'UVEL' ) THEN 
    454          CALL obs_uv_rej( profdata, iuvchku, iuvchkv ) 
     470         CALL obs_uv_rej( profdata, iuvchku, iuvchkv, iqc_cutoff ) 
    455471         CALL obs_mpp_sum_integer( iuvchku, iuvchkumpp ) 
    456472         CALL obs_mpp_sum_integer( iuvchkv, iuvchkvmpp ) 
     
    469485      END DO 
    470486 
    471       ! We want all data which has qc flags = 0 
    472  
    473       llvalid%luse(:) = ( profdata%nqc(:)  <= 10 ) 
     487      ! We want all data which has qc flags <= iqc_cutoff 
     488 
     489      llvalid%luse(:) = ( profdata%nqc(:)  <= iqc_cutoff ) 
    474490      DO jvar = 1,profdata%nvar 
    475          llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= 10 ) 
     491         llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= iqc_cutoff ) 
    476492      END DO 
    477493 
     
    783799      &                    kobsno,                                        & 
    784800      &                    kobsyea, kobsmon, kobsday, kobshou, kobsmin,   & 
    785       &                    ktyp,    kobsqc,  kobsstp, kotdobs, kdailyavtypes ) 
     801      &                    ktyp,    kobsqc,  kobsstp, kotdobs, kdailyavtypes, & 
     802      &                    kqc_cutoff ) 
    786803      !!---------------------------------------------------------------------- 
    787804      !!                    ***  ROUTINE obs_coo_tim *** 
     
    827844      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    828845         & kdailyavtypes    ! Types for daily averages 
     846      INTEGER, OPTIONAL, INTENT(IN) :: kqc_cutoff           ! QC cutoff value 
     847 
    829848      !! * Local declarations 
    830849      INTEGER :: jobs 
     850      INTEGER :: iqc_cutoff=255 
    831851 
    832852      !----------------------------------------------------------------------- 
     
    847867         DO jobs = 1, kobsno 
    848868             
    849             IF ( kobsqc(jobs) <= 10 ) THEN 
     869            IF ( kobsqc(jobs) <= iqc_cutoff ) THEN 
    850870                
    851871               IF ( ( kobsstp(jobs) == (nit000 - 1) ).AND.& 
    852872                  & ( ANY (kdailyavtypes(:) == ktyp(jobs)) ) ) THEN 
    853                   kobsqc(jobs) = kobsqc(jobs) + 14 
     873                  kobsqc(jobs) = IBSET(kobsqc(jobs),13) 
    854874                  kotdobs      = kotdobs + 1 
    855875                  CYCLE 
     
    894914      DO jobs = 1, kobsno 
    895915         IF ( ( kobsi(jobs) <= 0 ) .AND. ( kobsj(jobs) <= 0 ) ) THEN 
    896             kobsqc(jobs) = kobsqc(jobs) + 18 
     916            kobsqc(jobs) = IBSET(kobsqc(jobs),12) 
    897917            kgrdobs = kgrdobs + 1 
    898918         ENDIF 
     
    906926      &                       kobsqc, kosdobs, klanobs,          & 
    907927      &                       knlaobs,ld_nea,                    & 
    908       &                       kbdyobs,ld_bound_reject            ) 
     928      &                       kbdyobs,ld_bound_reject,           & 
     929      &                       kqc_cutoff                         ) 
    909930      !!---------------------------------------------------------------------- 
    910931      !!                    ***  ROUTINE obs_coo_spc_2d  *** 
     
    945966      LOGICAL, INTENT(IN)    :: ld_nea           ! Flag observations near land 
    946967      LOGICAL, INTENT(IN)    :: ld_bound_reject  ! Flag observations near open boundary  
     968      INTEGER, INTENT(IN)    :: kqc_cutoff       ! Cutoff QC value 
     969 
    947970      !! * Local declarations 
    948971      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
     
    969992         ! For invalid points use 2,2 
    970993 
    971          IF ( kobsqc(jobs) >= 10 ) THEN 
     994         IF ( kobsqc(jobs) >= kqc_cutoff ) THEN 
    972995 
    973996            igrdi(1,1,jobs) = 1 
     
    10161039 
    10171040         ! Skip bad observations 
    1018          IF ( kobsqc(jobs) >= 10 ) CYCLE 
     1041         IF ( kobsqc(jobs) >= kqc_cutoff ) CYCLE 
    10191042 
    10201043         ! Flag if the observation falls outside the model spatial domain 
     
    10231046            &  .OR. ( pobsphi(jobs) <  -90. ) & 
    10241047            &  .OR. ( pobsphi(jobs) >   90. ) ) THEN 
    1025             kobsqc(jobs) = kobsqc(jobs) + 11 
     1048            kobsqc(jobs) = IBSET(kobsqc(jobs),11) 
    10261049            kosdobs = kosdobs + 1 
    10271050            CYCLE 
     
    10301053         ! Flag if the observation falls with a model land cell 
    10311054         IF ( SUM( zgmsk(1:2,1:2,jobs) ) == 0.0_wp ) THEN 
    1032             kobsqc(jobs) = kobsqc(jobs)  + 12 
     1055            kobsqc(jobs) = IBSET(kobsqc(jobs),10) 
    10331056            klanobs = klanobs + 1 
    10341057            CYCLE 
     
    10551078         IF (lgridobs) THEN 
    10561079            IF (zgmsk(iig,ijg,jobs) == 0.0_wp ) THEN 
    1057                kobsqc(jobs) = kobsqc(jobs) + 12 
     1080               kobsqc(jobs) = IBSET(kobsqc(jobs),10) 
    10581081               klanobs = klanobs + 1 
    10591082               CYCLE 
     
    10661089            knlaobs = knlaobs + 1 
    10671090            IF (ld_nea) THEN 
    1068                kobsqc(jobs) = kobsqc(jobs) + 14 
     1091               kobsqc(jobs) = IBSET(kobsqc(jobs),9) 
    10691092               CYCLE 
    10701093            ENDIF 
     
    11011124      &                       kpobsqc, kobsqc,  kosdobs,        & 
    11021125      &                       klanobs, knlaobs, ld_nea,         & 
    1103       &                       kbdyobs, ld_bound_reject          ) 
     1126      &                       kbdyobs, ld_bound_reject,         & 
     1127      &                       kqc_cutoff                        ) 
    11041128      !!---------------------------------------------------------------------- 
    11051129      !!                    ***  ROUTINE obs_coo_spc_3d  *** 
     
    11691193      LOGICAL, INTENT(IN) :: ld_nea         ! Flag observations near land 
    11701194      LOGICAL, INTENT(IN) :: ld_bound_reject  ! Flag observations near open boundary 
     1195      INTEGER, INTENT(IN) :: kqc_cutoff     ! Cutoff QC value 
     1196 
    11711197      !! * Local declarations 
    11721198      REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: & 
     
    11961222         ! For invalid points use 2,2 
    11971223 
    1198          IF ( kpobsqc(jobs) >= 10 ) THEN 
     1224         IF ( kpobsqc(jobs) >= kqc_cutoff ) THEN 
    11991225             
    12001226            igrdi(1,1,jobs) = 1 
     
    12461272 
    12471273         ! Skip bad profiles 
    1248          IF ( kpobsqc(jobs) >= 10 ) CYCLE 
     1274         IF ( kpobsqc(jobs) >= kqc_cutoff ) CYCLE 
    12491275 
    12501276         ! Check if this observation is on a grid point 
     
    12841310               &  .OR. ( pobsdep(jobsp) < 0.0          )       & 
    12851311               &  .OR. ( pobsdep(jobsp) > gdepw_1d(kpk)) ) THEN 
    1286                kobsqc(jobsp) = kobsqc(jobsp) + 11 
     1312               kobsqc(jobsp) = IBSET(kobsqc(jobsp),11) 
    12871313               kosdobs = kosdobs + 1 
    12881314               CYCLE 
     
    12991325               IF ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) &  
    13001326                  &  == 0.0_wp ) THEN  
    1301                   kobsqc(jobsp) = kobsqc(jobsp) + 12  
     1327                  kobsqc(jobsp) = IBSET(kobsqc(jobsp),10) 
    13021328                  klanobs = klanobs + 1  
    13031329                  CYCLE  
     
    13091335                  knlaobs = knlaobs + 1  
    13101336                  IF (ld_nea) THEN    
    1311                      kobsqc(jobsp) = kobsqc(jobsp) + 14   
     1337                     kobsqc(jobsp) = IBSET(kobsqc(jobsp),10) 
    13121338                  ENDIF   
    13131339               ENDIF  
     
    13201346                  &  ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) & 
    13211347                  &  == 0.0_wp) ) THEN 
    1322                   kobsqc(jobsp) = kobsqc(jobsp) + 12  
     1348                  kobsqc(jobsp) = IBSET(kobsqc(jobsp),10) 
    13231349                  klanobs = klanobs + 1  
    13241350                  CYCLE  
     
    13291355                  knlaobs = knlaobs + 1  
    13301356                  IF (ld_nea) THEN    
    1331                      kobsqc(jobsp) = kobsqc(jobsp) + 14   
     1357                     kobsqc(jobsp) = IBSET(kobsqc(jobsp),10) 
    13321358                  ENDIF   
    13331359               ENDIF  
     
    13751401   END SUBROUTINE obs_coo_spc_3d 
    13761402 
    1377    SUBROUTINE obs_pro_rej( profdata ) 
     1403   SUBROUTINE obs_pro_rej( profdata, kqc_cutoff ) 
    13781404      !!---------------------------------------------------------------------- 
    13791405      !!                    ***  ROUTINE obs_pro_rej *** 
     
    13931419      !! * Arguments 
    13941420      TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Profile data 
     1421      INTEGER, INTENT(IN) :: kqc_cutoff             ! QC cutoff value 
     1422 
    13951423      !! * Local declarations 
    13961424      INTEGER :: jprof 
     
    14021430      DO jprof = 1, profdata%nprof 
    14031431 
    1404          IF ( profdata%nqc(jprof) > 10 ) THEN 
     1432         IF ( profdata%nqc(jprof) > kqc_cutoff ) THEN 
    14051433             
    14061434            DO jvar = 1, profdata%nvar 
     
    14101438                   
    14111439                  profdata%var(jvar)%nvqc(jobs) = & 
    1412                      & profdata%var(jvar)%nvqc(jobs) + 26 
     1440                     & IBSET(profdata%var(jvar)%nvqc(jobs),14) 
    14131441 
    14141442               END DO 
     
    14221450   END SUBROUTINE obs_pro_rej 
    14231451 
    1424    SUBROUTINE obs_uv_rej( profdata, knumu, knumv ) 
     1452   SUBROUTINE obs_uv_rej( profdata, knumu, knumv, kqc_cutof ) 
    14251453      !!---------------------------------------------------------------------- 
    14261454      !!                    ***  ROUTINE obs_uv_rej *** 
     
    14421470      INTEGER, INTENT(INOUT) :: knumu             ! Number of u rejected 
    14431471      INTEGER, INTENT(INOUT) :: knumv             ! Number of v rejected 
     1472      INTEGER, INTENT(IN) :: kqc_cutoff           ! QC cutoff value 
     1473 
    14441474      !! * Local declarations 
    14451475      INTEGER :: jprof 
     
    14611491         DO jobs = profdata%npvsta(jprof,1), profdata%npvend(jprof,1) 
    14621492             
    1463             IF ( ( profdata%var(1)%nvqc(jobs) > 10 ) .AND. & 
    1464                & ( profdata%var(2)%nvqc(jobs) <= 10) ) THEN 
    1465                profdata%var(2)%nvqc(jobs) = profdata%var(2)%nvqc(jobs) + 42 
     1493            IF ( ( profdata%var(1)%nvqc(jobs) >  kqc_cutoff ) .AND. & 
     1494               & ( profdata%var(2)%nvqc(jobs) <=  kqc_cutoff) ) THEN 
     1495               profdata%var(2)%nvqc(jobs) = IBSET(profdata%var(1)%nvqc(jobs),15) 
    14661496               knumv = knumv + 1 
    14671497            ENDIF 
    1468             IF ( ( profdata%var(2)%nvqc(jobs) > 10 ) .AND. & 
    1469                & ( profdata%var(1)%nvqc(jobs) <= 10) ) THEN 
    1470                profdata%var(1)%nvqc(jobs) = profdata%var(1)%nvqc(jobs) + 42 
     1498            IF ( ( profdata%var(2)%nvqc(jobs) >  kqc_cutoff ) .AND. & 
     1499               & ( profdata%var(1)%nvqc(jobs) <=  kqc_cutoff) ) THEN 
     1500               profdata%var(1)%nvqc(jobs) = IBSET(profdata%var(1)%nvqc(jobs),15) 
    14711501               knumu = knumu + 1 
    14721502            ENDIF 
  • branches/UKMO/obs_oper_do_not_assim_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90

    r7837 r7915  
    307307            inowin = 0 
    308308            DO ji = 1, inpfiles(jj)%nobs 
    309                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    310                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    311                   & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     309               IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     310               IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
     311                  & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
    312312               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    313313                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    325325            inowin = 0 
    326326            DO ji = 1, inpfiles(jj)%nobs 
    327                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    328                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    329                   & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     327               IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     328               IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
     329                  & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
    330330               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    331331                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    351351            inowin = 0 
    352352            DO ji = 1, inpfiles(jj)%nobs 
    353                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    354                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    355                   & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     353               IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     354               IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
     355                  & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
    356356               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    357357                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    373373 
    374374            DO ji = 1, inpfiles(jj)%nobs 
    375                IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    376                IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    377                   & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     375               IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     376               IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
     377                  & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
    378378               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    379379                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    388388                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    389389                           & CYCLE 
    390                         IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    391                            & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
     390                        IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
     391                           & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    392392                           ivar1t0 = ivar1t0 + 1 
    393393                        ENDIF 
     
    398398                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    399399                           & CYCLE 
    400                         IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    401                            & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
     400                        IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
     401                           & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    402402                           ivar2t0 = ivar2t0 + 1 
    403403                        ENDIF 
     
    407407                     IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) & 
    408408                        & CYCLE 
    409                      IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    410                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    411                         &     ldvar1 ) .OR. & 
    412                         & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    413                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
     409                     IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
     410                        &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
     411                        &    ldt3d ) .OR. & 
     412                        & ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
     413                        &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
    414414                        &     ldvar2 ) ) THEN 
    415415                        ip3dt = ip3dt + 1 
     
    437437      DO jj = 1, inobf 
    438438         DO ji = 1, inpfiles(jj)%nobs 
    439             IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    440             IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    441                & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     439            IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     440            IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
     441               & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
    442442            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    443443               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    452452      DO jj = 1, inobf 
    453453         DO ji = 1, inpfiles(jj)%nobs 
    454             IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    455             IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    456                & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     454            IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     455            IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
     456               & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
    457457            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. & 
    458458               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN 
     
    501501         ji = iprofidx(iindx(jk)) 
    502502 
    503          IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    504          IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    505             & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE 
     503            IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     504            IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
     505               & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
    506506 
    507507         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  & 
     
    518518            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE 
    519519 
    520             IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. & 
    521                & ( inpfiles(jj)%ivqc(ji,2) > 2 ) ) CYCLE 
     520            IF ( BTEST(inpfiles(jj)%ioqc(ji),2 ) ) CYCLE 
     521            IF ( BTEST(inpfiles(jj)%ivqc(ji,1),2) .AND. & 
     522               & BTEST(inpfiles(jj)%ivqc(ji,2),2) ) CYCLE 
    522523 
    523524            loop_prof : DO ij = 1, inpfiles(jj)%nlev 
     
    526527                  & CYCLE 
    527528 
    528                IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    529                   & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
     529               IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
     530                  & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    530531 
    531532                  llvalprof = .TRUE.  
     
    534535               ENDIF 
    535536 
    536                IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    537                   & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
     537               IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
     538                  & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    538539 
    539540                  llvalprof = .TRUE.  
     
    615616                  IF (ldsatt) THEN 
    616617 
    617                      IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    618                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    619                         &     ldvar1 ) .OR. & 
    620                         & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    621                         &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    622                         &     ldvar2 ) ) THEN 
     618                     IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
     619                        &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
     620                        &    ldt3d ) .OR. & 
     621                        & ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
     622                        &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
     623                        &   lds3d ) ) THEN 
    623624                        ip3dt = ip3dt + 1 
    624625                     ELSE 
     
    628629                  ENDIF 
    629630 
    630                   IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    631                      &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
    632                      &       ldvar1 ) .OR. ldsatt ) THEN 
     631                  IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
     632                    &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
     633                    &    ldt3d ) .OR. ldsatt ) THEN 
    633634 
    634635                     IF (ldsatt) THEN 
     
    661662 
    662663                     ! Profile var1 value 
    663                      IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. & 
    664                         & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
     664                     IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,1),2) .AND. & 
     665                        & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    665666                        profdata%var(1)%vobs(ivar1t) = & 
    666667                           &                inpfiles(jj)%pob(ij,ji,1) 
     
    692693                  ENDIF 
    693694 
    694                   IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    695                      &   ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. & 
     695                  IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
     696                     & .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) ) THEN 
    696697                     &   ldvar2 ) .OR. ldsatt ) THEN 
    697698 
     
    725726 
    726727                     ! Profile var2 value 
    727                      IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. & 
    728                         & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN 
     728                  IF ( ( .NOT. BTEST(inpfiles(jj)%ivlqc(ij,ji,2),2) .AND. & 
     729                    &   .NOT. BTEST(inpfiles(jj)%idqc(ij,ji),2) .AND. & 
    729730                        profdata%var(2)%vobs(ivar2t) = & 
    730731                           &                inpfiles(jj)%pob(ij,ji,2) 
  • branches/UKMO/obs_oper_do_not_assim_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_surf.F90

    r7837 r7915  
    294294                  ENDIF 
    295295                  llvalprof = .FALSE. 
    296                   IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. & 
    297                      & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN 
     296                  IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(1,ji,1),2) ) THEN 
    298297                     iobs = iobs + 1 
    299298                  ENDIF 
     
    367366            ! Set observation information 
    368367 
    369             IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. & 
    370                & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN 
     368            IF ( .NOT. BTEST(inpfiles(jj)%ivlqc(1,ji,1),2) ) THEN 
    371369 
    372370               iobs = iobs + 1 
  • branches/UKMO/obs_oper_do_not_assim_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90

    r7773 r7915  
    154154 
    155155! mark any masked data with a QC flag 
    156          IF( zobsmask(1) == 0 )   sladata%nqc(jobs) = 11 
     156         IF( zobsmask(1) == 0 )   sladata%nqc(jobs) = IBSET(sladata(jslano)%nqc(jobs),15) 
    157157 
    158158         END DO 
  • branches/UKMO/obs_oper_do_not_assim_update/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90

    r7837 r7915  
    196196         fbdata%ivqc(jo,:)    = profdata%ivqc(jo,:) 
    197197         fbdata%ivqcf(:,jo,:) = profdata%ivqcf(:,jo,:) 
    198          IF ( profdata%nqc(jo) > 10 ) THEN 
    199             fbdata%ioqc(jo)    = 4 
     198         IF ( profdata%nqc(jo) > 255 ) THEN 
     199            fbdata%ioqc(jo)    = IBSET(profdata%nqc(jo),2) 
    200200            fbdata%ioqcf(1,jo) = profdata%nqcf(1,jo) 
    201             fbdata%ioqcf(2,jo) = profdata%nqc(jo) - 10 
     201            fbdata%ioqcf(2,jo) = profdata%nqc(jo) 
    202202         ELSE 
    203203            fbdata%ioqc(jo)    = profdata%nqc(jo) 
     
    236236               fbdata%idqc(ik,jo)        = profdata%var(jvar)%idqc(jk) 
    237237               fbdata%idqcf(:,ik,jo)     = profdata%var(jvar)%idqcf(:,jk) 
    238                IF ( profdata%var(jvar)%nvqc(jk) > 10 ) THEN 
    239                   fbdata%ivlqc(ik,jo,jvar) = 4 
     238               IF ( profdata%var(jvar)%nvqc(jk) > 255 ) THEN 
     239                  fbdata%ivlqc(ik,jo,jvar) = IBSET(profdata%var(jvar)%nvqc(jk),2) 
    240240                  fbdata%ivlqcf(1,ik,jo,jvar) = profdata%var(jvar)%nvqcf(1,jk) 
    241                   fbdata%ivlqcf(2,ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) - 10 
     241                  fbdata%ivlqcf(2,ik,jo,jvar) = IAND(profdata%var(jvar)%nvqc(jk),b'0000 0000 1111 1111') 
    242242               ELSE 
    243243                  fbdata%ivlqc(ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) 
     
    558558         fbdata%ivqc(jo,:)    = 0 
    559559         fbdata%ivqcf(:,jo,:) = 0 
    560          IF ( surfdata%nqc(jo) > 10 ) THEN 
     560         IF ( surfdata%nqc(jo) > 255 ) THEN 
    561561            fbdata%ioqc(jo)    = 4 
    562562            fbdata%ioqcf(1,jo) = 0 
    563             fbdata%ioqcf(2,jo) = surfdata%nqc(jo) - 10 
     563            fbdata%ioqcf(2,jo) = IAND(surfdata%nqc(jo),b'0000 0000 1111 1111') 
    564564         ELSE 
    565565            fbdata%ioqc(jo)    = surfdata%nqc(jo) 
     
    593593         fbdata%idqc(1,jo)     = 0 
    594594         fbdata%idqcf(:,1,jo)  = 0 
    595          IF ( surfdata%nqc(jo) > 10 ) THEN 
     595         IF ( surfdata%nqc(jo) > 255 ) THEN 
    596596            fbdata%ivqc(jo,1)       = 4 
    597597            fbdata%ivlqc(1,jo,1)    = 4 
    598598            fbdata%ivlqcf(1,1,jo,1) = 0 
    599             fbdata%ivlqcf(2,1,jo,1) = surfdata%nqc(jo) - 10 
     599            fbdata%ivlqcf(2,1,jo,1) = IAND(surfdata%nqc(jo),b'0000 0000 1111 1111') 
    600600         ELSE 
    601601            fbdata%ivqc(jo,1)       = surfdata%nqc(jo) 
Note: See TracChangeset for help on using the changeset viewer.