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 14037 for NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/SWE/domvvl.F90 – NEMO

Ignore:
Timestamp:
2020-12-03T12:20:38+01:00 (3 years ago)
Author:
ayoung
Message:

Updated to trunk at 14020. Sette tests passed with change of results for configurations with non-linear ssh. Ticket #2506.

Location:
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG

    • Property svn:externals

      •  

        old new  
        88 
        99# SETTE 
        10 ^/utils/CI/sette@13292        sette 
         10^/utils/CI/sette_wave@13990         sette 

  • NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/SWE/domvvl.F90

    r13295 r14037  
    276276            IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 
    277277               IF( nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 
    278                   ii0 = 103   ;   ii1 = 111        
    279                   ij0 = 128   ;   ij1 = 135   ;    
     278                  ii0 = 103 + nn_hls - 1   ;   ii1 = 111 + nn_hls - 1       
     279                  ij0 = 128 + nn_hls       ;   ij1 = 135 + nn_hls 
    280280                  frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp 
    281281                  frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rn_Dt 
    … …  
    415415      LOGICAL                ::   ll_do_bclinic         ! local logical 
    416416      REAL(wp), DIMENSION(jpi,jpj)     ::   zht, z_scale, zwu, zwv, zhdiv 
    417       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t 
     417      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ze3t 
     418      LOGICAL , DIMENSION(:,:,:), ALLOCATABLE ::   llmsk 
    418419      !!---------------------------------------------------------------------- 
    419420      ! 
    … …  
    528529         ! Maximum deformation control 
    529530         ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
     531         ALLOCATE( ze3t(jpi,jpj,jpk), llmsk(jpi,jpj,jpk) ) 
    530532         ze3t(:,:,jpk) = 0._wp 
    531533         DO jk = 1, jpkm1 
    532534            ze3t(:,:,jk) = tilde_e3t_a(:,:,jk) / e3t_0(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 
    533535         END DO 
    534          z_tmax = MAXVAL( ze3t(:,:,:) ) 
    535          CALL mpp_max( 'domvvl', z_tmax )                 ! max over the global domain 
    536          z_tmin = MINVAL( ze3t(:,:,:) ) 
    537          CALL mpp_min( 'domvvl', z_tmin )                 ! min over the global domain 
     536         ! 
     537         llmsk(   1:Nis1,:,:) = .FALSE.   ! exclude halos from the checked region 
     538         llmsk(Nie1: jpi,:,:) = .FALSE. 
     539         llmsk(:,   1:Njs1,:) = .FALSE. 
     540         llmsk(:,Nje1: jpj,:) = .FALSE. 
     541         ! 
     542         llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp                  ! define only the inner domain 
     543         z_tmax = MAXVAL( ze3t(:,:,:), mask = llmsk )   ;   CALL mpp_max( 'domvvl', z_tmax )   ! max over the global domain 
     544         z_tmin = MINVAL( ze3t(:,:,:), mask = llmsk )   ;   CALL mpp_min( 'domvvl', z_tmin )   ! min over the global domain 
    538545         ! - ML - test: for the moment, stop simulation for too large e3_t variations 
    539546         IF( ( z_tmax >  rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 
    540             IF( lk_mpp ) THEN 
    541                CALL mpp_maxloc( 'domvvl', ze3t, tmask, z_tmax, ijk_max ) 
    542                CALL mpp_minloc( 'domvvl', ze3t, tmask, z_tmin, ijk_min ) 
    543             ELSE 
    544                ijk_max = MAXLOC( ze3t(:,:,:) ) 
    545                ijk_max(1) = ijk_max(1) + nimpp - 1 
    546                ijk_max(2) = ijk_max(2) + njmpp - 1 
    547                ijk_min = MINLOC( ze3t(:,:,:) ) 
    548                ijk_min(1) = ijk_min(1) + nimpp - 1 
    549                ijk_min(2) = ijk_min(2) + njmpp - 1 
    550             ENDIF 
     547            CALL mpp_maxloc( 'domvvl', ze3t, llmsk, z_tmax, ijk_max ) 
     548            CALL mpp_minloc( 'domvvl', ze3t, llmsk, z_tmin, ijk_min ) 
    551549            IF (lwp) THEN 
    552550               WRITE(numout, *) 'MAX( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmax 
    … …  
    557555            ENDIF 
    558556         ENDIF 
     557         DEALLOCATE( ze3t, llmsk ) 
    559558         ! - ML - end test 
    560559         ! - ML - Imposing these limits will cause a baroclinicity error which is corrected for below 
    … …  
    697696      LOGICAL                ::   ll_do_bclinic         ! local logical 
    698697      REAL(wp), DIMENSION(jpi,jpj)     ::   zht, z_scale, zwu, zwv, zhdiv 
    699       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t 
    700698      !!---------------------------------------------------------------------- 
    701699      ! 
    … …  
    11071105         IF( ln_rstart ) THEN                   !* Read the restart file 
    11081106            CALL rst_read_open                  !  open the restart file if necessary 
    1109             CALL iom_get( numror, jpdom_autoglo, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
     1107            CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm)    ) 
    11101108            ! 
    11111109            id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
    … …  
    11201118            ! 
    11211119            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    1122                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    1123                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     1120               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 
     1121               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 
    11241122               ! needed to restart if land processor not computed  
    11251123               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' 
    … …  
    11351133               IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 
    11361134               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    1137                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
     1135               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 
    11381136               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    11391137               l_1st_euler = .true. 
    … …  
    11421140               IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 
    11431141               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    1144                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     1142               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 
    11451143               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    11461144               l_1st_euler = .true. 
    … …  
    11671165               !                          ! ----------------------- ! 
    11681166               IF( MIN( id3, id4 ) > 0 ) THEN  ! all required arrays exist 
    1169                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
    1170                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
     1167                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 
     1168                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 
    11711169               ELSE                            ! one at least array is missing 
    11721170                  tilde_e3t_b(:,:,:) = 0.0_wp 
    … …  
    11771175                  !                       ! ------------ ! 
    11781176                  IF( id5 > 0 ) THEN  ! required array exists 
    1179                      CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 
     1177                     CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) ) 
    11801178                  ELSE                ! array is missing 
    11811179                     hdiv_lf(:,:,:) = 0.0_wp 
    … …  
    12531251         !                                   ! =================== 
    12541252         IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 
    1255          IF( lwxios ) CALL iom_swap(      cwxios_context          ) 
    12561253         !                                           ! --------- ! 
    12571254         !                                           ! all cases ! 
    12581255         !                                           ! --------- ! 
    1259          CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lwxios ) 
    1260          CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lwxios ) 
     1256         CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t(:,:,:,Kbb) ) 
     1257         CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t(:,:,:,Kmm) ) 
    12611258         !                                           ! ----------------------- ! 
    12621259         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases ! 
    12631260            !                                        ! ----------------------- ! 
    1264             CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lwxios) 
    1265             CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lwxios) 
     1261            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:)) 
     1262            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:)) 
    12661263         END IF 
    12671264         !                                           ! -------------!     
    12681265         IF( ln_vvl_ztilde ) THEN                    ! z_tilde case ! 
    12691266            !                                        ! ------------ ! 
    1270             CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lwxios) 
     1267            CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:)) 
    12711268         ENDIF 
    12721269         ! 
    1273          IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    12741270      ENDIF 
    12751271      ! 
Note: See TracChangeset for help on using the changeset viewer.