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

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

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

Location:
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC
Files:
6 edited

Legend:

Unmodified
Added
Removed

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

    r5656 r5845  
    4646# endif 
    4747 
    48 #  include "domzgr_substitute.h90"   
    4948#  include "vectopt_loop_substitute.h90" 
    5049   !!---------------------------------------------------------------------- 
    … …  
    7675      !!                  ***  ROUTINE Agrif_DYN  *** 
    7776      !!----------------------------------------------------------------------   
    78       !!  
    7977      INTEGER, INTENT(in) ::   kt 
    80       !! 
     78      ! 
    8179      INTEGER :: ji,jj,jk, j1,j2, i1,i2 
    8280      REAL(wp) :: timeref 
    … …  
    137135         DO jk=1,jpkm1 
    138136            DO jj=1,jpj 
    139                spgu(2,jj)=spgu(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk) 
     137               spgu(2,jj)=spgu(2,jj)+e3u_n(2,jj,jk)*ua(2,jj,jk) 
    140138            END DO 
    141139         END DO 
    … …  
    143141         DO jj=1,jpj 
    144142            IF (umask(2,jj,1).NE.0.) THEN 
    145                spgu(2,jj)=spgu(2,jj)/hu(2,jj) 
     143               spgu(2,jj)=spgu(2,jj)*r1_hu_n(2,jj) 
    146144            ENDIF 
    147145         END DO 
    … …  
    161159         DO jk=1,jpkm1 
    162160            DO jj=1,jpj 
    163                spgu1(2,jj)=spgu1(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk) 
     161               spgu1(2,jj)=spgu1(2,jj)+e3u_n(2,jj,jk)*ua(2,jj,jk) 
    164162            END DO 
    165163         END DO 
    … …  
    167165         DO jj=1,jpj 
    168166            IF (umask(2,jj,1).NE.0.) THEN 
    169                spgu1(2,jj)=spgu1(2,jj)/hu(2,jj) 
     167               spgu1(2,jj)=spgu1(2,jj)*r1_hu_n(2,jj) 
    170168            ENDIF 
    171169         END DO 
    … …  
    182180         DO jk=1,jpkm1 
    183181            DO jj=1,jpj 
    184                spgv1(2,jj)=spgv1(2,jj)+fse3v_a(2,jj,jk)*va(2,jj,jk) 
     182               spgv1(2,jj)=spgv1(2,jj)+e3v_a(2,jj,jk)*va(2,jj,jk) 
    185183            END DO 
    186184         END DO 
    187185         DO jj=1,jpj 
    188             spgv1(2,jj)=spgv1(2,jj)*hvr_a(2,jj) 
     186            spgv1(2,jj)=spgv1(2,jj)*r1_hv_a(2,jj) 
    189187         END DO 
    190188         DO jk=1,jpkm1 
    … …  
    207205         DO jk=1,jpkm1 
    208206            DO jj=1,jpj 
    209                spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 
     207               spgu(nlci-2,jj)=spgu(nlci-2,jj)+e3u_n(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 
    210208            ENDDO 
    211209         ENDDO 
    212210         DO jj=1,jpj 
    213211            IF (umask(nlci-2,jj,1).NE.0.) THEN 
    214                spgu(nlci-2,jj)=spgu(nlci-2,jj)/hu(nlci-2,jj) 
     212               spgu(nlci-2,jj)=spgu(nlci-2,jj)*r1_hu_n(nlci-2,jj) 
    215213            ENDIF 
    216214         END DO 
    … …  
    229227         DO jk=1,jpkm1 
    230228            DO jj=1,jpj 
    231                spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk) 
     229               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+e3u_n(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk) 
    232230            END DO 
    233231         END DO 
    234232         DO jj=1,jpj 
    235233            IF (umask(nlci-2,jj,1).NE.0.) THEN 
    236                spgu1(nlci-2,jj)=spgu1(nlci-2,jj)/hu(nlci-2,jj) 
     234               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)*r1_hu_n(nlci-2,jj) 
    237235            ENDIF 
    238236         END DO 
    … …  
    248246         DO jk=1,jpkm1 
    249247            DO jj=1,jpj 
    250                spgv1(nlci-1,jj)=spgv1(nlci-1,jj)+fse3v_a(nlci-1,jj,jk)*va(nlci-1,jj,jk)*vmask(nlci-1,jj,jk) 
     248               spgv1(nlci-1,jj)=spgv1(nlci-1,jj)+e3v_a(nlci-1,jj,jk)*va(nlci-1,jj,jk)*vmask(nlci-1,jj,jk) 
    251249            END DO 
    252250         END DO 
    253251 
    254252         DO jj=1,jpj 
    255             spgv1(nlci-1,jj)=spgv1(nlci-1,jj)*hvr_a(nlci-1,jj) 
     253            spgv1(nlci-1,jj)=spgv1(nlci-1,jj)*r1_hv_a(nlci-1,jj) 
    256254         END DO 
    257255 
    … …  
    278276         DO jk=1,jpkm1 
    279277            DO ji=1,jpi 
    280                spgv(ji,2)=spgv(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk) 
     278               spgv(ji,2)=spgv(ji,2)+e3v_n(ji,2,jk)*va(ji,2,jk) 
    281279            END DO 
    282280         END DO 
    … …  
    284282         DO ji=1,jpi 
    285283            IF (vmask(ji,2,1).NE.0.) THEN 
    286                spgv(ji,2)=spgv(ji,2)/hv(ji,2) 
     284               spgv(ji,2)=spgv(ji,2)* r1_hv_n(ji,2) 
    287285            ENDIF 
    288286         END DO 
    … …  
    302300         DO jk=1,jpkm1 
    303301            DO ji=1,jpi 
    304                spgv1(ji,2)=spgv1(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk) 
     302               spgv1(ji,2)=spgv1(ji,2)+e3v_n(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk) 
    305303            END DO 
    306304         END DO 
    … …  
    308306         DO ji=1,jpi 
    309307            IF (vmask(ji,2,1).NE.0.) THEN 
    310                spgv1(ji,2)=spgv1(ji,2)/hv(ji,2) 
     308               spgv1(ji,2)=spgv1(ji,2)*r1_hv_n(ji,2) 
    311309            ENDIF 
    312310         END DO 
    … …  
    323321         DO jk=1,jpkm1 
    324322            DO ji=1,jpi 
    325                spgu1(ji,2)=spgu1(ji,2)+fse3u_a(ji,2,jk)*ua(ji,2,jk)*umask(ji,2,jk) 
     323               spgu1(ji,2)=spgu1(ji,2)+e3u_a(ji,2,jk)*ua(ji,2,jk)*umask(ji,2,jk) 
    326324            END DO 
    327325         END DO 
    328326 
    329327         DO ji=1,jpi 
    330             spgu1(ji,2)=spgu1(ji,2)*hur_a(ji,2) 
     328            spgu1(ji,2)=spgu1(ji,2)*r1_hu_a(ji,2) 
    331329         END DO 
    332330 
    … …  
    353351         DO jk=1,jpkm1 
    354352            DO ji=1,jpi 
    355                spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
     353               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+e3v_n(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
    356354            END DO 
    357355         END DO 
    … …  
    359357         DO ji=1,jpi 
    360358            IF (vmask(ji,nlcj-2,1).NE.0.) THEN 
    361                spgv(ji,nlcj-2)=spgv(ji,nlcj-2)/hv(ji,nlcj-2) 
     359               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)*r1_hv_n(ji,nlcj-2) 
    362360            ENDIF 
    363361         END DO 
    … …  
    378376         DO jk=1,jpkm1 
    379377            DO ji=1,jpi 
    380                spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
     378               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+e3v_n(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 
    381379            END DO 
    382380         END DO 
    … …  
    384382         DO ji=1,jpi 
    385383            IF (vmask(ji,nlcj-2,1).NE.0.) THEN 
    386                spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)/hv(ji,nlcj-2) 
     384               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)*r1_hv_n(ji,nlcj-2) 
    387385            ENDIF 
    388386         END DO 
    … …  
    399397         DO jk=1,jpkm1 
    400398            DO ji=1,jpi 
    401                spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)+fse3u_a(ji,nlcj-1,jk)*ua(ji,nlcj-1,jk) 
     399               spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)+e3u_a(ji,nlcj-1,jk)*ua(ji,nlcj-1,jk) 
    402400            END DO 
    403401         END DO 
    404402 
    405403         DO ji=1,jpi 
    406             spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)*hur_a(ji,nlcj-1) 
     404            spgu1(ji,nlcj-1)=spgu1(ji,nlcj-1)*r1_hu_a(ji,nlcj-1) 
    407405         END DO 
    408406 
    … …  
    812810               DO ji=i1,i2 
    813811                  ptab(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 
    814                   ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3u(ji,jj,jk) 
     812                  ptab(ji,jj,jk) = ptab(ji,jj,jk) * e3u_n(ji,jj,jk) 
    815813               END DO 
    816814            END DO 
    … …  
    821819            DO jj=j1,j2 
    822820               ua(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhoy*e2u(i1:i2,jj))) 
    823                ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / fse3u(i1:i2,jj,jk) 
     821               ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / e3u_n(i1:i2,jj,jk) 
    824822            END DO 
    825823         END DO 
    … …  
    880878               DO ji=i1,i2 
    881879                  ptab(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 
    882                   ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3v(ji,jj,jk) 
     880                  ptab(ji,jj,jk) = ptab(ji,jj,jk) * e3v_n(ji,jj,jk) 
    883881               END DO 
    884882            END DO 
    … …  
    889887            DO jj=j1,j2 
    890888               va(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhox*e1v(i1:i2,jj))) 
    891                va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / fse3v(i1:i2,jj,jk) 
     889               va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / e3v_n(i1:i2,jj,jk) 
    892890            END DO 
    893891         END DO 
    … …  
    944942         DO jj=j1,j2 
    945943            DO ji=i1,i2 
    946                ptab(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu(ji,jj)  
     944               ptab(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu_n(ji,jj)  
    947945            END DO 
    948946         END DO 
    … …  
    10211019         DO jj=j1,j2 
    10221020            DO ji=i1,i2 
    1023                ptab(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv(ji,jj)  
     1021               ptab(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv_n(ji,jj)  
    10241022            END DO 
    10251023         END DO 
    … …  
    12091207                        WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk 
    12101208                     ENDIF 
    1211                      WRITE(numout,*) '      ptab(ji,jj,jk), fse3t(ji,jj,jk) ', ptab(ji,jj,jk), e3t_0(ji,jj,jk) 
     1209                     WRITE(numout,*) '      ptab(ji,jj,jk), e3t(ji,jj,jk) ', ptab(ji,jj,jk), e3t_0(ji,jj,jk) 
    12121210                     kindic_agr = kindic_agr + 1 
    12131211                  ENDIF 
    … …  
    12191217      !  
    12201218   END SUBROUTINE interpe3t 
     1219 
    12211220 
    12221221   SUBROUTINE interpumsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 

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

    r5836 r5845  
    1717   PUBLIC interptsn_sponge, interpun_sponge, interpvn_sponge 
    1818 
    19    !! * Substitutions 
    20 #  include "domzgr_substitute.h90" 
    2119   !!---------------------------------------------------------------------- 
    2220   !! NEMO/NST 3.3 , NEMO Consortium (2010) 
    … …  
    210208               DO jj = j1,j2-1 
    211209                  DO ji = i1,i2-1 
    212                      zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
    213                      zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
     210                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) 
     211                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) 
    214212                     ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) )  
    215213                     ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
    … …  
    239237 
    240238                     IF (.NOT. tabspongedone_tsn(ji,jj)) THEN  
    241                         zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) 
     239                        zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    242240                        ! horizontal diffusive trends 
    243241                        ztsa = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) 
    … …  
    290288            DO jj = j1,j2 
    291289               DO ji = i1+1,i2   ! vector opt. 
    292                   zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 
    293                   hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*fse3u_n(ji  ,jj,jk) * ubdiff(ji  ,jj,jk) & 
    294                                      &   -e2u(ji-1,jj)*fse3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr 
     290                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 
     291                  hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*e3u_n(ji  ,jj,jk) * ubdiff(ji  ,jj,jk) & 
     292                                     &   -e2u(ji-1,jj)*e3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr 
    295293               END DO 
    296294            END DO 
    … …  
    298296            DO jj = j1,j2-1 
    299297               DO ji = i1,i2   ! vector opt. 
    300                   zbtr = r1_e1e2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
     298                  zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
    301299                  rotdiff(ji,jj,jk) = (-e1u(ji,jj+1) * ubdiff(ji,jj+1,jk) & 
    302300                                       +e1u(ji,jj  ) * ubdiff(ji,jj  ,jk) &  
    … …  
    318316                     ze1v = hdivdiff(ji,jj,jk) 
    319317                     ! horizontal diffusive trends 
    320                      zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) )   & 
     318                     zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) )   & 
    321319                           + ( hdivdiff(ji+1,jj,jk) - ze1v  ) / e1u(ji,jj) 
    322320 
    … …  
    344342 
    345343                     ! horizontal diffusive trends 
    346                      zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) )   & 
     344                     zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) )   & 
    347345                           + ( hdivdiff(ji,jj+1,jk) - ze1v  ) / e2v(ji,jj) 
    348346 
    … …  
    396394            DO jj = j1+1,j2 
    397395               DO ji = i1,i2   ! vector opt. 
    398                   zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 
    399                   hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * fse3v(ji,jj  ,jk) * vbdiff(ji,jj  ,jk)  & 
    400                                      &  -e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vbdiff(ji,jj-1,jk)  ) * zbtr 
     396                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 
     397                  hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vbdiff(ji,jj  ,jk)  & 
     398                                     &  -e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vbdiff(ji,jj-1,jk)  ) * zbtr 
    401399               END DO 
    402400            END DO 
    403401            DO jj = j1,j2 
    404402               DO ji = i1,i2-1   ! vector opt. 
    405                   zbtr = r1_e1e2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
     403                  zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
    406404                  rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) &  
    407405                                    &  -e2v(ji  ,jj) * vbdiff(ji  ,jj,jk) & 
    … …  
    424422                     ze1v = hdivdiff(ji,jj,jk) 
    425423                     ! horizontal diffusive trends 
    426                      zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) ) + ( hdivdiff(ji+1,jj,jk) - ze1v) & 
     424                     zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) + ( hdivdiff(ji+1,jj,jk) - ze1v) & 
    427425                           / e1u(ji,jj) 
    428426 
    … …  
    446444                     ! horizontal diffusive trends 
    447445 
    448                      zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) ) + ( hdivdiff(ji,jj+1,jk) - ze1v) & 
     446                     zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) + ( hdivdiff(ji,jj+1,jk) - ze1v) & 
    449447                           / e2v(ji,jj) 
    450448 

  • 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      !!--------------------------------------------- 

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

    r5656 r5845  
    1717   PUBLIC Agrif_trc, interptrn 
    1818 
    19 #  include "domzgr_substitute.h90"   
    2019#  include "vectopt_loop_substitute.h90" 
    2120  !!---------------------------------------------------------------------- 

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

    r5836 r5845  
    1919   PUBLIC Agrif_Sponge_trc, interptrn_sponge 
    2020 
    21    !! * Substitutions 
    22 #  include "domzgr_substitute.h90" 
    2321   !!---------------------------------------------------------------------- 
    2422   !! NEMO/NST 3.6 , NEMO Consortium (2010) 
    … …  
    7472               DO jj = j1,j2-1 
    7573                  DO ji = i1,i2-1 
    76                      zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 
    77                      zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 
     74                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) 
     75                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) 
    7876                     ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
    7977                     ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
    … …  
    8583 
    8684                     IF (.NOT. tabspongedone_trn(ji,jj)) THEN  
    87                         zbtr = r1_e1e2t(ji,jj) / fse3t(ji,jj,jk) 
     85                        zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk) 
    8886                        ! horizontal diffusive trends 
    8987                        ztra = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  ) + ztv(ji,jj) - ztv(ji  ,jj-1)  ) 

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

    r5656 r5845  
    6464      !!           *** ROUTINE updateT *** 
    6565      !!--------------------------------------------- 
    66 #  include "domzgr_substitute.h90" 
    6766      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
    6867      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab 
Note: See TracChangeset for help on using the changeset viewer.