- Timestamp:
- 2011-12-11T16:00:26+01:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r2715 r3211 58 58 REAL(wp) :: rbcp ! Brown & Campana parameters for semi-implicit hpg 59 59 60 !! * Control permutation of array indices 61 # include "oce_ftrans.h90" 62 # include "dom_oce_ftrans.h90" 63 # include "sbc_oce_ftrans.h90" 64 # include "zdf_oce_ftrans.h90" 65 # include "domvvl_ftrans.h90" 66 # include "obc_oce_ftrans.h90" 67 60 68 !! * Substitutions 61 69 # include "domzgr_substitute.h90" … … 93 101 INTEGER, INTENT(in) :: kt ! ocean time-step index 94 102 !! 95 INTEGER :: jk, jn ! dummy loop indices 96 REAL(wp) :: zfact ! local scalars 103 INTEGER :: ji, jj, jk, jn ! dummy loop indices 104 REAL(wp) :: zfact ! local scalar 105 106 !FTRANS ztrdt ztrds :I :I :z 97 107 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds 98 108 !!---------------------------------------------------------------------- … … 142 152 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step (only swap) 143 153 DO jn = 1, jpts 154 #if defined key_z_first 155 DO jj = 1, jpj 156 DO ji = 1, jpi 157 DO jk = 1, jpkm1 158 tsn(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) 159 END DO 160 END DO 161 END DO 162 #else 144 163 DO jk = 1, jpkm1 145 164 tsn(:,:,jk,jn) = tsa(:,:,jk,jn) 146 165 END DO 166 #endif 147 167 END DO 148 168 ELSE ! Leap-Frog + Asselin filter time stepping … … 162 182 ! trends computation 163 183 IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 184 #if defined key_z_first 185 DO jj = 1, jpj 186 DO ji = 1, jpi 187 DO jk = 1, jpkm1 188 zfact = 1.e0 / r2dtra(jk) 189 ztrdt(ji,jj,jk) = ( tsb(ji,jj,jk,jp_tem) - ztrdt(ji,jj,jk) ) * zfact 190 ztrds(ji,jj,jk) = ( tsb(ji,jj,jk,jp_sal) - ztrds(ji,jj,jk) ) * zfact 191 END DO 192 END DO 193 END DO 194 #else 164 195 DO jk = 1, jpkm1 165 196 zfact = 1.e0 / r2dtra(jk) … … 167 198 ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact 168 199 END DO 200 #endif 169 201 CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_atf, ztrdt ) 170 202 CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_atf, ztrds ) … … 178 210 END SUBROUTINE tra_nxt 179 211 212 !! * Reset control of array index permutation 213 !FTRANS CLEAR 214 # include "oce_ftrans.h90" 215 # include "dom_oce_ftrans.h90" 216 # include "sbc_oce_ftrans.h90" 217 # include "zdf_oce_ftrans.h90" 218 # include "domvvl_ftrans.h90" 219 # include "obc_oce_ftrans.h90" 180 220 181 221 SUBROUTINE tra_nxt_fix( kt, cdtype, ptb, ptn, pta, kjpt ) … … 205 245 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 206 246 INTEGER , INTENT(in ) :: kjpt ! number of tracers 207 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields 208 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! now tracer fields 209 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 247 248 !! DCSE_NEMO: This style defeats ftrans 249 ! REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields 250 ! REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! now tracer fields 251 ! REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 252 253 !FTRANS ptb ptn pta :I :I :z : 254 REAL(wp) , INTENT(inout) :: ptb(jpi,jpj,jpk,kjpt) ! before tracer fields 255 REAL(wp) , INTENT(inout) :: ptn(jpi,jpj,jpk,kjpt) ! now tracer fields 256 REAL(wp) , INTENT(inout) :: pta(jpi,jpj,jpk,kjpt) ! tracer trend 210 257 ! 211 258 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 226 273 DO jn = 1, kjpt 227 274 ! 275 #if defined key_z_first 276 DO jj = 1, jpj 277 DO ji = 1, jpi 278 DO jk = 1, jpkm1 279 #else 228 280 DO jk = 1, jpkm1 229 281 DO jj = 1, jpj 230 282 DO ji = 1, jpi 283 #endif 231 284 ztn = ptn(ji,jj,jk,jn) 232 285 ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn) ! time laplacian on tracers … … 244 297 END SUBROUTINE tra_nxt_fix 245 298 299 !! * Reset control of array index permutation 300 !FTRANS CLEAR 301 # include "oce_ftrans.h90" 302 # include "dom_oce_ftrans.h90" 303 # include "sbc_oce_ftrans.h90" 304 # include "zdf_oce_ftrans.h90" 305 # include "domvvl_ftrans.h90" 306 # include "obc_oce_ftrans.h90" 246 307 247 308 SUBROUTINE tra_nxt_vvl( kt, cdtype, ptb, ptn, pta, kjpt ) … … 272 333 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 273 334 INTEGER , INTENT(in ) :: kjpt ! number of tracers 274 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields 275 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! now tracer fields 276 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 335 336 !! DCSE_NEMO: This style defeats ftrans 337 ! REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields 338 ! REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! now tracer fields 339 ! REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 340 341 !FTRANS ptb ptn pta :I :I :z : 342 REAL(wp) , INTENT(inout) :: ptb(jpi,jpj,jpk,kjpt) ! before tracer fields 343 REAL(wp) , INTENT(inout) :: ptn(jpi,jpj,jpk,kjpt) ! now tracer fields 344 REAL(wp) , INTENT(inout) :: pta(jpi,jpj,jpk,kjpt) ! tracer trend 345 277 346 !! 278 347 LOGICAL :: ll_tra, ll_tra_hpg, ll_traqsr ! local logical … … 299 368 ! 300 369 DO jn = 1, kjpt 370 #if defined key_z_first 371 DO jj = 1, jpj 372 DO ji = 1, jpi 373 DO jk = 1, jpkm1 374 !! DCSE_NEMO: could try promoting these scalars to vectors 375 zfact1 = atfp * rdttra(jk) 376 zfact2 = zfact1 / rau0 377 #else 301 378 DO jk = 1, jpkm1 302 379 zfact1 = atfp * rdttra(jk) … … 304 381 DO jj = 1, jpj 305 382 DO ji = 1, jpi 383 #endif 306 384 ze3t_b = fse3t_b(ji,jj,jk) 307 385 ze3t_n = fse3t_n(ji,jj,jk)
Note: See TracChangeset
for help on using the changeset viewer.
