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 5956 for branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90 – NEMO

Ignore:
Timestamp:
2015-11-30T20:55:41+01:00 (8 years ago)
Author:
mathiot
Message:

ISF : merged trunk (5936) into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90

    r5621 r5956  
    1313   USE oce            ! ocean dynamics and tracers variables 
    1414   USE dom_oce        ! ocean space and time domain variables 
     15   USE sbc_oce        ! surface boundary condition: ocean 
    1516   USE zdf_oce        ! ocean vertical physics variables 
    1617   USE trd_oce        ! trends: ocean variables 
    1718!!gm   USE dynhpg          ! hydrostatic pressure gradient    
    1819   USE zdfbfr         ! bottom friction 
    19    USE ldftra_oce     ! ocean active tracers lateral physics 
    20    USE sbc_oce        ! surface boundary condition: ocean 
     20   USE ldftra         ! ocean active tracers lateral physics 
    2121   USE phycst         ! physical constants 
    2222   USE trdvor         ! ocean vorticity trends  
    2323   USE trdglo         ! trends:global domain averaged 
    24    USE trdmxl         ! ocean active mixed layer tracers trends  
     24   USE trdmxl         ! ocean active mixed layer tracers trends 
     25   ! 
    2526   USE in_out_manager ! I/O manager 
    2627   USE iom            ! I/O manager library 
     
    9697         nkstp = kt 
    9798         DO jk = 1, jpkm1 
    98             bu   (:,:,jk) =  e1u(:,:) * e2u(:,:) * fse3u_n(:,:,jk) 
    99             bv   (:,:,jk) =  e1v(:,:) * e2v(:,:) * fse3v_n(:,:,jk) 
     99            bu   (:,:,jk) =           e1e2u(:,:) * fse3u_n(:,:,jk) 
     100            bv   (:,:,jk) =           e1e2v(:,:) * fse3v_n(:,:,jk) 
    100101            r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * fse3t_n(:,:,jk) ) * tmask(:,:,jk) 
    101102         END DO 
     
    117118      ! 
    118119      SELECT CASE( ktrd ) 
    119          CASE( jpdyn_hpg )   ;   CALL iom_put( "ketrd_hpg", zke )    ! hydrostatic pressure gradient 
    120          CASE( jpdyn_spg )   ;   CALL iom_put( "ketrd_spg", zke )    ! surface pressure gradient 
    121          CASE( jpdyn_spgexp );   CALL iom_put( "ketrd_spgexp", zke ) ! surface pressure gradient (explicit) 
    122          CASE( jpdyn_spgflt );   CALL iom_put( "ketrd_spgflt", zke ) ! surface pressure gradient (filter) 
    123          CASE( jpdyn_pvo )   ;   CALL iom_put( "ketrd_pvo", zke )    ! planetary vorticity 
    124          CASE( jpdyn_rvo )   ;   CALL iom_put( "ketrd_rvo", zke )    ! relative  vorticity     (or metric term) 
    125          CASE( jpdyn_keg )   ;   CALL iom_put( "ketrd_keg", zke )    ! Kinetic Energy gradient (or had) 
    126          CASE( jpdyn_zad )   ;   CALL iom_put( "ketrd_zad", zke )    ! vertical   advection 
    127          CASE( jpdyn_ldf )   ;   CALL iom_put( "ketrd_ldf", zke )    ! lateral diffusion 
    128          CASE( jpdyn_zdf )   ;   CALL iom_put( "ketrd_zdf", zke )    ! vertical diffusion  
     120         CASE( jpdyn_hpg )   ;   CALL iom_put( "ketrd_hpg", zke )    ! hydrostatic pressure gradient 
     121         CASE( jpdyn_spg )   ;   CALL iom_put( "ketrd_spg", zke )    ! surface pressure gradient 
     122         CASE( jpdyn_pvo )   ;   CALL iom_put( "ketrd_pvo", zke )    ! planetary vorticity 
     123         CASE( jpdyn_rvo )   ;   CALL iom_put( "ketrd_rvo", zke )    ! relative  vorticity     (or metric term) 
     124         CASE( jpdyn_keg )   ;   CALL iom_put( "ketrd_keg", zke )    ! Kinetic Energy gradient (or had) 
     125         CASE( jpdyn_zad )   ;   CALL iom_put( "ketrd_zad", zke )    ! vertical   advection 
     126         CASE( jpdyn_ldf )   ;   CALL iom_put( "ketrd_ldf", zke )    ! lateral diffusion 
     127         CASE( jpdyn_zdf )   ;   CALL iom_put( "ketrd_zdf", zke )    ! vertical diffusion  
    129128                                 !                                   ! wind stress trends 
    130                                  CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d ) 
    131                            z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1u(:,:) * e2u(:,:) * umask(:,:,1) 
    132                            z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1v(:,:) * e2v(:,:) * vmask(:,:,1) 
    133                            zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp 
    134                            DO jj = 2, jpj 
    135                               DO ji = 2, jpi 
    136                                  zke2d(ji,jj) = 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   & 
    137                                  &                         + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1) 
    138                               END DO 
    139                            END DO 
    140                                  CALL iom_put( "ketrd_tau", zke2d ) 
    141                                  CALL wrk_dealloc( jpi, jpj     , z2dx, z2dy, zke2d ) 
    142          CASE( jpdyn_bfr )   ;   CALL iom_put( "ketrd_bfr", zke )    ! bottom friction (explicit case)  
     129                                 CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d ) 
     130                           z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1u(:,:) * e2u(:,:) * umask(:,:,1) 
     131                           z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1v(:,:) * e2v(:,:) * vmask(:,:,1) 
     132                           zke2d(1,:) = 0._wp   ;   zke2d(:,1) = 0._wp 
     133                           DO jj = 2, jpj 
     134                              DO ji = 2, jpi 
     135                                 zke2d(ji,jj) = 0.5_wp * (   z2dx(ji,jj) + z2dx(ji-1,jj)   & 
     136                                 &                         + z2dy(ji,jj) + z2dy(ji,jj-1)   ) * r1_bt(ji,jj,1) 
     137                              END DO 
     138                           END DO 
     139                                 CALL iom_put( "ketrd_tau", zke2d ) 
     140                                 CALL wrk_dealloc( jpi, jpj     , z2dx, z2dy, zke2d ) 
     141         CASE( jpdyn_bfr )   ;   CALL iom_put( "ketrd_bfr", zke )    ! bottom friction (explicit case)  
    143142!!gm TO BE DONE properly 
    144143!!gm only valid if ln_bfrimp=F otherwise the bottom stress as to be recomputed at the end of the computation.... 
     
    162161!         ENDIF 
    163162!!gm end 
    164          CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf", zke )    ! asselin filter trends  
     163         CASE( jpdyn_atf )   ;   CALL iom_put( "ketrd_atf", zke )    ! asselin filter trends  
    165164!! a faire !!!!  idee changer dynnxt pour avoir un appel a jpdyn_bfr avant le swap !!! 
    166165!! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf.... 
     
    184183!                              CALL iom_put( "ketrd_bfri", zke2d ) 
    185184!         ENDIF 
    186          CASE( jpdyn_ken )   ;   ! kinetic energy 
    187                            ! called in dynnxt.F90 before asselin time filter 
    188                            ! with putrd=ua and pvtrd=va 
    189                            zke(:,:,:) = 0.5_wp * zke(:,:,:) 
    190                            CALL iom_put( "KE", zke ) 
    191                            ! 
    192                            CALL ken_p2k( kt , zke ) 
    193                            CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w 
     185         CASE( jpdyn_ken )   ;   ! kinetic energy 
     186                           ! called in dynnxt.F90 before asselin time filter 
     187                           ! with putrd=ua and pvtrd=va 
     188                           zke(:,:,:) = 0.5_wp * zke(:,:,:) 
     189                           CALL iom_put( "KE", zke ) 
     190                           ! 
     191                           CALL ken_p2k( kt , zke ) 
     192                           CALL iom_put( "ketrd_convP2K", zke )     ! conversion -rau*g*w 
    194193         ! 
    195194      END SELECT 
     
    263262      ENDIF 
    264263      !                           ! allocate box volume arrays 
    265       IF ( trd_ken_alloc() /= 0 )   CALL ctl_stop('trd_ken_alloc: failed to allocate arrays') 
     264      IF( trd_ken_alloc() /= 0 )   CALL ctl_stop('trd_ken_alloc: failed to allocate arrays') 
    266265      ! 
    267266!!gm      IF( .NOT. (ln_hpg_zco.OR.ln_hpg_zps) )   & 
    268267!!gm         &   CALL ctl_stop('trd_ken_init : only full and partial cells are coded for conversion rate') 
    269268      ! 
    270       IF ( .NOT.lk_vvl ) THEN     ! constant volume: bu, bv, 1/bt computed one for all 
     269      IF( .NOT.lk_vvl ) THEN      ! constant volume: bu, bv, 1/bt computed one for all 
    271270         DO jk = 1, jpkm1 
    272             bu   (:,:,jk) =  e1u(:,:) * e2u(:,:) * fse3u_n(:,:,jk) 
    273             bv   (:,:,jk) =  e1v(:,:) * e2v(:,:) * fse3v_n(:,:,jk) 
     271            bu   (:,:,jk) =           e1e2u(:,:) * fse3u_n(:,:,jk) 
     272            bv   (:,:,jk) =           e1e2v(:,:) * fse3v_n(:,:,jk) 
    274273            r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * fse3t_n(:,:,jk) ) 
    275274         END DO 
Note: See TracChangeset for help on using the changeset viewer.