Changeset 11463 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/NST/agrif_oce_update.F90
- Timestamp:
- 2019-08-20T14:14:56+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/NST/agrif_oce_update.F90
r11099 r11463 315 315 DO jj=j1,j2 316 316 DO ji=i1,i2 317 tabres(ji,jj,jk,jn) = ( ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) )&318 * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1)*999._wp317 tabres(ji,jj,jk,jn) = ( ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) ) & 318 & * tmask(ji,jj,jk) + (tmask(ji,jj,jk) - 1._wp)*999._wp 319 319 END DO 320 320 END DO … … 325 325 DO ji=i1,i2 326 326 tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) & 327 + (tmask(ji,jj,jk)-1)*999._wp327 & + (tmask(ji,jj,jk) - 1._wp)*999._wp 328 328 END DO 329 329 END DO 330 330 END DO 331 331 ELSE 332 tabres_child(:,:,:,:) = 0. 332 tabres_child(:,:,:,:) = 0._wp 333 333 AGRIF_SpecialValue = 0._wp 334 334 DO jj=j1,j2 … … 356 356 ENDIF 357 357 DO jn=n1,n2-1 358 CALL reconstructandremap(tabin(1:N_in,jn),h_in(1:N_in),tabres_child(ji,jj,1:N_out,jn),h_out(1:N_out),N_in,N_out) 358 CALL reconstructandremap( tabin(1:N_in,jn), h_in(1:N_in), tabres_child(ji,jj,1:N_out,jn), & 359 & h_out(1:N_out) , N_in , N_out ) 359 360 ENDDO 360 361 ENDIF … … 369 370 DO ji=i1,i2 370 371 IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 371 ts(ji,jj,jk,jn,Kbb_a) = ts(ji,jj,jk,jn,Kbb_a) & 372 & + atfp * ( tabres_child(ji,jj,jk,jn) & 373 & - ts(ji,jj,jk,jn,Kmm_a) ) * tmask(ji,jj,jk) 372 ts(ji,jj,jk,jn,Kbb_a) = ts(ji,jj,jk,jn,Kbb_a) & 373 & + atfp * ( tabres_child(ji,jj,jk,jn) & 374 & - ts(ji,jj,jk,jn,Kmm_a) & 375 & ) * tmask(ji,jj,jk) 374 376 ENDIF 375 377 ENDDO … … 414 416 !> jc tmp 415 417 tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) / e3t_0(ji,jj,jk) 416 ! 418 ! tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) 417 419 !< jc tmp 418 420 END DO … … 438 440 ztno = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a) 439 441 ts(ji,jj,jk,jn,Kbb_a) = ( ztb + atfp * ( ztnu - ztno) ) & 440 & * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a)442 & * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a) 441 443 ENDIF 442 444 END DO … … 496 498 DO ji=i1,i2 497 499 tabres(ji,jj,jk,1) = zrhoy * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * umask(ji,jj,jk) * uu(ji,jj,jk,Kmm_a) & 498 + (umask(ji,jj,jk)-1)*999._wp500 & + (umask(ji,jj,jk)-1._wp)*999._wp 499 501 tabres(ji,jj,jk,2) = zrhoy * umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) & 500 + (umask(ji,jj,jk)-1)*999._wp502 & + (umask(ji,jj,jk)-1._wp)*999._wp 501 503 END DO 502 504 END DO … … 513 515 IF( tabres(ji,jj,jk,2) < -900) EXIT 514 516 N_in = N_in + 1 515 tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2)517 tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2) 516 518 h_in(N_in) = tabres(ji,jj,jk,2)/e2u(ji,jj) 517 519 ENDDO … … 523 525 ENDDO 524 526 IF (N_in * N_out > 0) THEN 525 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))527 h_diff = SUM( h_out(1:N_out) ) - SUM( h_in(1:N_in) ) 526 528 IF (h_diff < -1.e-4) THEN 527 529 !Even if bathy at T points match it's possible for the U points to be deeper in the child grid. … … 540 542 ENDDO 541 543 ENDIF 542 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) 543 tabres_child(ji,jj,N_out) = tabres_child(ji,jj,N_out) + excess/(e2u(ji,jj)*h_out(N_out)) 544 CALL reconstructandremap( tabin(1:N_in) , h_in(1:N_in), tabres_child(ji,jj,1:N_out), & 545 & h_out(1:N_out), N_in , N_out ) 546 tabres_child(ji,jj,N_out) = tabres_child(ji,jj,N_out) + excess/( e2u(ji,jj)*h_out(N_out) ) 544 547 ENDIF 545 548 ENDDO … … 550 553 DO ji=i1,i2 551 554 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 552 uu(ji,jj,jk,Kbb_a) = uu(ji,jj,jk,Kbb_a)&553 & + atfp * ( tabres_child(ji,jj,jk) - uu(ji,jj,jk,Kmm_a) ) * umask(ji,jj,jk)555 uu(ji,jj,jk,Kbb_a) = uu(ji,jj,jk,Kbb_a) & 556 & + atfp * ( tabres_child(ji,jj,jk) - uu(ji,jj,jk,Kmm_a) ) * umask(ji,jj,jk) 554 557 ENDIF 555 558 ! … … 579 582 zrhoy = Agrif_Rhoy() 580 583 DO jk = k1, k2 581 tabres(i1:i2,j1:j2,jk,1) = zrhoy * e2u(i1:i2,j1:j2) * e3u(i1:i2,j1:j2,jk,Kmm_a) * uu(i1:i2,j1:j2,jk,Kmm_a) 584 tabres(i1:i2,j1:j2,jk,1) = zrhoy * e2u(i1:i2,j1:j2) * e3u(i1:i2,j1:j2,jk,Kmm_a) & 585 & * uu(i1:i2,j1:j2,jk,Kmm_a) 582 586 END DO 583 587 ELSE … … 591 595 zuno = uu(ji,jj,jk,Kmm_a) * e3u(ji,jj,jk,Krhs_a) 592 596 zunu = tabres(ji,jj,jk,1) 593 uu(ji,jj,jk,Kbb_a) = ( zub + atfp * ( zunu - zuno ) )&594 &* umask(ji,jj,jk) / e3u(ji,jj,jk,Kbb_a)597 uu(ji,jj,jk,Kbb_a) = ( zub + atfp * ( zunu - zuno ) ) & 598 & * umask(ji,jj,jk) / e3u(ji,jj,jk,Kbb_a) 595 599 ENDIF 596 600 ! … … 682 686 DO jj=j1,j2 683 687 DO ji=i1,i2 684 tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk) * vv(ji,jj,jk,Kmm_a) & 685 + (vmask(ji,jj,jk)-1)*999._wp 688 tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) & 689 & * vmask(ji,jj,jk) * vv(ji,jj,jk,Kmm_a) & 690 & + (vmask(ji,jj,jk)-1)*999._wp 686 691 tabres(ji,jj,jk,2) = vmask(ji,jj,jk) * zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) & 687 692 + (vmask(ji,jj,jk)-1)*999._wp … … 708 713 ENDDO 709 714 IF (N_in * N_out > 0) THEN 710 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))715 h_diff = SUM( h_out(1:N_out) ) - SUM( h_in(1:N_in) ) 711 716 IF (h_diff < -1.e-4) then 712 717 !Even if bathy at T points match it's possible for the U points to be deeper in the child grid. … … 714 719 excess = 0._wp 715 720 DO jk=N_in,1,-1 716 thick = MIN( -1*h_diff, h_in(jk))721 thick = MIN( -1._wp*h_diff, h_in(jk) ) 717 722 excess = excess + tabin(jk)*thick*e2u(ji,jj) 718 tabin(jk) = tabin(jk)*(1. - thick/h_in(jk))723 tabin(jk) = tabin(jk)*(1._wp - thick/h_in(jk)) 719 724 h_diff = h_diff + thick 720 725 IF ( h_diff == 0) THEN … … 725 730 ENDDO 726 731 ENDIF 727 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) 732 CALL reconstructandremap( tabin(1:N_in) , h_in(1:N_in), tabres_child(ji,jj,1:N_out), & 733 & h_out(1:N_out), N_in , N_out ) 728 734 tabres_child(ji,jj,N_out) = tabres_child(ji,jj,N_out) + excess/(e1v(ji,jj)*h_out(N_out)) 729 735 ENDIF … … 736 742 ! 737 743 IF( .NOT.(lk_agrif_fstep.AND.(neuler==0)) ) THEN ! Add asselin part 738 vv(ji,jj,jk,Kbb_a) = vv(ji,jj,jk,Kbb_a) & 739 & + atfp * ( tabres_child(ji,jj,jk) - vv(ji,jj,jk,Kmm_a) ) * vmask(ji,jj,jk) 744 vv(ji,jj,jk,Kbb_a) = vv(ji,jj,jk,Kbb_a) & 745 & + atfp * ( tabres_child(ji,jj,jk) - vv(ji,jj,jk,Kmm_a) ) & 746 & * vmask(ji,jj,jk) 740 747 ENDIF 741 748 ! … … 781 788 zvno = vv(ji,jj,jk,Kmm_a) * e3v(ji,jj,jk,Krhs_a) 782 789 zvnu = tabres(ji,jj,jk,1) 783 vv(ji,jj,jk,Kbb_a) = ( zvb + atfp * ( zvnu - zvno) ) &784 &* vmask(ji,jj,jk) / e3v(ji,jj,jk,Kbb_a)790 vv(ji,jj,jk,Kbb_a) = ( zvb + atfp * ( zvnu - zvno) ) & 791 & * vmask(ji,jj,jk) / e3v(ji,jj,jk,Kbb_a) 785 792 ENDIF 786 793 ! … … 883 890 ! Update barotropic velocities: 884 891 IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN 885 IF ( .NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN! Add asselin part892 IF ( .NOT.( lk_agrif_fstep .AND. (neuler==0) ) ) THEN ! Add asselin part 886 893 zcorr = (tabres(ji,jj) - uu_b(ji,jj,Kmm_a) * hu(ji,jj,Krhs_a)) * r1_hu(ji,jj,Kbb_a) 887 894 uu_b(ji,jj,Kbb_a) = uu_b(ji,jj,Kbb_a) + atfp * zcorr * umask(ji,jj,1) … … 948 955 ! 949 956 ! Update barotropic velocities: 950 IF ( .NOT.ln_dynspg_ts .OR. ( ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN951 IF ( .NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN! Add asselin part957 IF ( .NOT.ln_dynspg_ts .OR. ( ln_dynspg_ts .AND. ( .NOT.ln_bt_fw ) ) ) THEN 958 IF ( .NOT. ( lk_agrif_fstep .AND. ( neuler==0 ) ) ) THEN ! Add asselin part 952 959 zcorr = (tabres(ji,jj) - vv_b(ji,jj,Kmm_a) * hv(ji,jj,Krhs_a)) * r1_hv(ji,jj,Kbb_a) 953 vv_b(ji,jj,Kbb_a) = vv_b(ji,jj,Kbb_a) + atfp * zcorr *vmask(ji,jj,1)960 vv_b(ji,jj,Kbb_a) = vv_b(ji,jj,Kbb_a) + atfp * zcorr * vmask(ji,jj,1) 954 961 END IF 955 962 ENDIF … … 1000 1007 DO jj=j1,j2 1001 1008 DO ji=i1,i2 1002 ssh(ji,jj,Kbb_a) = ssh(ji,jj,Kbb_a) & 1003 & + atfp * ( tabres(ji,jj) - ssh(ji,jj,Kmm_a) ) * tmask(ji,jj,1) 1009 ssh(ji,jj,Kbb_a) = ssh(ji,jj,Kbb_a) & 1010 & + atfp * ( tabres(ji,jj) - ssh(ji,jj,Kmm_a) ) & 1011 & * tmask(ji,jj,1) 1004 1012 END DO 1005 1013 END DO … … 1095 1103 zcor = rdt * r1_e1e2t(i1 ,jj) * e2u(i1,jj) * (ub2_b(i1,jj)-tabres(i1,jj)) 1096 1104 ssh(i1 ,jj,Kmm_a) = ssh(i1 ,jj,Kmm_a) + zcor 1097 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) ssh(i1 ,jj,Kbb_a) = ssh(i1 ,jj,Kbb_a) + atfp * zcor 1105 IF ( .NOT. ( lk_agrif_fstep .AND. ( neuler==0 ) ) ) & 1106 & ssh(i1 ,jj,Kbb_a) = ssh(i1 ,jj,Kbb_a) + atfp * zcor 1098 1107 END DO 1099 1108 ENDIF … … 1102 1111 zcor = - rdt * r1_e1e2t(i2+1,jj) * e2u(i2,jj) * (ub2_b(i2,jj)-tabres(i2,jj)) 1103 1112 ssh(i2+1,jj,Kmm_a) = ssh(i2+1,jj,Kmm_a) + zcor 1104 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) ssh(i2+1,jj,Kbb_a) = ssh(i2+1,jj,Kbb_a) + atfp * zcor 1113 IF ( .NOT. ( lk_agrif_fstep .AND. ( neuler==0 ) ) ) & 1114 & ssh(i2+1,jj,Kbb_a) = ssh(i2+1,jj,Kbb_a) + atfp * zcor 1105 1115 END DO 1106 1116 ENDIF … … 1181 1191 IF (southern_side) THEN 1182 1192 DO ji=i1,i2 1183 zcor = rdt * r1_e1e2t(ji,j1 ) * e1v(ji,j1 ) * ( vb2_b(ji,j1)-tabres(ji,j1))1193 zcor = rdt * r1_e1e2t(ji,j1 ) * e1v(ji,j1 ) * ( vb2_b(ji,j1)-tabres(ji,j1) ) 1184 1194 ssh(ji,j1 ,Kmm_a) = ssh(ji,j1 ,Kmm_a) + zcor 1185 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) ssh(ji,j1 ,Kbb_a) = ssh(ji,j1,Kbb_a) + atfp * zcor 1195 IF ( .NOT. ( lk_agrif_fstep .AND. ( neuler==0 ) ) ) & 1196 & ssh(ji,j1 ,Kbb_a) = ssh(ji,j1,Kbb_a) + atfp * zcor 1186 1197 END DO 1187 1198 ENDIF 1188 1199 IF (northern_side) THEN 1189 1200 DO ji=i1,i2 1190 zcor = - rdt * r1_e1e2t(ji,j2+1) * e1v(ji,j2 ) * ( vb2_b(ji,j2)-tabres(ji,j2))1201 zcor = - rdt * r1_e1e2t(ji,j2+1) * e1v(ji,j2 ) * ( vb2_b(ji,j2)-tabres(ji,j2) ) 1191 1202 ssh(ji,j2+1,Kmm_a) = ssh(ji,j2+1,Kmm_a) + zcor 1192 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) ssh(ji,j2+1,Kbb_a) = ssh(ji,j2+1,Kbb_a) + atfp * zcor 1203 IF ( .NOT. ( lk_agrif_fstep .AND. ( neuler==0 ) ) ) & 1204 & ssh(ji,j2+1,Kbb_a) = ssh(ji,j2+1,Kbb_a) + atfp * zcor 1193 1205 END DO 1194 1206 ENDIF … … 1223 1235 END DO 1224 1236 END DO 1225 tabres(:,:,:,1) =tabres(:,:,:,1)*Agrif_Rhox()*Agrif_Rhoy()1226 tabres(:,:,:,2) =tabres(:,:,:,2)*Agrif_Rhox()1227 tabres(:,:,:,3) =tabres(:,:,:,3)*Agrif_Rhoy()1237 tabres(:,:,:,1) = tabres(:,:,:,1)*Agrif_Rhox()*Agrif_Rhoy() 1238 tabres(:,:,:,2) = tabres(:,:,:,2)*Agrif_Rhox() 1239 tabres(:,:,:,3) = tabres(:,:,:,3)*Agrif_Rhoy() 1228 1240 ELSE 1229 1241 DO jk=k1,k2 … … 1234 1246 print *,'VAL2 = ',ji,jj,jk,tabres(ji,jj,jk,2),e1t(ji,jj)*tmask(ji,jj,jk) 1235 1247 print *,'VAL3 = ',ji,jj,jk,tabres(ji,jj,jk,3),e2t(ji,jj)*tmask(ji,jj,jk) 1236 ztemp = sqrt(tabres(ji,jj,jk,1)/(tabres(ji,jj,jk,2)*tabres(ji,jj,jk,3)))1248 ztemp = SQRT( tabres(ji,jj,jk,1)/(tabres(ji,jj,jk,2)*tabres(ji,jj,jk,3)) ) 1237 1249 print *,'CORR = ',ztemp-1. 1238 1250 print *,'NEW VALS = ',tabres(ji,jj,jk,2)*ztemp,tabres(ji,jj,jk,3)*ztemp, & 1239 1251 tabres(ji,jj,jk,2)*ztemp*tabres(ji,jj,jk,3)*ztemp 1240 e1t(ji,jj) = tabres(ji,jj,jk,2) *ztemp1241 e2t(ji,jj) = tabres(ji,jj,jk,3) *ztemp1252 e1t(ji,jj) = tabres(ji,jj,jk,2) * ztemp 1253 e2t(ji,jj) = tabres(ji,jj,jk,3) * ztemp 1242 1254 END IF 1243 1255 END DO … … 1319 1331 DO jj=j1,j2 1320 1332 DO ji=i1,i2 1321 ptab(ji,jj,jk) = e3t_0(ji,jj,jk) * (1._wp + ssh(ji,jj,Kmm_a) & 1322 & *ssmask(ji,jj)/(ht_0(ji,jj)-1._wp + ssmask(ji,jj))) 1333 ptab(ji,jj,jk) = e3t_0(ji,jj,jk) & 1334 & * ( 1._wp + ssh(ji,jj,Kmm_a) & 1335 & * ssmask(ji,jj) & 1336 & / ( ht_0(ji,jj)-1._wp + ssmask(ji,jj) ) ) 1323 1337 END DO 1324 1338 END DO … … 1339 1353 DO jj=j1,j2 1340 1354 DO ji=i1,i2 1341 e3t(ji,jj,jk,Kbb_a) = e3t(ji,jj,jk,Kbb_a)&1342 &+ atfp * ( ptab(ji,jj,jk) - e3t(ji,jj,jk,Kmm_a) )1355 e3t(ji,jj,jk,Kbb_a) = e3t(ji,jj,jk,Kbb_a) & 1356 & + atfp * ( ptab(ji,jj,jk) - e3t(ji,jj,jk,Kmm_a) ) 1343 1357 END DO 1344 1358 END DO … … 1353 1367 DO ji = i1,i2 1354 1368 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 1355 e3w(ji,jj,jk,Kbb_a) = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) *&1356 &( e3t(ji,jj,jk-1,Kbb_a) - e3t_0(ji,jj,jk-1) ) &1357 & + 0.5_wp * tmask(ji,jj,jk) *&1358 &( e3t(ji,jj,jk ,Kbb_a) - e3t_0(ji,jj,jk ) )1359 gdepw(ji,jj,jk,Kbb_a) = gdepw(ji,jj,jk-1,Kbb_a) +e3t(ji,jj,jk-1,Kbb_a)1360 gdept(ji,jj,jk,Kbb_a) = zcoef * ( gdepw(ji,jj,jk ,Kbb_a) + 0.5 * e3w(ji,jj,jk,Kbb_a)) &1361 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb_a) + e3w(ji,jj,jk,Kbb_a))1369 e3w(ji,jj,jk,Kbb_a) = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) & 1370 & * ( e3t(ji,jj,jk-1,Kbb_a) - e3t_0(ji,jj,jk-1) ) & 1371 & + 0.5_wp * tmask(ji,jj,jk) & 1372 & * ( e3t(ji,jj,jk ,Kbb_a) - e3t_0(ji,jj,jk ) ) 1373 gdepw(ji,jj,jk,Kbb_a) = gdepw(ji,jj,jk-1,Kbb_a) + e3t(ji,jj,jk-1,Kbb_a) 1374 gdept(ji,jj,jk,Kbb_a) = zcoef * ( gdepw(ji,jj,jk ,Kbb_a) + 0.5 * e3w(ji,jj,jk ,Kbb_a) ) & 1375 & + (1._wp - zcoef) * ( gdept(ji,jj,jk-1,Kbb_a) + e3w(ji,jj,jk ,Kbb_a) ) 1362 1376 END DO 1363 1377 END DO … … 1379 1393 ! 1380 1394 ! Update vertical scale factor at W-points and depths: 1381 e3w(i1:i2,j1:j2,1,Kmm_a) = e3w_0(i1:i2,j1:j2,1) + e3t(i1:i2,j1:j2,1,Kmm_a) - e3t_0(i1:i2,j1:j2,1)1395 e3w(i1:i2,j1:j2,1,Kmm_a) = e3w_0(i1:i2,j1:j2,1) + e3t(i1:i2,j1:j2,1,Kmm_a) - e3t_0(i1:i2,j1:j2,1) 1382 1396 gdept(i1:i2,j1:j2,1,Kmm_a) = 0.5_wp * e3w(i1:i2,j1:j2,1,Kmm_a) 1383 1397 gdepw(i1:i2,j1:j2,1,Kmm_a) = 0.0_wp 1384 gde3w(i1:i2,j1:j2,1 ) = gdept(i1:i2,j1:j2,1,Kmm_a) - (ht(i1:i2,j1:j2)-ht_0(i1:i2,j1:j2)) ! Last term in the rhs is ssh1398 gde3w(i1:i2,j1:j2,1 ) = gdept(i1:i2,j1:j2,1,Kmm_a) - ( ht(i1:i2,j1:j2) - ht_0(i1:i2,j1:j2) ) ! Last term in the rhs is ssh 1385 1399 ! 1386 1400 DO jk = 2, jpk … … 1388 1402 DO ji = i1,i2 1389 1403 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 1390 e3w(ji,jj,jk,Kmm_a) = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) * ( e3t(ji,jj,jk-1,Kmm_a) - e3t_0(ji,jj,jk-1) ) & 1391 & + 0.5_wp * tmask(ji,jj,jk) * ( e3t(ji,jj,jk ,Kmm_a) - e3t_0(ji,jj,jk ) ) 1392 gdepw(ji,jj,jk,Kmm_a) = gdepw(ji,jj,jk-1,Kmm_a) + e3t(ji,jj,jk-1,Kmm_a) 1393 gdept(ji,jj,jk,Kmm_a) = zcoef * ( gdepw(ji,jj,jk ,Kmm_a) + 0.5 * e3w(ji,jj,jk,Kmm_a)) & 1394 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm_a) + e3w(ji,jj,jk,Kmm_a)) 1395 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm_a) - (ht(ji,jj)-ht_0(ji,jj)) ! Last term in the rhs is ssh 1404 e3w(ji,jj,jk,Kmm_a) = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) & 1405 & * ( e3t(ji,jj,jk-1,Kmm_a) - e3t_0(ji,jj,jk-1) ) & 1406 & + 0.5_wp * tmask(ji,jj,jk) & 1407 & * ( e3t(ji,jj,jk ,Kmm_a) - e3t_0(ji,jj,jk ) ) 1408 gdepw(ji,jj,jk,Kmm_a) = gdepw(ji,jj,jk-1,Kmm_a) + e3t(ji,jj,jk-1,Kmm_a) 1409 gdept(ji,jj,jk,Kmm_a) = zcoef * ( gdepw(ji,jj,jk ,Kmm_a) + 0.5 * e3w(ji,jj,jk ,Kmm_a) ) & 1410 & + ( 1._wp - zcoef ) * ( gdept(ji,jj,jk-1,Kmm_a) + e3w(ji,jj,jk ,Kmm_a) ) 1411 gde3w(ji,jj,jk ) = gdept(ji,jj,jk ,Kmm_a) - ( ht(ji,jj)-ht_0(ji,jj) ) ! Last term in the rhs is ssh 1396 1412 END DO 1397 1413 END DO … … 1399 1415 ! 1400 1416 IF ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 1401 e3t (i1:i2,j1:j2,1:jpk,Kbb_a) = e3t(i1:i2,j1:j2,1:jpk,Kmm_a)1402 e3w (i1:i2,j1:j2,1:jpk,Kbb_a) = e3w(i1:i2,j1:j2,1:jpk,Kmm_a)1417 e3t(i1:i2,j1:j2,1:jpk,Kbb_a) = e3t(i1:i2,j1:j2,1:jpk,Kmm_a) 1418 e3w(i1:i2,j1:j2,1:jpk,Kbb_a) = e3w(i1:i2,j1:j2,1:jpk,Kmm_a) 1403 1419 gdepw(i1:i2,j1:j2,1:jpk,Kbb_a) = gdepw(i1:i2,j1:j2,1:jpk,Kmm_a) 1404 1420 gdept(i1:i2,j1:j2,1:jpk,Kbb_a) = gdept(i1:i2,j1:j2,1:jpk,Kmm_a)
Note: See TracChangeset
for help on using the changeset viewer.