- Timestamp:
- 2017-06-06T15:55:44+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90
r6140 r8143 15 15 USE oce ! ocean dynamics and tracers variables 16 16 USE dom_oce ! ocean space and time domain variables 17 USE zdf_oce ! ocean vertical physics variables 17 USE phycst ! physical constants 18 USE sbc_oce ! surface boundary condition: ocean 19 USE zdf_oce ! ocean vertical physics: variables 20 USE zdfdrg ! ocean vertical physics: bottom friction 18 21 USE trd_oce ! trends: ocean variables 19 USE zdfbfr ! bottom friction20 USE sbc_oce ! surface boundary condition: ocean21 USE phycst ! physical constants22 22 USE trdken ! trends: Kinetic ENergy 23 23 USE trdglo ! trends: global domain averaged 24 24 USE trdvor ! trends: vertical averaged vorticity 25 25 USE trdmxl ! trends: mixed layer averaged 26 ! 26 27 USE in_out_manager ! I/O manager 27 28 USE lbclnk ! lateral boundary condition 28 29 USE iom ! I/O manager library 29 30 USE lib_mpp ! MPP library 30 USE wrk_nemo ! Memory allocation31 31 32 32 IMPLICIT NONE 33 33 PRIVATE 34 34 35 PUBLIC trd_dyn ! called by all dynXX modules35 PUBLIC trd_dyn ! called by all dynXXX modules 36 36 37 37 !! * Substitutions 38 38 # include "vectopt_loop_substitute.h90" 39 39 !!---------------------------------------------------------------------- 40 !! NEMO/OPA 3.3 , NEMO Consortium (2010)40 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 41 41 !! $Id$ 42 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 103 103 INTEGER :: ji, jj, jk ! dummy loop indices 104 104 INTEGER :: ikbu, ikbv ! local integers 105 REAL(wp), POINTER, DIMENSION(:,:) :: z2dx, z2dy ! 2D workspace106 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3dx, z3dy ! 3D workspace105 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2dx, z2dy ! 2D workspace 106 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3dx, z3dy ! 3D workspace 107 107 !!---------------------------------------------------------------------- 108 108 ! … … 118 118 CASE( jpdyn_keg ) ; CALL iom_put( "utrd_keg", putrd ) ! Kinetic Energy gradient (or had) 119 119 CALL iom_put( "vtrd_keg", pvtrd ) 120 CALL wrk_alloc( jpi, jpj, jpk, z3dx, z3dy)120 ALLOCATE( z3dx(jpi,jpj,jpk) , z3dy(jpi,jpj,jpk) ) 121 121 z3dx(:,:,:) = 0._wp ! U.dxU & V.dyV (approximation) 122 122 z3dy(:,:,:) = 0._wp … … 133 133 CALL iom_put( "utrd_udx", z3dx ) 134 134 CALL iom_put( "vtrd_vdy", z3dy ) 135 CALL wrk_dealloc( jpi, jpj, jpk, z3dx, z3dy )136 CASE( jpdyn_zad ) ; CALL iom_put( "utrd_zad", putrd ) ! vertical 135 DEALLOCATE( z3dx , z3dy ) 136 CASE( jpdyn_zad ) ; CALL iom_put( "utrd_zad", putrd ) ! vertical advection 137 137 CALL iom_put( "vtrd_zad", pvtrd ) 138 CASE( jpdyn_ldf ) ; CALL iom_put( "utrd_ldf", putrd ) ! lateral diffusion138 CASE( jpdyn_ldf ) ; CALL iom_put( "utrd_ldf", putrd ) ! lateral diffusion 139 139 CALL iom_put( "vtrd_ldf", pvtrd ) 140 140 CASE( jpdyn_zdf ) ; CALL iom_put( "utrd_zdf", putrd ) ! vertical diffusion 141 141 CALL iom_put( "vtrd_zdf", pvtrd ) 142 ! 142 143 ! ! wind stress trends 143 CALL wrk_alloc( jpi, jpj, z2dx, z2dy)144 ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) ) 144 145 z2dx(:,:) = ( utau_b(:,:) + utau(:,:) ) / ( e3u_n(:,:,1) * rau0 ) 145 146 z2dy(:,:) = ( vtau_b(:,:) + vtau(:,:) ) / ( e3v_n(:,:,1) * rau0 ) 146 147 CALL iom_put( "utrd_tau", z2dx ) 147 148 CALL iom_put( "vtrd_tau", z2dy ) 148 CALL wrk_dealloc( jpi, jpj, z2dx, z2dy ) 149 CASE( jpdyn_bfr ) ! called if ln_bfrimp=T 150 CALL iom_put( "utrd_bfr", putrd ) ! bottom friction (explicit case) 151 CALL iom_put( "vtrd_bfr", pvtrd ) 152 CASE( jpdyn_atf ) ; CALL iom_put( "utrd_atf", putrd ) ! asselin filter trends 153 CALL iom_put( "vtrd_atf", pvtrd ) 154 CASE( jpdyn_bfri ) ; IF( ln_bfrimp ) THEN ! bottom friction (implicit case) 155 CALL wrk_alloc( jpi, jpj, jpk, z3dx, z3dy ) 149 DEALLOCATE( z2dx , z2dy ) 150 ! ! bottom stress tends (implicit case) 151 IF( ln_drgimp ) THEN 152 ALLOCATE( z3dx(jpi,jpj,jpk) , z3dy(jpi,jpj,jpk) ) 156 153 z3dx(:,:,:) = 0._wp ; z3dy(:,:,:) = 0._wp ! after velocity known (now filed at this stage) 157 154 DO jk = 1, jpkm1 … … 160 157 ikbu = mbku(ji,jj) ! deepest ocean u- & v-levels 161 158 ikbv = mbkv(ji,jj) 162 z3dx(ji,jj,jk) = bfrua(ji,jj) * un(ji,jj,ikbu) /e3u_n(ji,jj,ikbu)163 z3dy(ji,jj,jk) = bfrva(ji,jj) * vn(ji,jj,ikbv) /e3v_n(ji,jj,ikbv)159 z3dx(ji,jj,jk) = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) )*un(ji,jj,ikbu)/e3u_n(ji,jj,ikbu) 160 z3dy(ji,jj,jk) = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) )*vn(ji,jj,ikbv)/e3v_n(ji,jj,ikbv) 164 161 END DO 165 162 END DO 166 163 END DO 167 CALL lbc_lnk( z3dx, 'U', -1. ) ; CALL lbc_lnk( z3dy, 'V', -1. ) 168 CALL iom_put( "utrd_bfri", z3dx ) 169 CALL iom_put( "vtrd_bfri", z3dy ) 170 CALL wrk_dealloc( jpi, jpj, jpk, z3dx, z3dy ) 171 ENDIF 164 CALL lbc_lnk( z3dx, 'U', -1. ) ; CALL lbc_lnk( z3dy, 'V', -1. ) 165 CALL iom_put( "utrd_bfr", z3dx ) 166 CALL iom_put( "vtrd_bfr", z3dy ) 167 DEALLOCATE( z3dx , z3dy ) 168 ENDIF 169 CASE( jpdyn_bfr ) ! called if ln_drgimp=F 170 CALL iom_put( "utrd_bfr", putrd ) ! bottom friction (explicit case) 171 CALL iom_put( "vtrd_bfr", pvtrd ) 172 CASE( jpdyn_atf ) ; CALL iom_put( "utrd_atf", putrd ) ! asselin filter trends 173 CALL iom_put( "vtrd_atf", pvtrd ) 172 174 END SELECT 173 175 !
Note: See TracChangeset
for help on using the changeset viewer.
