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 5845 for branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90 – NEMO

Ignore:
Timestamp:
2015-10-31T08:40:45+01:00 (8 years ago)
Author:
gm
Message:

#1613: vvl by default: suppression of domzgr_substitute.h90

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r5656 r5845  
    2626   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    2727   !!---------------------------------------------------------------------- 
    28  
    2928CONTAINS 
    3029 
    … …  
    6766      ! 
    6867   END SUBROUTINE Agrif_Update_Tra 
     68 
    6969 
    7070   RECURSIVE SUBROUTINE Agrif_Update_Dyn( ) 
    … …  
    153153 
    154154# if defined key_zdftke 
     155 
    155156   SUBROUTINE Agrif_Update_Tke( kt ) 
    156157      !!--------------------------------------------- 
    … …  
    175176       
    176177   END SUBROUTINE Agrif_Update_Tke 
     178    
    177179# endif /* key_zdftke */ 
    178180 
    … …  
    181183      !!           *** ROUTINE updateT *** 
    182184      !!--------------------------------------------- 
    183 #  include "domzgr_substitute.h90" 
    184185      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    185186      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    … …  
    231232   END SUBROUTINE updateTS 
    232233 
     234 
    233235   SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, before ) 
    234236      !!--------------------------------------------- 
    235237      !!           *** ROUTINE updateu *** 
    236238      !!--------------------------------------------- 
    237 #  include "domzgr_substitute.h90" 
    238       !! 
    239239      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
    240240      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    … …  
    250250            DO jj=j1,j2 
    251251               DO ji=i1,i2 
    252                   tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 
    253                   tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u_n(ji,jj,jk) 
     252                  tabres(ji,jj,jk) = e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) 
    254253               END DO 
    255254            END DO 
    … …  
    260259            DO jj=j1,j2 
    261260               DO ji=i1,i2 
    262                   tabres(ji,jj,jk) = tabres(ji,jj,jk) / e2u(ji,jj) / fse3u_n(ji,jj,jk) 
     261                  tabres(ji,jj,jk) = tabres(ji,jj,jk) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) 
    263262                  ! 
    264263                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    … …  
    275274   END SUBROUTINE updateu 
    276275 
     276 
    277277   SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, before ) 
    278278      !!--------------------------------------------- 
    279279      !!           *** ROUTINE updatev *** 
    280280      !!--------------------------------------------- 
    281 #  include "domzgr_substitute.h90" 
    282       !! 
    283281      INTEGER :: i1,i2,j1,j2,k1,k2 
    284282      INTEGER :: ji,jj,jk 
    … …  
    294292            DO jj=j1,j2 
    295293               DO ji=i1,i2 
    296                   tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 
    297                   tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v_n(ji,jj,jk) 
     294                  tabres(ji,jj,jk) = e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 
    298295               END DO 
    299296            END DO 
    … …  
    304301            DO jj=j1,j2 
    305302               DO ji=i1,i2 
    306                   tabres(ji,jj,jk) = tabres(ji,jj,jk) / e1v(ji,jj) / fse3v_n(ji,jj,jk) 
     303                  tabres(ji,jj,jk) = tabres(ji,jj,jk) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) 
    307304                  ! 
    308305                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    … …  
    319316   END SUBROUTINE updatev 
    320317 
     318 
    321319   SUBROUTINE updateu2d( tabres, i1, i2, j1, j2, before ) 
    322320      !!--------------------------------------------- 
    323321      !!          *** ROUTINE updateu2d *** 
    324322      !!--------------------------------------------- 
    325 #  include "domzgr_substitute.h90" 
    326       !! 
    327323      INTEGER, INTENT(in) :: i1, i2, j1, j2 
    328324      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
    … …  
    338334         DO jj=j1,j2 
    339335            DO ji=i1,i2 
    340                tabres(ji,jj) = un_b(ji,jj) * hu(ji,jj) * e2u(ji,jj) 
     336               tabres(ji,jj) = un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj) 
    341337            END DO 
    342338         END DO 
    … …  
    345341         DO jj=j1,j2 
    346342            DO ji=i1,i2 
    347                tabres(ji,jj) =  tabres(ji,jj) * hur(ji,jj) / e2u(ji,jj)   
     343               tabres(ji,jj) =  tabres(ji,jj) * r1_hu_n(ji,jj) * r1_e2u(ji,jj)   
    348344               !     
    349345               ! Update "now" 3d velocities: 
    350346               spgu(ji,jj) = 0.e0 
    351347               DO jk=1,jpkm1 
    352                   spgu(ji,jj) = spgu(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) 
    353                END DO 
    354                spgu(ji,jj) = spgu(ji,jj) * hur(ji,jj) 
     348                  spgu(ji,jj) = spgu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) 
     349               END DO 
     350               spgu(ji,jj) = spgu(ji,jj) * r1_hu_n(ji,jj) 
    355351               ! 
    356352               zcorr = tabres(ji,jj) - spgu(ji,jj) 
    … …  
    371367               spgu(ji,jj) = 0.e0 
    372368               DO jk=1,jpkm1 
    373                   spgu(ji,jj) = spgu(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) 
    374                END DO 
    375                spgu(ji,jj) = spgu(ji,jj) * hur_b(ji,jj) 
     369                  spgu(ji,jj) = spgu(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) 
     370               END DO 
     371               spgu(ji,jj) = spgu(ji,jj) * r1_hu_b(ji,jj) 
    376372               ! 
    377373               zcorr = ub_b(ji,jj) - spgu(ji,jj) 
    … …  
    385381      ! 
    386382   END SUBROUTINE updateu2d 
     383 
    387384 
    388385   SUBROUTINE updatev2d( tabres, i1, i2, j1, j2, before ) 
    … …  
    403400         DO jj=j1,j2 
    404401            DO ji=i1,i2 
    405                tabres(ji,jj) = vn_b(ji,jj) * hv(ji,jj) * e1v(ji,jj)  
     402               tabres(ji,jj) = vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj)  
    406403            END DO 
    407404         END DO 
    … …  
    410407         DO jj=j1,j2 
    411408            DO ji=i1,i2 
    412                tabres(ji,jj) =  tabres(ji,jj) * hvr(ji,jj) / e1v(ji,jj)   
     409               tabres(ji,jj) =  tabres(ji,jj) * r1_hv_n(ji,jj) * r1_e1v(ji,jj)   
    413410               !     
    414411               ! Update "now" 3d velocities: 
    415412               spgv(ji,jj) = 0.e0 
    416413               DO jk=1,jpkm1 
    417                   spgv(ji,jj) = spgv(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) 
    418                END DO 
    419                spgv(ji,jj) = spgv(ji,jj) * hvr(ji,jj) 
     414                  spgv(ji,jj) = spgv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) 
     415               END DO 
     416               spgv(ji,jj) = spgv(ji,jj) * r1_hv_n(ji,jj) 
    420417               ! 
    421418               zcorr = tabres(ji,jj) - spgv(ji,jj) 
    … …  
    436433               spgv(ji,jj) = 0.e0 
    437434               DO jk=1,jpkm1 
    438                   spgv(ji,jj) = spgv(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) 
    439                END DO 
    440                spgv(ji,jj) = spgv(ji,jj) * hvr_b(ji,jj) 
     435                  spgv(ji,jj) = spgv(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) 
     436               END DO 
     437               spgv(ji,jj) = spgv(ji,jj) * r1_hv_b(ji,jj) 
    441438               ! 
    442439               zcorr = vb_b(ji,jj) - spgv(ji,jj) 
    … …  
    489486   END SUBROUTINE updateSSH 
    490487 
     488 
    491489   SUBROUTINE updateub2b( tabres, i1, i2, j1, j2, before ) 
    492490      !!--------------------------------------------- 
    … …  
    519517   END SUBROUTINE updateub2b 
    520518 
     519 
    521520   SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before ) 
    522521      !!--------------------------------------------- 
    … …  
    555554      !!           *** ROUTINE updateT *** 
    556555      !!--------------------------------------------- 
    557 #  include "domzgr_substitute.h90" 
    558  
    559556      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    560557      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    561558      LOGICAL, iNTENT(in) :: before 
    562  
     559      ! 
    563560      INTEGER :: ji,jj,jk 
    564561      REAL(wp) :: ztemp 
     562      !!--------------------------------------------- 
    565563 
    566564      IF (before) THEN 
    … …  
    600598 
    601599# if defined key_zdftke 
     600 
    602601   SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before ) 
    603602      !!--------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.