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

Changeset 15430


Ignore:
Timestamp:
2021-10-21T15:30:26+02:00 (10 months ago)
Author:
petesykes
Message:

merging vertical interp bug fix from parent branch

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

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_obs_oper_update_amm7ps45/NEMOGCM/NEMO/OPA_SRC/OBS/obs_level_search.h90

    r7960 r15430  
    1313      !! ** Method  : Straightforward search 
    1414      !! 
    15       !! ** Action  :  
     15      !! ** Action  : Will return level associated with T-point below the obs 
     16      !!              depth, except when observation is in the top box will  
     17      !!              return level 2. Also, if obs depth greater than depth  
     18      !!              of last wet T-point (kpk-1) will return level kpk. 
    1619      !! 
    1720      !! History : 
     
    4346      DO ji = 1, kobs  
    4447         kobsk(ji) = 1 
    45          depk: DO jk = 2, kgrd 
    46             IF ( pgrddep(jk) >= pobsdep(ji) ) EXIT depk 
     48         depk: DO jk = 2, kgrd-1 
     49            IF ( pgrddep(jk) > pobsdep(ji) ) EXIT depk 
    4750         END DO depk 
    4851         kobsk(ji) = jk 
  • branches/UKMO/dev_r5518_obs_oper_update_amm7ps45/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90

    r11461 r15430  
    1616   USE par_kind, ONLY : & ! Precision variables 
    1717      & wp    
     18   USE dom_oce            ! ocean space and time domain 
    1819   USE in_out_manager     ! I/O manager 
    1920   USE obs_profiles_def   ! Definitions for storage arrays for profiles 
     
    11631164      REAL(KIND=wp), DIMENSION(2,2,kprofno) :: & 
    11641165         & zglam, &           ! Model longitude at grid points 
    1165          & zgphi              ! Model latitude at grid points 
     1166         & zgphi, &           ! Model latitude at grid points 
     1167         & zbathy             ! Index of deepest wet level at grid points 
    11661168      INTEGER, DIMENSION(2,2,kprofno) :: & 
    11671169         & igrdi, &           ! Grid i,j 
     
    11711173      INTEGER :: iig, ijg           ! i,j of observation on model grid point. 
    11721174      INTEGER :: jobs, jobsp, jk, ji, jj 
     1175      REAL(KIND=wp) :: maxdepw 
    11731176 
    11741177      ! Get grid point indices 
     
    12211224      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, plam, zglam ) 
    12221225      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, pphi, zgphi ) 
     1226      CALL obs_int_comm_2d( 2, 2, kprofno, kpi, kpj, igrdi, igrdj, REAL(mbathy), zbathy ) 
    12231227      ! Need to know the bathy depth for each observation for sco 
    12241228      CALL obs_int_comm_3d( 2, 2, kprofno, kpi, kpj, kpk, igrdi, igrdj, fsdepw(:,:,:), & 
     
    12611265         DO jobsp = kpstart(jobs), kpend(jobs) 
    12621266 
     1267            ! Calculate max T and W depths of 2x2 grid 
     1268            maxdepw=zgdepw(1,1,NINT(zbathy(1,1,jobs))+1,jobs) 
     1269            DO jj = 1, 2 
     1270               DO ji = 1, 2 
     1271                  IF ( zgdepw(ji,jj,NINT(zbathy(ji,jj,jobs))+1,jobs) > maxdepw ) THEN 
     1272                     maxdepw = zgdepw(ji,jj,NINT(zbathy(ji,jj,jobs))+1,jobs) 
     1273                  END IF 
     1274               END DO 
     1275            END DO 
     1276 
    12631277            ! Flag if the observation falls outside the model spatial domain 
    12641278            IF (       ( pobslam(jobs) < -180.         )       & 
     
    12671281               &  .OR. ( pobsphi(jobs) >   90.         )       & 
    12681282               &  .OR. ( pobsdep(jobsp) < 0.0          )       & 
    1269                &  .OR. ( pobsdep(jobsp) > gdepw_1d(kpk)) ) THEN 
     1283               &  .OR. ( pobsdep(jobsp) >= maxdepw ) ) THEN 
    12701284               kobsqc(jobsp) = IBSET(kobsqc(jobsp),11) 
    12711285               kosdobs = kosdobs + 1 
     
    13291343               ENDIF 
    13301344            ENDIF 
    1331              
    1332             ! Set observation depth equal to that of the first model depth 
    1333             IF ( pobsdep(jobsp) < MINVAL(zgdept(1:2,1:2,1,jobs) ) ) THEN 
    1334                pobsdep(jobsp) = MINVAL(zgdept(1:2,1:2,1,jobs)) 
    1335             ENDIF 
    1336              
     1345            
    13371346#if defined key_bdy 
    13381347            ! Flag if the observation falls close to the boundary rim 
  • branches/UKMO/dev_r5518_obs_oper_update_amm7ps45/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_z1d.h90

    r7960 r15430  
    6262         z1dm = ( pdep(kkco(jdep)) - pobsdep(jdep)      ) 
    6363         z1dp = ( pobsdep(jdep)    - pdep(kkco(jdep)-1) ) 
    64          IF ( pobsmask(kkco(jdep)) == 0.0_wp ) z1dp = 0.0_wp 
    65  
    66          zsum = z1dm + z1dp 
     64 
    6765          
    68          IF ( k1dint == 0 ) THEN 
    69  
    70             !----------------------------------------------------------------- 
    71             !  Linear interpolation 
    72             !----------------------------------------------------------------- 
    73             pobs(jdep) = (   z1dm * pobsk(kkco(jdep)-1) & 
    74                &           + z1dp * pobsk(kkco(jdep)  ) ) / zsum 
    75  
    76          ELSEIF ( k1dint == 1 ) THEN 
    77  
    78             !----------------------------------------------------------------- 
    79             ! Cubic spline interpolation 
    80             !----------------------------------------------------------------- 
    81             zsum2 = zsum * zsum 
    82             pobs(jdep)  = (  z1dm                             * pobsk (kkco(jdep)-1) & 
    83                &           + z1dp                             * pobsk (kkco(jdep)  ) & 
    84                &           + ( z1dm * ( z1dm * z1dm - zsum2 ) * pobs2k(kkco(jdep)-1) & 
    85                &           +   z1dp * ( z1dp * z1dp - zsum2 ) * pobs2k(kkco(jdep)  ) & 
    86                &             ) / 6.0_wp                                              & 
    87                &          ) / zsum 
    88  
     66         ! Where both levels are masked, return a fill value 
     67         IF ( ( pobsmask(kkco(jdep)-1) == 0.0_wp ) .AND. (pobsmask(kkco(jdep)) == 0.0_wp) ) THEN 
     68            pobs(jdep)  = 99999. 
     69         ELSE 
     70          
     71            ! Where upper level is masked (e.g., under ice cavity), only use deeper level 
     72            ! otherwise where ob is at or above upper level model T-point,  
     73            ! use upper model level rather than extrapolate 
     74            IF ( pobsmask(kkco(jdep)-1) == 0.0_wp ) THEN 
     75               z1dm = 0.0_wp 
     76            ELSE IF ( pobsdep(jdep) <= pdep(kkco(jdep)-1) ) THEN 
     77               z1dp = 0.0_wp    
     78            END IF    
     79 
     80            ! Where deeper level is masked (e.g., near sea bed), only use upper level 
     81            ! otherwise where ob is at or below deeper level model T-point,  
     82            ! use deeper model level rather than extrapolate 
     83            IF ( pobsmask(kkco(jdep)) == 0.0_wp ) THEN 
     84               z1dp = 0.0_wp 
     85            ELSE IF ( pobsdep(jdep) >= pdep(kkco(jdep)) ) THEN 
     86               z1dm = 0.0_wp    
     87            END IF    
     88 
     89            zsum = z1dm + z1dp 
     90          
     91            IF ( k1dint == 0 ) THEN 
     92 
     93               !----------------------------------------------------------------- 
     94               !  Linear interpolation 
     95               !----------------------------------------------------------------- 
     96               pobs(jdep) = (   z1dm * pobsk(kkco(jdep)-1) & 
     97                  &           + z1dp * pobsk(kkco(jdep)  ) ) / zsum 
     98 
     99            ELSEIF ( k1dint == 1 ) THEN 
     100 
     101               !----------------------------------------------------------------- 
     102               ! Cubic spline interpolation 
     103               !----------------------------------------------------------------- 
     104               zsum2 = zsum * zsum 
     105               pobs(jdep)  = (  z1dm                             * pobsk (kkco(jdep)-1) & 
     106                  &           + z1dp                             * pobsk (kkco(jdep)  ) & 
     107                  &           + ( z1dm * ( z1dm * z1dm - zsum2 ) * pobs2k(kkco(jdep)-1) & 
     108                  &           +   z1dp * ( z1dp * z1dp - zsum2 ) * pobs2k(kkco(jdep)  ) & 
     109                  &             ) / 6.0_wp                                              & 
     110                  &          ) / zsum 
     111 
     112            ENDIF 
    89113         ENDIF 
    90114      END DO 
Note: See TracChangeset for help on using the changeset viewer.