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

Changeset 15271


Ignore:
Timestamp:
2021-09-20T11:12:08+02:00 (15 months ago)
Author:
dbruciaferri
Message:

rewriting saw tooth dignostic

Location:
NEMO/branches/UKMO/tools_r4.0-HEAD_dev_MEs/DOMAINcfg/src
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/tools_r4.0-HEAD_dev_MEs/DOMAINcfg/src/dom_oce.f90

    r15121 r15271  
    244244 
    245245   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4) 
     246 
     247   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mes_msk      ! mask for local-ME coordinates (ln_loc_mes=TRUE)   
     248                                                                       !    MEs-area (=1), 
     249                                                                       !    z-area (=0) 
     250 
    246251 
    247252   !!---------------------------------------------------------------------- 
     
    367372         &     tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                                       &  
    368373         &     ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , & 
    369          &     mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , STAT=ierr(9) ) 
     374         &     mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , mes_msk(jpi,jpj) , STAT=ierr(9) ) 
    370375 
    371376! (ISF) Allocation of basic array    
  • NEMO/branches/UKMO/tools_r4.0-HEAD_dev_MEs/DOMAINcfg/src/domwri.f90

    r15153 r15271  
    1616   !!---------------------------------------------------------------------- 
    1717   USE dom_oce         ! ocean space and time domain 
     18   USE mes, ONLY : ln_loc_mes 
    1819   USE in_out_manager  ! I/O manager 
    1920   USE iom             ! I/O library 
     
    554555      REAL(wp), DIMENSION(:,:), INTENT(out), OPTIONAL ::   px1   ! saw-tooth metric 
    555556      ! 
    556       INTEGER                                         ::   ji, jj, k1, k2 
     557      INTEGER                                         ::   ji, jj, kk, km1, kp1 
     558      REAL(wp)                                        ::   dm1, dp1 
    557559      REAL(wp), DIMENSION(4)                          ::   zr1 
    558560      REAL(wp), DIMENSION(jpi,jpj)                    ::   zx1 
     
    564566         DO jj = 2, jpjm1 
    565567            ! Avoiding coastal points 
    566             IF ( ( + tmask(ji-1,jj+1) + tmask(ji,jj+1) + tmask(ji+1,jj+1)             & 
    567                &   + tmask(ji-1,jj  )                  + tmask(ji+1,jj  )             & 
    568                &   + tmask(ji-1,jj-1) + tmask(ji,jj+1) + tmask(ji+1,jj-1) ) == 8._wp ) THEN 
     568            IF ( ( + ssmask(ji-1,jj+1) + ssmask(ji,jj+1) + ssmask(ji+1,jj+1)             & 
     569               &   + ssmask(ji-1,jj  )                   + ssmask(ji+1,jj  )             & 
     570               &   + ssmask(ji-1,jj-1) + ssmask(ji,jj+1) + ssmask(ji+1,jj-1) ) == 8._wp ) THEN 
    569571               ! 
    570572               zr1(:) = 0._wp    
    571                k1 = mbkt(ji,jj)  
    572                ! i-1 
    573                k2 = mbkt(ji-1,jj) 
    574                IF ( ( (k1 > k2) .AND. (gdepw_0(ji,jj,jpk) < gdepw_0(ji-1,jj,jpk)) ) .OR. & 
    575                   & ( (k1 < k2) .AND. (gdepw_0(ji,jj,jpk) > gdepw_0(ji-1,jj,jpk)) ) ) THEN  
    576                   zr1(1) = ABS( mbkt(ji,jj) - mbkt(ji-1,jj) ) * umask(ji-1,jj) 
     573               kk = mbkt(ji,jj) 
     574               ! 
     575               ! i-direction 
     576               km1 = mbkt(ji-1,jj)  
     577               kp1 = mbkt(ji+1,jj) 
     578               dm1 = gdept_0(ji-1, jj, km1) - gdept_0(ji, jj, kk) 
     579               dp1 = gdept_0(ji+1, jj, kp1) - gdept_0(ji, jj, kk) 
     580               IF ( (dp1 * dm1) > 0. ) THEN 
     581                  zr1(1) = ABS( kk - km1 ) * umask(ji-1, jj) 
     582                  zr1(2) = ABS( kk - kp1 ) * umask(ji  , jj) 
    577583               END IF 
    578                ! i+1 
    579                k2 = mbkt(ji+1,jj) 
    580                IF ( ( (k1 > k2) .AND. (gdepw_0(ji,jj,jpk) < gdepw_0(ji+1,jj,jpk)) ) .OR. & 
    581                   & ( (k1 < k2) .AND. (gdepw_0(ji,jj,jpk) > gdepw_0(ji+1,jj,jpk)) ) ) THEN 
    582                   zr1(2) = ABS( mbkt(ji,jj) - mbkt(ji+1,jj) ) * umask(ji,jj) 
    583                END IF 
    584                ! j+1 
    585                k2 = mbkt(ji,jj+1) 
    586                IF ( ( (k1 > k2) .AND. (gdepw_0(ji,jj,jpk) < gdepw_0(ji,jj+1,jpk)) ) .OR. & 
    587                   & ( (k1 < k2) .AND. (gdepw_0(ji,jj,jpk) > gdepw_0(ji,jj+1,jpk)) ) ) THEN 
    588                   zr1(3) = ABS( mbkt(ji,jj) - mbkt(ji,jj+1) ) * vmask(ji,jj) 
    589                END IF 
    590                ! j-1 
    591                k2 = mbkt(ji,jj-1) 
    592                IF ( ( (k1 > k2) .AND. (gdepw_0(ji,jj,jpk) < gdepw_0(ji,jj-1,jpk)) ) .OR. & 
    593                   & ( (k1 < k2) .AND. (gdepw_0(ji,jj,jpk) > gdepw_0(ji,jj-1,jpk)) ) ) THEN 
    594                   zr1(4) = ABS( mbkt(ji,jj) - mbkt(ji,jj-1) ) * vmask(ji,jj-1) 
     584               ! j-direction 
     585               km1 = mbkt(ji,jj-1) 
     586               kp1 = mbkt(ji,jj+1) 
     587               dm1 = gdept_0(ji, jj-1, km1) - gdept_0(ji, jj, kk) 
     588               dp1 = gdept_0(ji, jj+1, kp1) - gdept_0(ji, jj, kk) 
     589               IF ( (dp1 * dm1) > 0. ) THEN 
     590                  zr1(3) = ABS( kk - km1 ) * vmask(ji, jj-1) 
     591                  zr1(4) = ABS( kk - kp1 ) * vmask(ji, jj  ) 
    595592               END IF 
    596593               zx1(ji,jj) = REAL( MAXVAL(zr1(1:4)), wp ) 
     
    599596         END DO 
    600597      END DO 
     598      IF( ln_loc_mes ) zx1 = zx1 * mes_msk  
    601599      CALL lbc_lnk( zx1, 'T', 1. ) 
    602600      ! 
  • NEMO/branches/UKMO/tools_r4.0-HEAD_dev_MEs/DOMAINcfg/src/mes.F90

    r15172 r15271  
    11MODULE mes 
    22   !!============================================================================== 
    3    !!                       ***  MODULE zgrmes   *** 
     3   !!                       ***  MODULE mes   *** 
    44   !! Ocean initialization : Multiple Enveloped s coordinate (MES) 
    55   !!============================================================================== 
  • NEMO/branches/UKMO/tools_r4.0-HEAD_dev_MEs/DOMAINcfg/src/zgrmes.F90

    r15129 r15271  
    178178     CALL iom_get( inum, jpdom_data, 's2z_wgt', s2z_wgt) 
    179179 
     180     mes_msk(:,:) = 1. 
     181     WHERE (s2z_msk(:,:).eq.0.0)  mes_msk(:,:) = 0.0 
     182 
    180183     DO jj = 1,jpj 
    181184        DO ji = 1,jpi 
Note: See TracChangeset for help on using the changeset viewer.