- Timestamp:
- 2015-02-11T11:50:34+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO7_STARTHOUR/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r4292 r5075 52 52 53 53 SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pgu, pgv, & 54 & pgui, pgvi, & 54 55 & ptb, pta, kjpt, pahtb0 ) 55 56 !!---------------------------------------------------------------------- … … 98 99 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 99 100 INTEGER , INTENT(in ) :: kjpt ! number of tracers 100 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 101 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu , pgv ! tracer gradient at pstep levels 102 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at pstep levels 101 103 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 102 104 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend … … 110 112 REAL(wp) :: zztmp ! local scalar 111 113 #endif 112 REAL(wp), POINTER, DIMENSION(:,: ) :: z dkt, zdk1t, z2d113 REAL(wp), POINTER, DIMENSION(:,:,:) :: zd it, zdjt, ztfw114 REAL(wp), POINTER, DIMENSION(:,: ) :: z2d 115 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdkt, zdk1t, zdit, zdjt, ztfw 114 116 !!---------------------------------------------------------------------- 115 117 ! 116 118 IF( nn_timing == 1 ) CALL timing_start('tra_ldf_iso') 117 119 ! 118 CALL wrk_alloc( jpi, jpj, z dkt, zdk1t, z2d )119 CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw 120 CALL wrk_alloc( jpi, jpj, z2d ) 121 CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t ) 120 122 ! 121 123 … … 150 152 DO jj = 1, jpjm1 151 153 DO ji = 1, fs_jpim1 ! vector opt. 152 zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 153 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 154 ! IF useless if zpshde defines pgu everywhere 155 IF (mbku(ji,jj) > 1) zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 156 IF (mbkv(ji,jj) > 1) zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 157 ! (ISF) 158 IF (miku(ji,jj) > 1) zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn) 159 IF (mikv(ji,jj) > 1) zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn) 154 160 END DO 155 161 END DO … … 161 167 !CDIR PARALLEL DO PRIVATE( zdk1t ) 162 168 ! ! =============== 163 DO j k = 1, jpkm1! Horizontal slab169 DO jj = 1, jpj ! Horizontal slab 164 170 ! ! =============== 165 ! 1. Vertical tracer gradient at level jk and jk+1 166 ! ------------------------------------------------ 167 ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 168 zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1) 169 ! 170 IF( jk == 1 ) THEN ; zdkt(:,:) = zdk1t(:,:) 171 ELSE ; zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk) 172 ENDIF 171 DO ji = 1, jpi ! vector opt. 172 DO jk = mikt(ji,jj), jpkm1 173 ! 1. Vertical tracer gradient at level jk and jk+1 174 ! ------------------------------------------------ 175 ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 176 zdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn) - ptb(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1) 177 ! 178 IF( jk == mikt(ji,jj) ) THEN ; zdkt(ji,jj,jk) = zdk1t(ji,jj,jk) 179 ELSE ; zdkt(ji,jj,jk) = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 180 ENDIF 181 END DO 182 END DO 183 END DO 173 184 174 185 ! 2. Horizontal fluxes 175 186 ! -------------------- 176 DO jj = 1 , jpjm1 177 DO ji = 1, fs_jpim1 ! vector opt. 187 DO jj = 1 , jpjm1 188 DO ji = 1, fs_jpim1 ! vector opt. 189 DO jk = mikt(ji,jj), jpkm1 178 190 zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) 179 191 zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) … … 189 201 ! 190 202 zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk) & 191 & + zcof1 * ( zdkt (ji+1,jj ) + zdk1t(ji,jj) &192 & + zdk1t(ji+1,jj ) + zdkt (ji,jj) ) ) * umask(ji,jj,jk)203 & + zcof1 * ( zdkt (ji+1,jj,jk) + zdk1t(ji,jj,jk) & 204 & + zdk1t(ji+1,jj,jk) + zdkt (ji,jj,jk) ) ) * umask(ji,jj,jk) 193 205 zftv(ji,jj,jk) = ( zabe2 * zdjt(ji,jj,jk) & 194 & + zcof2 * ( zdkt (ji,jj+1) + zdk1t(ji,jj) & 195 & + zdk1t(ji,jj+1) + zdkt (ji,jj) ) ) * vmask(ji,jj,jk) 196 END DO 197 END DO 206 & + zcof2 * ( zdkt (ji,jj+1,jk) + zdk1t(ji,jj,jk) & 207 & + zdk1t(ji,jj+1,jk) + zdkt (ji,jj,jk) ) ) * vmask(ji,jj,jk) 208 END DO 209 END DO 210 END DO 198 211 199 212 ! II.4 Second derivative (divergence) and add to the general trend 200 213 ! ---------------------------------------------------------------- 201 DO jj = 2 , jpjm1 202 DO ji = fs_2, fs_jpim1 ! vector opt. 203 zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) ) 214 DO jj = 2 , jpjm1 215 DO ji = fs_2, fs_jpim1 ! vector opt. 216 DO jk = mikt(ji,jj), jpkm1 217 zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 204 218 ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) 205 219 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra … … 264 278 DO jj = 2, jpjm1 265 279 DO ji = fs_2, fs_jpim1 ! vector opt. 266 zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk) 280 zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 267 281 ! 268 282 zmsku = 1./MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) & … … 297 311 END DO 298 312 ! 299 CALL wrk_dealloc( jpi, jpj, zdkt, zdk1t,z2d )300 CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw 313 CALL wrk_dealloc( jpi, jpj, z2d ) 314 CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t ) 301 315 ! 302 316 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_iso') … … 309 323 !!---------------------------------------------------------------------- 310 324 CONTAINS 311 SUBROUTINE tra_ldf_iso( kt, kit000,cdtype, pgu, pgv, p tb, pta, kjpt, pahtb0 ) ! Empty routine325 SUBROUTINE tra_ldf_iso( kt, kit000,cdtype, pgu, pgv, pgui, pgvi, ptb, pta, kjpt, pahtb0 ) ! Empty routine 312 326 INTEGER:: kt, kit000 313 327 CHARACTER(len=3) :: cdtype 314 REAL, DIMENSION(:,:,:) :: pgu, pgv ! tracer gradient at pstep levels328 REAL, DIMENSION(:,:,:) :: pgu, pgv, pgui, pgvi ! tracer gradient at pstep levels 315 329 REAL, DIMENSION(:,:,:,:) :: ptb, pta 316 330 WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, kit000, cdtype, &
Note: See TracChangeset
for help on using the changeset viewer.
