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

Location:
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/OBS
Files:
2 edited

Legend:

Unmodified
Added
Removed

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

    r9023 r9490  
    1010   !!   obs_surf_opt :    Compute the model counterpart of surface data 
    1111   !!---------------------------------------------------------------------- 
    12  
    13    !! * Modules used 
    14    USE par_kind, ONLY : &         ! Precision variables 
    15       & wp 
    16    USE in_out_manager             ! I/O manager 
    17    USE obs_inter_sup              ! Interpolation support 
    18    USE obs_inter_h2d, ONLY : &    ! Horizontal interpolation to the obs pt 
    19       & obs_int_h2d, & 
    20       & obs_int_h2d_init 
    21    USE obs_averg_h2d, ONLY : &    ! Horizontal averaging to the obs footprint 
    22       & obs_avg_h2d, & 
    23       & obs_avg_h2d_init, & 
    24       & obs_max_fpsize 
    25    USE obs_inter_z1d, ONLY : &    ! Vertical interpolation to the obs pt 
    26       & obs_int_z1d,    & 
    27       & obs_int_z1d_spl 
    28    USE obs_const,  ONLY :    &    ! Obs fill value 
    29       & obfillflt 
    30    USE dom_oce,       ONLY : & 
    31       & glamt, glamf, & 
    32       & gphit, gphif 
    33    USE lib_mpp,       ONLY : &    ! Warning and stopping routines 
    34       & ctl_warn, ctl_stop 
    35    USE sbcdcy,        ONLY : &    ! For calculation of where it is night-time 
    36       & sbc_dcy, nday_qsr 
    37    USE obs_grid,      ONLY : &  
    38       & obs_level_search      
     12   USE obs_inter_sup                                        ! Interpolation support 
     13   USE obs_inter_h2d, ONLY : obs_int_h2d, obs_int_h2d_init  ! Horizontal interpolation to the obs pt 
     14   USE obs_averg_h2d, ONLY : obs_avg_h2d, obs_avg_h2d_init, obs_max_fpsize    ! Horizontal averaging to the obs footprint 
     15   USE obs_inter_z1d, ONLY : obs_int_z1d, obs_int_z1d_spl   ! Vertical interpolation to the obs pt 
     16   USE obs_const    , ONLY : obfillflt                      ! Obs fill value 
     17   USE dom_oce,       ONLY :   glamt, glamf, gphit, gphif   ! lat/lon of ocean grid-points 
     18   USE lib_mpp,       ONLY :   ctl_warn, ctl_stop           ! Warning and stopping routines 
     19   USE sbcdcy,        ONLY :   sbc_dcy, nday_qsr            ! For calculation of where it is night-time 
     20   USE obs_grid,      ONLY :   obs_level_search      
     21   ! 
     22   USE par_kind     , ONLY :   wp   ! Precision variables 
     23   USE in_out_manager               ! I/O manager 
    3924 
    4025   IMPLICIT NONE 
    41  
    42    !! * Routine accessibility 
    4326   PRIVATE 
    4427 
    45    PUBLIC obs_prof_opt, &  ! Compute the model counterpart of profile obs 
    46       &   obs_surf_opt     ! Compute the model counterpart of surface obs 
    47  
    48    INTEGER, PARAMETER, PUBLIC :: & 
    49       & imaxavtypes = 20   ! Max number of daily avgd obs types 
     28   PUBLIC   obs_prof_opt   !: Compute the model counterpart of profile obs 
     29   PUBLIC   obs_surf_opt   !: Compute the model counterpart of surface obs 
     30 
     31   INTEGER, PARAMETER, PUBLIC ::   imaxavtypes = 20   !: Max number of daily avgd obs types 
    5032 
    5133   !!---------------------------------------------------------------------- 
    52    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     34   !! NEMO/OPA 4.0 , NEMO Consortium (2018) 
    5335   !! $Id$ 
    5436   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    5537   !!---------------------------------------------------------------------- 
    56  
    5738CONTAINS 
    58  
    5939 
    6040   SUBROUTINE obs_prof_opt( prodatqc, kt, kpi, kpj, kpk,          & 
    … …  
    6444      &                     plam1, plam2, pphi1, pphi2,           & 
    6545      &                     k1dint, k2dint, kdailyavtypes ) 
    66  
    6746      !!----------------------------------------------------------------------- 
    68       !! 
    6947      !!                     ***  ROUTINE obs_pro_opt  *** 
    7048      !! 
    … …  
    11492      !!      ! 17-02 (M. Martin) Include generalised vertical coordinate changes 
    11593      !!----------------------------------------------------------------------- 
    116  
    117       !! * Modules used 
    11894      USE obs_profiles_def ! Definition of storage space for profile obs. 
    11995 
    12096      IMPLICIT NONE 
    12197 
    122       !! * Arguments 
    123       TYPE(obs_prof), INTENT(INOUT) :: & 
    124          & prodatqc                  ! Subset of profile data passing QC 
    125       INTEGER, INTENT(IN) :: kt      ! Time step 
    126       INTEGER, INTENT(IN) :: kpi     ! Model grid parameters 
    127       INTEGER, INTENT(IN) :: kpj 
    128       INTEGER, INTENT(IN) :: kpk 
    129       INTEGER, INTENT(IN) :: kit000  ! Number of the first time step 
    130                                      !   (kit000-1 = restart time) 
    131       INTEGER, INTENT(IN) :: k1dint  ! Vertical interpolation type (see header) 
    132       INTEGER, INTENT(IN) :: k2dint  ! Horizontal interpolation type (see header) 
    133       INTEGER, INTENT(IN) :: kdaystp ! Number of time steps per day 
    134       REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: & 
    135          & pvar1,    &               ! Model field 1 
    136          & pvar2,    &               ! Model field 2 
    137          & pmask1,   &               ! Land-sea mask 1 
    138          & pmask2                    ! Land-sea mask 2 
    139       REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: & 
    140          & plam1,    &               ! Model longitudes for variable 1 
    141          & plam2,    &               ! Model longitudes for variable 2 
    142          & pphi1,    &               ! Model latitudes for variable 1 
    143          & pphi2                     ! Model latitudes for variable 2 
    144       REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &  
    145          & pgdept, &                 ! Model array of depth T levels  
    146          & pgdepw                    ! Model array of depth W levels  
    147       INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: & 
    148          & kdailyavtypes             ! Types for daily averages 
     98      TYPE(obs_prof), INTENT(inout) ::   prodatqc        ! Subset of profile data passing QC 
     99      INTEGER       , INTENT(in   ) ::   kt              ! Time step 
     100      INTEGER       , INTENT(in   ) ::   kpi, kpj, kpk   ! Model grid parameters 
     101      INTEGER       , INTENT(in   ) ::   kit000          ! Number of the first time step (kit000-1 = restart time) 
     102      INTEGER       , INTENT(in   ) ::   k1dint          ! Vertical interpolation type (see header) 
     103      INTEGER       , INTENT(in   ) ::   k2dint          ! Horizontal interpolation type (see header) 
     104      INTEGER       , INTENT(in   ) ::   kdaystp         ! Number of time steps per day 
     105      REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj,kpk) ::   pvar1 , pvar2    ! Model field     1 and 2 
     106      REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj,kpk) ::   pmask1, pmask2   ! Land-sea mask   1 and 2 
     107      REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj)     ::   plam1 , plam2    ! Model longitude 1 and 2 
     108      REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj)     ::   pphi1 , pphi2    ! Model latitudes 1 and 2 
     109      REAL(KIND=wp) , INTENT(in   ), DIMENSION(kpi,kpj,kpk) ::   pgdept, pgdepw   ! depth of T and W levels  
     110      INTEGER, DIMENSION(imaxavtypes), OPTIONAL ::   kdailyavtypes             ! Types for daily averages 
    149111 
    150112      !! * Local declarations 
    … …  
    706668      !!      ! 17-03 (M. Martin) Added horizontal averaging options 
    707669      !!----------------------------------------------------------------------- 
    708  
    709       !! * Modules used 
    710670      USE obs_surf_def  ! Definition of storage space for surface observations 
    711671 
    712672      IMPLICIT NONE 
    713673 
    714       !! * Arguments 
    715674      TYPE(obs_surf), INTENT(INOUT) :: & 
    716675         & surfdataqc                  ! Subset of surface data passing QC 
    … …  
    866825         DO ji = 0, imaxifp 
    867826            imodi = surfdataqc%mi(jobs) - int(imaxifp/2) + ji - 1 
    868              
     827            ! 
    869828            !Deal with wrap around in longitude 
    870829            IF ( imodi < 1      ) imodi = imodi + jpiglo 
    871830            IF ( imodi > jpiglo ) imodi = imodi - jpiglo 
    872              
     831            ! 
    873832            DO jj = 0, imaxjfp 
    874833               imodj = surfdataqc%mj(jobs) - int(imaxjfp/2) + jj - 1 
    … …  
    877836               IF ( imodj < 1      ) imodj = 1 
    878837               IF ( imodj > jpjglo ) imodj = jpjglo 
    879  
     838               ! 
    880839               igrdip1(ji+1,jj+1,iobs) = imodi 
    881840               igrdjp1(ji+1,jj+1,iobs) = imodj 
    882                 
     841               ! 
    883842               IF ( ji >= 1 .AND. jj >= 1 ) THEN 
    884843                  igrdi(ji,jj,iobs) = imodi 
    885844                  igrdj(ji,jj,iobs) = imodj 
    886845               ENDIF 
    887                 
     846               ! 
    888847            END DO 
    889848         END DO 
    … …  
    1010969            & ) 
    1011970      ENDIF 
    1012  
     971      ! 
    1013972      surfdataqc%nsurfup = surfdataqc%nsurfup + isurf 
    1014  
     973      ! 
    1015974   END SUBROUTINE obs_surf_opt 
    1016975 
     976   !!====================================================================== 
    1017977END MODULE obs_oper 

  • 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.