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

Changeset 7480


Ignore:
Timestamp:
2016-12-08T14:27:10+01:00 (7 years ago)
Author:
dford
Message:

Merge in changes to reject obs near open boundaries.

Location:
branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS
Files:
4 edited

Legend:

Unmodified
Added
Removed

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

    r7479 r7480  
    196196         &            ln_sla, ln_sladt, ln_slafb,                     & 
    197197         &            ln_ssh, ln_sst, ln_sstfb, ln_sss, ln_nea,       & 
     198         &            ln_bound_reject,                                & 
    198199         &            enactfiles, coriofiles, profbfiles,             & 
    199200         &            slafilesact, slafilespas, slafbfiles,           & 
    … …  
    302303      ln_velfb_av(:) = .FALSE. 
    303304      ln_ignmis = .FALSE. 
     305      ln_bound_reject = .TRUE. 
    304306 
    305307      ! Read Namelist namobs : control observation diagnostics 
    … …  
    623625         WRITE(numout,*) '             Type of horizontal interpolation method        n2dint = ', n2dint 
    624626         WRITE(numout,*) '             Rejection of observations near land swithch    ln_nea = ', ln_nea 
     627         WRITE(numout,*) '             Rejection of obs near open bdys       ln_bound_reject = ', ln_bound_reject 
    625628         WRITE(numout,*) '             MSSH correction scheme                         nmsshc = ', nmsshc 
    626629         WRITE(numout,*) '             MDT  correction                               mdtcorr = ', mdtcorr 

  • branches/UKMO/dev_r4650_general_vert_coord_obsoper_surf_bgc/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90

    r6406 r7480  
    9898      ! 
    9999      INTEGER :: ierr  
    100       INTEGER, DIMENSION(kno) ::   ivals 
    101       ! 
    102 INCLUDE 'mpif.h' 
    103       !!---------------------------------------------------------------------- 
     100      INTEGER, DIMENSION(:), ALLOCATABLE ::   ivals 
     101      ! 
     102INCLUDE 'mpif.h' 
     103      !!---------------------------------------------------------------------- 
     104 
     105      ALLOCATE( ivals(kno) ) 
    104106 
    105107      ! Call the MPI library to find the maximum across processors 
    … …  
    107109         &                mpi_max, mpi_comm_opa, ierr ) 
    108110      kvals(:) = ivals(:) 
     111 
     112      DEALLOCATE( ivals ) 
    109113#else 
    110114      ! no MPI: empty routine 
    … …  
    138142      ! 
    139143      INTEGER :: ji, isum 
    140       INTEGER, DIMENSION(kno) ::   iobsp 
    141       !! 
    142       !! 
    143  
    144       iobsp=kobsp 
     144      INTEGER, DIMENSION(:), ALLOCATABLE ::   iobsp 
     145      !! 
     146      !! 
     147 
     148      ALLOCATE( iobsp(kno) ) 
     149 
     150      iobsp(:)=kobsp(:) 
    145151 
    146152      WHERE( iobsp(:) == -1 ) 
    … …  
    148154      END WHERE 
    149155 
    150       iobsp=-1*iobsp 
     156      iobsp(:)=-1*iobsp(:) 
    151157 
    152158      CALL obs_mpp_max_integer( iobsp, kno ) 
    153159 
    154       kobsp=-1*iobsp 
     160      kobsp(:)=-1*iobsp(:) 
    155161 
    156162      isum=0 
    … …  
    168174      ENDIF 
    169175 
     176      DEALLOCATE( iobsp ) 
     177 
    170178#else 
    171179      ! no MPI: empty routine 

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

    r6857 r7480  
    3131   USE obs_inter_sup      ! Interpolation support 
    3232   USE obs_oper           ! Observation operators 
     33#if defined key_bdy 
     34   USE bdy_oce, ONLY : &        ! Boundary information 
     35      idx_bdy, nb_bdy 
     36#endif 
    3337   USE lib_mpp, ONLY : & 
    3438      & ctl_warn, ctl_stop 
    … …  
    5155      & calc_month_len     ! Calculate the number of days in the months of a year   
    5256 
     57   LOGICAL, PUBLIC :: ln_bound_reject  !: Remove obs near open boundaries    
     58 
    5359   !!---------------------------------------------------------------------- 
    5460   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    … …  
    8793         & gphit,   & 
    8894         & gdept_1d,& 
    89          & tmask      
     95#if defined key_vvl 
     96         & gdepw_n, & 
     97         & gdept_n, & 
     98#else 
     99         & gdepw_1d,   & 
     100         & gdept_1d,   & 
     101#endif          
     102         & tmask,   & 
     103         & ln_zco,  & 
     104         & ln_zps,  & 
     105         & nproc 
    90106      !! * Arguments 
    91107      TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Full set of profile data 
    … …  
    109125      INTEGER :: ilantobs      !  - within a model land cell (temperature) 
    110126      INTEGER :: ilansobs      !  - within a model land cell (salinity) 
     127      INTEGER :: ibdytobs      !  - boundary (temperature)  
     128      INTEGER :: ibdysobs      !  - boundary (salinity)       
    111129      INTEGER :: inlatobs      !  - close to land (temperature) 
    112130      INTEGER :: inlasobs      !  - close to land (salinity) 
    … …  
    118136      INTEGER :: ilantobsmpp   !  - within a model land cell (temperature) 
    119137      INTEGER :: ilansobsmpp   !  - within a model land cell (salinity) 
     138      INTEGER :: ibdytobsmpp   !  - boundary (temperature)  
     139      INTEGER :: ibdysobsmpp    !  - boundary (salinity)       
    120140      INTEGER :: inlatobsmpp   !  - close to land (temperature) 
    121141      INTEGER :: inlasobsmpp   !  - close to land (salinity) 
    … …  
    150170      inlatobs = 0 
    151171      inlasobs = 0 
     172      ibdytobs = 0 
     173      ibdysobs = 0 
    152174 
    153175      ! ----------------------------------------------------------------------- 
    … …  
    206228         &                 profdata%nqc,          profdata%var(1)%nvqc, & 
    207229         &                 iosdtobs,              ilantobs,             & 
    208          &                 inlatobs,              ld_nea                ) 
     230         &                 inlatobs,              ld_nea,               & 
     231         &                 ibdytobs,              ln_bound_reject       ) 
     232 
    209233 
    210234      CALL obs_mpp_sum_integer( iosdtobs, iosdtobsmpp ) 
    211235      CALL obs_mpp_sum_integer( ilantobs, ilantobsmpp ) 
    212236      CALL obs_mpp_sum_integer( inlatobs, inlatobsmpp ) 
     237      CALL obs_mpp_sum_integer( ibdytobs, ibdytobsmpp ) 
    213238 
    214239      ! Salinity 
    … …  
    226251         &                 profdata%nqc,          profdata%var(2)%nvqc, & 
    227252         &                 iosdsobs,              ilansobs,             & 
    228          &                 inlasobs,              ld_nea                ) 
     253         &                 inlasobs,              ld_nea,               & 
     254         &                 ibdysobs,              ln_bound_reject       ) 
    229255 
    230256      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    231257      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    232258      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
     259      CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 
    233260 
    234261      ! ----------------------------------------------------------------------- 
    … …  
    288315               &            inlatobsmpp 
    289316         ENDIF 
     317         WRITE(numout,*) ' Remaining T data near open boundary (removed) = ',& 
     318               &            ibdytobsmpp 
    290319         WRITE(numout,*) ' T data accepted                             = ', & 
    291320            &            prodatqc%nvprotmpp(1) 
    … …  
    301330               &            inlasobsmpp 
    302331         ENDIF 
     332         WRITE(numout,*) ' Remaining S data near open boundary (removed) = ',& 
     333               &            ibdysobsmpp 
    303334         WRITE(numout,*) ' S data accepted                             = ', & 
    304335            &            prodatqc%nvprotmpp(2) 
    … …  
    388419      INTEGER :: inlasobs     !  - close to land 
    389420      INTEGER :: igrdobs      !  - fail the grid search 
     421      INTEGER :: ibdysobs     !  - close to open boundary 
    390422                              ! Global counters for observations that 
    391423      INTEGER :: iotdobsmpp     !  - outside time domain 
    … …  
    394426      INTEGER :: inlasobsmpp    !  - close to land 
    395427      INTEGER :: igrdobsmpp     !  - fail the grid search 
     428      INTEGER :: ibdysobsmpp    !  - close to open boundary    
    396429      LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    397430         & llvalid            ! SLA data selection 
    … …  
    399432      INTEGER :: jstp         ! Time loop variable 
    400433      INTEGER :: inrc         ! Time index variable 
     434      INTEGER :: irec         ! Record index 
    401435 
    402436      IF(lwp) WRITE(numout,*)'obs_pre_sla : Preparing the SLA observations...' 
    … …  
    418452      ilansobs = 0 
    419453      inlasobs = 0 
     454      ibdysobs = 0 
    420455 
    421456      ! ----------------------------------------------------------------------- 
    … …  
    451486         &                 tmask(:,:,1), sladata%nqc,  & 
    452487         &                 iosdsobs,     ilansobs,     & 
    453          &                 inlasobs,     ld_nea        ) 
     488         &                 inlasobs,     ld_nea,       & 
     489         &                 ibdysobs,     ln_bound_reject        ) 
    454490 
    455491      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    456492      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    457493      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
     494      CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 
    458495 
    459496      ! ----------------------------------------------------------------------- 
    … …  
    504541               &            inlasobsmpp 
    505542         ENDIF 
     543         WRITE(numout,*) ' Remaining SLA data near open boundary (removed) = ', & 
     544            &            ibdysobsmpp   
    506545         WRITE(numout,*) ' SLA data accepted                             = ', & 
    507546            &            sladatqc%nsurfmpp 
    … …  
    529568      ENDIF 
    530569 
     570      !--------------------------------------------------------- 
     571      ! Record handling 
     572      !--------------------------------------------------------- 
     573      ! First count the number of records 
     574      sladatqc%nrec = 0 
     575      DO jstp = nit000 - 1, nitend 
     576         inrc = jstp - nit000 + 2 
     577         IF ( sladatqc%nsstpmpp(inrc) > 0 ) THEN 
     578            sladatqc%nrec = sladatqc%nrec + 1 
     579         ENDIF 
     580      END DO 
     581      ! Allocate record data 
     582      ALLOCATE( & 
     583         & sladatqc%mrecstp(sladatqc%nrec) & 
     584         & ) 
     585      ! Finally save the time step corresponding to record rank 
     586      irec = 0 
     587      DO jstp = nit000 - 1, nitend 
     588         inrc = jstp - nit000 + 2 
     589         IF ( sladatqc%nsstpmpp(inrc) > 0 ) THEN 
     590            irec = irec + 1 
     591            sladatqc%mrecstp(irec) = inrc 
     592         ENDIF 
     593         IF ( lwp ) THEN 
     594            WRITE(numout,1999) inrc, sladatqc%nsstpmpp(inrc) 
     595         ENDIF 
     596      END DO 
     597      
     598      ! Print record information 
     599      IF( lwp ) THEN 
     600         WRITE(numout,*) 
     601         WRITE(numout,2000) 
     602         WRITE(numout,2001) 
     603         DO irec = 1, sladatqc%nrec 
     604            WRITE(numout,1999) irec, sladatqc%mrecstp(irec) 
     605         END DO 
     606      ENDIF 
     607 
     608 
    5316091997  FORMAT(10X,'Time step',5X,'Sea level anomaly') 
    5326101998  FORMAT(10X,'---------',5X,'-----------------') 
    5336111999  FORMAT(10X,I9,5X,I17) 
     6122000  FORMAT(15X,'Record',10X,'Time step') 
     6132001  FORMAT(15X,'------',10X,'---------') 
    534614 
    535615   END SUBROUTINE obs_pre_sla 
    … …  
    575655      INTEGER :: inlasobs     !  - close to land 
    576656      INTEGER :: igrdobs      !  - fail the grid search 
     657      INTEGER :: ibdysobs     !  - close to open boundary 
    577658                              ! Global counters for observations that 
    578659      INTEGER :: iotdobsmpp   !  - outside time domain 
    … …  
    581662      INTEGER :: inlasobsmpp  !  - close to land 
    582663      INTEGER :: igrdobsmpp   !  - fail the grid search 
     664      INTEGER :: ibdysobsmpp  !  - close to open boundary 
    583665      LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    584666         & llvalid            ! SST data selection 
    … …  
    586668      INTEGER :: jstp         ! Time loop variable 
    587669      INTEGER :: inrc         ! Time index variable 
     670      INTEGER :: irec         ! Record index 
    588671 
    589672      IF(lwp) WRITE(numout,*)'obs_pre_sst : Preparing the SST observations...' 
    … …  
    605688      ilansobs = 0 
    606689      inlasobs = 0 
     690      ibdysobs = 0  
    607691 
    608692      ! ----------------------------------------------------------------------- 
    … …  
    635719         &                 tmask(:,:,1), sstdata%nqc,  & 
    636720         &                 iosdsobs,     ilansobs,     & 
    637          &                 inlasobs,     ld_nea        ) 
     721         &                 inlasobs,     ld_nea,       & 
     722         &                 ibdysobs,     ln_bound_reject        ) 
    638723 
    639724      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    640725      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    641726      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
     727      CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 
    642728 
    643729      ! ----------------------------------------------------------------------- 
    … …  
    688774               &            inlasobsmpp 
    689775         ENDIF 
     776         WRITE(numout,*) ' Remaining SST data near open boundary (removed) = ', & 
     777            &               ibdysobsmpp 
    690778         WRITE(numout,*) ' SST data accepted                             = ', & 
    691779            &            sstdatqc%nsurfmpp 
    … …  
    713801      ENDIF 
    714802 
     803      !--------------------------------------------------------- 
     804      ! Record handling 
     805      !--------------------------------------------------------- 
     806      ! First count the number of records 
     807      sstdatqc%nrec = 0 
     808      DO jstp = nit000 - 1, nitend 
     809         inrc = jstp - nit000 + 2 
     810         IF ( sstdatqc%nsstpmpp(inrc) > 0 ) THEN 
     811            sstdatqc%nrec = sstdatqc%nrec + 1 
     812         ENDIF 
     813      END DO 
     814      ! Allocate record data 
     815      ALLOCATE( & 
     816         & sstdatqc%mrecstp(sstdatqc%nrec) & 
     817         & ) 
     818      ! Finally save the time step corresponding to record rank 
     819      irec = 0 
     820      DO jstp = nit000 - 1, nitend 
     821         inrc = jstp - nit000 + 2 
     822         IF ( sstdatqc%nsstpmpp(inrc) > 0 ) THEN 
     823            irec = irec + 1 
     824            sstdatqc%mrecstp(irec) = inrc 
     825         ENDIF 
     826         IF ( lwp ) THEN 
     827            WRITE(numout,1999) jstp, sstdatqc%nsstpmpp(inrc) 
     828         ENDIF 
     829      END DO 
     830      
     831      ! Print record information 
     832      IF( lwp ) THEN 
     833         WRITE(numout,*) 
     834         WRITE(numout,2000) 
     835         WRITE(numout,2001) 
     836         DO irec = 1, sstdatqc%nrec 
     837            WRITE(numout,1999) irec, sstdatqc%mrecstp(irec) - 1 
     838         END DO 
     839      ENDIF 
     840       
    7158411997  FORMAT(10X,'Time step',5X,'Sea surface temperature') 
    7168421998  FORMAT(10X,'---------',5X,'-----------------') 
    7178431999  FORMAT(10X,I9,5X,I17) 
     8442000  FORMAT(15X,'Record',10X,'Time step') 
     8452001  FORMAT(15X,'------',10X,'---------') 
    718846       
    719847   END SUBROUTINE obs_pre_sst 
    … …  
    759887      INTEGER :: inlasobs     !  - close to land 
    760888      INTEGER :: igrdobs      !  - fail the grid search 
     889      INTEGER :: ibdysobs     !  - close to open boundary 
    761890                              ! Global counters for observations that 
    762891      INTEGER :: iotdobsmpp   !  - outside time domain 
    … …  
    765894      INTEGER :: inlasobsmpp  !  - close to land 
    766895      INTEGER :: igrdobsmpp   !  - fail the grid search 
     896      INTEGER :: ibdysobsmpp  !  - close to open boundary 
    767897      LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    768898         & llvalid            ! data selection 
    … …  
    770900      INTEGER :: jstp         ! Time loop variable 
    771901      INTEGER :: inrc         ! Time index variable 
     902      INTEGER :: irec         ! Record index 
    772903 
    773904      IF (lwp) WRITE(numout,*)'obs_pre_seaice : Preparing the sea ice observations...' 
    … …  
    789920      ilansobs = 0 
    790921      inlasobs = 0 
     922      ibdysobs = 0 
    791923 
    792924      ! ----------------------------------------------------------------------- 
    … …  
    819951         &                 tmask(:,:,1),    seaicedata%nqc,  & 
    820952         &                 iosdsobs,        ilansobs,        & 
    821          &                 inlasobs,        ld_nea           ) 
     953         &                 inlasobs,        ld_nea,          & 
     954         &                 ibdysobs,        ln_bound_reject           ) 
    822955 
    823956      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp ) 
    824957      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp ) 
    825958      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp ) 
     959      CALL obs_mpp_sum_integer( ibdysobs, ibdysobsmpp ) 
    826960 
    827961      ! ----------------------------------------------------------------------- 
    … …  
    8721006               &            inlasobsmpp 
    8731007         ENDIF 
     1008         WRITE(numout,*) ' Remaining sea ice data near open boundary (removed) = ', & 
     1009           &            ibdysobsmpp  
    8741010         WRITE(numout,*) ' Sea ice data accepted                             = ', & 
    8751011            &            seaicedatqc%nsurfmpp 
    … …  
    8971033      ENDIF 
    8981034 
     1035      !--------------------------------------------------------- 
     1036      ! Record handling 
     1037      !--------------------------------------------------------- 
     1038      ! First count the number of records 
     1039      seaicedatqc%nrec = 0 
     1040      DO jstp = nit000 - 1, nitend 
     1041         inrc = jstp - nit000 + 2 
     1042         IF ( seaicedatqc%nsstpmpp(inrc) > 0 ) THEN 
     1043            seaicedatqc%nrec = seaicedatqc%nrec + 1 
     1044         ENDIF 
     1045      END DO 
     1046      ! Allocate record data 
     1047      ALLOCATE( & 
     1048         & seaicedatqc%mrecstp(seaicedatqc%nrec) & 
     1049         & ) 
     1050      ! Finally save the time step corresponding to record rank 
     1051      irec = 0 
     1052      DO jstp = nit000 - 1, nitend 
     1053         inrc = jstp - nit000 + 2 
     1054         IF ( seaicedatqc%nsstpmpp(inrc) > 0 ) THEN 
     1055            irec = irec + 1 
     1056            seaicedatqc%mrecstp(irec) = inrc 
     1057         ENDIF 
     1058         IF ( lwp ) THEN 
     1059            WRITE(numout,1999) inrc, seaicedatqc%nsstpmpp(inrc) 
     1060         ENDIF 
     1061      END DO 
     1062      
     1063      ! Print record information 
     1064      IF( lwp ) THEN 
     1065         WRITE(numout,*) 
     1066         WRITE(numout,2000) 
     1067         WRITE(numout,2001) 
     1068         DO irec = 1, seaicedatqc%nrec 
     1069            WRITE(numout,1999) irec, seaicedatqc%mrecstp(irec) 
     1070         END DO 
     1071      ENDIF 
     1072 
    89910731997  FORMAT(10X,'Time step',5X,'Sea ice data           ') 
    90010741998  FORMAT(10X,'---------',5X,'-----------------') 
    90110751999  FORMAT(10X,I9,5X,I17) 
     10762000  FORMAT(15X,'Record',10X,'Time step') 
     10772001  FORMAT(15X,'------',10X,'---------') 
    9021078       
    9031079   END SUBROUTINE obs_pre_seaice 
    … …  
    9471123      INTEGER :: inlavobs     !  - close to land (meridional velocity component) 
    9481124      INTEGER :: igrdobs      !  - fail the grid search 
     1125      INTEGER :: ibdyuobs     !  - close to open boundary 
     1126      INTEGER :: ibdyvobs     !  - close to open boundary 
    9491127      INTEGER :: iuvchku      !  - reject u if v rejected and vice versa 
    9501128      INTEGER :: iuvchkv      ! 
    … …  
    9581136      INTEGER :: inlavobsmpp  !  - close to land (meridional velocity component) 
    9591137      INTEGER :: igrdobsmpp   !  - fail the grid search 
     1138      INTEGER :: ibdyuobsmpp  !  - close to open boundary 
     1139      INTEGER :: ibdyvobsmpp  !  - close to open boundary 
    9601140      INTEGER :: iuvchkumpp   !  - reject u if v rejected and vice versa 
    9611141      INTEGER :: iuvchkvmpp   ! 
    … …  
    9891169      inlauobs = 0 
    9901170      inlavobs = 0 
     1171      ibdyuobs = 0  
     1172      ibdyvobs = 0  
    9911173      iuvchku  = 0 
    9921174      iuvchkv = 0 
    … …  
    10411223         &                 profdata%nqc,          profdata%var(1)%nvqc, & 
    10421224         &                 iosduobs,              ilanuobs,             & 
    1043          &                 inlauobs,              ld_nea                ) 
     1225         &                 inlauobs,              ld_nea,               & 
     1226         &                 ibdyuobs,              ln_bound_reject                ) 
    10441227 
    10451228      CALL obs_mpp_sum_integer( iosduobs, iosduobsmpp ) 
    10461229      CALL obs_mpp_sum_integer( ilanuobs, ilanuobsmpp ) 
    10471230      CALL obs_mpp_sum_integer( inlauobs, inlauobsmpp ) 
     1231      CALL obs_mpp_sum_integer( ibdyuobs, ibdyuobsmpp ) 
    10481232 
    10491233      ! Meridional Velocity Component 
    … …  
    10611245         &                 profdata%nqc,          profdata%var(2)%nvqc, & 
    10621246         &                 iosdvobs,              ilanvobs,             & 
    1063          &                 inlavobs,              ld_nea                ) 
     1247         &                 inlavobs,              ld_nea,               & 
     1248         &                 ibdyvobs,              ln_bound_reject                ) 
    10641249 
    10651250      CALL obs_mpp_sum_integer( iosdvobs, iosdvobsmpp ) 
    10661251      CALL obs_mpp_sum_integer( ilanvobs, ilanvobsmpp ) 
    10671252      CALL obs_mpp_sum_integer( inlavobs, inlavobsmpp ) 
     1253      CALL obs_mpp_sum_integer( ibdyvobs, ibdyvobsmpp ) 
    10681254 
    10691255      ! ----------------------------------------------------------------------- 
    … …  
    11311317               &            inlauobsmpp 
    11321318         ENDIF 
     1319         WRITE(numout,*) ' Remaining U data near open boundary (removed) = ', & 
     1320           &            ibdyuobsmpp 
    11331321         WRITE(numout,*) ' U observation rejected since V rejected     = ', & 
    11341322            &            iuvchku      
    … …  
    11461334               &            inlavobsmpp 
    11471335         ENDIF 
     1336         WRITE(numout,*) ' Remaining V data near open boundary (removed) = ', & 
     1337            &            ibdyvobsmpp 
    11481338         WRITE(numout,*) ' V observation rejected since U rejected     = ', & 
    11491339            &            iuvchkv      
    … …  
    22702460      &                       plam,   pphi,    pmask,            & 
    22712461      &                       kobsqc, kosdobs, klanobs,          & 
    2272       &                       knlaobs,ld_nea                     ) 
     2462      &                       knlaobs,ld_nea,                    & 
     2463      &                       kbdyobs,ld_bound_reject            ) 
    22732464      !!---------------------------------------------------------------------- 
    22742465      !!                    ***  ROUTINE obs_coo_spc_2d  *** 
    … …  
    23062497      INTEGER, INTENT(INOUT) :: klanobs   ! Observations within a model land cell 
    23072498      INTEGER, INTENT(INOUT) :: knlaobs   ! Observations near land 
     2499      INTEGER, INTENT(INOUT) :: kbdyobs     ! Observations near boundary 
    23082500      LOGICAL, INTENT(IN) :: ld_nea       ! Flag observations near land 
     2501      LOGICAL, INTENT(IN) :: ld_bound_reject  ! Flag observations near open boundary  
    23092502      !! * Local declarations 
    23102503      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
    23112504         & zgmsk              ! Grid mask 
     2505#if defined key_bdy  
     2506      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
     2507         & zbmsk              ! Boundary mask 
     2508      REAL(KIND=wp), DIMENSION(jpi,jpj) :: zbdymask 
     2509#endif  
    23122510      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
    23132511         & zglam, &           ! Model longitude at grid points 
    … …  
    23512549 
    23522550      END DO 
     2551 
     2552#if defined key_bdy              
     2553      ! Create a mask grid points in boundary rim 
     2554      IF (ld_bound_reject) THEN 
     2555         zbdymask(:,:) = 1.0_wp 
     2556         DO ji = 1, nb_bdy 
     2557            DO jj = 1, idx_bdy(ji)%nblen(1) 
     2558               zbdymask(idx_bdy(ji)%nbi(jj,1),idx_bdy(ji)%nbj(jj,1)) = 0.0_wp 
     2559            ENDDO 
     2560         ENDDO 
     2561  
     2562         CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, zbdymask, zbmsk )        
     2563      ENDIF 
     2564#endif        
    23532565       
    23542566      CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pmask, zgmsk ) 
    … …  
    23962608         END DO 
    23972609   
    2398          ! For observations on the grid reject them if their are at 
    2399          ! a masked point 
    2400           
    2401          IF (lgridobs) THEN 
    2402             IF (zgmsk(iig,ijg,jobs) == 0.0_wp ) THEN 
    2403                kobsqc(jobs) = kobsqc(jobs) + 12 
    2404                klanobs = klanobs + 1 
     2610         ! Flag if the observation falls is close to land 
     2611         IF ( MINVAL( zgmsk(1:2,1:2,jobs) ) == 0.0_wp) THEN 
     2612            knlaobs = knlaobs + 1 
     2613            IF (ld_nea) THEN 
     2614               kobsqc(jobs) = kobsqc(jobs) + 14 
    24052615               CYCLE 
    24062616            ENDIF 
    24072617         ENDIF 
    2408                        
    2409          ! Flag if the observation falls is close to land 
    2410          IF ( MINVAL( zgmsk(1:2,1:2,jobs) ) == 0.0_wp) THEN 
    2411             IF (ld_nea) kobsqc(jobs) = kobsqc(jobs) + 14 
    2412             knlaobs = knlaobs + 1 
    2413             CYCLE 
    2414          ENDIF 
     2618 
     2619#if defined key_bdy 
     2620         ! Flag if the observation falls close to the boundary rim 
     2621         IF (ld_bound_reject) THEN 
     2622            IF ( MINVAL( zbmsk(1:2,1:2,jobs) ) == 0.0_wp ) THEN 
     2623               kobsqc(jobs) = kobsqc(jobs) + 15 
     2624               kbdyobs = kbdyobs + 1 
     2625               CYCLE 
     2626            ENDIF 
     2627            ! for observations on the grid... 
     2628            IF (lgridobs) THEN 
     2629               IF (zbmsk(iig,ijg,jobs) == 0.0_wp ) THEN 
     2630                  kobsqc(jobs) = kobsqc(jobs) + 15 
     2631                  kbdyobs = kbdyobs + 1 
     2632                  CYCLE 
     2633               ENDIF 
     2634            ENDIF 
     2635         ENDIF 
     2636#endif  
    24152637             
    24162638      END DO 
    … …  
    24242646      &                       plam,    pphi,    pdep,    pmask, & 
    24252647      &                       kpobsqc, kobsqc,  kosdobs,        & 
    2426       &                       klanobs, knlaobs, ld_nea          ) 
     2648      &                       klanobs, knlaobs, ld_nea,         & 
     2649      &                       kbdyobs, ld_bound_reject          ) 
    24272650      !!---------------------------------------------------------------------- 
    24282651      !!                    ***  ROUTINE obs_coo_spc_3d  *** 
    … …  
    24892712      INTEGER, INTENT(INOUT) :: klanobs     ! Observations within a model land cell 
    24902713      INTEGER, INTENT(INOUT) :: knlaobs     ! Observations near land 
     2714      INTEGER, INTENT(INOUT) :: kbdyobs     ! Observations near boundary 
    24912715      LOGICAL, INTENT(IN) :: ld_nea         ! Flag observations near land 
     2716      LOGICAL, INTENT(IN) :: ld_bound_reject  ! Flag observations near open boundary 
    24922717      !! * Local declarations 
    24932718      REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: & 
    24942719         & zgmsk              ! Grid mask 
     2720#if defined key_bdy  
     2721      REAL(KIND=wp), DIMENSION(2,2,kprofno) :: & 
     2722         & zbmsk              ! Boundary mask 
     2723      REAL(KIND=wp), DIMENSION(jpi,jpj) :: zbdymask 
     2724#endif  
    24952725      REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: & 
    24962726         & zgdepw          
    … …  
    25372767          
    25382768      END DO 
     2769 
     2770#if defined key_bdy  
     2771      ! Create a mask grid points in boundary rim 
     2772      IF (ld_bound_reject) THEN            
     2773         zbdymask(:,:) = 1.0_wp 
     2774         DO ji = 1, nb_bdy 
     2775            DO jj = 1, idx_bdy(ji)%nblen(1) 
     2776               zbdymask(idx_bdy(ji)%nbi(jj,1),idx_bdy(ji)%nbj(jj,1)) = 0.0_wp 
     2777            ENDDO 
     2778         ENDDO 
     2779      ENDIF 
     2780  
     2781      CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, zbdymask, zbmsk ) 
     2782#endif  
    25392783       
    25402784      CALL obs_int_comm_3d( 2, 2, kprofno, kpk, igrdi, igrdj, pmask, zgmsk ) 
    … …  
    26162860              
    26172861            ELSE ! Case 2  
    2618   
    26192862               ! Flag if the observation is deeper than the bathymetry  
    26202863               ! Or if it is within the mask  
    … …  
    26482891               ENDIF 
    26492892            ENDIF 
    2650             
    2651             ! Flag if the observation falls is close to land 
    2652             IF ( MINVAL( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) == & 
    2653                &  0.0_wp) THEN 
    2654                IF (ld_nea) kobsqc(jobsp) = kobsqc(jobsp) + 14 
    2655                knlaobs = knlaobs + 1 
    2656             ENDIF 
    2657  
     2893             
    26582894            ! Set observation depth equal to that of the first model depth 
    26592895            IF ( pobsdep(jobsp) <= pdep(1) ) THEN 
    26602896               pobsdep(jobsp) = pdep(1)   
    26612897            ENDIF 
     2898             
     2899#if defined key_bdy 
     2900            ! Flag if the observation falls close to the boundary rim 
     2901            IF (ld_bound_reject) THEN 
     2902               IF ( MINVAL( zbmsk(1:2,1:2,jobs) ) == 0.0_wp ) THEN 
     2903                  kobsqc(jobsp) = kobsqc(jobsp) + 15 
     2904                  kbdyobs = kbdyobs + 1 
     2905                  CYCLE 
     2906               ENDIF 
     2907               ! for observations on the grid... 
     2908               IF (lgridobs) THEN 
     2909                  IF (zbmsk(iig,ijg,jobs) == 0.0_wp ) THEN 
     2910                     kobsqc(jobsp) = kobsqc(jobsp) + 15 
     2911                     kbdyobs = kbdyobs + 1 
     2912                     CYCLE 
     2913                  ENDIF 
     2914               ENDIF 
     2915            ENDIF 
     2916#endif  
    26622917             
    26632918         END DO 

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

    r5838 r7480  
    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.