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 9923 for NEMO/branches/2018/dev_r9838_ENHANCE04_MLF/src/OCE/DYN/dynspg.F90 – NEMO

Ignore:
Timestamp:
2018-07-11T10:24:17+02:00 (6 years ago)
Author:
gm
Message:

#1911 (ENHANCE-04): step I.2: dev_r9838_ENHANCE04_MLF

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2018/dev_r9838_ENHANCE04_MLF/src/OCE/DYN/dynspg.F90

    r9863 r9923  
    6666      !!              ln_apr_dyn=T : the atmospheric pressure forcing is applied  
    6767      !!             as the gradient of the inverse barometer ssh: 
    68       !!                apgu = - 1/rau0 di[apr] = 0.5*grav di[ssh_ib+ssh_ibb] 
    69       !!                apgv = - 1/rau0 dj[apr] = 0.5*grav dj[ssh_ib+ssh_ibb] 
     68      !!                apgu = - 1/rho0 di[apr] = 0.5*grav di[ssh_ib+ssh_ibb] 
     69      !!                apgv = - 1/rho0 dj[apr] = 0.5*grav dj[ssh_ib+ssh_ibb] 
    7070      !!             Note that as all external forcing a time averaging over a two rdt 
    7171      !!             period is used to prevent the divergence of odd and even time step. 
     
    7474      ! 
    7575      INTEGER  ::   ji, jj, jk                   ! dummy loop indices 
    76       REAL(wp) ::   zg_2, zintp, zgrau0r, zld   ! local scalars 
     76      REAL(wp) ::   zg_2, zintp, zg_rho0, zld   ! local scalars 
    7777      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zpice 
    7878      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv 
     
    110110         ENDIF 
    111111         ! 
    112          !                                    !==  tide potential forcing term  ==! 
    113          IF( .NOT.ln_dynspg_ts .AND. ( ln_tide_pot .AND. ln_tide )  ) THEN   ! N.B. added directly at sub-time-step in ts-case 
    114             ! 
    115             CALL upd_tide( kt )                      ! update tide potential 
    116             ! 
    117             DO jj = 2, jpjm1                         ! add tide potential forcing 
    118                DO ji = fs_2, fs_jpim1   ! vector opt. 
    119                   spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 
    120                   spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 
    121                END DO  
    122             END DO 
    123             ! 
    124             IF (ln_scal_load) THEN 
    125                zld = rn_scal_load * grav 
    126                DO jj = 2, jpjm1                    ! add scalar approximation for load potential 
    127                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    128                      spgu(ji,jj) = spgu(ji,jj) + zld * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj) 
    129                      spgv(ji,jj) = spgv(ji,jj) + zld * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj) 
    130                   END DO  
    131                END DO 
     112         IF( .NOT.ln_dynspg_ts ) THEN   
     113            !                                    !==  tide potential forcing term  ==! 
     114            IF( ln_tide_pot .AND. ln_tide ) THEN      ! N.B. added directly at sub-time-step in ts-case 
     115               ! 
     116               CALL upd_tide( kt )                    ! update tide potential 
     117               ! 
     118               IF ( ln_scal_load ) THEN               
     119                  zld = rn_load * grav 
     120                  DO jj = 2, jpjm1                    ! add tide potential + scalar approximation of load potential 
     121                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     122                        spgu(ji,jj) = spgu(ji,jj) + (  grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) )  & 
     123                           &                         + zld  * ( sshn     (ji+1,jj) - sshn     (ji,jj) )  ) * r1_e1u(ji,jj) 
     124                        spgv(ji,jj) = spgv(ji,jj) + (  grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) )  & 
     125                           &                         + zld  * ( sshn     (ji,jj+1) - sshn     (ji,jj) )  ) * r1_e2v(ji,jj) 
     126                     END DO  
     127                  END DO 
     128               ELSE 
     129                  DO jj = 2, jpjm1                    ! add tide potential 
     130                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     131                        spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 
     132                        spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 
     133                     END DO  
     134                  END DO 
     135               ENDIF 
    132136            ENDIF 
    133137         ENDIF 
     
    136140            ALLOCATE( zpice(jpi,jpj) ) 
    137141            zintp = REAL( MOD( kt-1, nn_fsbc ) ) / REAL( nn_fsbc ) 
    138             zgrau0r     = - grav * r1_rau0 
    139             zpice(:,:) = (  zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:)  ) * zgrau0r 
     142            zg_rho0     = - grav * r1_rho0 
     143            zpice(:,:) = (  zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:)  ) * zg_rho0 
    140144            DO jj = 2, jpjm1 
    141145               DO ji = fs_2, fs_jpim1   ! vector opt. 
     
    191195      NAMELIST/namdyn_spg/ ln_dynspg_exp       , ln_dynspg_ts,   & 
    192196      &                    ln_bt_fw, ln_bt_av  , ln_bt_auto  ,   & 
    193       &                    nn_baro , rn_bt_cmax, nn_bt_flt, rn_bt_alpha 
     197      &                    nn_e    , rn_bt_cmax, nn_bt_flt, rn_bt_alpha 
    194198      !!---------------------------------------------------------------------- 
    195199      ! 
     
    227231         WRITE(numout,*) 
    228232         IF( nspg == np_EXP )   WRITE(numout,*) '   ==>>>   explicit free surface' 
    229          IF( nspg == np_TS  )   WRITE(numout,*) '   ==>>>   free surface with time splitting scheme' 
     233         IF( nspg == np_TS  )   WRITE(numout,*) '   ==>>>   split-explicit free surface' 
    230234         IF( nspg == np_NO  )   WRITE(numout,*) '   ==>>>   No surface surface pressure gradient trend in momentum Eqs.' 
    231235      ENDIF 
    232236      ! 
    233237      IF( nspg == np_TS ) THEN   ! split-explicit scheme initialisation 
    234          CALL dyn_spg_ts_init          ! do it first: set nn_baro used to allocate some arrays later on 
     238         CALL dyn_spg_ts_init          ! do it first: set nn_e used to allocate some arrays later on 
    235239      ENDIF 
    236240      ! 
Note: See TracChangeset for help on using the changeset viewer.