- Timestamp:
- 2017-06-28T10:02:58+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90
r7761 r8226 52 52 !!----------------------------------------------------------------------- 53 53 ! 54 IF( Agrif_Root() ) RETURN54 IF( Agrif_Root() .OR. nn_ice==0 ) RETURN ! clem2017: do not interpolate if inside Parent domain or if child domain does not have ice 55 55 ! 56 56 SELECT CASE(cd_type) … … 90 90 !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after) 91 91 !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points, 92 !! put -999 9WHERE the parent grid is masked. The child solution will be found in the 9(?) points around92 !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 93 93 !!----------------------------------------------------------------------- 94 94 INTEGER , INTENT(in) :: i1, i2, j1, j2 … … 101 101 IF( before ) THEN ! parent grid 102 102 ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice_b(i1:i2,j1:j2) 103 WHERE( umask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = -9999.103 WHERE( umask(i1:i2,j1:j2,1) == 0. ) ptab(i1:i2,j1:j2) = Agrif_SpecialValue 104 104 ELSE ! child grid 105 105 zrhoy = Agrif_Rhoy() 106 u_ice(i1:i2,j1:j2) = ptab( :,:) / ( e2u(i1:i2,j1:j2) * zrhoy ) * umask(i1:i2,j1:j2,1)106 u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / ( e2u(i1:i2,j1:j2) * zrhoy ) * umask(i1:i2,j1:j2,1) 107 107 ENDIF 108 108 ! … … 116 116 !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after) 117 117 !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points, 118 !! put -999 9WHERE the parent grid is masked. The child solution will be found in the 9(?) points around118 !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 119 119 !!----------------------------------------------------------------------- 120 120 INTEGER , INTENT(in) :: i1, i2, j1, j2 … … 127 127 IF( before ) THEN ! parent grid 128 128 ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice_b(i1:i2,j1:j2) 129 WHERE( vmask(i1:i2,j1:j2,1) == 0. ) ptab( :,:) = -9999.129 WHERE( vmask(i1:i2,j1:j2,1) == 0. ) ptab(i1:i2,j1:j2) = Agrif_SpecialValue 130 130 ELSE ! child grid 131 131 zrhox = Agrif_Rhox() 132 v_ice(i1:i2,j1:j2) = ptab( :,:) / ( e1v(i1:i2,j1:j2) * zrhox ) * vmask(i1:i2,j1:j2,1)132 v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / ( e1v(i1:i2,j1:j2) * zrhox ) * vmask(i1:i2,j1:j2,1) 133 133 ENDIF 134 134 ! … … 142 142 !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after) 143 143 !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points, 144 !! put -999 9WHERE the parent grid is masked. The child solution will be found in the 9(?) points around144 !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 145 145 !!----------------------------------------------------------------------- 146 146 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab … … 158 158 ! tracers are not multiplied by grid cell here => before: * e12t ; after: * r1_e12t / rhox / rhoy 159 159 ! and it is ok since we conserve tracers (same as in the ocean). 160 ALLOCATE( ztab(SIZE(a_i _b,1),SIZE(a_i_b,2),SIZE(ptab,3)) )160 ALLOCATE( ztab(SIZE(a_i,1),SIZE(a_i,2),SIZE(ptab,3)) ) 161 161 162 162 IF( before ) THEN ! parent grid 163 163 jm = 1 164 164 DO jl = 1, jpl 165 ptab(i1:i2,j1:j2,jm) = a_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 166 ptab(i1:i2,j1:j2,jm) = v_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 167 ptab(i1:i2,j1:j2,jm) = v_s_b (i1:i2,j1:j2,jl) ; jm = jm + 1 168 ptab(i1:i2,j1:j2,jm) = smv_i_b(i1:i2,j1:j2,jl) ; jm = jm + 1 169 ptab(i1:i2,j1:j2,jm) = oa_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 165 ptab(i1:i2,j1:j2,jm ) = a_i_b (i1:i2,j1:j2,jl) 166 ptab(i1:i2,j1:j2,jm+1) = v_i_b (i1:i2,j1:j2,jl) 167 ptab(i1:i2,j1:j2,jm+2) = v_s_b (i1:i2,j1:j2,jl) 168 ptab(i1:i2,j1:j2,jm+3) = smv_i_b(i1:i2,j1:j2,jl) 169 ptab(i1:i2,j1:j2,jm+4) = oa_i_b (i1:i2,j1:j2,jl) 170 jm = jm + 5 170 171 DO jk = 1, nlay_s 171 172 ptab(i1:i2,j1:j2,jm) = e_s_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 … … 177 178 178 179 DO jk = k1, k2 179 WHERE( tmask(i1:i2,j1:j2,1) == 0. ) ptab(i1:i2,j1:j2,jk) = -9999.180 WHERE( tmask(i1:i2,j1:j2,1) == 0. ) ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValue 180 181 ENDDO 181 182 182 183 ELSE ! child grid 183 !! ==> The easiest interpolation is the following commented lines 184 jm = 1 185 DO jl = 1, jpl 186 a_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 187 v_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 188 v_s (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 189 smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 190 oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 191 DO jk = 1, nlay_s 192 e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 193 ENDDO 194 DO jk = 1, nlay_i 195 e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 196 ENDDO 197 ENDDO 198 199 !! ==> this is a more complex interpolation since we mix solutions over a couple of grid points 200 !! it is advised to use it for fields modified by high order schemes (e.g. advection UM5...) 201 !! clem: for some reason (I don't know why), the following lines do not work 202 !! with mpp (or in realistic configurations?). It makes the model crash 203 ! ! record ztab 204 ! jm = 1 205 ! DO jl = 1, jpl 206 ! ztab(:,:,jm) = a_i (:,:,jl) ; jm = jm + 1 207 ! ztab(:,:,jm) = v_i (:,:,jl) ; jm = jm + 1 208 ! ztab(:,:,jm) = v_s (:,:,jl) ; jm = jm + 1 209 ! ztab(:,:,jm) = smv_i(:,:,jl) ; jm = jm + 1 210 ! ztab(:,:,jm) = oa_i (:,:,jl) ; jm = jm + 1 211 ! DO jk = 1, nlay_s 212 ! ztab(:,:,jm) = e_s(:,:,jk,jl) ; jm = jm + 1 213 ! ENDDO 214 ! DO jk = 1, nlay_i 215 ! ztab(:,:,jm) = e_i(:,:,jk,jl) ; jm = jm + 1 216 ! ENDDO 217 ! ENDDO 218 ! ! 219 ! ! borders of the domain 220 ! western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 221 ! southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 222 ! ! 223 ! ! spatial smoothing 224 ! zrhox = Agrif_Rhox() 225 ! z1 = ( zrhox - 1. ) * 0.5 226 ! z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 227 ! z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 228 ! z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 229 ! z2 = 1. - z1 230 ! z4 = 1. - z3 231 ! z5 = 1. - z6 - z7 232 ! ! 233 ! ! Remove corners 234 ! imin = i1 ; imax = i2 ; jmin = j1 ; jmax = j2 235 ! IF( (nbondj == -1) .OR. (nbondj == 2) ) jmin = 3 236 ! IF( (nbondj == +1) .OR. (nbondj == 2) ) jmax = nlcj-2 237 ! IF( (nbondi == -1) .OR. (nbondi == 2) ) imin = 3 238 ! IF( (nbondi == +1) .OR. (nbondi == 2) ) imax = nlci-2 239 ! 240 ! ! smoothed fields 241 ! IF( eastern_side ) THEN 242 ! ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:) 243 ! DO jj = jmin, jmax 244 ! rswitch = 0. 245 ! IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1. 246 ! ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:) & 247 ! & + umask(nlci-2,jj,1) * & 248 ! & ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:) + z3 * ztab(nlci-2,jj,:) ) & 249 ! & + rswitch * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) ) 250 ! ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1) 251 ! END DO 252 ! ENDIF 253 ! ! 254 ! IF( northern_side ) THEN 255 ! ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:) 256 ! DO ji = imin, imax 257 ! rswitch = 0. 258 ! IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1. 259 ! ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:) & 260 ! & + vmask(ji,nlcj-2,1) * & 261 ! & ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:) + z3 * ztab(ji,nlcj-2,:) ) & 262 ! & + rswitch * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) ) 263 ! ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1) 264 ! END DO 265 ! END IF 266 ! ! 267 ! IF( western_side) THEN 268 ! ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:) 269 ! DO jj = jmin, jmax 270 ! rswitch = 0. 271 ! IF( u_ice(2,jj) < 0._wp ) rswitch = 1. 272 ! ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:) & 273 ! & + umask(2,jj,1) * & 274 ! & ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) & 275 ! & + rswitch * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) ) 276 ! ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1) 277 ! END DO 278 ! ENDIF 279 ! ! 280 ! IF( southern_side ) THEN 281 ! ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:) 282 ! DO ji = imin, imax 283 ! rswitch = 0. 284 ! IF( v_ice(ji,2) < 0._wp ) rswitch = 1. 285 ! ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:) & 286 ! & + vmask(ji,2,1) * & 287 ! & ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) & 288 ! & + rswitch * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) ) 289 ! ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1) 290 ! END DO 291 ! END IF 292 ! ! 293 ! ! Treatment of corners 294 ! IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(nlci-1,2,:) = ptab(nlci-1,2,:) ! East south 295 ! IF( (eastern_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north 296 ! IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(2,2,:) = ptab(2,2,:) ! West south 297 ! IF( (western_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(2,nlcj-1,:) = ptab(2,nlcj-1,:) ! West north 298 ! 299 ! ! retrieve ice tracers 300 ! jm = 1 301 ! DO jl = 1, jpl 302 ! a_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 303 ! v_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 304 ! v_s (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 305 ! smv_i(i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 306 ! oa_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 307 ! DO jk = 1, nlay_s 308 ! e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 309 ! ENDDO 310 ! DO jk = 1, nlay_i 311 ! e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 312 ! ENDDO 313 ! ENDDO 314 184 185 IF( nbghostcells > 1 ) THEN 186 !! ==> The easiest interpolation is the following lines 187 188 jm = 1 189 DO jl = 1, jpl 190 ! 191 DO jj = j1, j2 192 DO ji = i1, i2 193 a_i (ji,jj,jl) = ptab(ji,jj,jm ) * tmask(ji,jj,1) 194 v_i (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1) 195 v_s (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1) 196 smv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1) 197 oa_i (ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1) 198 ENDDO 199 ENDDO 200 jm = jm + 5 201 ! 202 DO jk = 1, nlay_s 203 e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) 204 jm = jm + 1 205 ENDDO 206 ! 207 DO jk = 1, nlay_i 208 e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) 209 jm = jm + 1 210 ENDDO 211 ! 212 ENDDO 213 214 ELSE 215 !! ==> this is a more complex interpolation since we mix solutions over a couple of grid points 216 !! it is advised to use it for fields modified by high order schemes (e.g. advection UM5...) 217 !! clem: for some reason (I don't know why), the following lines do not work 218 !! with mpp (or in realistic configurations?). It makes the model crash 219 ! I think there is an issue with Agrif_SpecialValue here (not taken into account properly) 220 ! record ztab 221 jm = 1 222 DO jl = 1, jpl 223 ztab(:,:,jm ) = a_i (:,:,jl) 224 ztab(:,:,jm+1) = v_i (:,:,jl) 225 ztab(:,:,jm+2) = v_s (:,:,jl) 226 ztab(:,:,jm+3) = smv_i(:,:,jl) 227 ztab(:,:,jm+4) = oa_i (:,:,jl) 228 jm = jm + 5 229 DO jk = 1, nlay_s 230 ztab(:,:,jm) = e_s(:,:,jk,jl) 231 jm = jm + 1 232 ENDDO 233 DO jk = 1, nlay_i 234 ztab(:,:,jm) = e_i(:,:,jk,jl) 235 jm = jm + 1 236 ENDDO 237 ! 238 ENDDO 239 ! 240 ! borders of the domain 241 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 242 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 243 ! 244 ! spatial smoothing 245 zrhox = Agrif_Rhox() 246 z1 = ( zrhox - 1. ) * 0.5 247 z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 248 z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 249 z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 250 z2 = 1. - z1 251 z4 = 1. - z3 252 z5 = 1. - z6 - z7 253 ! 254 ! Remove corners 255 imin = i1 ; imax = i2 ; jmin = j1 ; jmax = j2 256 IF( (nbondj == -1) .OR. (nbondj == 2) ) jmin = 3 257 IF( (nbondj == +1) .OR. (nbondj == 2) ) jmax = nlcj-2 258 IF( (nbondi == -1) .OR. (nbondi == 2) ) imin = 3 259 IF( (nbondi == +1) .OR. (nbondi == 2) ) imax = nlci-2 260 261 ! smoothed fields 262 IF( eastern_side ) THEN 263 ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:) 264 DO jj = jmin, jmax 265 rswitch = 0. 266 IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1. 267 ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:) & 268 & + umask(nlci-2,jj,1) * & 269 & ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:) + z3 * ztab(nlci-2,jj,:) ) & 270 & + rswitch * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) ) 271 ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1) 272 END DO 273 ENDIF 274 ! 275 IF( northern_side ) THEN 276 ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:) 277 DO ji = imin, imax 278 rswitch = 0. 279 IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1. 280 ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:) & 281 & + vmask(ji,nlcj-2,1) * & 282 & ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:) + z3 * ztab(ji,nlcj-2,:) ) & 283 & + rswitch * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) ) 284 ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1) 285 END DO 286 END IF 287 ! 288 IF( western_side) THEN 289 ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:) 290 DO jj = jmin, jmax 291 rswitch = 0. 292 IF( u_ice(2,jj) < 0._wp ) rswitch = 1. 293 ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:) & 294 & + umask(2,jj,1) * & 295 & ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) & 296 & + rswitch * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) ) 297 ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1) 298 END DO 299 ENDIF 300 ! 301 IF( southern_side ) THEN 302 ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:) 303 DO ji = imin, imax 304 rswitch = 0. 305 IF( v_ice(ji,2) < 0._wp ) rswitch = 1. 306 ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:) & 307 & + vmask(ji,2,1) * & 308 & ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) & 309 & + rswitch * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) ) 310 ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1) 311 END DO 312 END IF 313 ! 314 ! Treatment of corners 315 IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(nlci-1,2,:) = ptab(nlci-1,2,:) ! East south 316 IF( (eastern_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north 317 IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(2,2,:) = ptab(2,2,:) ! West south 318 IF( (western_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(2,nlcj-1,:) = ptab(2,nlcj-1,:) ! West north 319 320 ! retrieve ice tracers 321 jm = 1 322 DO jl = 1, jpl 323 ! 324 DO jj = j1, j2 325 DO ji = i1, i2 326 a_i (ji,jj,jl) = ztab(ji,jj,jm ) * tmask(ji,jj,1) 327 v_i (ji,jj,jl) = ztab(ji,jj,jm+1) * tmask(ji,jj,1) 328 v_s (ji,jj,jl) = ztab(ji,jj,jm+2) * tmask(ji,jj,1) 329 smv_i(ji,jj,jl) = ztab(ji,jj,jm+3) * tmask(ji,jj,1) 330 oa_i (ji,jj,jl) = ztab(ji,jj,jm+4) * tmask(ji,jj,1) 331 ENDDO 332 ENDDO 333 jm = jm + 5 334 ! 335 DO jk = 1, nlay_s 336 e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 337 jm = jm + 1 338 ENDDO 339 ! 340 DO jk = 1, nlay_i 341 e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 342 jm = jm + 1 343 ENDDO 344 ! 345 ENDDO 346 347 ENDIF ! nbghostcells=1 348 315 349 ! integrated values 316 350 vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 ) … … 319 353 et_s(i1:i2,j1:j2) = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 320 354 et_i(i1:i2,j1:j2) = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 321 355 322 356 ENDIF 357 358 DEALLOCATE( ztab ) 323 359 324 DEALLOCATE( ztab )325 360 ! 326 361 END SUBROUTINE interp_tra_ice
Note: See TracChangeset
for help on using the changeset viewer.