- Timestamp:
- 2017-12-13T15:58:53+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r8698 r9019 35 35 USE traqsr ! penetrative solar radiation (needed for nksr) 36 36 USE phycst ! physical constant 37 USE ldftra ! lateral physics ontracers38 USE ldfslp 39 USE bdy_oce , ONLY: ln_bdy37 USE ldftra ! lateral physics : tracers 38 USE ldfslp ! lateral physics : slopes 39 USE bdy_oce , ONLY : ln_bdy 40 40 USE bdytra ! open boundary condition (bdy_tra routine) 41 41 ! … … 43 43 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 44 44 USE prtctl ! Print control 45 USE wrk_nemo ! Memory allocation46 45 USE timing ! Timing 47 46 #if defined key_agrif … … 91 90 INTEGER :: ji, jj, jk, jn ! dummy loop indices 92 91 REAL(wp) :: zfact ! local scalars 93 REAL(wp), POINTER, DIMENSION(:,:,:) ::ztrdt, ztrds94 !!---------------------------------------------------------------------- 95 ! 96 IF( nn_timing == 1 )CALL timing_start( 'tra_nxt')92 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds 93 !!---------------------------------------------------------------------- 94 ! 95 IF( ln_timing ) CALL timing_start( 'tra_nxt') 97 96 ! 98 97 IF( kt == nit000 ) THEN … … 114 113 115 114 ! set time step size (Euler/Leapfrog) 116 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt! at nit000 (Euler)115 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! at nit000 (Euler) 117 116 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dt = 2._wp* rdt ! at nit000 or nit000+1 (Leapfrog) 118 117 ENDIF … … 120 119 ! trends computation initialisation 121 120 IF( l_trdtra ) THEN 122 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds)121 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 123 122 ztrdt(:,:,jpk) = 0._wp 124 123 ztrds(:,:,jpk) = 0._wp … … 136 135 CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt ) 137 136 CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds ) 138 IF( ln_linssh ) THEN 137 IF( ln_linssh ) THEN ! linear sea surface height only 139 138 ! Store now fields before applying the Asselin filter 140 139 ! in order to calculate Asselin filter trend later. … … 150 149 END DO 151 150 END DO 152 IF (l_trdtra .AND. .NOT. ln_linssh ) THEN! Zero Asselin filter contribution must be explicitly written out since for vvl153 ! Asselin filter is output by tra_nxt_vvl that is not called on this time step151 IF (l_trdtra .AND. .NOT. ln_linssh ) THEN ! Zero Asselin filter contribution must be explicitly written out since for vvl 152 ! ! Asselin filter is output by tra_nxt_vvl that is not called on this time step 154 153 ztrdt(:,:,:) = 0._wp 155 154 ztrds(:,:,:) = 0._wp … … 181 180 CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 182 181 END IF 183 IF( l_trdtra ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )182 IF( l_trdtra ) DEALLOCATE( ztrdt , ztrds ) 184 183 ! 185 184 ! ! control print … … 187 186 & tab3d_2=tsn(:,:,:,jp_sal), clinfo2= ' Sn: ', mask2=tmask ) 188 187 ! 189 IF( nn_timing == 1) CALL timing_stop('tra_nxt')188 IF( ln_timing ) CALL timing_stop('tra_nxt') 190 189 ! 191 190 END SUBROUTINE tra_nxt … … 271 270 REAL(wp) :: zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar 272 271 REAL(wp) :: zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d ! - - 273 REAL(wp), POINTER, DIMENSION(:,:,:,:) ::ztrd_atf272 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrd_atf 274 273 !!---------------------------------------------------------------------- 275 274 ! … … 290 289 ENDIF 291 290 ! 292 IF( ( l_trdtra . and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) ) THEN293 CALL wrk_alloc( jpi, jpj, jpk, kjpt, ztrd_atf)291 IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) ) THEN 292 ALLOCATE( ztrd_atf(jpi,jpj,jpk,kjpt) ) 294 293 ztrd_atf(:,:,:,:) = 0.0_wp 295 294 ENDIF 296 295 zfact = 1._wp / r2dt 296 zfact1 = atfp * p2dt 297 zfact2 = zfact1 * r1_rau0 297 298 DO jn = 1, kjpt 298 299 DO jk = 1, jpkm1 299 zfact1 = atfp * p2dt300 zfact2 = zfact1 * r1_rau0301 300 DO jj = 2, jpjm1 302 301 DO ji = fs_2, fs_jpim1 … … 357 356 END DO 358 357 ! 359 IF( l_trdtra .and. cdtype == 'TRA' ) THEN 360 CALL trd_tra( kt, cdtype, jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) ) 361 CALL trd_tra( kt, cdtype, jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) ) 362 CALL wrk_dealloc( jpi, jpj, jpk, kjpt, ztrd_atf ) 363 ENDIF 364 IF( l_trdtrc .and. cdtype == 'TRC' ) THEN 365 DO jn = 1, kjpt 366 CALL trd_tra( kt, cdtype, jn, jptra_atf, ztrd_atf(:,:,:,jn) ) 367 END DO 368 CALL wrk_dealloc( jpi, jpj, jpk, kjpt, ztrd_atf ) 358 IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) ) THEN 359 IF( l_trdtra .AND. cdtype == 'TRA' ) THEN 360 CALL trd_tra( kt, cdtype, jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) ) 361 CALL trd_tra( kt, cdtype, jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) ) 362 ENDIF 363 IF( l_trdtrc .AND. cdtype == 'TRC' ) THEN 364 DO jn = 1, kjpt 365 CALL trd_tra( kt, cdtype, jn, jptra_atf, ztrd_atf(:,:,:,jn) ) 366 END DO 367 ENDIF 368 DEALLOCATE( ztrd_atf ) 369 369 ENDIF 370 370 !
Note: See TracChangeset
for help on using the changeset viewer.