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

Ignore:
Timestamp:
2015-12-04T17:05:58+01:00 (8 years ago)
Author:
gm
Message:

#1613: vvl by default, step III: Merge with the trunk (free surface simplification) (see wiki)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r5845 r6004  
    1111   USE lib_mpp 
    1212   USE wrk_nemo   
    13    USE dynspg_oce 
    1413   USE zdf_oce        ! vertical physics: ocean variables  
    1514 
     
    107106# endif 
    108107 
    109 # if defined key_dynspg_ts 
    110       IF (ln_bt_fw) THEN 
     108      IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN 
    111109         ! Update time integrated transports 
    112110         IF (mod(nbcline,nbclineupdate) == 0) THEN 
     
    128126         ENDIF 
    129127      END IF 
    130 # endif 
    131128      ! 
    132129      nbcline = nbcline + 1 
     
    237234      !!           *** ROUTINE updateu *** 
    238235      !!--------------------------------------------- 
    239       INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
     236      INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2 
    240237      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    241       LOGICAL, INTENT(in) :: before 
    242       !!  
    243       INTEGER :: ji, jj, jk 
    244       REAL(wp) :: zrhoy 
    245       !!--------------------------------------------- 
    246       !  
    247       IF (before) THEN 
     238      LOGICAL                               , INTENT(in   ) :: before 
     239      ! 
     240      INTEGER  ::  ji, jj, jk 
     241      REAL(wp) ::   zrhoy 
     242      !!--------------------------------------------- 
     243      !  
     244      IF( before ) THEN 
    248245         zrhoy = Agrif_Rhoy() 
     246         DO jk = k1, k2 
     247            tabres(i1:i2,j1:j2,jk) = zrhoy * e2u(i1:i2,j1:j2) * e3u_n(i1:i2,j1:j2,jk) * un(i1:i2,j1:j2,jk) 
     248         END DO 
     249      ELSE 
    249250         DO jk=k1,k2 
    250251            DO jj=j1,j2 
    251252               DO ji=i1,i2 
    252                   tabres(ji,jj,jk) = e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) 
    253                END DO 
    254             END DO 
    255          END DO 
    256          tabres = zrhoy * tabres 
    257       ELSE 
    258          DO jk=k1,k2 
    259             DO jj=j1,j2 
    260                DO ji=i1,i2 
    261                   tabres(ji,jj,jk) = tabres(ji,jj,jk) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) 
     253                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * r1_e2u(ji,jj) / e3u_n(ji,jj,jk) 
    262254                  ! 
    263255                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     
    292284            DO jj=j1,j2 
    293285               DO ji=i1,i2 
    294                   tabres(ji,jj,jk) = e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 
    295                END DO 
    296             END DO 
    297          END DO 
    298          tabres = zrhox * tabres 
     286                  tabres(ji,jj,jk) = zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 
     287               END DO 
     288            END DO 
     289         END DO 
    299290      ELSE 
    300291         DO jk=k1,k2 
    301292            DO jj=j1,j2 
    302293               DO ji=i1,i2 
    303                   tabres(ji,jj,jk) = tabres(ji,jj,jk) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) 
     294                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * r1_e1v(ji,jj) / e3v_n(ji,jj,jk) 
    304295                  ! 
    305296                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     
    334325         DO jj=j1,j2 
    335326            DO ji=i1,i2 
    336                tabres(ji,jj) = un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj) 
    337             END DO 
    338          END DO 
    339          tabres = zrhoy * tabres 
     327               tabres(ji,jj) = zrhoy * un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj) 
     328            END DO 
     329         END DO 
    340330      ELSE 
    341331         DO jj=j1,j2 
     
    344334               !     
    345335               ! Update "now" 3d velocities: 
    346                spgu(ji,jj) = 0.e0 
     336               spgu(ji,jj) = 0._wp 
    347337               DO jk=1,jpkm1 
    348338                  spgu(ji,jj) = spgu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) 
     
    356346               ! 
    357347               ! Update barotropic velocities: 
    358 #if defined key_dynspg_ts 
    359                IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    360                   zcorr = tabres(ji,jj) - un_b(ji,jj) 
    361                   ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1) 
    362                END IF 
    363 #endif                
     348               IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN 
     349                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     350                     zcorr = tabres(ji,jj) - un_b(ji,jj) 
     351                     ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1) 
     352                  END IF 
     353               ENDIF              
    364354               un_b(ji,jj) = tabres(ji,jj) * umask(ji,jj,1) 
    365355               !        
     
    400390         DO jj=j1,j2 
    401391            DO ji=i1,i2 
    402                tabres(ji,jj) = vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj)  
    403             END DO 
    404          END DO 
    405          tabres = zrhox * tabres 
     392               tabres(ji,jj) = zrhox * vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj)  
     393            END DO 
     394         END DO 
    406395      ELSE 
    407396         DO jj=j1,j2 
     
    422411               ! 
    423412               ! Update barotropic velocities: 
    424 #if defined key_dynspg_ts 
    425                IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    426                   zcorr = tabres(ji,jj) - vn_b(ji,jj) 
    427                   vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1) 
    428                END IF 
    429 #endif                
     413               IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN 
     414                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     415                     zcorr = tabres(ji,jj) - vn_b(ji,jj) 
     416                     vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1) 
     417                  END IF 
     418               ENDIF               
    430419               vn_b(ji,jj) = tabres(ji,jj) * vmask(ji,jj,1) 
    431420               !        
     
    467456         END DO 
    468457      ELSE 
    469 #if ! defined key_dynspg_ts 
    470          IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
    471             DO jj=j1,j2 
    472                DO ji=i1,i2 
    473                   sshb(ji,jj) =   sshb(ji,jj) & 
    474                         & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 
    475                END DO 
    476             END DO 
     458         IF( .NOT.ln_dynspg_ts .OR. ( ln_dynspg_ts .AND. .NOT.ln_bt_fw ) ) THEN 
     459            IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
     460               DO jj=j1,j2 
     461                  DO ji=i1,i2 
     462                     sshb(ji,jj) =   sshb(ji,jj) & 
     463                           & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 
     464                  END DO 
     465               END DO 
     466            ENDIF 
    477467         ENDIF 
    478 #endif 
     468         ! 
    479469         DO jj=j1,j2 
    480470            DO ji=i1,i2 
Note: See TracChangeset for help on using the changeset viewer.