- 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/trazdf_imp.F90
r2715 r3211 42 42 43 43 REAL(wp) :: r_vvl ! variable volume indicator, =1 if lk_vvl=T, =0 otherwise 44 45 !! * Control permutation of array indices 46 # include "oce_ftrans.h90" 47 # include "dom_oce_ftrans.h90" 48 # include "zdf_oce_ftrans.h90" 49 # include "trc_oce_ftrans.h90" 50 # include "domvvl_ftrans.h90" 51 # include "ldftra_oce_ftrans.h90" 52 # include "ldfslp_ftrans.h90" 53 # include "zdfddm_ftrans.h90" 54 # include "traldf_iso_grif_ftrans.h90" 44 55 45 56 !! * Substitutions … … 77 88 USE oce , ONLY: zwd => ua , zws => va ! (ua,va) used as 3D workspace 78 89 USE wrk_nemo, ONLY: zwi => wrk_3d_6 , zwt => wrk_3d_7 ! 3D workspace 90 91 !! DCSE_NEMO: Need additional directives for renamed module variables 92 !FTRANS zwd zws :I :I :z 93 !FTRANS zwi zwt :I :I :z 79 94 ! 80 95 INTEGER , INTENT(in ) :: kt ! ocean time-step index … … 82 97 INTEGER , INTENT(in ) :: kjpt ! number of tracers 83 98 REAL(wp), DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step 84 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 85 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 99 100 !! DCSE_NEMO: This style defeats ftrans 101 ! REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 102 ! REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 103 104 !FTRANS ptb pta :I :I :z : 105 REAL(wp), INTENT(in ) :: ptb(jpi,jpj,jpk,kjpt) ! before and now tracer fields 106 REAL(wp), INTENT(inout) :: pta(jpi,jpj,jpk,kjpt) ! tracer trend 86 107 ! 87 108 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 115 136 ! 116 137 ! vertical mixing coef.: avt for temperature, avs for salinity and passive tracers 138 #if defined key_z_first 139 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 140 DO jj = 1, jpj 141 DO ji = 1, jpi 142 zwt(ji,jj,1) = 0._wp 143 DO jk = 2, jpk 144 zwt(ji,jj,jk) = avt (ji,jj,jk) 145 END DO 146 END DO 147 END DO 148 ELSE 149 DO jj = 1, jpj 150 DO ji = 1, jpi 151 zwt(ji,jj,1) = 0._wp 152 DO jk = 2, jpk 153 zwt(ji,jj,jk) = fsavs(ji,jj,jk) 154 END DO 155 END DO 156 END DO 157 ENDIF 158 #else 117 159 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN ; zwt(:,:,2:jpk) = avt (:,:,2:jpk) 118 160 ELSE ; zwt(:,:,2:jpk) = fsavs(:,:,2:jpk) 119 161 ENDIF 120 162 zwt(:,:,1) = 0._wp 163 #endif 121 164 ! 122 165 #if defined key_ldfslp 123 166 ! isoneutral diffusion: add the contribution 124 167 IF( ln_traldf_grif ) THEN ! Griffies isoneutral diff 168 #if defined key_z_first 169 DO jj = 2, jpjm1 170 DO ji = 2, jpim1 171 DO jk = 2, jpkm1 172 #else 125 173 DO jk = 2, jpkm1 126 174 DO jj = 2, jpjm1 127 175 DO ji = fs_2, fs_jpim1 ! vector opt. 176 #endif 128 177 zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 129 178 END DO … … 131 180 END DO 132 181 ELSE IF( l_traldf_rot ) THEN ! standard isoneutral diff 182 #if defined key_z_first 183 DO jj = 2, jpjm1 184 DO ji = 2, jpim1 185 DO jk = 2, jpkm1 186 #else 133 187 DO jk = 2, jpkm1 134 188 DO jj = 2, jpjm1 135 189 DO ji = fs_2, fs_jpim1 ! vector opt. 190 #endif 136 191 zwt(ji,jj,jk) = zwt(ji,jj,jk) + fsahtw(ji,jj,jk) & 137 192 & * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk) & … … 143 198 #endif 144 199 ! Diagonal, lower (i), upper (s) (including the bottom boundary condition since avt is masked) 200 #if defined key_z_first 201 DO jj = 2, jpjm1 202 DO ji = 2, jpim1 203 DO jk = 1, jpkm1 204 ze3ta = ( 1. - r_vvl ) + r_vvl * fse3t_a(ji,jj,jk) ! after scale factor at T-point 205 ze3tn = r_vvl + ( 1. - r_vvl ) * fse3t_n(ji,jj,jk) ! now scale factor at T-point 206 zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk ) / ( ze3tn * fse3w(ji,jj,jk ) ) 207 zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) ) 208 zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk) 209 END DO 210 #else 145 211 DO jk = 1, jpkm1 146 212 DO jj = 2, jpjm1 … … 154 220 END DO 155 221 END DO 222 #endif 156 223 ! 157 224 !! Matrix inversion from the first level … … 176 243 ! first recurrence: Tk = Dk - Ik Sk-1 / Tk-1 (increasing k) 177 244 ! done once for all passive tracers (so included in the IF instruction) 245 #if defined key_z_first 246 zwt(ji,jj,1) = zwd(ji,jj,1) 247 DO jk = 2, jpkm1 248 zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1) 249 END DO 250 END DO 251 END DO 252 #else 178 253 DO jj = 2, jpjm1 179 254 DO ji = fs_2, fs_jpim1 … … 188 263 END DO 189 264 END DO 265 #endif 190 266 ! 191 267 END IF 192 268 ! 193 269 ! second recurrence: Zk = Yk - Ik / Tk-1 Zk-1 270 #if defined key_z_first 271 DO jj = 2, jpjm1 272 DO ji = 2, jpim1 273 ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,1) 274 ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t(ji,jj,1) 275 pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn) + p2dt(1) * ze3tn * pta(ji,jj,1,jn) 276 DO jk = 2, jpkm1 277 ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,jk) 278 ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t (ji,jj,jk) 279 zrhs = ze3tb * ptb(ji,jj,jk,jn) + p2dt(jk) * ze3tn * pta(ji,jj,jk,jn) ! zrhs=right hand side 280 pta(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pta(ji,jj,jk-1,jn) 281 END DO 282 #else 194 283 DO jj = 2, jpjm1 195 284 DO ji = fs_2, fs_jpim1 … … 209 298 END DO 210 299 END DO 300 #endif 211 301 212 302 ! third recurrence: Xk = (Zk - Sk Xk+1 ) / Tk (result is the after tracer) 303 #if defined key_z_first 304 pta(ji,jj,jpkm1,jn) = pta(ji,jj,jpkm1,jn) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1) 305 DO jk = jpk-2, 1, -1 306 pta(ji,jj,jk,jn) = ( pta(ji,jj,jk,jn) - zws(ji,jj,jk) * pta(ji,jj,jk+1,jn) ) & 307 & / zwt(ji,jj,jk) * tmask(ji,jj,jk) 308 END DO 309 END DO 310 END DO 311 #else 213 312 DO jj = 2, jpjm1 214 313 DO ji = fs_2, fs_jpim1 … … 224 323 END DO 225 324 END DO 325 #endif 226 326 ! ! ================= ! 227 327 END DO ! end tracer loop !
Note: See TracChangeset
for help on using the changeset viewer.
