Changeset 13565 for NEMO/branches
- Timestamp:
- 2020-10-05T16:18:53+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src
- Files:
-
- 7 edited
-
NST/agrif_oce.F90 (modified) (1 diff)
-
NST/agrif_oce_sponge.F90 (modified) (1 diff)
-
NST/agrif_oce_update.F90 (modified) (13 diffs)
-
NST/agrif_user.F90 (modified) (6 diffs)
-
OCE/BDY/bdyini.F90 (modified) (23 diffs)
-
OCE/DIA/diawri.F90 (modified) (1 diff)
-
OCE/nemogcm.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_oce.F90
r13351 r13565 70 70 INTEGER, PUBLIC :: mbkt_id, ht0_id 71 71 INTEGER, PUBLIC :: glamt_id, gphit_id 72 INTEGER, PUBLIC :: batupd_id 72 73 INTEGER, PUBLIC :: kindic_agr 73 74 -
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_oce_sponge.F90
r13498 r13565 137 137 138 138 ztabramp(:,:) = 0._wp 139 140 ! Trick to remove sponge in 2DV domains:141 IF ( nbcellsx <= 3 ) ispongearea = -1142 IF ( nbcellsy <= 3 ) jspongearea = -1143 139 144 140 IF( lk_west ) THEN ! --- West --- ! -
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_oce_update.F90
r13351 r13565 21 21 USE zdf_oce ! vertical physics: ocean variables 22 22 USE agrif_oce 23 USE dom_oce 23 24 ! 24 25 USE in_out_manager ! I/O manager … … 32 33 33 34 PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn, Agrif_Update_vvl, Agrif_Update_ssh 34 PUBLIC Update_Scales 35 PUBLIC Update_Scales, Agrif_Check_parent_bat 35 36 36 37 !!---------------------------------------------------------------------- … … 50 51 IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers from grid Number',Agrif_Fixed() 51 52 52 Agrif_UseSpecialValueInUpdate = .NOT.l _vremap53 Agrif_UseSpecialValueInUpdate = .NOT.ln_vert_remap 53 54 Agrif_SpecialValueFineGrid = 0._wp 54 55 l_vremap = ln_vert_remap … … 343 344 N_in = 0 344 345 DO jk=k1,k2 !k2 = jpk of child grid 345 IF (tabres(ji,jj,jk,n2) == 0._wp ) EXIT346 IF (tabres(ji,jj,jk,n2) <= 1.e-6_wp ) EXIT 346 347 N_in = N_in + 1 347 348 tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)/tabres(ji,jj,jk,n2) … … 448 449 REAL(wp) :: h_in(k1:k2) 449 450 REAL(wp) :: h_out(1:jpk) 450 INTEGER :: N_in, N_out 451 REAL(wp) :: h_diff, excess, thick451 INTEGER :: N_in, N_out, N_in_save, N_out_save 452 REAL(wp) :: zhmin, zd 452 453 REAL(wp) :: tabin(k1:k2) 453 454 ! VERTICAL REFINEMENT END … … 470 471 471 472 tabres_child(:,:,:) = 0._wp 472 AGRIF_SpecialValue = 0._wp473 473 474 474 IF ( l_vremap ) THEN … … 480 480 tabin(:) = 0._wp 481 481 DO jk=k1,k2 !k2=jpk of child grid 482 IF( tabres(ji,jj,jk,2) == 0.) EXIT482 IF( tabres(ji,jj,jk,2)*r1_e2u(ji,jj) <= 1.e-6_wp ) EXIT 483 483 N_in = N_in + 1 484 484 tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2) … … 487 487 N_out = 0 488 488 DO jk=1,jpk 489 IF (umask(ji,jj,jk) == 0 ) EXIT489 IF (umask(ji,jj,jk) == 0._wp) EXIT 490 490 N_out = N_out + 1 491 491 h_out(N_out) = e3u(ji,jj,jk,Kmm_a) 492 492 ENDDO 493 493 IF (N_in * N_out > 0) THEN 494 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 495 excess = 0._wp 496 IF (h_diff < -1.e-4) THEN 497 DO jk=N_in,1,-1 498 thick = MIN(-1*h_diff, h_in(jk)) 499 excess = excess + tabin(jk)*thick*e2u(ji,jj) 500 tabin(jk) = tabin(jk)*(1. - thick/h_in(jk)) 501 h_diff = h_diff + thick 502 IF ( h_diff == 0) THEN 494 ! Deal with potentially different depths at velocity points: 495 N_in_save = N_in 496 N_out_save = N_out 497 IF ( ABS(sum(h_out(1:N_out))-sum(h_in(1:N_in))) > 1.e-6_wp ) THEN 498 zhmin = MIN(sum(h_out(1:N_out)), sum(h_in(1:N_in))) 499 zd = 0._wp 500 DO jk=1, N_in_save 501 IF ( (zd + h_in(jk)) > zhmin-1.e-6) THEN 503 502 N_in = jk 504 h_in(jk) = h_in(jk) - thick505 EXIT 503 h_in(jk) = zhmin - zd 504 EXIT 506 505 ENDIF 507 ENDDO 508 ENDIF 506 zd = zd + h_in(jk) 507 END DO 508 zd = 0._wp 509 DO jk=1, N_out_save 510 IF ( (zd + h_out(jk)) > zhmin-1.e-6) THEN 511 N_out = jk 512 h_out(jk) = zhmin - zd 513 EXIT 514 ENDIF 515 zd = zd + h_out(jk) 516 END DO 517 END IF 509 518 CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 510 tabres_child(ji,jj,N_out) = tabres_child(ji,jj,N_out) + excess/(e2u(ji,jj)*h_out(N_out))519 IF (N_out < N_out_save) tabres_child(ji,jj,N_out+1:N_out_save) = tabres_child(ji,jj,N_out) 511 520 ENDIF 512 521 ENDDO … … 606 615 REAL(wp) :: h_in(k1:k2) 607 616 REAL(wp) :: h_out(1:jpk) 608 INTEGER :: N_in, N_out609 REAL(wp) :: h_diff, excess, thick617 INTEGER :: N_in, N_out, N_in_save, N_out_save 618 REAL(wp) :: zhmin, zd 610 619 REAL(wp) :: tabin(k1:k2) 611 620 ! VERTICAL REFINEMENT END … … 628 637 629 638 tabres_child(:,:,:) = 0._wp 630 AGRIF_SpecialValue = 0._wp631 639 632 640 IF ( l_vremap ) THEN … … 636 644 N_in = 0 637 645 DO jk=k1,k2 638 IF (tabres(ji,jj,jk,2) == 0) EXIT646 IF (tabres(ji,jj,jk,2)* r1_e1v(ji,jj) <= 1.e-6_wp) EXIT 639 647 N_in = N_in + 1 640 648 tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2) … … 648 656 ENDDO 649 657 IF (N_in * N_out > 0) THEN 650 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 651 excess = 0._wp 652 IF (h_diff < -1.e-4) then 653 !Even if bathy at T points match it's possible for the V points to be deeper in the child grid. 654 !In this case we need to move transport from the child grid cells below bed of parent grid into the bottom cell. 655 DO jk=N_in,1,-1 656 thick = MIN(-1*h_diff, h_in(jk)) 657 excess = excess + tabin(jk)*thick*e2u(ji,jj) 658 tabin(jk) = tabin(jk)*(1. - thick/h_in(jk)) 659 h_diff = h_diff + thick 660 IF ( h_diff == 0) THEN 658 ! Deal with potentially different depths at velocity points: 659 N_in_save = N_in 660 N_out_save = N_out 661 IF ( ABS(sum(h_out(1:N_out))-sum(h_in(1:N_in))) > 1.e-6_wp ) THEN 662 zhmin = MIN(sum(h_out(1:N_out)), sum(h_in(1:N_in))) 663 zd = 0._wp 664 DO jk=1, N_in_save 665 IF ( (zd + h_in(jk)) > zhmin-1.e-6) THEN 661 666 N_in = jk 662 h_in(jk) = h_in(jk) - thick663 EXIT 667 h_in(jk) = zhmin - zd 668 EXIT 664 669 ENDIF 665 ENDDO 666 ENDIF 670 zd = zd + h_in(jk) 671 END DO 672 zd = 0._wp 673 DO jk=1, N_out_save 674 IF ( (zd + h_out(jk)) > zhmin-1.e-6) THEN 675 N_out = jk 676 h_out(jk) = zhmin - zd 677 EXIT 678 ENDIF 679 zd = zd + h_out(jk) 680 END DO 681 END IF 667 682 CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 668 tabres_child(ji,jj,N_out) = tabres_child(ji,jj,N_out) + excess/(e1v(ji,jj)*h_out(N_out))683 IF (N_out < N_out_save) tabres_child(ji,jj,N_out+1:N_out_save) = tabres_child(ji,jj,N_out) 669 684 ENDIF 670 685 ENDDO … … 1316 1331 END SUBROUTINE updatee3t 1317 1332 1333 SUBROUTINE Agrif_Check_parent_bat( ) 1334 !!---------------------------------------------------------------------- 1335 !! *** ROUTINE Agrif_Check_parent_bat *** 1336 !!---------------------------------------------------------------------- 1337 ! 1338 IF (( .NOT.ln_agrif_2way ).OR.(.NOT.ln_chk_bathy).OR.(Agrif_Root())) RETURN 1339 ! 1340 Agrif_UseSpecialValueInUpdate = .FALSE. 1341 ! 1342 IF(lwp) WRITE(numout,*) ' ' 1343 IF(lwp) WRITE(numout,*) 'AGRIF: Check parent volume at Level:', Agrif_Level() 1344 ! 1345 # if ! defined DECAL_FEEDBACK && ! defined DECAL_FEEDBACK_2D 1346 CALL Agrif_Update_Variable(batupd_id,procname = update_bat) 1347 # else 1348 CALL Agrif_Update_Variable(batupd_id,locupdate=(/1,0/),procname = update_bat) 1349 # endif 1350 ! 1351 kindic_agr = Agrif_Parent(kindic_agr) 1352 CALL mpp_sum( 'Agrif_Check_parent_bat', kindic_agr ) 1353 1354 IF( kindic_agr /= 0 ) THEN 1355 CALL ctl_stop('==> Averaged Bathymetry does not match parent volume') 1356 ELSE 1357 IF(lwp) WRITE(numout,*) '==> Averaged Bathymetry matches parent ' 1358 IF(lwp) WRITE(numout,*) '' 1359 ENDIF 1360 ! 1361 END SUBROUTINE Agrif_Check_parent_bat 1362 1363 SUBROUTINE update_bat(ptab, i1, i2, j1, j2, before ) 1364 !!--------------------------------------------- 1365 !! *** ROUTINE update_bat *** 1366 !!--------------------------------------------- 1367 REAL(wp), DIMENSION(i1:i2,j1:j2) :: ptab 1368 INTEGER, INTENT(in) :: i1, i2, j1, j2 1369 LOGICAL, INTENT(in) :: before 1370 INTEGER :: ji, jj 1371 ! 1372 !!--------------------------------------------- 1373 ! 1374 IF( before ) THEN 1375 ptab(i1:i2,j1:j2) = ht_0(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 1376 ELSE 1377 kindic_agr = 0 1378 ! 1379 DO jj=j1,j2 1380 DO ji=i1,i2 1381 IF ( (ssmask(ji,jj).NE.0._wp).AND.& 1382 & (ABS(ptab(ji,jj)-ht_0(ji,jj)).GE.1.e-6) ) THEN 1383 kindic_agr = kindic_agr + 1 1384 ENDIF 1385 END DO 1386 END DO 1387 ! 1388 ENDIF 1389 ! 1390 END SUBROUTINE update_bat 1391 1318 1392 #else 1319 1393 !!---------------------------------------------------------------------- -
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_user.F90
r13371 r13565 91 91 CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /),sshini_id) 92 92 ! 93 ! Update location 94 CALL agrif_declare_variable((/2,2/),(/ind2 ,ind3 /),(/'x','y'/),(/1,1/),(/jpi,jpj/), batupd_id) 93 95 94 96 ! 2. Type of interpolation … … 138 140 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average , update2=Agrif_Update_Full_Weighting) 139 141 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average ) 142 CALL Agrif_Set_Updatetype(batupd_id, update = Agrif_Update_Full_Weighting) 140 143 #else 141 144 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy , update2=Agrif_Update_Average ) 142 145 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average , update2=Agrif_Update_Copy ) 143 #endif 144 146 CALL Agrif_Set_Updatetype(batupd_id, update = Agrif_Update_Average) 147 #endif 148 145 149 ! CALL Agrif_Set_ExternalMapping(nemo_mapping) 146 150 ! … … 199 203 IF ( ln_sco.AND.Agrif_Parent(ln_sco) ) THEN 200 204 DO_2D( 1, 0, 1, 0 ) 201 hu0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji+1,jj) ) 202 hv0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji,jj+1) ) 205 hu0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji+1,jj) ) * ssumask(ji,jj) 206 hv0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji,jj+1) ) * ssvmask(ji,jj) 203 207 END_2D 204 208 ELSE … … 432 436 ! 433 437 ! > Divergence conserving alternative: 438 ! CALL Agrif_Set_bcinterp( ts_interp_id,interp =AGRIF_constant) 439 ! CALL Agrif_Set_bcinterp( un_interp_id,interp1=Agrif_linear,interp2=AGRIF_constant ) 440 ! CALL Agrif_Set_bcinterp( vn_interp_id,interp1=AGRIF_constant ,interp2=Agrif_linear) 441 ! 442 ! CALL Agrif_Set_bcinterp( ts_sponge_id,interp =AGRIF_constant) 443 ! CALL Agrif_Set_bcinterp( un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_constant ) 444 ! CALL Agrif_Set_bcinterp( vn_sponge_id,interp1=AGRIF_constant ,interp2=Agrif_linear) 445 ! 434 446 ! CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant) 435 447 ! CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_constant) … … 785 797 ENDIF 786 798 799 ! JC => side effects of lines below to be checked: 787 800 lk_west = .NOT. ( Agrif_Ix() == 1 ) 788 801 lk_east = .NOT. ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(jpiglo) -1 ) 789 802 lk_south = .NOT. ( Agrif_Iy() == 1 ) 790 803 lk_north = .NOT. ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(jpjglo) -1 ) 791 792 804 ! 793 805 ! Set the number of ghost cells according to periodicity … … 798 810 IF( jperio == 1 ) nbghostcells_x = 0 799 811 IF( .NOT. lk_south ) nbghostcells_y_s = 0 812 ! For 2DV domains: 813 IF (( nbcellsy <= 3 ).AND.(AGRIF_Irhoy()==1)) THEN 814 lk_north = .FALSE. ; lk_south = .FALSE. 815 nbghostcells_y_s = nbghostcells 816 ENDIF 817 IF (( nbcellsx <= 3 ).AND.(AGRIF_Irhox()==1)) THEN 818 lk_east = .FALSE. ; lk_north = .FALSE. 819 ENDIF 800 820 ! Some checks 801 821 IF( jpiglo /= nbcellsx + 2 + 2*nn_hls + nbghostcells_x + nbghostcells_x ) CALL ctl_stop( 'STOP', & -
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/BDY/bdyini.F90
r13286 r13565 397 397 IF( nbdysege > 0 .OR. nbdysegw > 0 .OR. nbdysegn > 0 .OR. nbdysegs > 0) CALL bdy_ctl_seg 398 398 399 399 400 ! Allocate arrays 400 401 !--------------- … … 786 787 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 787 788 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 788 IF( mig (ii) > 2 .AND. mig(ii) < jpiglo-2 .AND. mjg(ij) > 2 .AND. mjg(ij) < jpjglo-2 ) THEN789 IF( mig0(ii) > 2 .AND. mig0(ii) < Ni0glo-2 .AND. mjg0(ij) > 2 .AND. mjg0(ij) < Nj0glo-2 ) THEN 789 790 WRITE(ctmp1,*) ' Orlanski is not safe when the open boundaries are on the interior of the computational domain' 790 791 CALL ctl_stop( ctmp1 ) … … 1111 1112 CASE( 'N' ) 1112 1113 IF( nbdyind == -1 ) THEN ! Automatic boundary definition: if nbdysegX = -1 1113 nbdyind = jpjglo - 2 ! set boundary to whole side of model domain.1114 nbdyind = Nj0glo - 2 ! set boundary to whole side of model domain. 1114 1115 nbdybeg = 2 1115 nbdyend = jpiglo - 11116 nbdyend = Ni0glo - 1 1116 1117 ENDIF 1117 1118 nbdysegn = nbdysegn + 1 1118 1119 npckgn(nbdysegn) = kb_bdy ! Save bdy package number 1119 jpjnob(nbdysegn) = nbdyind 1120 jpjnob(nbdysegn) = nbdyind 1120 1121 jpindt(nbdysegn) = nbdybeg 1121 1122 jpinft(nbdysegn) = nbdyend … … 1125 1126 nbdyind = 2 ! set boundary to whole side of model domain. 1126 1127 nbdybeg = 2 1127 nbdyend = jpiglo - 11128 nbdyend = Ni0glo - 1 1128 1129 ENDIF 1129 1130 nbdysegs = nbdysegs + 1 … … 1135 1136 CASE( 'E' ) 1136 1137 IF( nbdyind == -1 ) THEN ! Automatic boundary definition: if nbdysegX = -1 1137 nbdyind = jpiglo - 2 ! set boundary to whole side of model domain.1138 nbdyind = Ni0glo - 2 ! set boundary to whole side of model domain. 1138 1139 nbdybeg = 2 1139 nbdyend = jpjglo - 11140 nbdyend = Nj0glo - 1 1140 1141 ENDIF 1141 1142 nbdysege = nbdysege + 1 … … 1149 1150 nbdyind = 2 ! set boundary to whole side of model domain. 1150 1151 nbdybeg = 2 1151 nbdyend = jpjglo - 11152 nbdyend = Nj0glo - 1 1152 1153 ENDIF 1153 1154 nbdysegw = nbdysegw + 1 … … 1196 1197 DO ib = 1, nbdysegn 1197 1198 IF (lwp) WRITE(numout,*) '**check north seg bounds pckg: ', npckgn(ib) 1198 IF ((jpjnob(ib).ge. jpjglo-1).or.&1199 IF ((jpjnob(ib).ge.Nj0glo-1).or.& 1199 1200 &(jpjnob(ib).le.1)) CALL ctl_stop( 'nbdyind out of domain' ) 1200 1201 IF (jpindt(ib).ge.jpinft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' ) 1201 1202 IF (jpindt(ib).lt.1 ) CALL ctl_stop( 'Start index out of domain' ) 1202 IF (jpinft(ib).gt. jpiglo) CALL ctl_stop( 'End index out of domain' )1203 IF (jpinft(ib).gt.Ni0glo) CALL ctl_stop( 'End index out of domain' ) 1203 1204 END DO 1204 1205 ! 1205 1206 DO ib = 1, nbdysegs 1206 1207 IF (lwp) WRITE(numout,*) '**check south seg bounds pckg: ', npckgs(ib) 1207 IF ((jpjsob(ib).ge. jpjglo-1).or.&1208 IF ((jpjsob(ib).ge.Nj0glo-1).or.& 1208 1209 &(jpjsob(ib).le.1)) CALL ctl_stop( 'nbdyind out of domain' ) 1209 1210 IF (jpisdt(ib).ge.jpisft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' ) 1210 1211 IF (jpisdt(ib).lt.1 ) CALL ctl_stop( 'Start index out of domain' ) 1211 IF (jpisft(ib).gt. jpiglo) CALL ctl_stop( 'End index out of domain' )1212 IF (jpisft(ib).gt.Ni0glo) CALL ctl_stop( 'End index out of domain' ) 1212 1213 END DO 1213 1214 ! 1214 1215 DO ib = 1, nbdysege 1215 1216 IF (lwp) WRITE(numout,*) '**check east seg bounds pckg: ', npckge(ib) 1216 IF ((jpieob(ib).ge. jpiglo-1).or.&1217 IF ((jpieob(ib).ge.Ni0glo-1).or.& 1217 1218 &(jpieob(ib).le.1)) CALL ctl_stop( 'nbdyind out of domain' ) 1218 1219 IF (jpjedt(ib).ge.jpjeft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' ) 1219 1220 IF (jpjedt(ib).lt.1 ) CALL ctl_stop( 'Start index out of domain' ) 1220 IF (jpjeft(ib).gt. jpjglo) CALL ctl_stop( 'End index out of domain' )1221 IF (jpjeft(ib).gt.Nj0glo) CALL ctl_stop( 'End index out of domain' ) 1221 1222 END DO 1222 1223 ! 1223 1224 DO ib = 1, nbdysegw 1224 1225 IF (lwp) WRITE(numout,*) '**check west seg bounds pckg: ', npckgw(ib) 1225 IF ((jpiwob(ib).ge. jpiglo-1).or.&1226 IF ((jpiwob(ib).ge.Ni0glo-1).or.& 1226 1227 &(jpiwob(ib).le.1)) CALL ctl_stop( 'nbdyind out of domain' ) 1227 1228 IF (jpjwdt(ib).ge.jpjwft(ib)) CALL ctl_stop( 'Bdy start index is greater than end index' ) 1228 1229 IF (jpjwdt(ib).lt.1 ) CALL ctl_stop( 'Start index out of domain' ) 1229 IF (jpjwft(ib).gt. jpjglo) CALL ctl_stop( 'End index out of domain' )1230 IF (jpjwft(ib).gt.Nj0glo) CALL ctl_stop( 'End index out of domain' ) 1230 1231 ENDDO 1231 1232 ! … … 1378 1379 DO ji = 1, jpi 1379 1380 DO jj = 1, jpj 1380 IF( mig (ji) == jpiwob(ib) .AND. mjg(jj) == jpjwdt(ib) ) ztestmask(1) = tmask(ji,jj,1)1381 IF( mig (ji) == jpiwob(ib) .AND. mjg(jj) == jpjwft(ib) ) ztestmask(2) = tmask(ji,jj,1)1381 IF( mig0(ji) == jpiwob(ib) .AND. mjg0(jj) == jpjwdt(ib) ) ztestmask(1) = tmask(ji,jj,1) 1382 IF( mig0(ji) == jpiwob(ib) .AND. mjg0(jj) == jpjwft(ib) ) ztestmask(2) = tmask(ji,jj,1) 1382 1383 END DO 1383 1384 END DO … … 1414 1415 DO ji = 1, jpi 1415 1416 DO jj = 1, jpj 1416 IF( mig (ji) == jpieob(ib)+1 .AND. mjg(jj) == jpjedt(ib) ) ztestmask(1) = tmask(ji,jj,1)1417 IF( mig (ji) == jpieob(ib)+1 .AND. mjg(jj) == jpjeft(ib) ) ztestmask(2) = tmask(ji,jj,1)1417 IF( mig0(ji) == jpieob(ib)+1 .AND. mjg0(jj) == jpjedt(ib) ) ztestmask(1) = tmask(ji,jj,1) 1418 IF( mig0(ji) == jpieob(ib)+1 .AND. mjg0(jj) == jpjeft(ib) ) ztestmask(2) = tmask(ji,jj,1) 1418 1419 END DO 1419 1420 END DO … … 1450 1451 DO ji = 1, jpi 1451 1452 DO jj = 1, jpj 1452 IF( mjg (jj) == jpjsob(ib) .AND. mig(ji) == jpisdt(ib) ) ztestmask(1) = tmask(ji,jj,1)1453 IF( mjg (jj) == jpjsob(ib) .AND. mig(ji) == jpisft(ib) ) ztestmask(2) = tmask(ji,jj,1)1453 IF( mjg0(jj) == jpjsob(ib) .AND. mig0(ji) == jpisdt(ib) ) ztestmask(1) = tmask(ji,jj,1) 1454 IF( mjg0(jj) == jpjsob(ib) .AND. mig0(ji) == jpisft(ib) ) ztestmask(2) = tmask(ji,jj,1) 1454 1455 END DO 1455 1456 END DO … … 1472 1473 DO ji = 1, jpi 1473 1474 DO jj = 1, jpj 1474 IF( mjg (jj) == jpjnob(ib)+1 .AND. mig(ji) == jpindt(ib) ) ztestmask(1) = tmask(ji,jj,1)1475 IF( mjg (jj) == jpjnob(ib)+1 .AND. mig(ji) == jpinft(ib) ) ztestmask(2) = tmask(ji,jj,1)1475 IF( mjg0(jj) == jpjnob(ib)+1 .AND. mig0(ji) == jpindt(ib) ) ztestmask(1) = tmask(ji,jj,1) 1476 IF( mjg0(jj) == jpjnob(ib)+1 .AND. mig0(ji) == jpinft(ib) ) ztestmask(2) = tmask(ji,jj,1) 1476 1477 END DO 1477 1478 END DO … … 1526 1527 DO ij = jpjedt(iseg), jpjeft(iseg) 1527 1528 icount = icount + 1 1528 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir 1529 nbjdta(icount, igrd, ib_bdy) = ij 1529 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir + nn_hls 1530 nbjdta(icount, igrd, ib_bdy) = ij + nn_hls 1530 1531 nbrdta(icount, igrd, ib_bdy) = ir 1531 1532 ENDDO … … 1538 1539 DO ij = jpjedt(iseg), jpjeft(iseg) 1539 1540 icount = icount + 1 1540 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 1 - ir 1541 nbjdta(icount, igrd, ib_bdy) = ij 1541 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 1 - ir + nn_hls 1542 nbjdta(icount, igrd, ib_bdy) = ij + nn_hls 1542 1543 nbrdta(icount, igrd, ib_bdy) = ir 1543 1544 ENDDO … … 1551 1552 DO ij = jpjedt(iseg), jpjeft(iseg) 1552 1553 icount = icount + 1 1553 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir 1554 nbjdta(icount, igrd, ib_bdy) = ij 1554 nbidta(icount, igrd, ib_bdy) = jpieob(iseg) + 2 - ir + nn_hls 1555 nbjdta(icount, igrd, ib_bdy) = ij + nn_hls 1555 1556 nbrdta(icount, igrd, ib_bdy) = ir 1556 1557 ENDDO … … 1571 1572 DO ij = jpjwdt(iseg), jpjwft(iseg) 1572 1573 icount = icount + 1 1573 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 1574 nbjdta(icount, igrd, ib_bdy) = ij 1574 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 + nn_hls 1575 nbjdta(icount, igrd, ib_bdy) = ij + nn_hls 1575 1576 nbrdta(icount, igrd, ib_bdy) = ir 1576 1577 ENDDO … … 1583 1584 DO ij = jpjwdt(iseg), jpjwft(iseg) 1584 1585 icount = icount + 1 1585 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 1586 nbjdta(icount, igrd, ib_bdy) = ij 1586 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 + nn_hls 1587 nbjdta(icount, igrd, ib_bdy) = ij + nn_hls 1587 1588 nbrdta(icount, igrd, ib_bdy) = ir 1588 1589 ENDDO … … 1596 1597 DO ij = jpjwdt(iseg), jpjwft(iseg) 1597 1598 icount = icount + 1 1598 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 1599 nbjdta(icount, igrd, ib_bdy) = ij 1599 nbidta(icount, igrd, ib_bdy) = jpiwob(iseg) + ir - 1 + nn_hls 1600 nbjdta(icount, igrd, ib_bdy) = ij + nn_hls 1600 1601 nbrdta(icount, igrd, ib_bdy) = ir 1601 1602 ENDDO … … 1616 1617 DO ii = jpindt(iseg), jpinft(iseg) 1617 1618 icount = icount + 1 1618 nbidta(icount, igrd, ib_bdy) = ii 1619 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir 1619 nbidta(icount, igrd, ib_bdy) = ii + nn_hls 1620 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir + nn_hls 1620 1621 nbrdta(icount, igrd, ib_bdy) = ir 1621 1622 ENDDO … … 1629 1630 DO ii = jpindt(iseg), jpinft(iseg) 1630 1631 icount = icount + 1 1631 nbidta(icount, igrd, ib_bdy) = ii 1632 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir 1632 nbidta(icount, igrd, ib_bdy) = ii + nn_hls 1633 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 2 - ir + nn_hls 1633 1634 nbrdta(icount, igrd, ib_bdy) = ir 1634 1635 ENDDO … … 1643 1644 DO ii = jpindt(iseg), jpinft(iseg) 1644 1645 icount = icount + 1 1645 nbidta(icount, igrd, ib_bdy) = ii 1646 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 1 - ir 1646 nbidta(icount, igrd, ib_bdy) = ii + nn_hls 1647 nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) + 1 - ir + nn_hls 1647 1648 nbrdta(icount, igrd, ib_bdy) = ir 1648 1649 ENDDO … … 1661 1662 DO ii = jpisdt(iseg), jpisft(iseg) 1662 1663 icount = icount + 1 1663 nbidta(icount, igrd, ib_bdy) = ii 1664 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 1664 nbidta(icount, igrd, ib_bdy) = ii + nn_hls 1665 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 + nn_hls 1665 1666 nbrdta(icount, igrd, ib_bdy) = ir 1666 1667 ENDDO … … 1674 1675 DO ii = jpisdt(iseg), jpisft(iseg) 1675 1676 icount = icount + 1 1676 nbidta(icount, igrd, ib_bdy) = ii 1677 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 1677 nbidta(icount, igrd, ib_bdy) = ii + nn_hls 1678 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 + nn_hls 1678 1679 nbrdta(icount, igrd, ib_bdy) = ir 1679 1680 ENDDO … … 1688 1689 DO ii = jpisdt(iseg), jpisft(iseg) 1689 1690 icount = icount + 1 1690 nbidta(icount, igrd, ib_bdy) = ii 1691 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 1691 nbidta(icount, igrd, ib_bdy) = ii + nn_hls 1692 nbjdta(icount, igrd, ib_bdy) = jpjsob(iseg) + ir - 1 + nn_hls 1692 1693 nbrdta(icount, igrd, ib_bdy) = ir 1693 1694 ENDDO -
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/DIA/diawri.F90
r13295 r13565 137 137 CALL iom_put("e3v_0", e3v_0(:,:,:) ) 138 138 ! 139 IF ( iom_use("tpt_dep") ) THEN 140 DO jk = 1, jpk 141 z3d(:,:,jk) = gdept(:,:,jk,Kmm) 142 END DO 143 CALL iom_put( "tpt_dep", z3d(:,:,:) ) 144 ENDIF 145 139 146 IF ( iom_use("e3t") .OR. iom_use("e3tdef") ) THEN ! time-varying e3t 140 147 DO jk = 1, jpk -
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/nemogcm.F90
r13286 r13565 98 98 #if defined key_agrif 99 99 USE agrif_all_update ! Master Agrif update 100 USE agrif_oce_update 100 101 #endif 101 102 USE halo_mng … … 181 182 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices 182 183 CALL Agrif_step_child_adj(Agrif_Update_All) 184 CALL Agrif_step_child_adj(Agrif_Check_parent_bat) 183 185 ! 184 186 DO WHILE( istp <= nitend .AND. nstop == 0 )
Note: See TracChangeset
for help on using the changeset viewer.
