Changeset 5034 for branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
- Timestamp:
- 2015-01-15T14:48:42+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r4499 r5034 4 4 !! Ocean tracers: horizontal & vertical advective trend 5 5 !!====================================================================== 6 !! History : 8.2 ! 2001-08 (G. Madec, E. Durand)trahad+trazad=traadv7 !! 8 !! 9.0! 2004-08 (C. Talandier) New trends organization6 !! History : OPA ! 2001-08 (G. Madec, E. Durand) v8.2 trahad+trazad=traadv 7 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 8 !! - ! 2004-08 (C. Talandier) New trends organization 9 9 !! - ! 2005-11 (V. Garnier) Surface pressure gradient organization 10 10 !! 2.0 ! 2006-04 (R. Benshila, G. Madec) Step reorganization … … 21 21 USE dom_oce ! ocean space and time domain 22 22 USE eosbn2 ! equation of state 23 USE trd mod_oce ! tracers trends24 USE trdtra ! tr acers trends23 USE trd_oce ! trends: ocean variables 24 USE trdtra ! trends manager: tracers 25 25 USE closea ! closed sea 26 26 USE sbcrnf ! river runoffs … … 33 33 USE wrk_nemo ! Memory Allocation 34 34 USE timing ! Timing 35 USE phycst 35 36 36 37 IMPLICIT NONE 37 38 PRIVATE 38 39 39 PUBLIC tra_adv_cen2 ! routine called by step.F90 40 PUBLIC ups_orca_set ! routine used by traadv_cen2_jki.F90 41 42 LOGICAL :: l_trd ! flag to compute trends 40 PUBLIC tra_adv_cen2 ! routine called by traadv.F90 43 41 44 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits … … 55 53 56 54 SUBROUTINE tra_adv_cen2( kt, kit000, cdtype, pun, pvn, pwn, & 57 & ptb, ptn, pta, kjpt )55 & ptb, ptn, pta, kjpt ) 58 56 !!---------------------------------------------------------------------- 59 57 !! *** ROUTINE tra_adv_cen2 *** … … 85 83 !! * Add this trend now to the general trend of tracer (ta,sa): 86 84 !! pta = pta + ztra 87 !! * trend diagnostic ( 'key_trdtra' defined): the trend is85 !! * trend diagnostic (l_trdtra=T or l_trctra=T): the trend is 88 86 !! saved for diagnostics. The trends saved is expressed as 89 !! Uh.gradh(T), i.e. 90 !! save trend = ztra + ptn divn 87 !! Uh.gradh(T), i.e. save trend = ztra + ptn divn 91 88 !! 92 89 !! Part II : vertical advection … … 104 101 !! Add this trend now to the general trend of tracer (ta,sa): 105 102 !! pta = pta + ztra 106 !! Trend diagnostic ( 'key_trdtra' defined): the trend is103 !! Trend diagnostic (l_trdtra=T or l_trctra=T): the trend is 107 104 !! saved for diagnostics. The trends saved is expressed as : 108 105 !! save trend = w.gradz(T) = ztra - ptn divn. … … 111 108 !! - save trends if needed 112 109 !!---------------------------------------------------------------------- 113 USE oce , ONLY: zwx => ua , zwy => va ! (ua,va) used as 3D workspace114 !115 110 INTEGER , INTENT(in ) :: kt ! ocean time-step index 116 111 INTEGER , INTENT(in ) :: kit000 ! first time step index … … 121 116 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 122 117 ! 123 INTEGER :: ji, jj, jk, jn ! dummy loop indices124 INTEGER :: ierr ! local integer118 INTEGER :: ji, jj, jk, jn, ikt ! dummy loop indices 119 INTEGER :: ierr ! local integer 125 120 REAL(wp) :: zbtr, ztra ! local scalars 126 121 REAL(wp) :: zfp_ui, zfp_vj, zfp_w, zcofi ! - - … … 128 123 REAL(wp) :: zupsut, zcenut, zupst ! - - 129 124 REAL(wp) :: zupsvt, zcenvt, zcent, zice ! - - 130 REAL(wp), POINTER, DIMENSION(:,: ) :: ztfreez 131 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zind 125 REAL(wp), POINTER, DIMENSION(:,:) :: zfzp, zpres ! 2D workspace 126 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwx, zwy ! 3D - 127 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zind ! - - 132 128 !!---------------------------------------------------------------------- 133 129 ! 134 130 IF( nn_timing == 1 ) CALL timing_start('tra_adv_cen2') 135 131 ! 136 CALL wrk_alloc( jpi, jpj, z tfreez)137 CALL wrk_alloc( jpi, jpj, jpk, zw z, zind )132 CALL wrk_alloc( jpi, jpj, zpres, zfzp ) 133 CALL wrk_alloc( jpi, jpj, jpk, zwx, zwy, zwz, zind ) 138 134 ! 139 135 … … 144 140 IF(lwp) WRITE(numout,*) 145 141 ! 146 IF 142 IF( .NOT. ALLOCATED( upsmsk ) ) THEN 147 143 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 148 144 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'tra_adv_cen2: unable to allocate array') … … 162 158 ENDIF 163 159 ! 164 l_trd = .FALSE.165 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.166 !167 160 ! Upstream / centered scheme indicator 168 161 ! ------------------------------------ 169 162 !!gm not strickly exact : the freezing point should be computed at each ocean levels... 170 163 !!gm not a big deal since cen2 is no more used in global ice-ocean simulations 171 ztfreez(:,:) = tfreez( tsn(:,:,1,jp_sal) ) 164 !!ch changes for ice shelf to retain standard behaviour elsewhere, even if not optimal 165 DO jj = 1, jpj 166 DO ji = 1, jpi 167 ikt = mikt(ji,jj) 168 IF (ikt > 1 ) THEN 169 zpres(ji,jj) = grav * rau0 * fsdept(ji,jj,ikt) * 1.e-04 170 ELSE 171 zpres(ji,jj) = 0.0 172 ENDIF 173 END DO 174 END DO 175 zfzp(:,:) = eos_fzp( tsn(:,:,1,jp_sal), zpres(:,:) ) 172 176 DO jk = 1, jpk 173 177 DO jj = 1, jpj 174 178 DO ji = 1, jpi 175 179 ! ! below ice covered area (if tn < "freezing"+0.1 ) 176 IF( tsn(ji,jj,jk,jp_tem) <= z tfreez(ji,jj) + 0.1 ) THEN ; zice = 1.e0177 ELSE ; zice = 0.e0180 IF( tsn(ji,jj,jk,jp_tem) <= zfzp(ji,jj) + 0.1 ) THEN ; zice = 1._wp 181 ELSE ; zice = 0._wp 178 182 ENDIF 179 183 zind(ji,jj,jk) = MAX ( & … … 224 228 ! ! Surface value : 225 229 IF( lk_vvl ) THEN ; zwz(:,:, 1 ) = 0.e0 ! volume variable 226 ELSE ; zwz(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn) ! linear free surface 230 ELSE 231 DO jj = 1, jpj ! vector opt. 232 DO ji = 1, jpi ! vector opt. 233 ikt = mikt(ji,jj) 234 zwz(ji,jj,ikt ) = pwn(ji,jj,ikt) * ptn(ji,jj,ikt,jn) ! linear free surface 235 zwz(ji,jj,1:ikt-1) = 0.e0 236 END DO 237 END DO 227 238 ENDIF 228 239 ! … … 260 271 END DO 261 272 262 ! ! trend diagnostics (contribution of upstream fluxes) 263 IF( l_trd ) THEN 264 CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptn(:,:,:,jn) ) 265 CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptn(:,:,:,jn) ) 266 CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwz, pwn, ptn(:,:,:,jn) ) 273 ! ! trend diagnostics 274 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. & 275 &( cdtype == 'TRC' .AND. l_trdtrc ) ) THEN 276 CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 277 CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 278 CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) ) 267 279 END IF 268 280 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 269 281 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 270 IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) )271 IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) )282 IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) ) 283 IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) ) 272 284 ENDIF 273 285 ! 274 END DO286 END DO 275 287 276 288 ! --------------------------- required in restart file to ensure restartability) … … 281 293 ENDIF 282 294 ! 283 CALL wrk_dealloc( jpi, jpj, z tfreez)284 CALL wrk_dealloc( jpi, jpj, jpk, zw z, zind )295 CALL wrk_dealloc( jpi, jpj, zpres, zfzp ) 296 CALL wrk_dealloc( jpi, jpj, jpk, zwx, zwy, zwz, zind ) 285 297 ! 286 298 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_cen2') … … 303 315 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integers 304 316 !!---------------------------------------------------------------------- 305 306 317 ! 307 318 IF( nn_timing == 1 ) CALL timing_start('ups_orca_set')
Note: See TracChangeset
for help on using the changeset viewer.
