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 7841 for branches/UKMO/dev_rev5518_OBS_DoNotAssim/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90 – NEMO

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

Added "Do not Assimlate" funtionality to OBS code

File:
1 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 
Note: See TracChangeset for help on using the changeset viewer.