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 5240 for branches/UKMO/dev_r5021_nn_etau_revision/NEMOGCM/NEMO/OPA_SRC/DYN – NEMO

Ignore:
Timestamp:
2015-04-29T12:17:12+02:00 (9 years ago)
Author:
davestorkey
Message:

Update UKMO nn_etau_revision branch with trunk changes to rev 5107.

Location:
branches/UKMO/dev_r5021_nn_etau_revision/NEMOGCM/NEMO/OPA_SRC/DYN
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5021_nn_etau_revision/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90

    r5239 r5240  
    116116         DO jj = 2, jpjm1                          ! laplacian 
    117117            DO ji = fs_2, fs_jpim1   ! vector opt. 
    118                zlu_uu(ji,jj,jk,1) = ( ub (ji+1,jj,jk)-2.*ub (ji,jj,jk)+ub (ji-1,jj,jk) ) * umask(ji,jj,jk) 
    119                zlv_vv(ji,jj,jk,1) = ( vb (ji,jj+1,jk)-2.*vb (ji,jj,jk)+vb (ji,jj-1,jk) ) * vmask(ji,jj,jk)  
    120                zlu_uv(ji,jj,jk,1) = ( ub (ji,jj+1,jk)-2.*ub (ji,jj,jk)+ub (ji,jj-1,jk) ) * umask(ji,jj,jk) 
    121                zlv_vu(ji,jj,jk,1) = ( vb (ji+1,jj,jk)-2.*vb (ji,jj,jk)+vb (ji-1,jj,jk) ) * vmask(ji,jj,jk) 
    122                ! 
    123                zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj,jk)-2.*zfu(ji,jj,jk)+zfu(ji-1,jj,jk) ) * umask(ji,jj,jk) 
    124                zlv_vv(ji,jj,jk,2) = ( zfv(ji,jj+1,jk)-2.*zfv(ji,jj,jk)+zfv(ji,jj-1,jk) ) * vmask(ji,jj,jk) 
    125                zlu_uv(ji,jj,jk,2) = ( zfu(ji,jj+1,jk)-2.*zfu(ji,jj,jk)+zfu(ji,jj-1,jk) ) * umask(ji,jj,jk) 
    126                zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj,jk)-2.*zfv(ji,jj,jk)+zfv(ji-1,jj,jk) ) * vmask(ji,jj,jk) 
    127             END DO 
    128          END DO 
    129       END DO 
    130 !!gm BUG !!!  just below this should be +1 in all the communications 
    131 !      CALL lbc_lnk( zlu_uu(:,:,:,1), 'U', -1.)   ;   CALL lbc_lnk( zlu_uv(:,:,:,1), 'U', -1.) 
    132 !      CALL lbc_lnk( zlu_uu(:,:,:,2), 'U', -1.)   ;   CALL lbc_lnk( zlu_uv(:,:,:,2), 'U', -1.) 
    133 !      CALL lbc_lnk( zlv_vv(:,:,:,1), 'V', -1.)   ;   CALL lbc_lnk( zlv_vu(:,:,:,1), 'V', -1.) 
    134 !      CALL lbc_lnk( zlv_vv(:,:,:,2), 'V', -1.)   ;   CALL lbc_lnk( zlv_vu(:,:,:,2), 'V', -1.) 
    135 ! 
    136 !!gm corrected: 
     118               ! 
     119               zlu_uu(ji,jj,jk,1) = ( ub (ji+1,jj  ,jk) - 2.*ub (ji,jj,jk) + ub (ji-1,jj  ,jk) ) * umask(ji,jj,jk) 
     120               zlv_vv(ji,jj,jk,1) = ( vb (ji  ,jj+1,jk) - 2.*vb (ji,jj,jk) + vb (ji  ,jj-1,jk) ) * vmask(ji,jj,jk) 
     121               zlu_uv(ji,jj,jk,1) = ( ub (ji  ,jj+1,jk) - ub (ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   & 
     122                  &               - ( ub (ji  ,jj  ,jk) - ub (ji  ,jj-1,jk) ) * fmask(ji  ,jj-1,jk) 
     123               zlv_vu(ji,jj,jk,1) = ( vb (ji+1,jj  ,jk) - vb (ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   & 
     124                  &               - ( vb (ji  ,jj  ,jk) - vb (ji-1,jj  ,jk) ) * fmask(ji-1,jj  ,jk) 
     125               ! 
     126               zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj  ,jk) - 2.*zfu(ji,jj,jk) + zfu(ji-1,jj  ,jk) ) * umask(ji,jj,jk) 
     127               zlv_vv(ji,jj,jk,2) = ( zfv(ji  ,jj+1,jk) - 2.*zfv(ji,jj,jk) + zfv(ji  ,jj-1,jk) ) * vmask(ji,jj,jk) 
     128               zlu_uv(ji,jj,jk,2) = ( zfu(ji  ,jj+1,jk) - zfu(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   & 
     129                  &               - ( zfu(ji  ,jj  ,jk) - zfu(ji  ,jj-1,jk) ) * fmask(ji  ,jj-1,jk) 
     130               zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj  ,jk) - zfv(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   & 
     131                  &               - ( zfv(ji  ,jj  ,jk) - zfv(ji-1,jj  ,jk) ) * fmask(ji-1,jj  ,jk) 
     132            END DO 
     133         END DO 
     134      END DO 
    137135      CALL lbc_lnk( zlu_uu(:,:,:,1), 'U', 1. )   ;   CALL lbc_lnk( zlu_uv(:,:,:,1), 'U', 1. ) 
    138136      CALL lbc_lnk( zlu_uu(:,:,:,2), 'U', 1. )   ;   CALL lbc_lnk( zlu_uv(:,:,:,2), 'U', 1. ) 
    139137      CALL lbc_lnk( zlv_vv(:,:,:,1), 'V', 1. )   ;   CALL lbc_lnk( zlv_vu(:,:,:,1), 'V', 1. ) 
    140138      CALL lbc_lnk( zlv_vv(:,:,:,2), 'V', 1. )   ;   CALL lbc_lnk( zlv_vu(:,:,:,2), 'V', 1. )  
    141 !!gm end 
    142139       
    143140      !                                      ! ====================== ! 

  • branches/UKMO/dev_r5021_nn_etau_revision/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r5239 r5240  
    9797      ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT= ierr(2) ) 
    9898 
    99       IF( ln_dynvor_een ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , &  
    100                              &      ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) ) 
     99      IF( ln_dynvor_een .or. ln_dynvor_een_old ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , &  
     100                                                    &      ftsw(jpi,jpj) , ftse(jpi,jpj) , STAT=ierr(3) ) 
    101101 
    102102      dyn_spg_ts_alloc = MAXVAL(ierr(:)) 
    … …  
    218218      ! 
    219219      IF ( kt == nit000 .OR. lk_vvl ) THEN 
    220          IF ( ln_dynvor_een ) THEN 
     220         IF ( ln_dynvor_een_old ) THEN 
     221            DO jj = 1, jpjm1 
     222               DO ji = 1, jpim1 
     223                  zwz(ji,jj) =   ( ht(ji  ,jj+1) + ht(ji+1,jj+1) +                    & 
     224                        &          ht(ji  ,jj  ) + ht(ji+1,jj  )   ) / 4._wp   
     225                  IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zwz(ji,jj) 
     226               END DO 
     227            END DO 
     228            CALL lbc_lnk( zwz, 'F', 1._wp ) 
     229            zwz(:,:) = ff(:,:) * zwz(:,:) 
     230 
     231            ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 
     232            DO jj = 2, jpj 
     233               DO ji = fs_2, jpi   ! vector opt. 
     234                  ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1) 
     235                  ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  ) 
     236                  ftse(ji,jj) = zwz(ji  ,jj  ) + zwz(ji  ,jj-1) + zwz(ji-1,jj-1) 
     237                  ftsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  ) 
     238               END DO 
     239            END DO 
     240         ELSE IF ( ln_dynvor_een ) THEN 
    221241            DO jj = 1, jpjm1 
    222242               DO ji = 1, jpim1 
    … …  
    339359         END DO 
    340360         ! 
    341       ELSEIF ( ln_dynvor_een ) THEN                    ! enstrophy and energy conserving scheme 
     361      ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old ) THEN  ! enstrophy and energy conserving scheme 
    342362         DO jj = 2, jpjm1 
    343363            DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    687707            END DO 
    688708            ! 
    689          ELSEIF ( ln_dynvor_een ) THEN                    !==  energy and enstrophy conserving scheme  ==! 
     709         ELSEIF ( ln_dynvor_een .or. ln_dynvor_een_old ) THEN !==  energy and enstrophy conserving scheme  ==! 
    690710            DO jj = 2, jpjm1 
    691711               DO ji = fs_2, fs_jpim1   ! vector opt. 

  • branches/UKMO/dev_r5021_nn_etau_revision/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r5239 r5240  
    5151   LOGICAL, PUBLIC ::   ln_dynvor_mix   !: mixed scheme 
    5252   LOGICAL, PUBLIC ::   ln_dynvor_een   !: energy and enstrophy conserving scheme 
     53   LOGICAL, PUBLIC ::   ln_dynvor_een_old !: energy and enstrophy conserving scheme (original formulation) 
    5354 
    5455   INTEGER ::   nvor = 0   ! type of vorticity trend used 
    … …  
    596597 
    597598      IF( kt == nit000 .OR. lk_vvl ) THEN      ! reciprocal of e3 at F-point (masked averaging of e3t over ocean points) 
    598          DO jk = 1, jpk 
    599             DO jj = 1, jpjm1 
    600                DO ji = 1, jpim1 
    601                   ze3  = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
    602                      &   + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) 
    603                   zmsk = (                   tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   & 
    604                      &                     + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk) ) 
    605                   IF( ze3 /= 0._wp )   ze3f(ji,jj,jk) = zmsk / ze3 
    606                END DO 
    607             END DO 
    608          END DO 
     599 
     600         IF( ln_dynvor_een_old ) THEN ! original formulation 
     601            DO jk = 1, jpk 
     602               DO jj = 1, jpjm1 
     603                  DO ji = 1, jpim1 
     604                     ze3  = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
     605                        &   + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) 
     606                     IF( ze3 /= 0._wp )   ze3f(ji,jj,jk) = 4.0_wp / ze3 
     607                  END DO 
     608               END DO 
     609            END DO 
     610         ELSE ! new formulation from NEMO 3.6 
     611            DO jk = 1, jpk 
     612               DO jj = 1, jpjm1 
     613                  DO ji = 1, jpim1 
     614                     ze3  = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
     615                        &   + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) 
     616                     zmsk = (                   tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   & 
     617                        &                     + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk) ) 
     618                     IF( ze3 /= 0._wp )   ze3f(ji,jj,jk) = zmsk / ze3 
     619                  END DO 
     620               END DO 
     621            END DO 
     622         ENDIF 
     623 
    609624         CALL lbc_lnk( ze3f, 'F', 1. ) 
    610625      ENDIF 
    … …  
    705720      INTEGER ::   ios             ! Local integer output status for namelist read 
    706721      !! 
    707       NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een 
     722      NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een, ln_dynvor_een_old 
    708723      !!---------------------------------------------------------------------- 
    709724 
    … …  
    726741         WRITE(numout,*) '           mixed enstrophy/energy conserving scheme   ln_dynvor_mix = ', ln_dynvor_mix 
    727742         WRITE(numout,*) '           enstrophy and energy conserving scheme     ln_dynvor_een = ', ln_dynvor_een 
     743         WRITE(numout,*) '           enstrophy and energy conserving scheme (old) ln_dynvor_een_old= ', ln_dynvor_een_old 
    728744      ENDIF 
    729745 
    … …  
    749765      IF( ln_dynvor_mix )   ioptio = ioptio + 1 
    750766      IF( ln_dynvor_een )   ioptio = ioptio + 1 
     767      IF( ln_dynvor_een_old )   ioptio = ioptio + 1 
    751768      IF( lk_esopa      )   ioptio =          1 
    752769 
    … …  
    757774      IF( ln_dynvor_ens )   nvor =  1 
    758775      IF( ln_dynvor_mix )   nvor =  2 
    759       IF( ln_dynvor_een )   nvor =  3 
     776      IF( ln_dynvor_een .or. ln_dynvor_een_old )   nvor =  3 
    760777      IF( lk_esopa      )   nvor = -1 
    761778       
Note: See TracChangeset for help on using the changeset viewer.