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

Changeset 6990


Ignore:
Timestamp:
2016-10-05T11:18:51+02:00 (8 years ago)
Author:
kingr
Message:

Added code from nemo3.4 OBS branch to allow rejection of observations near open boundaries.

Location:
branches/UKMO/dev_r4650_general_vert_coord_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS
Files:
3 edited

Legend:

Unmodified
Added
Removed

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

    r6406 r6990  
    171171         &            ln_sla, ln_sladt, ln_slafb,                     & 
    172172         &            ln_ssh, ln_sst, ln_sstfb, ln_sss, ln_nea,       & 
     173         &            ln_bound_reject,                                & 
    173174         &            enactfiles, coriofiles, profbfiles,             & 
    174175         &            slafilesact, slafilespas, slafbfiles,           & 
    … …  
    244245      ln_velfb_av(:) = .FALSE. 
    245246      ln_ignmis = .FALSE. 
     247      ln_bound_reject = .TRUE. 
    246248 
    247249      ! Read Namelist namobs : control observation diagnostics 
    … …  
    469471         WRITE(numout,*) '             Type of horizontal interpolation method        n2dint = ', n2dint 
    470472         WRITE(numout,*) '             Rejection of observations near land swithch    ln_nea = ', ln_nea 
     473         WRITE(numout,*) '             Rejection of obs near open bdys       ln_bound_reject = ', ln_bound_reject 
    471474         WRITE(numout,*) '             MSSH correction scheme                         nmsshc = ', nmsshc 
    472475         WRITE(numout,*) '             MDT  correction                               mdtcorr = ', mdtcorr 

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

    r6301 r6990  
    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 
    … …  
    4347      & calc_month_len     ! Calculate the number of days in the months of a year   
    4448 
     49   LOGICAL, PUBLIC :: ln_bound_reject  !: Remove obs near open boundaries    
     50 
    4551   !!---------------------------------------------------------------------- 
    4652   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    7985         & gphit,   & 
    8086         & gdept_1d,& 
    81          & tmask      
     87#if defined key_vvl 
     88         & gdepw_n, & 
     89         & gdept_n, & 
     90#else 
     91         & gdepw_1d,   & 
     92         & gdept_1d,   & 
     93#endif          
     94         & tmask,   & 
     95         & ln_zco,  & 
     96         & ln_zps,  & 
     97         & nproc 
    8298      !! * Arguments 
    8399      TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Full set of profile data 
    … …  
    101117      INTEGER :: ilantobs      !  - within a model land cell (temperature) 
    102118      INTEGER :: ilansobs      !  - within a model land cell (salinity) 
     119      INTEGER :: ibdytobs      !  - boundary (temperature)  
     120      INTEGER :: ibdysobs      !  - boundary (salinity)       
    103121      INTEGER :: inlatobs      !  - close to land (temperature) 
    104122      INTEGER :: inlasobs      !  - close to land (salinity) 
    … …  
    110128      INTEGER :: ilantobsmpp   !  - within a model land cell (temperature) 
    111129      INTEGER :: ilansobsmpp   !  - within a model land cell (salinity) 
     130      INTEGER :: ibdytobsmpp   !  - boundary (temperature)  
     131      INTEGER :: ibdysobsmpp    !  - boundary (salinity)       
    112132      INTEGER :: inlatobsmpp   !  - close to land (temperature) 
    113133      INTEGER :: inlasobsmpp   !  - close to land (salinity) 
    … …  
    142162      inlatobs = 0 
    143163      inlasobs = 0 
     164      ibdytobs = 0 
     165      ibdysobs = 0 
    144166 
    145167      ! ----------------------------------------------------------------------- 
    … …  
    198220         &                 profdata%nqc,          profdata%var(1)%nvqc, & 
    199221         &                 iosdtobs,              ilantobs,             & 
    200          &                 inlatobs,              ld_nea                ) 
     222         &                 inlatobs,              ld_nea,               & 
     223         &                 ibdytobs,              ln_bound_reject       ) 
     224 
    201225 
    202226      CALL obs_mpp_sum_integer( iosdtobs, iosdtobsmpp ) 
    203227      CALL obs_mpp_sum_integer( ilantobs, ilantobsmpp ) 
    204228      CALL obs_mpp_sum_integer( inlatobs, inlatobsmpp ) 
     229      CALL obs_mpp_sum_integer( ibdytobs, ibdytobsmpp ) 
    205230 
    206231      ! Salinity 
    … …  
    218243         &                 profdata%nqc,          profdata%var(2)%nvqc, & 
    219244         &                 iosdsobs,              ilansobs,             & 
    220          &                 inlasobs,              ld_nea                ) 
     245         &                 inlasobs,              ld_nea,               & 
     246         &                 ibdysobs,              ln_bound_reject       ) 
    221247 
    222248      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    223249      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    224250      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
     251      CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 
    225252 
    226253      ! ----------------------------------------------------------------------- 
    … …  
    280307               &            inlatobsmpp 
    281308         ENDIF 
     309         WRITE(numout,*) ' Remaining T data near open boundary (removed) = ',& 
     310               &            ibdytobsmpp 
    282311         WRITE(numout,*) ' T data accepted                             = ', & 
    283312            &            prodatqc%nvprotmpp(1) 
    … …  
    293322               &            inlasobsmpp 
    294323         ENDIF 
     324         WRITE(numout,*) ' Remaining S data near open boundary (removed) = ',& 
     325               &            ibdysobsmpp 
    295326         WRITE(numout,*) ' S data accepted                             = ', & 
    296327            &            prodatqc%nvprotmpp(2) 
    … …  
    380411      INTEGER :: inlasobs     !  - close to land 
    381412      INTEGER :: igrdobs      !  - fail the grid search 
     413      INTEGER :: ibdysobs     !  - close to open boundary 
    382414                              ! Global counters for observations that 
    383415      INTEGER :: iotdobsmpp     !  - outside time domain 
    … …  
    386418      INTEGER :: inlasobsmpp    !  - close to land 
    387419      INTEGER :: igrdobsmpp     !  - fail the grid search 
     420      INTEGER :: ibdysobsmpp    !  - close to open boundary    
    388421      LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    389422         & llvalid            ! SLA data selection 
    … …  
    391424      INTEGER :: jstp         ! Time loop variable 
    392425      INTEGER :: inrc         ! Time index variable 
     426      INTEGER :: irec         ! Record index 
    393427 
    394428      IF(lwp) WRITE(numout,*)'obs_pre_sla : Preparing the SLA observations...' 
    … …  
    410444      ilansobs = 0 
    411445      inlasobs = 0 
     446      ibdysobs = 0 
    412447 
    413448      ! ----------------------------------------------------------------------- 
    … …  
    443478         &                 tmask(:,:,1), sladata%nqc,  & 
    444479         &                 iosdsobs,     ilansobs,     & 
    445          &                 inlasobs,     ld_nea        ) 
     480         &                 inlasobs,     ld_nea,       & 
     481         &                 ibdysobs,     ln_bound_reject        ) 
    446482 
    447483      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    448484      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    449485      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
     486      CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 
    450487 
    451488      ! ----------------------------------------------------------------------- 
    … …  
    496533               &            inlasobsmpp 
    497534         ENDIF 
     535         WRITE(numout,*) ' Remaining SLA data near open boundary (removed) = ', & 
     536            &            ibdysobsmpp   
    498537         WRITE(numout,*) ' SLA data accepted                             = ', & 
    499538            &            sladatqc%nsurfmpp 
    … …  
    521560      ENDIF 
    522561 
     562      !--------------------------------------------------------- 
     563      ! Record handling 
     564      !--------------------------------------------------------- 
     565      ! First count the number of records 
     566      sladatqc%nrec = 0 
     567      DO jstp = nit000 - 1, nitend 
     568         inrc = jstp - nit000 + 2 
     569         IF ( sladatqc%nsstpmpp(inrc) > 0 ) THEN 
     570            sladatqc%nrec = sladatqc%nrec + 1 
     571         ENDIF 
     572      END DO 
     573      ! Allocate record data 
     574      ALLOCATE( & 
     575         & sladatqc%mrecstp(sladatqc%nrec) & 
     576         & ) 
     577      ! Finally save the time step corresponding to record rank 
     578      irec = 0 
     579      DO jstp = nit000 - 1, nitend 
     580         inrc = jstp - nit000 + 2 
     581         IF ( sladatqc%nsstpmpp(inrc) > 0 ) THEN 
     582            irec = irec + 1 
     583            sladatqc%mrecstp(irec) = inrc 
     584         ENDIF 
     585         IF ( lwp ) THEN 
     586            WRITE(numout,1999) inrc, sladatqc%nsstpmpp(inrc) 
     587         ENDIF 
     588      END DO 
     589      
     590      ! Print record information 
     591      IF( lwp ) THEN 
     592         WRITE(numout,*) 
     593         WRITE(numout,2000) 
     594         WRITE(numout,2001) 
     595         DO irec = 1, sladatqc%nrec 
     596            WRITE(numout,1999) irec, sladatqc%mrecstp(irec) 
     597         END DO 
     598      ENDIF 
     599 
     600 
    5236011997  FORMAT(10X,'Time step',5X,'Sea level anomaly') 
    5246021998  FORMAT(10X,'---------',5X,'-----------------') 
    5256031999  FORMAT(10X,I9,5X,I17) 
     6042000  FORMAT(15X,'Record',10X,'Time step') 
     6052001  FORMAT(15X,'------',10X,'---------') 
    526606 
    527607   END SUBROUTINE obs_pre_sla 
    … …  
    567647      INTEGER :: inlasobs     !  - close to land 
    568648      INTEGER :: igrdobs      !  - fail the grid search 
     649      INTEGER :: ibdysobs     !  - close to open boundary 
    569650                              ! Global counters for observations that 
    570651      INTEGER :: iotdobsmpp   !  - outside time domain 
    … …  
    573654      INTEGER :: inlasobsmpp  !  - close to land 
    574655      INTEGER :: igrdobsmpp   !  - fail the grid search 
     656      INTEGER :: ibdysobsmpp  !  - close to open boundary 
    575657      LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    576658         & llvalid            ! SST data selection 
    … …  
    578660      INTEGER :: jstp         ! Time loop variable 
    579661      INTEGER :: inrc         ! Time index variable 
     662      INTEGER :: irec         ! Record index 
    580663 
    581664      IF(lwp) WRITE(numout,*)'obs_pre_sst : Preparing the SST observations...' 
    … …  
    597680      ilansobs = 0 
    598681      inlasobs = 0 
     682      ibdysobs = 0  
    599683 
    600684      ! ----------------------------------------------------------------------- 
    … …  
    627711         &                 tmask(:,:,1), sstdata%nqc,  & 
    628712         &                 iosdsobs,     ilansobs,     & 
    629          &                 inlasobs,     ld_nea        ) 
     713         &                 inlasobs,     ld_nea,       & 
     714         &                 ibdysobs,     ln_bound_reject        ) 
    630715 
    631716      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    632717      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    633718      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
     719      CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 
    634720 
    635721      ! ----------------------------------------------------------------------- 
    … …  
    680766               &            inlasobsmpp 
    681767         ENDIF 
     768         WRITE(numout,*) ' Remaining SST data near open boundary (removed) = ', & 
     769            &               ibdysobsmpp 
    682770         WRITE(numout,*) ' SST data accepted                             = ', & 
    683771            &            sstdatqc%nsurfmpp 
    … …  
    705793      ENDIF 
    706794 
     795      !--------------------------------------------------------- 
     796      ! Record handling 
     797      !--------------------------------------------------------- 
     798      ! First count the number of records 
     799      sstdatqc%nrec = 0 
     800      DO jstp = nit000 - 1, nitend 
     801         inrc = jstp - nit000 + 2 
     802         IF ( sstdatqc%nsstpmpp(inrc) > 0 ) THEN 
     803            sstdatqc%nrec = sstdatqc%nrec + 1 
     804         ENDIF 
     805      END DO 
     806      ! Allocate record data 
     807      ALLOCATE( & 
     808         & sstdatqc%mrecstp(sstdatqc%nrec) & 
     809         & ) 
     810      ! Finally save the time step corresponding to record rank 
     811      irec = 0 
     812      DO jstp = nit000 - 1, nitend 
     813         inrc = jstp - nit000 + 2 
     814         IF ( sstdatqc%nsstpmpp(inrc) > 0 ) THEN 
     815            irec = irec + 1 
     816            sstdatqc%mrecstp(irec) = inrc 
     817         ENDIF 
     818         IF ( lwp ) THEN 
     819            WRITE(numout,1999) jstp, sstdatqc%nsstpmpp(inrc) 
     820         ENDIF 
     821      END DO 
     822      
     823      ! Print record information 
     824      IF( lwp ) THEN 
     825         WRITE(numout,*) 
     826         WRITE(numout,2000) 
     827         WRITE(numout,2001) 
     828         DO irec = 1, sstdatqc%nrec 
     829            WRITE(numout,1999) irec, sstdatqc%mrecstp(irec) - 1 
     830         END DO 
     831      ENDIF 
     832       
    7078331997  FORMAT(10X,'Time step',5X,'Sea surface temperature') 
    7088341998  FORMAT(10X,'---------',5X,'-----------------') 
    7098351999  FORMAT(10X,I9,5X,I17) 
     8362000  FORMAT(15X,'Record',10X,'Time step') 
     8372001  FORMAT(15X,'------',10X,'---------') 
    710838       
    711839   END SUBROUTINE obs_pre_sst 
    … …  
    751879      INTEGER :: inlasobs     !  - close to land 
    752880      INTEGER :: igrdobs      !  - fail the grid search 
     881      INTEGER :: ibdysobs     !  - close to open boundary 
    753882                              ! Global counters for observations that 
    754883      INTEGER :: iotdobsmpp   !  - outside time domain 
    … …  
    757886      INTEGER :: inlasobsmpp  !  - close to land 
    758887      INTEGER :: igrdobsmpp   !  - fail the grid search 
     888      INTEGER :: ibdysobsmpp  !  - close to open boundary 
    759889      LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    760890         & llvalid            ! data selection 
    … …  
    762892      INTEGER :: jstp         ! Time loop variable 
    763893      INTEGER :: inrc         ! Time index variable 
     894      INTEGER :: irec         ! Record index 
    764895 
    765896      IF (lwp) WRITE(numout,*)'obs_pre_seaice : Preparing the sea ice observations...' 
    … …  
    781912      ilansobs = 0 
    782913      inlasobs = 0 
     914      ibdysobs = 0 
    783915 
    784916      ! ----------------------------------------------------------------------- 
    … …  
    811943         &                 tmask(:,:,1),    seaicedata%nqc,  & 
    812944         &                 iosdsobs,        ilansobs,        & 
    813          &                 inlasobs,        ld_nea           ) 
     945         &                 inlasobs,        ld_nea,          & 
     946         &                 ibdysobs,        ln_bound_reject           ) 
    814947 
    815948      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    816949      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    817950      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
     951      CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 
    818952 
    819953      ! ----------------------------------------------------------------------- 
    … …  
    864998               &            inlasobsmpp 
    865999         ENDIF 
     1000         WRITE(numout,*) ' Remaining sea ice data near open boundary (removed) = ', & 
     1001           &            ibdysobsmpp  
    8661002         WRITE(numout,*) ' Sea ice data accepted                             = ', & 
    8671003            &            seaicedatqc%nsurfmpp 
    … …  
    8891025      ENDIF 
    8901026 
     1027      !--------------------------------------------------------- 
     1028      ! Record handling 
     1029      !--------------------------------------------------------- 
     1030      ! First count the number of records 
     1031      seaicedatqc%nrec = 0 
     1032      DO jstp = nit000 - 1, nitend 
     1033         inrc = jstp - nit000 + 2 
     1034         IF ( seaicedatqc%nsstpmpp(inrc) > 0 ) THEN 
     1035            seaicedatqc%nrec = seaicedatqc%nrec + 1 
     1036         ENDIF 
     1037      END DO 
     1038      ! Allocate record data 
     1039      ALLOCATE( & 
     1040         & seaicedatqc%mrecstp(seaicedatqc%nrec) & 
     1041         & ) 
     1042      ! Finally save the time step corresponding to record rank 
     1043      irec = 0 
     1044      DO jstp = nit000 - 1, nitend 
     1045         inrc = jstp - nit000 + 2 
     1046         IF ( seaicedatqc%nsstpmpp(inrc) > 0 ) THEN 
     1047            irec = irec + 1 
     1048            seaicedatqc%mrecstp(irec) = inrc 
     1049         ENDIF 
     1050         IF ( lwp ) THEN 
     1051            WRITE(numout,1999) inrc, seaicedatqc%nsstpmpp(inrc) 
     1052         ENDIF 
     1053      END DO 
     1054      
     1055      ! Print record information 
     1056      IF( lwp ) THEN 
     1057         WRITE(numout,*) 
     1058         WRITE(numout,2000) 
     1059         WRITE(numout,2001) 
     1060         DO irec = 1, seaicedatqc%nrec 
     1061            WRITE(numout,1999) irec, seaicedatqc%mrecstp(irec) 
     1062         END DO 
     1063      ENDIF 
     1064 
    89110651997  FORMAT(10X,'Time step',5X,'Sea ice data           ') 
    89210661998  FORMAT(10X,'---------',5X,'-----------------') 
    89310671999  FORMAT(10X,I9,5X,I17) 
     10682000  FORMAT(15X,'Record',10X,'Time step') 
     10692001  FORMAT(15X,'------',10X,'---------') 
    8941070       
    8951071   END SUBROUTINE obs_pre_seaice 
    … …  
    9391115      INTEGER :: inlavobs     !  - close to land (meridional velocity component) 
    9401116      INTEGER :: igrdobs      !  - fail the grid search 
     1117      INTEGER :: ibdyuobs     !  - close to open boundary 
     1118      INTEGER :: ibdyvobs     !  - close to open boundary 
    9411119      INTEGER :: iuvchku      !  - reject u if v rejected and vice versa 
    9421120      INTEGER :: iuvchkv      ! 
    … …  
    9501128      INTEGER :: inlavobsmpp  !  - close to land (meridional velocity component) 
    9511129      INTEGER :: igrdobsmpp   !  - fail the grid search 
     1130      INTEGER :: ibdyuobsmpp  !  - close to open boundary 
     1131      INTEGER :: ibdyvobsmpp  !  - close to open boundary 
    9521132      INTEGER :: iuvchkumpp   !  - reject u if v rejected and vice versa 
    9531133      INTEGER :: iuvchkvmpp   ! 
    … …  
    9811161      inlauobs = 0 
    9821162      inlavobs = 0 
     1163      ibdyuobs = 0  
     1164      ibdyvobs = 0  
    9831165      iuvchku  = 0 
    9841166      iuvchkv = 0 
    … …  
    10331215         &                 profdata%nqc,          profdata%var(1)%nvqc, & 
    10341216         &                 iosduobs,              ilanuobs,             & 
    1035          &                 inlauobs,              ld_nea                ) 
     1217         &                 inlauobs,              ld_nea,               & 
     1218         &                 ibdyuobs,              ln_bound_reject                ) 
    10361219 
    10371220      CALL obs_mpp_sum_integer( iosduobs, iosduobsmpp ) 
    10381221      CALL obs_mpp_sum_integer( ilanuobs, ilanuobsmpp ) 
    10391222      CALL obs_mpp_sum_integer( inlauobs, inlauobsmpp ) 
     1223      CALL obs_mpp_sum_integer( ibdyuobs, ibdyuobsmpp ) 
    10401224 
    10411225      ! Meridional Velocity Component 
    … …  
    10531237         &                 profdata%nqc,          profdata%var(2)%nvqc, & 
    10541238         &                 iosdvobs,              ilanvobs,             & 
    1055          &                 inlavobs,              ld_nea                ) 
     1239         &                 inlavobs,              ld_nea,               & 
     1240         &                 ibdyvobs,              ln_bound_reject                ) 
    10561241 
    10571242      CALL obs_mpp_sum_integer( iosdvobs, iosdvobsmpp ) 
    10581243      CALL obs_mpp_sum_integer( ilanvobs, ilanvobsmpp ) 
    10591244      CALL obs_mpp_sum_integer( inlavobs, inlavobsmpp ) 
     1245      CALL obs_mpp_sum_integer( ibdyvobs, ibdyvobsmpp ) 
    10601246 
    10611247      ! ----------------------------------------------------------------------- 
    … …  
    11231309               &            inlauobsmpp 
    11241310         ENDIF 
     1311         WRITE(numout,*) ' Remaining U data near open boundary (removed) = ', & 
     1312           &            ibdyuobsmpp 
    11251313         WRITE(numout,*) ' U observation rejected since V rejected     = ', & 
    11261314            &            iuvchku      
    … …  
    11381326               &            inlavobsmpp 
    11391327         ENDIF 
     1328         WRITE(numout,*) ' Remaining V data near open boundary (removed) = ', & 
     1329            &            ibdyvobsmpp 
    11401330         WRITE(numout,*) ' V observation rejected since U rejected     = ', & 
    11411331            &            iuvchkv      
    … …  
    15301720      &                       plam,   pphi,    pmask,            & 
    15311721      &                       kobsqc, kosdobs, klanobs,          & 
    1532       &                       knlaobs,ld_nea                     ) 
     1722      &                       knlaobs,ld_nea,                    & 
     1723      &                       kbdyobs,ld_bound_reject            ) 
    15331724      !!---------------------------------------------------------------------- 
    15341725      !!                    ***  ROUTINE obs_coo_spc_2d  *** 
    … …  
    15661757      INTEGER, INTENT(INOUT) :: klanobs   ! Observations within a model land cell 
    15671758      INTEGER, INTENT(INOUT) :: knlaobs   ! Observations near land 
     1759      INTEGER, INTENT(INOUT) :: kbdyobs     ! Observations near boundary 
    15681760      LOGICAL, INTENT(IN) :: ld_nea       ! Flag observations near land 
     1761      LOGICAL, INTENT(IN) :: ld_bound_reject  ! Flag observations near open boundary  
    15691762      !! * Local declarations 
    15701763      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
    15711764         & zgmsk              ! Grid mask 
     1765#if defined key_bdy  
     1766      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
     1767         & zbmsk              ! Boundary mask 
     1768      REAL(KIND=wp), DIMENSION(jpi,jpj) :: zbdymask 
     1769#endif  
    15721770      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
    15731771         & zglam, &           ! Model longitude at grid points 
    … …  
    16111809 
    16121810      END DO 
     1811 
     1812#if defined key_bdy              
     1813      ! Create a mask grid points in boundary rim 
     1814      IF (ld_bound_reject) THEN 
     1815         zbdymask(:,:) = 1.0_wp 
     1816         DO ji = 1, nb_bdy 
     1817            DO jj = 1, idx_bdy(ji)%nblen(1) 
     1818               zbdymask(idx_bdy(ji)%nbi(jj,1),idx_bdy(ji)%nbj(jj,1)) = 0.0_wp 
     1819            ENDDO 
     1820         ENDDO 
     1821  
     1822         CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, zbdymask, zbmsk )        
     1823      ENDIF 
     1824#endif        
    16131825       
    16141826      CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pmask, zgmsk ) 
    … …  
    16561868         END DO 
    16571869   
    1658          ! For observations on the grid reject them if their are at 
    1659          ! a masked point 
    1660           
    1661          IF (lgridobs) THEN 
    1662             IF (zgmsk(iig,ijg,jobs) == 0.0_wp ) THEN 
    1663                kobsqc(jobs) = kobsqc(jobs) + 12 
    1664                klanobs = klanobs + 1 
     1870         ! Flag if the observation falls is close to land 
     1871         IF ( MINVAL( zgmsk(1:2,1:2,jobs) ) == 0.0_wp) THEN 
     1872            knlaobs = knlaobs + 1 
     1873            IF (ld_nea) THEN 
     1874               kobsqc(jobs) = kobsqc(jobs) + 14 
    16651875               CYCLE 
    16661876            ENDIF 
    16671877         ENDIF 
    1668                        
    1669          ! Flag if the observation falls is close to land 
    1670          IF ( MINVAL( zgmsk(1:2,1:2,jobs) ) == 0.0_wp) THEN 
    1671             IF (ld_nea) kobsqc(jobs) = kobsqc(jobs) + 14 
    1672             knlaobs = knlaobs + 1 
    1673             CYCLE 
    1674          ENDIF 
     1878 
     1879#if defined key_bdy 
     1880         ! Flag if the observation falls close to the boundary rim 
     1881         IF (ld_bound_reject) THEN 
     1882            IF ( MINVAL( zbmsk(1:2,1:2,jobs) ) == 0.0_wp ) THEN 
     1883               kobsqc(jobs) = kobsqc(jobs) + 15 
     1884               kbdyobs = kbdyobs + 1 
     1885               CYCLE 
     1886            ENDIF 
     1887            ! for observations on the grid... 
     1888            IF (lgridobs) THEN 
     1889               IF (zbmsk(iig,ijg,jobs) == 0.0_wp ) THEN 
     1890                  kobsqc(jobs) = kobsqc(jobs) + 15 
     1891                  kbdyobs = kbdyobs + 1 
     1892                  CYCLE 
     1893               ENDIF 
     1894            ENDIF 
     1895         ENDIF 
     1896#endif  
    16751897             
    16761898      END DO 
    … …  
    16841906      &                       plam,    pphi,    pdep,    pmask, & 
    16851907      &                       kpobsqc, kobsqc,  kosdobs,        & 
    1686       &                       klanobs, knlaobs, ld_nea          ) 
     1908      &                       klanobs, knlaobs, ld_nea,         & 
     1909      &                       kbdyobs, ld_bound_reject          ) 
    16871910      !!---------------------------------------------------------------------- 
    16881911      !!                    ***  ROUTINE obs_coo_spc_3d  *** 
    … …  
    17491972      INTEGER, INTENT(INOUT) :: klanobs     ! Observations within a model land cell 
    17501973      INTEGER, INTENT(INOUT) :: knlaobs     ! Observations near land 
     1974      INTEGER, INTENT(INOUT) :: kbdyobs     ! Observations near boundary 
    17511975      LOGICAL, INTENT(IN) :: ld_nea         ! Flag observations near land 
     1976      LOGICAL, INTENT(IN) :: ld_bound_reject  ! Flag observations near open boundary 
    17521977      !! * Local declarations 
    17531978      REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: & 
    17541979         & zgmsk              ! Grid mask 
     1980#if defined key_bdy  
     1981      REAL(KIND=wp), DIMENSION(2,2,kprofno) :: & 
     1982         & zbmsk              ! Boundary mask 
     1983      REAL(KIND=wp), DIMENSION(jpi,jpj) :: zbdymask 
     1984#endif  
    17551985      REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: & 
    17561986         & zgdepw          
    … …  
    17972027          
    17982028      END DO 
     2029 
     2030#if defined key_bdy  
     2031      ! Create a mask grid points in boundary rim 
     2032      IF (ld_bound_reject) THEN            
     2033         zbdymask(:,:) = 1.0_wp 
     2034         DO ji = 1, nb_bdy 
     2035            DO jj = 1, idx_bdy(ji)%nblen(1) 
     2036               zbdymask(idx_bdy(ji)%nbi(jj,1),idx_bdy(ji)%nbj(jj,1)) = 0.0_wp 
     2037            ENDDO 
     2038         ENDDO 
     2039      ENDIF 
     2040  
     2041      CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, zbdymask, zbmsk ) 
     2042#endif  
    17992043       
    18002044      CALL obs_int_comm_3d( 2, 2, kprofno, kpk, igrdi, igrdj, pmask, zgmsk ) 
    … …  
    18762120              
    18772121            ELSE ! Case 2  
    1878   
    18792122               ! Flag if the observation is deeper than the bathymetry  
    18802123               ! Or if it is within the mask  
    … …  
    19082151               ENDIF 
    19092152            ENDIF 
    1910             
    1911             ! Flag if the observation falls is close to land 
    1912             IF ( MINVAL( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) == & 
    1913                &  0.0_wp) THEN 
    1914                IF (ld_nea) kobsqc(jobsp) = kobsqc(jobsp) + 14 
    1915                knlaobs = knlaobs + 1 
    1916             ENDIF 
    1917  
     2153             
    19182154            ! Set observation depth equal to that of the first model depth 
    19192155            IF ( pobsdep(jobsp) <= pdep(1) ) THEN 
    19202156               pobsdep(jobsp) = pdep(1)   
    19212157            ENDIF 
     2158             
     2159#if defined key_bdy 
     2160            ! Flag if the observation falls close to the boundary rim 
     2161            IF (ld_bound_reject) THEN 
     2162               IF ( MINVAL( zbmsk(1:2,1:2,jobs) ) == 0.0_wp ) THEN 
     2163                  kobsqc(jobsp) = kobsqc(jobsp) + 15 
     2164                  kbdyobs = kbdyobs + 1 
     2165                  CYCLE 
     2166               ENDIF 
     2167               ! for observations on the grid... 
     2168               IF (lgridobs) THEN 
     2169                  IF (zbmsk(iig,ijg,jobs) == 0.0_wp ) THEN 
     2170                     kobsqc(jobsp) = kobsqc(jobsp) + 15 
     2171                     kbdyobs = kbdyobs + 1 
     2172                     CYCLE 
     2173                  ENDIF 
     2174               ENDIF 
     2175            ENDIF 
     2176#endif  
    19222177             
    19232178         END DO 

  • branches/UKMO/dev_r4650_general_vert_coord_obsoper/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90

    r5838 r6990  
    5050      INTEGER :: npj 
    5151      INTEGER :: nsurfup    !: Observation counter used in obs_oper 
     52      INTEGER :: nrec       !: Number of surface observation records in window 
    5253 
    5354      ! Arrays with size equal to the number of surface observations 
    … …  
    5657         & mi,   &        !: i-th grid coord. for interpolating to surface observation 
    5758         & mj,   &        !: j-th grid coord. for interpolating to surface observation 
     59         & mt,   &        !: time record number for gridded data 
    5860         & nsidx,&        !: Surface observation number 
    5961         & nsfil,&        !: Surface observation number in file 
    … …  
    9092         & nsstpmpp       !: Global number of surface observations per time step 
    9193 
     94      ! Arrays with size equal to the number of observation records in the window 
     95      INTEGER, POINTER, DIMENSION(:) :: & 
     96         & mrecstp   ! Time step of the records 
     97 
    9298      ! Arrays used to store source indices when  
    9399      ! compressing obs_surf derived types 
    … …  
    97103      INTEGER, POINTER, DIMENSION(:) :: & 
    98104         & nsind          !: Source indices of surface data in compressed data 
     105 
     106      ! Is this a gridded product? 
     107      
     108      LOGICAL :: lgrid 
    99109 
    100110   END TYPE obs_surf 
    … …  
    146156         & surf%mi(ksurf),      & 
    147157         & surf%mj(ksurf),      & 
     158         & surf%mt(ksurf),      & 
    148159         & surf%nsidx(ksurf),   & 
    149160         & surf%nsfil(ksurf),   & 
    … …  
    162173         & ) 
    163174 
     175      surf%mt(:) = -1 
     176 
    164177 
    165178      ! Allocate arrays of number of surface data size * number of variables 
    … …  
    176189         & ) 
    177190 
     191      surf%rext(:,:) = 0.0_wp  
     192 
    178193      ! Allocate arrays of number of time step size 
    179194 
    … …  
    203218 
    204219      surf%nsurfup     = 0 
     220       
     221      ! Not gridded by default 
     222           
     223      surf%lgrid       = .FALSE. 
    205224               
    206225   END SUBROUTINE obs_surf_alloc 
    … …  
    228247         & surf%mi,      & 
    229248         & surf%mj,      & 
     249         & surf%mt,      & 
    230250         & surf%nsidx,   & 
    231251         & surf%nsfil,   & 
    … …  
    350370            newsurf%mi(insurf)    = surf%mi(ji) 
    351371            newsurf%mj(insurf)    = surf%mj(ji) 
     372            newsurf%mt(insurf)    = surf%mt(ji) 
    352373            newsurf%nsidx(insurf) = surf%nsidx(ji) 
    353374            newsurf%nsfil(insurf) = surf%nsfil(ji) 
    … …  
    393414 
    394415      newsurf%nstp  = surf%nstp 
     416       
     417      ! Set gridded stuff 
     418       
     419      newsurf%mt(insurf)    = surf%mt(ji) 
    395420  
    396421      ! Deallocate temporary data 
    … …  
    433458         oldsurf%mi(jj)    = surf%mi(ji) 
    434459         oldsurf%mj(jj)    = surf%mj(ji) 
     460         oldsurf%mt(jj)    = surf%mt(ji) 
    435461         oldsurf%nsidx(jj) = surf%nsidx(ji) 
    436462         oldsurf%nsfil(jj) = surf%nsfil(ji) 
Note: See TracChangeset for help on using the changeset viewer.