Changeset 9134
- Timestamp:
- 2017-12-19T16:37:38+01:00 (5 years ago)
- Location:
- branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r9116 r9134 106 106 ibdy2 = 1+nbghostcells 107 107 ! 108 ! Smoothing109 ! ---------110 108 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 111 109 ua_b(ibdy1:ibdy2,:) = 0._wp 112 110 DO jk = 1, jpkm1 113 111 DO jj = 1, jpj 114 ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) 112 ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) & 113 & + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk) 115 114 END DO 116 115 END DO … … 121 120 ! 122 121 IF( .NOT.lk_agrif_clp ) THEN 123 DO jk=1,jpkm1 122 DO jk=1,jpkm1 ! Smooth 124 123 DO jj=j1,j2 125 124 ua(ibdy2,jj,jk) = 0.25_wp*(ua(ibdy2-1,jj,jk)+2._wp*ua(ibdy2,jj,jk)+ua(ibdy2+1,jj,jk)) 126 ua(ibdy2,jj,jk) = ua(ibdy2,jj,jk) * umask(ibdy2,jj,jk) 127 END DO 128 END DO 129 ENDIF 130 ! 131 zub(ibdy1:ibdy2,:) = 0._wp ! Correct transport 125 END DO 126 END DO 127 ENDIF 128 ! 129 zub(ibdy1:ibdy2,:) = 0._wp ! Correct transport 132 130 DO jk = 1, jpkm1 133 131 DO jj = 1, jpj 134 zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) 132 zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) & 133 & + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk)*umask(ibdy1:ibdy2,jj,jk) 135 134 END DO 136 135 END DO … … 141 140 DO jk = 1, jpkm1 142 141 DO jj = 1, jpj 143 ua(ibdy1:ibdy2,jj,jk) = (ua(ibdy1:ibdy2,jj,jk)+ua_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj))*umask(ibdy1:ibdy2,jj,jk) 142 ua(ibdy1:ibdy2,jj,jk) = ua(ibdy1:ibdy2,jj,jk) & 143 & + (ua_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj)) * umask(ibdy1:ibdy2,jj,jk) 144 144 END DO 145 145 END DO … … 149 149 DO jk = 1, jpkm1 150 150 DO jj = 1, jpj 151 zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) + e3v_a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) 151 zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) & 152 & + e3v_a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) * vmask(ibdy1:ibdy2,jj,jk) 152 153 END DO 153 154 END DO … … 157 158 DO jk = 1, jpkm1 158 159 DO jj = 1, jpj 159 va(ibdy1:ibdy2,jj,jk) = (va(ibdy1:ibdy2,jj,jk)+va_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj)) * vmask(ibdy1:ibdy2,jj,jk) 160 END DO 161 END DO 162 ENDIF 163 ! 160 va(ibdy1:ibdy2,jj,jk) = va(ibdy1:ibdy2,jj,jk) & 161 & + (va_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj))*vmask(ibdy1:ibdy2,jj,jk) 162 END DO 163 END DO 164 ENDIF 165 ! 166 DO jk = 1, jpkm1 ! Mask domain edges 167 DO jj = 1, jpj 168 ua(1,jj,jk) = 0._wp 169 va(1,jj,jk) = 0._wp 170 END DO 171 END DO 164 172 ENDIF 165 173 … … 169 177 ibdy2 = nlci-2 170 178 ! 171 ! Smoothing172 ! ---------173 179 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 174 180 ua_b(ibdy1:ibdy2,:) = 0._wp 175 181 DO jk = 1, jpkm1 176 182 DO jj = 1, jpj 177 ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) 183 ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) & 184 & + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk) 178 185 END DO 179 186 END DO … … 184 191 ! 185 192 IF( .NOT.lk_agrif_clp ) THEN 186 DO jk=1,jpkm1 193 DO jk=1,jpkm1 ! Smooth 187 194 DO jj=j1,j2 188 195 ua(ibdy1,jj,jk) = 0.25_wp*(ua(ibdy1-1,jj,jk)+2._wp*ua(ibdy1,jj,jk)+ua(ibdy1+1,jj,jk)) 189 ua(ibdy1,jj,jk) = ua(ibdy1,jj,jk) * umask(ibdy1,jj,jk) 190 END DO 191 END DO 192 ENDIF 193 ! 194 zub(ibdy1:ibdy2,:) = 0._wp ! Correct transport 196 END DO 197 END DO 198 ENDIF 199 ! 200 zub(ibdy1:ibdy2,:) = 0._wp ! Correct transport 195 201 DO jk = 1, jpkm1 196 202 DO jj = 1, jpj 197 zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) 203 zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) & 204 & + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk) 198 205 END DO 199 206 END DO … … 204 211 DO jk = 1, jpkm1 205 212 DO jj = 1, jpj 206 ua(ibdy1:ibdy2,jj,jk) = (ua(ibdy1:ibdy2,jj,jk)+ua_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj))*umask(ibdy1:ibdy2,jj,jk) 213 ua(ibdy1:ibdy2,jj,jk) = ua(ibdy1:ibdy2,jj,jk) & 214 & + (ua_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj))*umask(ibdy1:ibdy2,jj,jk) 207 215 END DO 208 216 END DO … … 214 222 DO jk = 1, jpkm1 215 223 DO jj = 1, jpj 216 zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) + e3v_a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) 224 zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) & 225 & + e3v_a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) * vmask(ibdy1:ibdy2,jj,jk) 217 226 END DO 218 227 END DO … … 222 231 DO jk = 1, jpkm1 223 232 DO jj = 1, jpj 224 va(ibdy1:ibdy2,jj,jk) = (va(ibdy1:ibdy2,jj,jk)+va_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj)) * vmask(ibdy1:ibdy2,jj,jk) 225 END DO 226 END DO 227 ENDIF 228 ! 233 va(ibdy1:ibdy2,jj,jk) = va(ibdy1:ibdy2,jj,jk) & 234 & + (va_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj)) * vmask(ibdy1:ibdy2,jj,jk) 235 END DO 236 END DO 237 ENDIF 238 ! 239 DO jk = 1, jpkm1 ! Mask domain edges 240 DO jj = 1, jpj 241 ua(nlci-1,jj,jk) = 0._wp 242 va(nlci ,jj,jk) = 0._wp 243 END DO 244 END DO 229 245 ENDIF 230 246 … … 234 250 jbdy2 = 1+nbghostcells 235 251 ! 236 ! Smoothing237 ! ---------238 252 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 239 253 va_b(:,jbdy1:jbdy2) = 0._wp 240 254 DO jk = 1, jpkm1 241 255 DO ji = 1, jpi 242 va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) 256 va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) & 257 & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 243 258 END DO 244 259 END DO … … 249 264 ! 250 265 IF ( .NOT.lk_agrif_clp ) THEN 251 DO jk = 1, jpkm1 266 DO jk = 1, jpkm1 ! Smooth 252 267 DO ji = i1, i2 253 va(ji,jbdy2,jk) = 0.25_wp * vmask(ji,jbdy2,jk) & 254 & * ( va(ji,jbdy2-1,jk) + 2._wp*va(ji,jbdy2,jk) + va(ji,jbdy2+1,jk) ) 255 END DO 256 END DO 257 ENDIF 258 ! 259 zvb(:,jbdy1:jbdy2) = 0._wp ! Correct transport 268 va(ji,jbdy2,jk) = 0.25_wp*(va(ji,jbdy2-1,jk)+2._wp*va(ji,jbdy2,jk)+va(ji,jbdy2+1,jk)) 269 END DO 270 END DO 271 ENDIF 272 ! 273 zvb(:,jbdy1:jbdy2) = 0._wp ! Correct transport 260 274 DO jk=1,jpkm1 261 275 DO ji=1,jpi 262 zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 276 zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) & 277 & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 263 278 END DO 264 279 END DO … … 266 281 zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 267 282 END DO 283 268 284 DO jk = 1, jpkm1 269 285 DO ji = 1, jpi 270 va(ji,jbdy1:jbdy2,jk) = ( va(ji,jbdy1:jbdy2,jk) + va_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 286 va(ji,jbdy1:jbdy2,jk) = va(ji,jbdy1:jbdy2,jk) & 287 & + (va_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 271 288 END DO 272 289 END DO 273 290 274 291 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 275 zub(:, 2) = 0._wp292 zub(:,jbdy1:jbdy2) = 0._wp 276 293 DO jk = 1, jpkm1 277 294 DO ji = 1, jpi 278 zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) + e3u_a(ji,jbdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk) 295 zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) & 296 & + e3u_a(ji,jbdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk) 279 297 END DO 280 298 END DO … … 285 303 DO jk = 1, jpkm1 286 304 DO ji = 1, jpi 287 ua(ji,jbdy1:jbdy2,jk) = ( ua(ji,jbdy1:jbdy2,jk) + ua_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 288 END DO 289 END DO 290 ENDIF 291 ! 305 ua(ji,jbdy1:jbdy2,jk) = ua(ji,jbdy1:jbdy2,jk) & 306 & + (ua_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 307 END DO 308 END DO 309 ENDIF 310 ! 311 DO jk = 1, jpkm1 ! Mask domain edges 312 DO ji = 1, jpi 313 ua(ji,1,jk) = 0._wp 314 va(ji,1,jk) = 0._wp 315 END DO 316 END DO 292 317 ENDIF 293 318 … … 297 322 jbdy2 = nlcj-2 298 323 ! 299 ! Smoothing300 ! ---------301 324 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 302 325 va_b(:,jbdy1:jbdy2) = 0._wp 303 326 DO jk = 1, jpkm1 304 327 DO ji = 1, jpi 305 va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) 328 va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) & 329 & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 306 330 END DO 307 331 END DO … … 312 336 ! 313 337 IF ( .NOT.lk_agrif_clp ) THEN 314 DO jk = 1, jpkm1 338 DO jk = 1, jpkm1 ! Smooth 315 339 DO ji = i1, i2 316 va(ji,jbdy1,jk) = 0.25_wp * vmask(ji,jbdy1,jk) & 317 & * ( va(ji,jbdy1-1,jk) + 2._wp*va(ji,jbdy1,jk) + va(ji,jbdy1+1,jk) ) 318 END DO 319 END DO 320 ENDIF 321 ! 322 zvb(:,jbdy1:jbdy2) = 0._wp ! Correct transport 340 va(ji,jbdy1,jk) = 0.25_wp*(va(ji,jbdy1-1,jk)+2._wp*va(ji,jbdy1,jk)+va(ji,jbdy1+1,jk)) 341 END DO 342 END DO 343 ENDIF 344 ! 345 zvb(:,jbdy1:jbdy2) = 0._wp ! Correct transport 323 346 DO jk=1,jpkm1 324 347 DO ji=1,jpi 325 zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 348 zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) & 349 & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 326 350 END DO 327 351 END DO … … 329 353 zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 330 354 END DO 355 331 356 DO jk = 1, jpkm1 332 357 DO ji = 1, jpi 333 va(ji,jbdy1:jbdy2,jk) = ( va(ji,jbdy1:jbdy2,jk) + va_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 358 va(ji,jbdy1:jbdy2,jk) = va(ji,jbdy1:jbdy2,jk) & 359 & + (va_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 334 360 END DO 335 361 END DO … … 338 364 jbdy1 = jbdy1 + 1 339 365 jbdy2 = jbdy2 + 1 340 zub(:, 2) = 0._wp366 zub(:,jbdy1:jbdy2) = 0._wp 341 367 DO jk = 1, jpkm1 342 368 DO ji = 1, jpi 343 zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) + e3u_a(ji,jbdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk) 369 zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) & 370 & + e3u_a(ji,jbdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk) 344 371 END DO 345 372 END DO … … 350 377 DO jk = 1, jpkm1 351 378 DO ji = 1, jpi 352 ua(ji,jbdy1:jbdy2,jk) = ( ua(ji,jbdy1:jbdy2,jk) + ua_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 353 END DO 354 END DO 355 ENDIF 356 ! 379 ua(ji,jbdy1:jbdy2,jk) = ua(ji,jbdy1:jbdy2,jk) & 380 & + ( ua_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 381 END DO 382 END DO 383 ENDIF 384 ! 385 DO jk = 1, jpkm1 ! Mask domain edges 386 DO ji = 1, jpi 387 ua(ji,nlcj ,jk) = 0._wp 388 va(ji,nlcj-1,jk) = 0._wp 389 END DO 390 END DO 357 391 ENDIF 358 392 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r9116 r9134 413 413 414 414 IF( ln_zdftke.OR.ln_zdfgls ) THEN 415 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/ jpi,jpj,jpk/), en_id)416 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/ jpi,jpj,jpk/),avt_id)415 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id) 416 ! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id) 417 417 # if defined key_vertical 418 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/ jpi,jpj,jpk,2/),avm_id)418 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),avm_id) 419 419 # else 420 420 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id) … … 603 603 ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) 604 604 !-------------------------------------------------- 605 # if defined UPD_HIGH 606 CALL Agrif_Set_Updatetype(tra_ice_id, update = Agrif_Update_Full_Weighting) 607 CALL Agrif_Set_Updatetype(u_ice_id ,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting) 608 CALL Agrif_Set_Updatetype(v_ice_id ,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 609 #else 605 610 CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average) 606 611 CALL Agrif_Set_Updatetype(u_ice_id ,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average) 607 612 CALL Agrif_Set_Updatetype(v_ice_id ,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy ) 613 #endif 608 614 609 615 END SUBROUTINE agrif_declare_var_lim3
Note: See TracChangeset
for help on using the changeset viewer.