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 9490 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90 – NEMO

Ignore:
Timestamp:
2018-04-23T10:44:07+02:00 (6 years ago)
Author:
gm
Message:

#2075 - dev_merge_2017: scale-aware setting of lateral viscous and diffusive coefficient

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90

    r9023 r9490  
    108108      imin0 = ( nn_time0 - ihou0 * 100 ) 
    109109 
    110       icycle = no     ! Assimilation cycle 
     110      icycle = nn_no     ! Assimilation cycle 
    111111 
    112112      ! Diagnotics counters for various failures. 
    … …  
    339339      imin0 = ( nn_time0 - ihou0 * 100 ) 
    340340 
    341       icycle = no     ! Assimilation cycle 
     341      icycle = nn_no     ! Assimilation cycle 
    342342 
    343343      ! Diagnotics counters for various failures. 
    344344 
    345       iotdobs  = 0 
    346       igrdobs  = 0 
     345      iotdobs   = 0 
     346      igrdobs   = 0 
    347347      iosdv1obs = 0 
    348348      iosdv2obs = 0 
    … …  
    884884      !!        !  2007-01  (K. Mogensen)  Original 
    885885      !!---------------------------------------------------------------------- 
    886       !! * Arguments 
    887886      INTEGER, INTENT(IN) :: kobsno        ! Number of observations 
    888887      INTEGER, DIMENSION(kobsno), INTENT(IN ) :: & 
    … …  
    924923      !! ** Action  :  
    925924      !!    
    926       !! History : 
    927       !!        !  2007-03  (A. Weaver, K. Mogensen)  Original 
    928       !!        !  2007-06  (K. Mogensen et al) Reject obs. near land. 
    929       !!---------------------------------------------------------------------- 
    930       !! * Modules used 
    931  
    932       !! * Arguments 
    933       INTEGER, INTENT(IN) :: kobsno    ! Total number of observations 
    934       INTEGER, INTENT(IN) :: kpi       ! Number of grid points in (i,j) 
    935       INTEGER, INTENT(IN) :: kpj 
    936       INTEGER, DIMENSION(kobsno), INTENT(IN) :: & 
    937          & kobsi, &           ! Observation (i,j) coordinates 
    938          & kobsj 
    939       REAL(KIND=wp), DIMENSION(kobsno), INTENT(IN) :: & 
    940          & pobslam, &         ! Observation (lon,lat) coordinates 
    941          & pobsphi 
    942       REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: & 
    943          & plam, pphi         ! Model (lon,lat) coordinates 
    944       REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: & 
    945          & pmask              ! Land mask array 
    946       INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: & 
    947          & kobsqc             ! Observation quality control 
    948       INTEGER, INTENT(INOUT) :: kosdobs          ! Observations outside space domain 
    949       INTEGER, INTENT(INOUT) :: klanobs          ! Observations within a model land cell 
    950       INTEGER, INTENT(INOUT) :: knlaobs          ! Observations near land 
    951       INTEGER, INTENT(INOUT) :: kbdyobs          ! Observations near boundary 
    952       LOGICAL, INTENT(IN)    :: ld_nea           ! Flag observations near land 
    953       LOGICAL, INTENT(IN)    :: ld_bound_reject  ! Flag observations near open boundary  
    954       INTEGER, INTENT(IN)    :: kqc_cutoff       ! Cutoff QC value 
    955  
    956       !! * Local declarations 
    957       REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
    958          & zgmsk              ! Grid mask 
    959  
    960       REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
    961          & zbmsk              ! Boundary mask 
    962       REAL(KIND=wp), DIMENSION(jpi,jpj) :: zbdymask 
    963       REAL(KIND=wp), DIMENSION(2,2,kobsno) :: & 
    964          & zglam, &           ! Model longitude at grid points 
    965          & zgphi              ! Model latitude at grid points 
    966       INTEGER, DIMENSION(2,2,kobsno) :: & 
    967          & igrdi, &           ! Grid i,j 
    968          & igrdj 
    969       LOGICAL :: lgridobs           ! Is observation on a model grid point. 
    970       INTEGER :: iig, ijg           ! i,j of observation on model grid point. 
    971       INTEGER :: jobs, ji, jj 
     925      !! History :  2007-03  (A. Weaver, K. Mogensen)  Original 
     926      !!         !  2007-06  (K. Mogensen et al) Reject obs. near land. 
     927      !!---------------------------------------------------------------------- 
     928      INTEGER , INTENT(in   )                     ::   kobsno            ! Total number of observations 
     929      INTEGER , INTENT(in   )                     ::   kpi    , kpj      ! Number of grid points in (i,j) 
     930      INTEGER , INTENT(in   ), DIMENSION(kobsno)  ::   kobsi  , kobsj    ! Observation (i,j) coordinates 
     931      REAL(wp), INTENT(in   ), DIMENSION(kobsno)  ::   pobslam, pobsphi  ! Observation (lon,lat) coordinates 
     932      REAL(wp), INTENT(in   ), DIMENSION(kpi,kpj) ::   plam   , pphi     ! Model (lon,lat) coordinates 
     933      REAL(wp), INTENT(in   ), DIMENSION(kpi,kpj) ::   pmask             ! Land mask array 
     934      INTEGER , INTENT(inout), DIMENSION(kobsno)  ::   kobsqc            ! Observation quality control 
     935      INTEGER , INTENT(inout)                     ::   kosdobs           ! Observations outside space domain 
     936      INTEGER , INTENT(inout)                     ::   klanobs           ! Observations within a model land cell 
     937      INTEGER , INTENT(inout)                     ::   knlaobs           ! Observations near land 
     938      INTEGER , INTENT(inout)                     ::   kbdyobs           ! Observations near boundary 
     939      LOGICAL , INTENT(in   )                     ::   ld_nea            ! Flag observations near land 
     940      LOGICAL , INTENT(in   )                     ::   ld_bound_reject   ! Flag observations near open boundary  
     941      INTEGER , INTENT(in   )                     ::   kqc_cutoff        ! Cutoff QC value 
     942      ! 
     943      REAL(KIND=wp), DIMENSION(2,2,kobsno) ::   zgmsk          ! Grid mask 
     944      REAL(KIND=wp), DIMENSION(2,2,kobsno) ::   zbmsk          ! Boundary mask 
     945      REAL(KIND=wp), DIMENSION(jpi,jpj)    ::   zbdymask 
     946      REAL(KIND=wp), DIMENSION(2,2,kobsno) ::   zglam, zgphi   ! Model Lon/lat at grid points 
     947      INTEGER      , DIMENSION(2,2,kobsno) ::   igrdi, igrdj   ! Grid i,j 
     948      LOGICAL ::   lgridobs           ! Is observation on a model grid point. 
     949      INTEGER ::   iig, ijg           ! i,j of observation on model grid point. 
     950      INTEGER ::   jobs, ji, jj 
     951      !!---------------------------------------------------------------------- 
    972952       
    973953      ! Get grid point indices 
    … …  
    11001080            ENDIF 
    11011081         ENDIF 
    1102              
     1082         ! 
    11031083      END DO 
    1104  
     1084      ! 
    11051085   END SUBROUTINE obs_coo_spc_2d 
     1086 
    11061087 
    11071088   SUBROUTINE obs_coo_spc_3d( kprofno, kobsno,  kpstart, kpend, & 
    … …  
    11981179      INTEGER :: iig, ijg           ! i,j of observation on model grid point. 
    11991180      INTEGER :: jobs, jobsp, jk, ji, jj 
     1181      !!---------------------------------------------------------------------- 
    12001182 
    12011183      ! Get grid point indices 
    … …  
    13591341               ENDIF 
    13601342            ENDIF 
    1361              
     1343            ! 
    13621344         END DO 
    13631345      END DO 
    1364  
     1346      ! 
    13651347   END SUBROUTINE obs_coo_spc_3d 
     1348 
    13661349 
    13671350   SUBROUTINE obs_pro_rej( profdata, kqc_cutoff ) 
    … …  
    13771360      !! References : 
    13781361      !!    
    1379       !! History : 
    1380       !!        !  2007-10  (K. Mogensen) Original code 
    1381       !!---------------------------------------------------------------------- 
    1382       !! * Modules used 
    1383       !! * Arguments 
    1384       TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Profile data 
    1385       INTEGER, INTENT(IN) :: kqc_cutoff             ! QC cutoff value 
    1386  
    1387       !! * Local declarations 
     1362      !! History :   2007-10  (K. Mogensen) Original code 
     1363      !!---------------------------------------------------------------------- 
     1364      TYPE(obs_prof), INTENT(inout) ::   profdata     ! Profile data 
     1365      INTEGER       , INTENT(in   ) ::   kqc_cutoff   ! QC cutoff value 
     1366      ! 
    13881367      INTEGER :: jprof 
    13891368      INTEGER :: jvar 
    13901369      INTEGER :: jobs 
     1370      !!---------------------------------------------------------------------- 
    13911371       
    13921372      ! Loop over profiles 
    … …  
    14111391 
    14121392      END DO 
    1413  
     1393      ! 
    14141394   END SUBROUTINE obs_pro_rej 
     1395 
    14151396 
    14161397   SUBROUTINE obs_uv_rej( profdata, knumu, knumv, kqc_cutoff ) 
    … …  
    14261407      !! References : 
    14271408      !!    
    1428       !! History : 
    1429       !!        !  2009-2  (K. Mogensen) Original code 
    1430       !!---------------------------------------------------------------------- 
    1431       !! * Modules used 
    1432       !! * Arguments 
     1409      !! History :   2009-2  (K. Mogensen) Original code 
     1410      !!---------------------------------------------------------------------- 
    14331411      TYPE(obs_prof), INTENT(INOUT) :: profdata   ! Profile data 
    14341412      INTEGER, INTENT(INOUT) :: knumu             ! Number of u rejected 
    14351413      INTEGER, INTENT(INOUT) :: knumv             ! Number of v rejected 
    14361414      INTEGER, INTENT(IN) :: kqc_cutoff           ! QC cutoff value 
    1437  
    1438       !! * Local declarations 
     1415      ! 
    14391416      INTEGER :: jprof 
    14401417      INTEGER :: jvar 
    14411418      INTEGER :: jobs 
    1442        
    1443       ! Loop over profiles 
    1444  
    1445       DO jprof = 1, profdata%nprof 
    1446  
     1419      !!---------------------------------------------------------------------- 
     1420 
     1421      DO jprof = 1, profdata%nprof      !==  Loop over profiles  ==! 
     1422         ! 
    14471423         IF ( ( profdata%npvsta(jprof,1) /= profdata%npvsta(jprof,2) ) .OR. & 
    14481424            & ( profdata%npvend(jprof,1) /= profdata%npvend(jprof,2) ) ) THEN 
    1449  
     1425            ! 
    14501426            CALL ctl_stop('U,V profiles inconsistent in obs_uv_rej') 
    14511427            RETURN 
    1452  
    1453          ENDIF 
    1454  
     1428            ! 
     1429         ENDIF 
     1430         ! 
    14551431         DO jobs = profdata%npvsta(jprof,1), profdata%npvend(jprof,1) 
    1456              
     1432            !   
    14571433            IF ( ( profdata%var(1)%nvqc(jobs) >  kqc_cutoff ) .AND. & 
    14581434               & ( profdata%var(2)%nvqc(jobs) <=  kqc_cutoff) ) THEN 
    … …  
    14651441               knumu = knumu + 1 
    14661442            ENDIF 
    1467              
     1443            ! 
    14681444         END DO 
    1469              
     1445         ! 
    14701446      END DO 
    1471  
     1447      ! 
    14721448   END SUBROUTINE obs_uv_rej 
    14731449 
     1450   !!===================================================================== 
    14741451END MODULE obs_prep 
Note: See TracChangeset for help on using the changeset viewer.