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 13540 for NEMO/branches/2020/r12377_ticket2386/src/OCE/TRA/zpshde.F90 – NEMO

Ignore:
Timestamp:
2020-09-29T12:41:06+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2386: update to latest trunk

Location:
NEMO/branches/2020/r12377_ticket2386
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/r12377_ticket2386

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
        88 
        99# SETTE 
        10 ^/utils/CI/sette@HEAD         sette 
         10^/utils/CI/sette@13507        sette 

  • NEMO/branches/2020/r12377_ticket2386/src/OCE/TRA/zpshde.F90

    r12377 r13540  
    3232   !! * Substitutions 
    3333#  include "do_loop_substitute.h90" 
     34#  include "domzgr_substitute.h90" 
    3435   !!---------------------------------------------------------------------- 
    3536   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    6566      !!              ___ |   |   |           ___  |   |   | 
    6667      !!                   
    67       !!      case 1->   e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then 
    68       !!          t~ = t(i+1,j  ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1) 
    69       !!        ( t~ = t(i  ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1)  ) 
     68      !!      case 1->   e3w(i+1,:,:,Kmm) >= e3w(i,:,:,Kmm) ( and e3w(:,j+1,:,Kmm) >= e3w(:,j,:,Kmm) ) then 
     69      !!          t~ = t(i+1,j  ,k) + (e3w(i+1,j,k,Kmm) - e3w(i,j,k,Kmm)) * dk(Ti+1)/e3w(i+1,j,k,Kmm) 
     70      !!        ( t~ = t(i  ,j+1,k) + (e3w(i,j+1,k,Kmm) - e3w(i,j,k,Kmm)) * dk(Tj+1)/e3w(i,j+1,k,Kmm)  ) 
    7071      !!          or 
    71       !!      case 2->   e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then 
    72       !!          t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i ) 
    73       !!        ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) ) 
     72      !!      case 2->   e3w(i+1,:,:,Kmm) <= e3w(i,:,:,Kmm) ( and e3w(:,j+1,:,Kmm) <= e3w(:,j,:,Kmm) ) then 
     73      !!          t~ = t(i,j,k) + (e3w(i,j,k,Kmm) - e3w(i+1,j,k,Kmm)) * dk(Ti)/e3w(i,j,k,Kmm) 
     74      !!        ( t~ = t(i,j,k) + (e3w(i,j,k,Kmm) - e3w(i,j+1,k,Kmm)) * dk(Tj)/e3w(i,j,k,Kmm) ) 
    7475      !!          Idem for di(s) and dj(s)           
    7576      !! 
    … …  
    106107      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    107108         ! 
    108          DO_2D_10_10 
     109         DO_2D( 1, 0, 1, 0 ) 
    109110            iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
    110111            ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1 
    111 !!gm BUG ? when applied to before fields, e3w(:,:,:,Kbb) should be used.... 
     112!!gm BUG ? when applied to before fields, e3w(:,:,k,Kbb) should be used.... 
    112113            ze3wu = e3w(ji+1,jj  ,iku,Kmm) - e3w(ji,jj,iku,Kmm) 
    113114            ze3wv = e3w(ji  ,jj+1,ikv,Kmm) - e3w(ji,jj,ikv,Kmm) 
    … …  
    145146      END DO 
    146147      ! 
    147       CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1. , pgtv(:,:,:), 'V', -1. )   ! Lateral boundary cond. 
     148      CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
    148149      !                 
    149150      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
    150151         pgru(:,:) = 0._wp 
    151152         pgrv(:,:) = 0._wp                ! depth of the partial step level 
    152          DO_2D_10_10 
     153         DO_2D( 1, 0, 1, 0 ) 
    153154            iku = mbku(ji,jj) 
    154155            ikv = mbkv(ji,jj) 
    … …  
    166167         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj  
    167168         ! 
    168          DO_2D_10_10 
     169         DO_2D( 1, 0, 1, 0 )              ! Gradient of density at the last level 
    169170            iku = mbku(ji,jj) 
    170171            ikv = mbkv(ji,jj) 
    … …  
    178179            ENDIF 
    179180         END_2D 
    180          CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1. , pgrv , 'V', -1. )   ! Lateral boundary conditions 
     181         CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
    181182         ! 
    182183      END IF 
    … …  
    214215      !!              ___ |   |   |           ___  |   |   | 
    215216      !!                   
    216       !!      case 1->   e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then 
    217       !!          t~ = t(i+1,j  ,k) + (e3w(i+1) - e3w(i)) * dk(Ti+1)/e3w(i+1) 
    218       !!        ( t~ = t(i  ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(Tj+1)/e3w(j+1)  ) 
     217      !!      case 1->   e3w(i+1,j,k,Kmm) >= e3w(i,j,k,Kmm) ( and e3w(i,j+1,k,Kmm) >= e3w(i,j,k,Kmm) ) then 
     218      !!          t~ = t(i+1,j  ,k) + (e3w(i+1,j  ,k,Kmm) - e3w(i,j,k,Kmm)) * dk(Ti+1)/e3w(i+1,j  ,k,Kmm) 
     219      !!        ( t~ = t(i  ,j+1,k) + (e3w(i  ,j+1,k,Kmm) - e3w(i,j,k,Kmm)) * dk(Tj+1)/e3w(i  ,j+1,k,Kmm)  ) 
    219220      !!          or 
    220       !!      case 2->   e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then 
    221       !!          t~ = t(i,j,k) + (e3w(i) - e3w(i+1)) * dk(Ti)/e3w(i ) 
    222       !!        ( t~ = t(i,j,k) + (e3w(j) - e3w(j+1)) * dk(Tj)/e3w(j ) ) 
     221      !!      case 2->   e3w(i+1,j,k,Kmm) <= e3w(i,j,k,Kmm) ( and e3w(i,j+1,k,Kmm) <= e3w(i,j,k,Kmm) ) then 
     222      !!          t~ = t(i,j,k) + (e3w(i,j,k,Kmm) - e3w(i+1,j  ,k,Kmm)) * dk(Ti)/e3w(i,j,k,Kmm) 
     223      !!        ( t~ = t(i,j,k) + (e3w(i,j,k,Kmm) - e3w(i  ,j+1,k,Kmm)) * dk(Tj)/e3w(i,j,k,Kmm) ) 
    223224      !!          Idem for di(s) and dj(s)           
    224225      !! 
    … …  
    261262      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==! 
    262263         ! 
    263          DO_2D_10_10 
     264         DO_2D( 1, 0, 1, 0 ) 
    264265 
    265266            iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points 
    … …  
    301302      END DO 
    302303      ! 
    303       CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1. , pgtv(:,:,:), 'V', -1. )   ! Lateral boundary cond. 
     304      CALL lbc_lnk_multi( 'zpshde', pgtu(:,:,:), 'U', -1.0_wp , pgtv(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
    304305 
    305306      ! horizontal derivative of density anomalies (rd) 
    … …  
    307308         pgru(:,:)=0.0_wp   ; pgrv(:,:)=0.0_wp ;  
    308309         ! 
    309          DO_2D_10_10 
     310         DO_2D( 1, 0, 1, 0 ) 
    310311 
    311312            iku = mbku(ji,jj) 
    … …  
    328329         CALL eos( ztj, zhj, zrj ) 
    329330 
    330          DO_2D_10_10 
     331         DO_2D( 1, 0, 1, 0 )            ! Gradient of density at the last level 
    331332            iku = mbku(ji,jj) 
    332333            ikv = mbkv(ji,jj) 
    … …  
    343344         END_2D 
    344345 
    345          CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1. , pgrv , 'V', -1. )   ! Lateral boundary conditions 
     346         CALL lbc_lnk_multi( 'zpshde', pgru , 'U', -1.0_wp , pgrv , 'V', -1.0_wp )   ! Lateral boundary conditions 
    346347         ! 
    347348      END IF 
    … …  
    350351      ! 
    351352      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!            ! 
    352          DO_2D_10_10 
     353         DO_2D( 1, 0, 1, 0 ) 
    353354            iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1 
    354355            ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1 
    … …  
    356357            ! (ISF) case partial step top and bottom in adjacent cell in vertical 
    357358            ! cannot used e3w because if 2 cell water column, we have ps at top and bottom 
    358             ! in this case e3w(i,j) - e3w(i,j+1) is not the distance between Tj~ and Tj 
     359            ! in this case e3w(i,j,k,Kmm) - e3w(i,j+1,k,Kmm) is not the distance between Tj~ and Tj 
    359360            ! the only common depth between cells (i,j) and (i,j+1) is gdepw_0 
    360361            ze3wu  =  gdept(ji,jj,iku,Kmm) - gdept(ji+1,jj,iku,Kmm) 
    … …  
    394395         ! 
    395396      END DO 
    396       CALL lbc_lnk_multi( 'zpshde', pgtui(:,:,:), 'U', -1. , pgtvi(:,:,:), 'V', -1. )   ! Lateral boundary cond. 
     397      CALL lbc_lnk_multi( 'zpshde', pgtui(:,:,:), 'U', -1.0_wp , pgtvi(:,:,:), 'V', -1.0_wp )   ! Lateral boundary cond. 
    397398 
    398399      IF( PRESENT( prd ) ) THEN    !==  horizontal derivative of density anomalies (rd)  ==!    (optional part) 
    399400         ! 
    400401         pgrui(:,:)  =0.0_wp; pgrvi(:,:)  =0.0_wp; 
    401          DO_2D_10_10 
     402         DO_2D( 1, 0, 1, 0 ) 
    402403 
    403404            iku = miku(ji,jj) 
    … …  
    419420         CALL eos( ztj, zhj, zrj )        ! at the partial step depth output in  zri, zrj  
    420421         ! 
    421          DO_2D_10_10 
     422         DO_2D( 1, 0, 1, 0 )              ! Gradient of density at the last level 
    422423            iku = miku(ji,jj)  
    423424            ikv = mikv(ji,jj)  
    … …  
    433434 
    434435         END_2D 
    435          CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1. , pgrvi, 'V', -1. )   ! Lateral boundary conditions 
     436         CALL lbc_lnk_multi( 'zpshde', pgrui, 'U', -1.0_wp , pgrvi, 'V', -1.0_wp )   ! Lateral boundary conditions 
    436437         ! 
    437438      END IF   
Note: See TracChangeset for help on using the changeset viewer.