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 6736 for branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN – NEMO

Ignore:
Timestamp:
2016-06-24T09:50:27+02:00 (8 years ago)
Author:
jamesharle
Message:

FASTNEt code modifications

Location:
branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90

    r3634 r6736  
    144144          
    145145         ! Multiply by the eddy viscosity coef. (at u- and v-points) 
    146          zlu(:,:,jk) = zlu(:,:,jk) * ( fsahmu(:,:,jk) * (1-nkahm_smag) + nkahm_smag) 
    147  
    148          zlv(:,:,jk) = zlv(:,:,jk) * ( fsahmv(:,:,jk) * (1-nkahm_smag) + nkahm_smag) 
     146         zlu(:,:,jk) = zlu(:,:,jk) * fsahmu(:,:,jk) 
     147         zlv(:,:,jk) = zlv(:,:,jk) * fsahmv(:,:,jk) 
    149148          
    150149         ! Contravariant "laplacian" 
    … …  
    201200                  &  + ( zut(ji,jj+1,jk) - zut(ji  ,jj,jk) ) / e2v(ji,jj) 
    202201               ! add it to the general momentum trends 
    203                ua(ji,jj,jk) = ua(ji,jj,jk) + zua * ( fsahmu(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag )) 
    204                va(ji,jj,jk) = va(ji,jj,jk) + zva * ( fsahmv(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag )) 
     202               ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
     203               va(ji,jj,jk) = va(ji,jj,jk) + zva 
    205204            END DO 
    206205         END DO 

  • branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90

    r3634 r6736  
    414414         ! II.3 Divergence of vertical fluxes added to the horizontal divergence 
    415415         ! --------------------------------------------------------------------- 
    416          IF( (kahm -nkahm_smag) ==1 ) THEN 
     416 
     417         IF( kahm == 1 ) THEN 
    417418            ! multiply the laplacian by the eddy viscosity coefficient 
    418419            DO jk = 1, jpkm1 
    … …  
    429430               END DO 
    430431            END DO 
    431          ELSEIF( (kahm +nkahm_smag ) == 2 ) THEN 
     432         ELSEIF( kahm == 2 ) THEN 
    432433            ! second call, no multiplication 
    433434            DO jk = 1, jpkm1 

  • branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r3764 r6736  
    215215            !                             ! ================! 
    216216            ! 
     217#if ! defined key_jth_fix 
    217218            DO jk = 1, jpkm1                 ! Before scale factor at t-points 
    218219               fse3t_b(:,:,jk) = fse3t_n(:,:,jk)                                   & 
    … …  
    220221                  &                         - 2._wp * fse3t_n(:,:,jk)            ) 
    221222            END DO 
     223#endif 
    222224            zec = atfp * rdt / rau0          ! Add filter correction only at the 1st level of t-point scale factors 
     225#if ! defined key_jth_fix 
    223226            fse3t_b(:,:,1) = fse3t_b(:,:,1) - zec * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1) 
     227#endif 
    224228            ! 
    225229            IF( ln_dynadv_vec ) THEN         ! vector invariant form (no thickness weighted calulation) 
    226230               ! 
    227231               !                                      ! before scale factors at u- & v-pts (computed from fse3t_b) 
     232#if ! defined key_jth_fix 
    228233               CALL dom_vvl_2( kt, fse3u_b(:,:,:), fse3v_b(:,:,:) ) 
     234#endif 
    229235               ! 
    230236               DO jk = 1, jpkm1                       ! Leap-Frog - Asselin filter and swap: applied on velocity 
    … …  
    244250            ELSE                             ! flux form (thickness weighted calulation) 
    245251               ! 
     252#if ! defined key_jth_fix 
    246253               CALL dom_vvl_2( kt, ze3u_f, ze3v_f )   ! before scale factors at u- & v-pts (computed from fse3t_b) 
     254#endif 
    247255               ! 
    248256               DO jk = 1, jpkm1                       ! Leap-Frog - Asselin filter and swap:  
    … …  
    266274                  END DO 
    267275               END DO 
     276#if ! defined key_jth_fix 
    268277               fse3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)      ! e3u_b <-- filtered scale factor 
    269278               fse3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 
     279#endif 
     280               CALL lbc_lnk( ub, 'U', -1. )                    ! lateral boundary conditions 
     281               CALL lbc_lnk( vb, 'V', -1. ) 
    270282            ENDIF 
    271283            ! 

  • branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r3625 r6736  
    8181      ! 
    8282      INTEGER  ::   ji, jj, jk                             ! dummy loop indices 
    83       REAL(wp) ::   z2dt, zg_2, zintp, zgrau0r             ! temporary scalar 
     83      REAL(wp) ::   z2dt, zg_2                             ! temporary scalar 
    8484      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    85       REAL(wp), POINTER, DIMENSION(:,:)   ::  zpice 
    8685      !!---------------------------------------------------------------------- 
    8786      ! 
    … …  
    118117            END DO 
    119118         END DO 
    120       ENDIF 
    121  
    122       IF( nn_ice_embd == 2 ) THEN             !== embedded sea ice: Pressure gradient due to snow-ice mass ==! 
    123          CALL wrk_alloc( jpi, jpj, zpice ) 
    124          !                                             
    125          zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) 
    126          zgrau0r     = - grav * r1_rau0 
    127          zpice(:,:) = (  zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:)  ) * zgrau0r 
    128          DO jj = 2, jpjm1 
    129             DO ji = fs_2, fs_jpim1   ! vector opt. 
    130                spgu(ji,jj) = ( zpice(ji+1,jj) - zpice(ji,jj) ) / e1u(ji,jj) 
    131                spgv(ji,jj) = ( zpice(ji,jj+1) - zpice(ji,jj) ) / e2v(ji,jj) 
    132             END DO 
    133          END DO 
    134          DO jk = 1, jpkm1                             ! Add the surface pressure trend to the general trend 
    135             DO jj = 2, jpjm1 
    136                DO ji = fs_2, fs_jpim1   ! vector opt. 
    137                   ua(ji,jj,jk) = ua(ji,jj,jk) + spgu(ji,jj) 
    138                   va(ji,jj,jk) = va(ji,jj,jk) + spgv(ji,jj) 
    139                END DO 
    140             END DO 
    141          END DO 
    142          ! 
    143          CALL wrk_dealloc( jpi, jpj, zpice ) 
    144119      ENDIF 
    145120 

  • branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90

    r3680 r6736  
    2727   USE prtctl          ! Print control 
    2828   USE iom             ! I/O library 
     29   USE restart         ! only for lrst_oce 
    2930   USE timing          ! Timing 
    3031 

  • branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r3765 r6736  
    4545   USE prtctl          ! Print control 
    4646   USE iom 
     47   USE restart         ! only for lrst_oce 
    4748   USE lib_fortran 
    4849#if defined key_agrif 
    … …  
    188189#if defined key_obc 
    189190      IF( lk_obc ) CALL obc_dyn( kt )   ! Update velocities on each open boundary with the radiation algorithm 
    190       IF( lk_obc ) CALL obc_vol( kt )   ! Correction of the barotropic componant velocity to control the volume of the system 
     191      IF( lk_obc) CALL obc_vol( kt )   ! Correction of the barotropic componant velocity to control the volume of the system 
    191192#endif 
    192193#if defined key_bdy 
    … …  
    255256      END DO 
    256257      ! applied the lateral boundary conditions 
    257       IF( nn_solv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0 )   CALL lbc_lnk_e( gcb, c_solver_pt, 1., jpr2di, jpr2dj )    
     258      IF( nn_solv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0 )   CALL lbc_lnk_e( gcb, c_solver_pt, 1. )    
    258259 
    259260#if defined key_agrif 
    … …  
    307308            ! multiplied by z2dt 
    308309#if defined key_obc 
    309             IF(lk_obc) THEN 
    310310            ! caution : grad D = 0 along open boundaries 
    311311            ! Remark: The filtering force could be reduced here in the FRS zone 
    312312            !         by multiplying spgu/spgv by (1-alpha) ??   
    313                spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj) 
    314                spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj) 
    315             ELSE 
    316                spgu(ji,jj) = z2dt * ztdgu 
    317                spgv(ji,jj) = z2dt * ztdgv 
    318             ENDIF 
     313            spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj) 
     314            spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj) 
    319315#elif defined key_bdy 
    320             IF(lk_bdy) THEN 
    321316            ! caution : grad D = 0 along open boundaries 
    322                spgu(ji,jj) = z2dt * ztdgu * bdyumask(ji,jj) 
    323                spgv(ji,jj) = z2dt * ztdgv * bdyvmask(ji,jj) 
    324             ELSE 
    325                spgu(ji,jj) = z2dt * ztdgu 
    326                spgv(ji,jj) = z2dt * ztdgv 
    327             ENDIF 
     317            spgu(ji,jj) = z2dt * ztdgu * bdyumask(ji,jj) 
     318            spgv(ji,jj) = z2dt * ztdgv * bdyvmask(ji,jj) 
    328319#else 
    329320            spgu(ji,jj) = z2dt * ztdgu 

  • branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r3680 r6736  
    4141   USE in_out_manager  ! I/O manager 
    4242   USE iom             ! IOM library 
     43   USE restart         ! only for lrst_oce 
    4344   USE zdf_oce         ! Vertical diffusion 
    4445   USE wrk_nemo        ! Memory Allocation 
    … …  
    402403         IF( lk_obc )   CALL obc_dta_bt ( kt, jn   ) 
    403404         IF( lk_bdy )   CALL bdy_dta ( kt, jit=jn, time_offset=+1 ) 
    404          IF ( ln_tide_pot .AND. lk_tide) CALL upd_tide( kt, jn ) 
     405         IF ( ln_tide_pot ) CALL upd_tide( kt, jn ) 
    405406 
    406407         !                                                !* after ssh_e 
    … …  
    452453                  ENDIF 
    453454                  ! add tidal astronomical forcing 
    454                   IF ( ln_tide_pot .AND. lk_tide ) THEN  
     455                  IF ( ln_tide_pot ) THEN  
    455456                  zu_spg = zu_spg + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) / e1u(ji,jj) 
    456457                  zv_spg = zv_spg + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) / e2v(ji,jj) 
    … …  
    502503                  ENDIF 
    503504                  ! add tidal astronomical forcing 
    504                   IF ( ln_tide_pot .AND. lk_tide ) THEN 
     505                  IF ( ln_tide_pot ) THEN 
    505506                  zu_spg = zu_spg + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) / e1u(ji,jj) 
    506507                  zv_spg = zv_spg + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) / e2v(ji,jj) 
    … …  
    549550                  ENDIF 
    550551                  ! add tidal astronomical forcing 
    551                   IF ( ln_tide_pot .AND. lk_tide ) THEN 
     552                  IF ( ln_tide_pot ) THEN 
    552553                  zu_spg = zu_spg + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) / e1u(ji,jj) 
    553554                  zv_spg = zv_spg + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) / e2v(ji,jj) 

  • branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90

    r3625 r6736  
    6161      ! 
    6262      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    63       REAL(wp) ::   zlavmr, zua, zva   ! local scalars 
     63      REAL(wp) ::   zrau0r, zlavmr, zua, zva   ! local scalars 
    6464      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwx, zwy, zwz, zww 
    6565      !!---------------------------------------------------------------------- 
    … …  
    7575      ENDIF 
    7676 
     77      zrau0r = 1. / rau0               ! Local constant initialization 
    7778      zlavmr = 1. / REAL( nn_zdfexp ) 
    7879 
    … …  
    8081      DO jj = 2, jpjm1                 ! Surface boundary condition 
    8182         DO ji = 2, jpim1 
    82             zwy(ji,jj,1) = ( utau_b(ji,jj) + utau(ji,jj) ) * r1_rau0 
    83             zww(ji,jj,1) = ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_rau0 
     83            zwy(ji,jj,1) = ( utau_b(ji,jj) + utau(ji,jj) ) * zrau0r 
     84            zww(ji,jj,1) = ( vtau_b(ji,jj) + vtau(ji,jj) ) * zrau0r 
    8485         END DO   
    8586      END DO   

  • branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r3625 r6736  
    161161         DO ji = fs_2, fs_jpim1   ! vector opt. 
    162162            ua(ji,jj,1) = ub(ji,jj,1) + p2dt * (  ua(ji,jj,1) + 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   & 
    163                &                                                       * r1_rau0 / fse3u(ji,jj,1)       ) 
     163               &                                                       / ( fse3u(ji,jj,1) * rau0       )  ) 
    164164         END DO 
    165165      END DO 
    … …  
    247247         DO ji = fs_2, fs_jpim1   ! vector opt. 
    248248            va(ji,jj,1) = vb(ji,jj,1) + p2dt * (  va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   & 
    249                &                                                       * r1_rau0 / fse3v(ji,jj,1)       ) 
     249               &                                                       / ( fse3v(ji,jj,1) * rau0       )  ) 
    250250         END DO 
    251251      END DO 

  • branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r3764 r6736  
    2020   USE divcur          ! hor. divergence and curl      (div & cur routines) 
    2121   USE iom             ! I/O library 
     22   USE restart         ! only for lrst_oce 
    2223   USE in_out_manager  ! I/O manager 
    2324   USE prtctl          ! Print control 
Note: See TracChangeset for help on using the changeset viewer.