- Timestamp:
- 2017-09-27T16:29:24+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
r7753 r8568 22 22 USE lib_mpp ! MPP library 23 23 USE prtctl ! Print control 24 USE wrk_nemo ! Memory Allocation25 24 USE timing ! Timing 26 25 USE bdy_oce ! ocean open boundary conditions … … 39 38 # include "vectopt_loop_substitute.h90" 40 39 !!---------------------------------------------------------------------- 41 !! NEMO/OPA 3.6 , NEMO Consortium (2015)40 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 42 41 !! $Id$ 43 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 75 74 INTEGER, INTENT( in ) :: kscheme ! =0/1 type of KEG scheme 76 75 ! 77 INTEGER :: ji, jj, jk ! dummy loop indices 78 REAL(wp) :: zu, zv ! temporary scalars 79 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhke 80 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 81 INTEGER :: jb ! dummy loop indices 82 INTEGER :: ii, ij, igrd, ib_bdy ! local integers 83 INTEGER :: fu, fv 76 INTEGER :: ji, jj, jk, jb ! dummy loop indices 77 INTEGER :: ii, ifu, ib_bdy ! local integers 78 INTEGER :: ij, ifv, igrd ! - - 79 REAL(wp) :: zu, zv ! local scalars 80 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhke 81 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdu, ztrdv 84 82 !!---------------------------------------------------------------------- 85 83 ! 86 IF( nn_timing == 1 ) CALL timing_start('dyn_keg') 87 ! 88 CALL wrk_alloc( jpi,jpj,jpk, zhke ) 84 IF( ln_timing ) CALL timing_start('dyn_keg') 89 85 ! 90 86 IF( kt == nit000 ) THEN … … 94 90 ENDIF 95 91 96 IF( l_trddyn ) THEN ! Save ua and vatrends97 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv)92 IF( l_trddyn ) THEN ! Save the input trends 93 ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 98 94 ztrdu(:,:,:) = ua(:,:,:) 99 95 ztrdv(:,:,:) = va(:,:,:) … … 112 108 ii = idx_bdy(ib_bdy)%nbi(jb,igrd) 113 109 ij = idx_bdy(ib_bdy)%nbj(jb,igrd) 114 fu = NINT( idx_bdy(ib_bdy)%flagu(jb,igrd) )115 un(ii- fu,ij,jk) = un(ii,ij,jk) * umask(ii,ij,jk)110 ifu = NINT( idx_bdy(ib_bdy)%flagu(jb,igrd) ) 111 un(ii-ifu,ij,jk) = un(ii,ij,jk) * umask(ii,ij,jk) 116 112 END DO 117 113 END DO … … 122 118 ii = idx_bdy(ib_bdy)%nbi(jb,igrd) 123 119 ij = idx_bdy(ib_bdy)%nbj(jb,igrd) 124 fv = NINT( idx_bdy(ib_bdy)%flagv(jb,igrd) )125 vn(ii,ij- fv,jk) = vn(ii,ij,jk) * vmask(ii,ij,jk)120 ifv = NINT( idx_bdy(ib_bdy)%flagv(jb,igrd) ) 121 vn(ii,ij-ifv,jk) = vn(ii,ij,jk) * vmask(ii,ij,jk) 126 122 END DO 127 123 END DO … … 172 168 ENDIF 173 169 174 175 170 ! 176 171 DO jk = 1, jpkm1 !== grad( KE ) added to the general momentum trends ==! … … 187 182 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 188 183 CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 189 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv )184 DEALLOCATE( ztrdu , ztrdv ) 190 185 ENDIF 191 186 ! … … 193 188 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 194 189 ! 195 CALL wrk_dealloc( jpi,jpj,jpk, zhke ) 196 ! 197 IF( nn_timing == 1 ) CALL timing_stop('dyn_keg') 190 IF( ln_timing ) CALL timing_stop('dyn_keg') 198 191 ! 199 192 END SUBROUTINE dyn_keg
Note: See TracChangeset
for help on using the changeset viewer.