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 6980 – NEMO

Changeset 6980


Ignore:
Timestamp:
2016-10-03T18:31:01+02:00 (8 years ago)
Author:
kingr
Message:

Update to add ability to reject observations near open boundaries.

Location:
branches/UKMO/dev_CO6_obs_bound_reject/NEMOGCM/NEMO/OPA_SRC/OBS
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_CO6_obs_bound_reject/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r6331 r6980  
    8787   LOGICAL, PUBLIC :: ln_ignmis      !: Logical switch for ignoring missing files 
    8888   LOGICAL, PUBLIC :: ln_s_at_t      !: Logical switch to compute model S at T observations 
     89   LOGICAL, PUBLIC :: ln_bound_reject !: Logical switch to reject observations near open boundaries 
    8990 
    9091   REAL(KIND=dp), PUBLIC :: dobsini   !: Observation window start date YYYYMMDD.HHMMSS 
    … …  
    163164         &            ln_sla, ln_sladt, ln_slafb,                     & 
    164165         &            ln_ssh, ln_sst, ln_sstfb, ln_sss, ln_nea,       & 
     166         &            ln_bound_reject,                                & 
    165167         &            enactfiles, coriofiles, profbfiles,             & 
    166168         &            slafilesact, slafilespas, slafbfiles,           & 
    … …  
    232234      ln_velfb_av(:) = .FALSE. 
    233235      ln_ignmis = .FALSE. 
     236      ln_bound_reject = .TRUE. 
    234237       
    235238      CALL ini_date( dobsini ) 
    … …  
    450453         WRITE(numout,*) '             Type of horizontal interpolation method        n2dint = ', n2dint 
    451454         WRITE(numout,*) '             Rejection of observations near land swithch    ln_nea = ', ln_nea 
     455         WRITE(numout,*) '             Rejection of obs near open bdys       ln_bound_reject = ', ln_bound_reject 
    452456         WRITE(numout,*) '             MSSH correction scheme                         nmsshc = ', nmsshc 
    453457         WRITE(numout,*) '             MDT  correction                               mdtcorr = ', mdtcorr 

  • branches/UKMO/dev_CO6_obs_bound_reject/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90

    r6331 r6980  
    2727   USE obs_inter_sup      ! Interpolation support 
    2828   USE obs_oper           ! Observation operators 
     29#if defined key_bdy 
     30   USE bdy_oce, ONLY : &        ! Boundary information 
     31      idx_bdy, nb_bdy 
     32#endif 
    2933   USE lib_mpp, ONLY : & 
    3034      & ctl_warn, ctl_stop 
    … …  
    4145      & obs_pre_seaice, & ! First level check and screening of sea ice data 
    4246      & obs_pre_vel, &     ! First level check and screening of velocity profiles 
    43       & calc_month_len     ! Calculate the number of days in the months of a year   
    44  
     47      & calc_month_len     ! Calculate the number of days in the months of a year 
     48    
    4549   !!---------------------------------------------------------------------- 
    4650   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    7579         & glamt,   & 
    7680         & gphit,   & 
    77          & gdept_1d,& 
     81         & gdept_0, & 
     82#if defined key_vvl 
     83         & gdepw_1, & 
     84         & gdept_1, & 
     85#else 
     86         & gdepw,   & 
     87         & gdept,   & 
     88#endif          
    7889         & tmask,   & 
     90         & ln_zco,  & 
     91         & ln_zps,  & 
    7992         & nproc 
    8093      !! * Arguments 
    … …  
    99112      INTEGER :: ilantobs      !  - within a model land cell (temperature) 
    100113      INTEGER :: ilansobs      !  - within a model land cell (salinity) 
     114      INTEGER :: ibdytobs      !  - boundary (temperature)  
     115      INTEGER :: ibdysobs      !  - boundary (salinity)       
    101116      INTEGER :: inlatobs      !  - close to land (temperature) 
    102117      INTEGER :: inlasobs      !  - close to land (salinity) 
    … …  
    110125      INTEGER :: inlatobsmpp   !  - close to land (temperature) 
    111126      INTEGER :: inlasobsmpp   !  - close to land (salinity) 
     127      INTEGER :: ibdytobsmpp   !  - boundary (temperature)  
     128      INTEGER :: ibdysobsmpp   !  - boundary (salinity)       
    112129      INTEGER :: igrdobsmpp    !  - fail the grid search 
    113130      TYPE(obs_prof_valid) ::  llvalid     ! Profile selection  
    … …  
    140157      inlatobs = 0 
    141158      inlasobs = 0 
     159      ibdytobs = 0 
     160      ibdysobs = 0 
    142161 
    143162      ! ----------------------------------------------------------------------- 
    … …  
    196215         &                 profdata%nqc,          profdata%var(1)%nvqc, & 
    197216         &                 iosdtobs,              ilantobs,             & 
    198          &                 inlatobs,              ld_nea                ) 
     217         &                 inlatobs,              ld_nea                & 
     218         &                 ibdytobs,              ld_bound_reject       ) 
    199219 
    200220      CALL obs_mpp_sum_integer( iosdtobs, iosdtobsmpp ) 
    201221      CALL obs_mpp_sum_integer( ilantobs, ilantobsmpp ) 
    202222      CALL obs_mpp_sum_integer( inlatobs, inlatobsmpp ) 
     223      CALL obs_mpp_sum_integer( ibdytobs, ibdytobsmpp ) 
    203224 
    204225      ! Salinity 
    … …  
    216237         &                 profdata%nqc,          profdata%var(2)%nvqc, & 
    217238         &                 iosdsobs,              ilansobs,             & 
    218          &                 inlasobs,              ld_nea                ) 
     239         &                 inlasobs,              ld_nea                & 
     240         &                 ibdysobs,              ld_bound_reject       ) 
    219241 
    220242      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    221243      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    222244      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
     245      CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 
    223246 
    224247      ! ----------------------------------------------------------------------- 
    … …  
    278301               &            inlatobsmpp 
    279302         ENDIF 
     303         WRITE(numout,*) ' Remaining T data near open boundary (removed) = ',& 
     304               &            ibdytobsmpp 
    280305         WRITE(numout,*) ' T data accepted                             = ', & 
    281306            &            prodatqc%nvprotmpp(1) 
    … …  
    291316               &            inlasobsmpp 
    292317         ENDIF 
     318         WRITE(numout,*) ' Remaining S data near open boundary (removed) = ',& 
     319               &            ibdysobsmpp 
    293320         WRITE(numout,*) ' S data accepted                             = ', & 
    294321            &            prodatqc%nvprotmpp(2) 
    … …  
    379406      INTEGER :: inlasobs     !  - close to land 
    380407      INTEGER :: igrdobs      !  - fail the grid search 
     408      INTEGER :: ibdysobs     !  - close to open boundary 
    381409                              ! Global counters for observations that 
    382410      INTEGER :: iotdobsmpp     !  - outside time domain 
    … …  
    385413      INTEGER :: inlasobsmpp    !  - close to land 
    386414      INTEGER :: igrdobsmpp     !  - fail the grid search 
     415      INTEGER :: ibdysobsmpp    !  - close to open boundary    
    387416      LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    388417         & llvalid            ! SLA data selection 
    … …  
    390419      INTEGER :: jstp         ! Time loop variable 
    391420      INTEGER :: inrc         ! Time index variable 
     421      INTEGER :: irec         ! Record index 
    392422 
    393423      IF(lwp) WRITE(numout,*)'obs_pre_sla : Preparing the SLA observations...' 
    … …  
    409439      ilansobs = 0 
    410440      inlasobs = 0 
     441      ibdysobs = 0 
    411442 
    412443      ! ----------------------------------------------------------------------- 
    … …  
    442473         &                 tmask(:,:,1), sladata%nqc,  & 
    443474         &                 iosdsobs,     ilansobs,     & 
    444          &                 inlasobs,     ld_nea        ) 
     475         &                 inlasobs,     ld_nea        & 
     476         &                 ibdysobs,     ln_bound_reject        ) 
    445477 
    446478      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    447479      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    448480      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
     481      CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 
    449482 
    450483      ! ----------------------------------------------------------------------- 
    … …  
    495528               &            inlasobsmpp 
    496529         ENDIF 
     530         WRITE(numout,*) ' Remaining SLA data near open boundary (removed) = ', & 
     531            &            ibdysobsmpp   
    497532         WRITE(numout,*) ' SLA data accepted                             = ', & 
    498533            &            sladatqc%nsurfmpp 
    … …  
    520555      ENDIF 
    521556 
     557      !--------------------------------------------------------- 
     558      ! Record handling 
     559      !--------------------------------------------------------- 
     560      ! First count the number of records 
     561      sladatqc%nrec = 0 
     562      DO jstp = nit000 - 1, nitend 
     563         inrc = jstp - nit000 + 2 
     564         IF ( sladatqc%nsstpmpp(inrc) > 0 ) THEN 
     565            sladatqc%nrec = sladatqc%nrec + 1 
     566         ENDIF 
     567      END DO 
     568      ! Allocate record data 
     569      ALLOCATE( & 
     570         & sladatqc%mrecstp(sladatqc%nrec) & 
     571         & ) 
     572      ! Finally save the time step corresponding to record rank 
     573      irec = 0 
     574      DO jstp = nit000 - 1, nitend 
     575         inrc = jstp - nit000 + 2 
     576         IF ( sladatqc%nsstpmpp(inrc) > 0 ) THEN 
     577            irec = irec + 1 
     578            sladatqc%mrecstp(irec) = inrc 
     579         ENDIF 
     580         IF ( lwp ) THEN 
     581            WRITE(numout,1999) inrc, sladatqc%nsstpmpp(inrc) 
     582         ENDIF 
     583      END DO 
     584      
     585      ! Print record information 
     586      IF( lwp ) THEN 
     587         WRITE(numout,*) 
     588         WRITE(numout,2000) 
     589         WRITE(numout,2001) 
     590         DO irec = 1, sladatqc%nrec 
     591            WRITE(numout,1999) irec, sladatqc%mrecstp(irec) 
     592         END DO 
     593      ENDIF 
     594 
     595 
    5225961997  FORMAT(10X,'Time step',5X,'Sea level anomaly') 
    5235971998  FORMAT(10X,'---------',5X,'-----------------') 
    5245981999  FORMAT(10X,I9,5X,I17) 
     5992000  FORMAT(15X,'Record',10X,'Time step') 
     6002001  FORMAT(15X,'------',10X,'---------') 
    525601 
    526602   END SUBROUTINE obs_pre_sla 
    … …  
    567643      INTEGER :: inlasobs     !  - close to land 
    568644      INTEGER :: igrdobs      !  - fail the grid search 
     645      INTEGER :: ibdysobs     !  - close to open boundary 
    569646                              ! Global counters for observations that 
    570647      INTEGER :: iotdobsmpp   !  - outside time domain 
    … …  
    573650      INTEGER :: inlasobsmpp  !  - close to land 
    574651      INTEGER :: igrdobsmpp   !  - fail the grid search 
     652      INTEGER :: ibdysobsmpp  !  - close to open boundary 
    575653      LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    576654         & llvalid            ! SST data selection 
    … …  
    578656      INTEGER :: jstp         ! Time loop variable 
    579657      INTEGER :: inrc         ! Time index variable 
     658      INTEGER :: irec         ! Record index 
    580659 
    581660      IF(lwp) WRITE(numout,*)'obs_pre_sst : Preparing the SST observations...' 
    … …  
    597676      ilansobs = 0 
    598677      inlasobs = 0 
     678      ibdysobs = 0  
    599679 
    600680      ! ----------------------------------------------------------------------- 
    … …  
    627707         &                 tmask(:,:,1), sstdata%nqc,  & 
    628708         &                 iosdsobs,     ilansobs,     & 
    629          &                 inlasobs,     ld_nea        ) 
     709         &                 inlasobs,     ld_nea        & 
     710         &                 ibdysobs,     ln_bound_reject        ) 
    630711 
    631712      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    632713      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    633714      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
     715      CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 
    634716 
    635717      ! ----------------------------------------------------------------------- 
    … …  
    680762               &            inlasobsmpp 
    681763         ENDIF 
     764         WRITE(numout,*) ' Remaining SST data near open boundary (removed) = ', & 
     765            &               ibdysobsmp 
    682766         WRITE(numout,*) ' SST data accepted                             = ', & 
    683767            &            sstdatqc%nsurfmpp 
    … …  
    705789      ENDIF 
    706790 
     791      !--------------------------------------------------------- 
     792      ! Record handling 
     793      !--------------------------------------------------------- 
     794      ! First count the number of records 
     795      sstdatqc%nrec = 0 
     796      DO jstp = nit000 - 1, nitend 
     797         inrc = jstp - nit000 + 2 
     798         IF ( sstdatqc%nsstpmpp(inrc) > 0 ) THEN 
     799            sstdatqc%nrec = sstdatqc%nrec + 1 
     800         ENDIF 
     801      END DO 
     802      ! Allocate record data 
     803      ALLOCATE( & 
     804         & sstdatqc%mrecstp(sstdatqc%nrec) & 
     805         & ) 
     806      ! Finally save the time step corresponding to record rank 
     807      irec = 0 
     808      DO jstp = nit000 - 1, nitend 
     809         inrc = jstp - nit000 + 2 
     810         IF ( sstdatqc%nsstpmpp(inrc) > 0 ) THEN 
     811            irec = irec + 1 
     812            sstdatqc%mrecstp(irec) = inrc 
     813         ENDIF 
     814         IF ( lwp ) THEN 
     815            WRITE(numout,1999) jstp, sstdatqc%nsstpmpp(inrc) 
     816         ENDIF 
     817      END DO 
     818      
     819      ! Print record information 
     820      IF( lwp ) THEN 
     821         WRITE(numout,*) 
     822         WRITE(numout,2000) 
     823         WRITE(numout,2001) 
     824         DO irec = 1, sstdatqc%nrec 
     825            WRITE(numout,1999) irec, sstdatqc%mrecstp(irec) - 1 
     826         END DO 
     827      ENDIF 
     828       
    7078291997  FORMAT(10X,'Time step',5X,'Sea surface temperature') 
    7088301998  FORMAT(10X,'---------',5X,'-----------------') 
    7098311999  FORMAT(10X,I9,5X,I17) 
     8322000  FORMAT(15X,'Record',10X,'Time step') 
     8332001  FORMAT(15X,'------',10X,'---------') 
    710834       
    711835   END SUBROUTINE obs_pre_sst 
    … …  
    752876      INTEGER :: inlasobs     !  - close to land 
    753877      INTEGER :: igrdobs      !  - fail the grid search 
     878      INTEGER :: ibdysobs     !  - close to open boundary 
    754879                              ! Global counters for observations that 
    755880      INTEGER :: iotdobsmpp   !  - outside time domain 
    … …  
    758883      INTEGER :: inlasobsmpp  !  - close to land 
    759884      INTEGER :: igrdobsmpp   !  - fail the grid search 
     885      INTEGER :: ibdysobsmpp  !  - close to open boundary 
    760886      LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    761887         & llvalid            ! data selection 
    … …  
    763889      INTEGER :: jstp         ! Time loop variable 
    764890      INTEGER :: inrc         ! Time index variable 
     891      INTEGER :: irec         ! Record index 
    765892 
    766893      IF (lwp) WRITE(numout,*)'obs_pre_seaice : Preparing the sea ice observations...' 
    … …  
    782909      ilansobs = 0 
    783910      inlasobs = 0 
     911      ibdysobs = 0 
    784912 
    785913      ! ----------------------------------------------------------------------- 
    … …  
    812940         &                 tmask(:,:,1),    seaicedata%nqc,  & 
    813941         &                 iosdsobs,        ilansobs,        & 
    814          &                 inlasobs,        ld_nea           ) 
     942         &                 inlasobs,        ld_nea           & 
     943         &                 ibdysobs,        ln_bound_reject           ) 
    815944 
    816945      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    817946      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    818947      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
     948      CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 
    819949 
    820950      ! ----------------------------------------------------------------------- 
    … …  
    865995               &            inlasobsmpp 
    866996         ENDIF 
     997         WRITE(numout,*) ' Remaining sea ice data near open boundary (removed) = ', & 
     998           &            ibdysobsmpp  
    867999         WRITE(numout,*) ' Sea ice data accepted                             = ', & 
    8681000            &            seaicedatqc%nsurfmpp 
    … …  
    8901022      ENDIF 
    8911023 
     1024      !--------------------------------------------------------- 
     1025      ! Record handling 
     1026      !--------------------------------------------------------- 
     1027      ! First count the number of records 
     1028      seaicedatqc%nrec = 0 
     1029      DO jstp = nit000 - 1, nitend 
     1030         inrc = jstp - nit000 + 2 
     1031         IF ( seaicedatqc%nsstpmpp(inrc) > 0 ) THEN 
     1032            seaicedatqc%nrec = seaicedatqc%nrec + 1 
     1033         ENDIF 
     1034      END DO 
     1035      ! Allocate record data 
     1036      ALLOCATE( & 
     1037         & seaicedatqc%mrecstp(seaicedatqc%nrec) & 
     1038         & ) 
     1039      ! Finally save the time step corresponding to record rank 
     1040      irec = 0 
     1041      DO jstp = nit000 - 1, nitend 
     1042         inrc = jstp - nit000 + 2 
     1043         IF ( seaicedatqc%nsstpmpp(inrc) > 0 ) THEN 
     1044            irec = irec + 1 
     1045            seaicedatqc%mrecstp(irec) = inrc 
     1046         ENDIF 
     1047         IF ( lwp ) THEN 
     1048            WRITE(numout,1999) inrc, seaicedatqc%nsstpmpp(inrc) 
     1049         ENDIF 
     1050      END DO 
     1051      
     1052      ! Print record information 
     1053      IF( lwp ) THEN 
     1054         WRITE(numout,*) 
     1055         WRITE(numout,2000) 
     1056         WRITE(numout,2001) 
     1057         DO irec = 1, seaicedatqc%nrec 
     1058            WRITE(numout,1999) irec, seaicedatqc%mrecstp(irec) 
     1059         END DO 
     1060      ENDIF 
     1061 
    89210621997  FORMAT(10X,'Time step',5X,'Sea ice data           ') 
    89310631998  FORMAT(10X,'---------',5X,'-----------------') 
    89410641999  FORMAT(10X,I9,5X,I17) 
     10652000  FORMAT(15X,'Record',10X,'Time step') 
     10662001  FORMAT(15X,'------',10X,'---------') 
    8951067       
    8961068   END SUBROUTINE obs_pre_seaice 
    … …  
    9411113      INTEGER :: inlavobs     !  - close to land (meridional velocity component) 
    9421114      INTEGER :: igrdobs      !  - fail the grid search 
     1115      INTEGER :: ibdyuobs     !  - close to open boundary 
     1116      INTEGER :: ibdyvobs     !  - close to open boundary 
    9431117      INTEGER :: iuvchku      !  - reject u if v rejected and vice versa 
    9441118      INTEGER :: iuvchkv      ! 
    … …  
    9521126      INTEGER :: inlavobsmpp  !  - close to land (meridional velocity component) 
    9531127      INTEGER :: igrdobsmpp   !  - fail the grid search 
     1128      INTEGER :: ibdyuobsmpp  !  - close to open boundary 
     1129      INTEGER :: ibdyvobsmpp  !  - close to open boundary 
    9541130      INTEGER :: iuvchkumpp   !  - reject u if v rejected and vice versa 
    9551131      INTEGER :: iuvchkvmpp   ! 
    … …  
    9831159      inlauobs = 0 
    9841160      inlavobs = 0 
     1161      ibdyuobs = 0  
     1162      ibdyvobs = 0  
    9851163      iuvchku  = 0 
    9861164      iuvchkv = 0 
    … …  
    10351213         &                 profdata%nqc,          profdata%var(1)%nvqc, & 
    10361214         &                 iosduobs,              ilanuobs,             & 
    1037          &                 inlauobs,              ld_nea                ) 
     1215         &                 inlauobs,              ld_nea                & 
     1216         &                 ibdyuobs,              ln_bound_reject                ) 
    10381217 
    10391218      CALL obs_mpp_sum_integer( iosduobs, iosduobsmpp ) 
    10401219      CALL obs_mpp_sum_integer( ilanuobs, ilanuobsmpp ) 
    10411220      CALL obs_mpp_sum_integer( inlauobs, inlauobsmpp ) 
     1221      CALL obs_mpp_sum_integer( ibdyuobs, ibdyuobsmpp ) 
    10421222 
    10431223      ! Meridional Velocity Component 
    … …  
    10551235         &                 profdata%nqc,          profdata%var(2)%nvqc, & 
    10561236         &                 iosdvobs,              ilanvobs,             & 
    1057          &                 inlavobs,              ld_nea                ) 
     1237         &                 inlavobs,              ld_nea                & 
     1238         &                 ibdyvobs,              ln_bound_reject                ) 
    10581239 
    10591240      CALL obs_mpp_sum_integer( iosdvobs, iosdvobsmpp ) 
    10601241      CALL obs_mpp_sum_integer( ilanvobs, ilanvobsmpp ) 
    10611242      CALL obs_mpp_sum_integer( inlavobs, inlavobsmpp ) 
     1243      CALL obs_mpp_sum_integer( ibdyvobs, ibdyvobsmpp ) 
    10621244 
    10631245      ! ----------------------------------------------------------------------- 
    … …  
    11251307               &            inlauobsmpp 
    11261308         ENDIF 
     1309         WRITE(numout,*) ' Remaining U data near open boundary (removed) = ', & 
     1310           &            ibdyuobsmpp 
    11271311         WRITE(numout,*) ' U observation rejected since V rejected     = ', & 
    11281312            &            iuvchku      
    … …  
    11401324               &            inlavobsmpp 
    11411325         ENDIF 
     1326         WRITE(numout,*) ' Remaining V data near open boundary (removed) = ', & 
     1327            &            ibdyvobsmpp 
    11421328         WRITE(numout,*) ' V observation rejected since U rejected     = ', & 
    11431329            &            iuvchkv      
    … …  
    15321718      &                       plam,   pphi,    pmask,            & 
    15331719      &                       kobsqc, kosdobs, klanobs,          & 
    1534       &                       knlaobs,ld_nea                     ) 
     1720      &                       knlaobs,ld_nea                     & 
     1721      &                       kbdyobs,ld_bound_reject            ) 
    15351722      !!---------------------------------------------------------------------- 
    15361723      !!                    ***  ROUTINE obs_coo_spc_2d  *** 
    … …  
    15681755      INTEGER, INTENT(INOUT) :: klanobs   ! Observations within a model land cell 
    15691756      INTEGER, INTENT(INOUT) :: knlaobs   ! Observations near land 
     1757      INTEGER, INTENT(INOUT) :: kbdyobs     ! Observations near boundary 
    15701758      LOGICAL, INTENT(IN) :: ld_nea       ! Flag observations near land 
     1759      LOGICAL, INTENT(IN) :: ld_bound_reject  ! Flag observations near open boundary  
    15711760      !! * Local declarations 
    15721761      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
    15731762         & zgmsk              ! Grid mask 
     1763#if defined key_bdy  
     1764      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
     1765         & zbmsk              ! Boundary mask 
     1766      REAL(KIND=wp), DIMENSION(jpi,jpj) :: zbdymask 
     1767#endif  
    15741768      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
    15751769         & zglam, &           ! Model longitude at grid points 
    … …  
    16131807 
    16141808      END DO 
     1809       
     1810#if defined key_bdy              
     1811      ! Create a mask grid points in boundary rim 
     1812      IF (ld_bound_reject) THEN 
     1813         zbdymask(:,:) = 1.0_wp 
     1814         DO ji = 1, nb_bdy 
     1815            DO jj = 1, idx_bdy(ji)%nblen(1) 
     1816               zbdymask(idx_bdy(ji)%nbi(jj,1),idx_bdy(ji)%nbj(jj,1)) = 0.0_wp 
     1817            ENDDO 
     1818         ENDDO 
     1819  
     1820         CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, zbdymask, zbmsk )        
     1821      ENDIF 
     1822#endif        
    16151823       
    16161824      CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pmask, zgmsk ) 
    … …  
    16711879         ! Flag if the observation falls is close to land 
    16721880         IF ( MINVAL( zgmsk(1:2,1:2,jobs) ) == 0.0_wp) THEN 
    1673             IF (ld_nea) kobsqc(jobs) = kobsqc(jobs) + 14 
    16741881            knlaobs = knlaobs + 1 
    1675             CYCLE 
    1676          ENDIF 
     1882            IF (ld_nea) THEN 
     1883               kobsqc(jobs) = kobsqc(jobs) + 14 
     1884               CYCLE 
     1885            ENDIF 
     1886         ENDIF 
     1887 
     1888#if defined key_bdy 
     1889         ! Flag if the observation falls close to the boundary rim 
     1890         IF (ld_bound_reject) THEN 
     1891            IF ( MINVAL( zbmsk(1:2,1:2,jobs) ) == 0.0_wp ) THEN 
     1892               kobsqc(jobs) = kobsqc(jobs) + 15 
     1893               kbdyobs = kbdyobs + 1 
     1894               CYCLE 
     1895            ENDIF 
     1896            ! for observations on the grid... 
     1897            IF (lgridobs) THEN 
     1898               IF (zbmsk(iig,ijg,jobs) == 0.0_wp ) THEN 
     1899                  kobsqc(jobs) = kobsqc(jobs) + 15 
     1900                  kbdyobs = kbdyobs + 1 
     1901                  CYCLE 
     1902               ENDIF 
     1903            ENDIF 
     1904         ENDIF 
     1905#endif  
    16771906             
    16781907      END DO 
    … …  
    16861915      &                       plam,    pphi,    pdep,    pmask, & 
    16871916      &                       kpobsqc, kobsqc,  kosdobs,        & 
    1688       &                       klanobs, knlaobs, ld_nea          ) 
     1917      &                       klanobs, knlaobs, ld_nea          & 
     1918      &                       kbdyobs, ld_bound_reject          ) 
    16891919      !!---------------------------------------------------------------------- 
    16901920      !!                    ***  ROUTINE obs_coo_spc_3d  *** 
    … …  
    17091939      !! * Modules used 
    17101940      USE dom_oce, ONLY : &       ! Geographical information 
    1711          & gdepw_1d                         
     1941         & ln_zco,        & 
     1942         & ln_zps,        & 
     1943         & gdepw_0,       &                        
     1944#if defined key_vvl 
     1945         & gdepw_1,       & 
     1946         & gdept_1 
     1947#else 
     1948         & gdepw,         & 
     1949         & gdept 
     1950#endif  
    17121951 
    17131952      !! * Arguments 
    … …  
    17431982      INTEGER, INTENT(INOUT) :: klanobs     ! Observations within a model land cell 
    17441983      INTEGER, INTENT(INOUT) :: knlaobs     ! Observations near land 
     1984      INTEGER, INTENT(INOUT) :: kbdyobs     ! Observations near boundary 
    17451985      LOGICAL, INTENT(IN) :: ld_nea         ! Flag observations near land 
     1986      LOGICAL, INTENT(IN) :: ld_bound_reject  ! Flag observations near open boundary 
    17461987      !! * Local declarations 
    17471988      REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: & 
    17481989         & zgmsk              ! Grid mask 
     1990#if defined key_bdy  
     1991      REAL(KIND=wp), DIMENSION(2,2,kprofno) :: & 
     1992         & zbmsk              ! Boundary mask 
     1993      REAL(KIND=wp), DIMENSION(jpi,jpj) :: zbdymask 
     1994#endif  
    17491995      REAL(KIND=wp), DIMENSION(2,2,kprofno) :: & 
    17501996         & zglam, &           ! Model longitude at grid points 
    … …  
    17542000         & igrdj 
    17552001      LOGICAL :: lgridobs           ! Is observation on a model grid point. 
     2002      LOGICAL :: ll_next_to_land    ! Is a profile next to land 
    17562003      INTEGER :: iig, ijg           ! i,j of observation on model grid point. 
    17572004      INTEGER :: jobs, jobsp, jk, ji, jj 
    … …  
    17882035          
    17892036      END DO 
     2037 
     2038#if defined key_bdy  
     2039      ! Create a mask grid points in boundary rim 
     2040      IF (ld_bound_reject) THEN            
     2041         zbdymask(:,:) = 1.0_wp 
     2042         DO ji = 1, nb_bdy 
     2043            DO jj = 1, idx_bdy(ji)%nblen(1) 
     2044               zbdymask(idx_bdy(ji)%nbi(jj,1),idx_bdy(ji)%nbj(jj,1)) = 0.0_wp 
     2045            ENDDO 
     2046         ENDDO 
     2047      ENDIF 
     2048  
     2049      CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, zbdymask, zbmsk ) 
     2050#endif  
    17902051       
    17912052      CALL obs_int_comm_3d( 2, 2, kprofno, kpk, igrdi, igrdj, pmask, zgmsk ) 
    … …  
    18152076            END DO 
    18162077         END DO 
     2078          
     2079         ! Check if next to land 
     2080         IF (  ANY( zgmsk(1:2,1:2,1,jobs) == 0.0_wp ) ) THEN 
     2081           ll_next_to_land=.TRUE. 
     2082         ELSE 
     2083           ll_next_to_land=.FALSE. 
     2084         ENDIF 
    18172085 
    18182086         ! Reject observations 
    … …  
    18322100            ENDIF 
    18332101 
    1834             ! Flag if the observation falls with a model land cell 
    1835             IF ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) & 
    1836                &  == 0.0_wp ) THEN 
    1837                kobsqc(jobsp) = kobsqc(jobsp) + 12 
    1838                klanobs = klanobs + 1 
    1839                CYCLE 
     2102            ! To check if an observations falls within land there are two cases: 
     2103            ! 1: z-coordibnates, where the check uses the mask 
     2104            ! 2: terrain following (eg s-coordinates), 
     2105            !    where we use the depth of the bottom cell to mask observations 
     2106            
     2107            IF( ln_zps .OR. ln_zco ) THEN !(CASE 1) 
     2108                
     2109               ! Flag if the observation falls with a model land cell 
     2110               IF ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) & 
     2111                  &  == 0.0_wp ) THEN 
     2112                  kobsqc(jobsp) = kobsqc(jobsp) + 12 
     2113                  klanobs = klanobs + 1 
     2114                  CYCLE 
     2115               ENDIF 
     2116            
     2117               ! Flag if the observation is close to land 
     2118               IF ( MINVAL( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) == & 
     2119                  &  0.0_wp) THEN 
     2120                  knlaobs = knlaobs + 1 
     2121                  IF (ld_nea) THEN  
     2122                     kobsqc(jobsp) = kobsqc(jobsp) + 14 
     2123                  ENDIF 
     2124               ENDIF 
     2125            
     2126            ELSE ! Case 2 
     2127               ! Flag if the observation is deeper than the bathymetry 
     2128               ! Or if it is within the mask 
     2129               IF ( ALL( fsdepw(iig-1:iig+1,ijg-1:ijg+1,kpk) < pobsdep(jobsp) ) & 
     2130               &     .OR. & 
     2131               &  ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) & 
     2132               &  == 0.0_wp) ) THEN 
     2133                  kobsqc(jobsp) = kobsqc(jobsp) + 12 
     2134                  klanobs = klanobs + 1 
     2135                  CYCLE 
     2136               ENDIF 
     2137                
     2138               ! Flag if the observation is close to land 
     2139               IF ( ll_next_to_land ) THEN 
     2140                  knlaobs = knlaobs + 1 
     2141                  IF (ld_nea) THEN  
     2142                     kobsqc(jobsp) = kobsqc(jobsp) + 14 
     2143                  ENDIF 
     2144               ENDIF 
     2145            
    18402146            ENDIF 
    18412147 
    … …  
    18512157            ENDIF 
    18522158             
    1853             ! Flag if the observation falls is close to land 
    1854             IF ( MINVAL( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) == & 
    1855                &  0.0_wp) THEN 
    1856                IF (ld_nea) kobsqc(jobsp) = kobsqc(jobsp) + 14 
    1857                knlaobs = knlaobs + 1 
    1858             ENDIF 
    1859  
    18602159            ! Set observation depth equal to that of the first model depth 
    18612160            IF ( pobsdep(jobsp) <= pdep(1) ) THEN 
    18622161               pobsdep(jobsp) = pdep(1)   
    18632162            ENDIF 
     2163             
     2164#if defined key_bdy 
     2165            ! Flag if the observation falls close to the boundary rim 
     2166            IF (ld_bound_reject) THEN 
     2167               IF ( MINVAL( zbmsk(1:2,1:2,jobs) ) == 0.0_wp ) THEN 
     2168                  kobsqc(jobsp) = kobsqc(jobsp) + 15 
     2169                  kbdyobs = kbdyobs + 1 
     2170                  CYCLE 
     2171               ENDIF 
     2172               ! for observations on the grid... 
     2173               IF (lgridobs) THEN 
     2174                  IF (zbmsk(iig,ijg,jobs) == 0.0_wp ) THEN 
     2175                     kobsqc(jobsp) = kobsqc(jobsp) + 15 
     2176                     kbdyobs = kbdyobs + 1 
     2177                     CYCLE 
     2178                  ENDIF 
     2179               ENDIF 
     2180            ENDIF 
     2181#endif  
    18642182             
    18652183         END DO 
Note: See TracChangeset for help on using the changeset viewer.