- Timestamp:
- 2017-12-01T10:48:12+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r8865 r8870 153 153 REAL(wp) :: zhura, zhvra ! - - 154 154 REAL(wp) :: za0, za1, za2, za3 ! - - 155 REAL(wp) :: zwdramp ! local scalar - only used if ln_ rwd= .True.155 REAL(wp) :: zwdramp ! local scalar - only used if ln_wd_dl = .True. 156 156 157 157 INTEGER :: iwdg, jwdg, kwdg ! short-hand values for the indices of the output point … … 178 178 CALL wrk_alloc( jpi,jpj, zsshu_a, zsshv_a ) 179 179 CALL wrk_alloc( jpi,jpj, zhf ) 180 IF( ln_wd ) CALL wrk_alloc( jpi, jpj, zcpx, zcpy ) 181 IF( ln_rwd ) CALL wrk_alloc( jpi, jpj, ztwdmask, zuwdmask, zvwdmask, zuwdav2, zvwdav2) 182 183 IF ( ln_wd_diag ) THEN 184 iwdg = jn_wd_i ; jwdg = jn_wd_j ; kwdg = jn_wd_k 185 WRITE(numout,*) 'kt, iwdg, jwdg, kwdg = ', kt, iwdg, jwdg, kwdg 186 END IF 180 IF( ln_wd_il ) CALL wrk_alloc( jpi, jpj, zcpx, zcpy ) 181 IF( ln_wd_dl ) CALL wrk_alloc( jpi, jpj, ztwdmask, zuwdmask, zvwdmask, zuwdav2, zvwdav2) 182 187 183 188 184 ! … … 417 413 ! ! ---------------------------------------------------- 418 414 IF( .NOT.ln_linssh ) THEN ! Variable volume : remove surface pressure gradient 419 IF( ln_wd ) THEN ! Calculating and applying W/D gravity filters415 IF( ln_wd_il ) THEN ! Calculating and applying W/D gravity filters 420 416 DO jj = 2, jpjm1 421 417 DO ji = 2, jpim1 … … 513 509 ! 514 510 ! Note that the "unclipped" bottom friction parameter is used even with explicit drag 515 IF( ln_wd ) THEN511 IF( ln_wd_il ) THEN 516 512 zu_frc(:,:) = zu_frc(:,:) + MAX(r1_hu_n(:,:) * bfrua(:,:),-1._wp / rdtbt) * zwx(:,:) * wdrampu(ji,jj) 517 513 zv_frc(:,:) = zv_frc(:,:) + MAX(r1_hv_n(:,:) * bfrva(:,:),-1._wp / rdtbt) * zwy(:,:) * wdrampv(ji,jj) … … 651 647 ! ! ==================== ! 652 648 653 IF (ln_ rwd) THEN649 IF (ln_wd_dl) THEN 654 650 zuwdmask(:,:) = 0._wp ! set to zero for definiteness (not sure this is necessary) 655 651 zvwdmask(:,:) = 0._wp ! … … 688 684 689 685 ! set wetting & drying mask at tracer points for this barotropic sub-step 690 IF ( ln_ rwd) THEN691 692 IF ( ln_ rwd_rmp ) THEN686 IF ( ln_wd_dl ) THEN 687 688 IF ( ln_wd_dl_rmp ) THEN 693 689 DO jj = 1, jpj 694 690 DO ji = 1, jpi ! vector opt. … … 715 711 END IF 716 712 717 IF ( ln_wd_diag ) WRITE(numout,*) 'kt, jn = ', kt, jn718 IF ( ln_wd_diag ) WRITE(numout, *) 'zsshp2_e: (i,j), (i+1,j), (i,j+1) = ', zsshp2_e(iwdg,jwdg), zsshp2_e(iwdg+1,jwdg), zsshp2_e(iwdg,jwdg+1)719 IF ( ln_wd_diag ) WRITE(numout, *) 'ht_0: (i,j), (i+1,j), (i,j+1) = ', ht_0(iwdg,jwdg), ht_0(iwdg+1,jwdg), (iwdg,jwdg+1)720 IF ( ln_wd_diag ) WRITE(numout, *) 'ztwdmask: (i,j), (i+1,j), (i,j+1) = ', ztwdmask(iwdg,jwdg), ztwdmask(iwdg+1,jwdg), ztwdmask(iwdg,jwdg+1)721 713 END IF 722 714 … … 773 765 ENDIF 774 766 #endif 775 IF( ln_wd ) CALL wad_lmt_bt(zwx, zwy, sshn_e, zssh_frc, rdtbt) 776 777 IF ( ln_rwd ) THEN 778 779 IF ( ln_wd_diag ) THEN 780 WRITE(numout, *) 'zwx: (i,j), (i+1,j) = ', zwx(iwdg,jwdg), zwx(iwdg+1,jwdg) 781 WRITE(numout, *) 'zwy: (i,j), (i,j+1) = ', zwy(iwdg,jwdg), zwx(iwdg,jwdg+1) 782 END IF 767 IF( ln_wd_il ) CALL wad_lmt_bt(zwx, zwy, sshn_e, zssh_frc, rdtbt) 768 769 IF ( ln_wd_dl ) THEN 770 783 771 784 772 ! un_e and vn_e are set to zero at faces where the direction of the flow is from dry cells … … 804 792 END DO 805 793 806 IF ( ln_wd_diag ) THEN807 WRITE(numout, *) 'zuwdmask: (i,j) = ', zuwdmask(iwdg,jwdg)808 WRITE(numout, *) 'zwx: (i,j) = ', zwx(iwdg,jwdg)809 WRITE(numout, *) 'e2u: (i,j) = ', e2u(iwdg,jwdg)810 WRITE(numout, *) 'ua_e: (i,j) = ', ua_e(iwdg,jwdg)811 WRITE(numout, *) 'un_e: (i,j) = ', un_e(iwdg,jwdg)812 WRITE(numout, *) 'zhup2_e: (i,j) = ', zhup2_e(iwdg,jwdg)813 WRITE(numout, *) 'zvwdmask: (i,j) = ', zvwdmask(iwdg,jwdg)814 WRITE(numout, *) 'zwy: (i,j) = ', zwy(iwdg,jwdg)815 END IF816 794 817 795 END IF … … 822 800 vn_adv(:,:) = vn_adv(:,:) + za2 * zwy(:,:) * r1_e1v(:,:) 823 801 824 ! sum over sub-time-steps to decide which baroclinic velocities to set to zero (zuwdav2 is only used when ln_ rwd_bc = True)825 IF ( ln_ rwd_bc ) THEN802 ! sum over sub-time-steps to decide which baroclinic velocities to set to zero (zuwdav2 is only used when ln_wd_dl_bc = True) 803 IF ( ln_wd_dl_bc ) THEN 826 804 zuwdav2(:,:) = zuwdav2(:,:) + za2 * zuwdmask(:,:) 827 805 zvwdav2(:,:) = zvwdav2(:,:) + za2 * zvwdmask(:,:) 828 829 IF ( ln_wd_diag ) THEN830 WRITE(numout, *) 'za2, r1_e2u(i,j) = ', za2, r1_e2u(iwdg,jwdg)831 WRITE(numout, *) 'un_adv: (i,j) = ', un_adv(iwdg,jwdg)832 WRITE(numout, *) 'zuwdav2: (i,j) = ', zuwdav2(iwdg,jwdg)833 WRITE(numout, *) 'zvwdav2: (i,j) = ', zvwdav2(iwdg,jwdg)834 END IF835 836 806 END IF 837 807 … … 889 859 zsshp2_e(:,:) = za0 * ssha_e(:,:) + za1 * sshn_e (:,:) & 890 860 & + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:) 891 IF( ln_wd ) THEN ! Calculating and applying W/D gravity filters861 IF( ln_wd_il ) THEN ! Calculating and applying W/D gravity filters 892 862 DO jj = 2, jpjm1 893 863 DO ji = 2, jpim1 … … 1019 989 ! Surface pressure trend: 1020 990 1021 IF( ln_wd ) THEN991 IF( ln_wd_il ) THEN 1022 992 DO jj = 2, jpjm1 1023 993 DO ji = 2, jpim1 … … 1069 1039 DO ji = fs_2, fs_jpim1 ! vector opt. 1070 1040 1071 IF( ln_wd ) THEN 1072 zhura = hu_0(ji,jj) + zsshu_a(ji,jj) 1073 zhvra = hv_0(ji,jj) + zsshv_a(ji,jj) 1074 ELSE 1075 zhura = hu_0(ji,jj) + zsshu_a(ji,jj) 1076 zhvra = hv_0(ji,jj) + zsshv_a(ji,jj) 1077 END IF 1041 zhura = hu_0(ji,jj) + zsshu_a(ji,jj) 1042 zhvra = hv_0(ji,jj) + zsshv_a(ji,jj) 1043 1078 1044 zhura = ssumask(ji,jj)/(zhura + 1._wp - ssumask(ji,jj)) 1079 1045 zhvra = ssvmask(ji,jj)/(zhvra + 1._wp - ssvmask(ji,jj)) … … 1094 1060 ENDIF 1095 1061 1096 ! if ln_rwd: ua_e and va_e should not be masked ; they are used to determine the direction of flow into all cells1097 1098 ! IF ( ln_rwd) THEN1099 ! IF ( ln_wd_diag ) THEN1100 ! WRITE(numout, *) 'ua_e: (i,j) = ', ua_e(iwdg,jwdg)1101 ! WRITE(numout, *) 'va_e: (i,j) = ', va_e(iwdg,jwdg)1102 ! END IF1103 ! ua_e(:,:) = ua_e(:,:) * zuwdmask(:,:)1104 ! va_e(:,:) = va_e(:,:) * zvwdmask(:,:)1105 ! IF ( ln_wd_diag ) THEN1106 ! WRITE(numout, *) 'ua_e: (i,j) = ', ua_e(iwdg,jwdg)1107 ! WRITE(numout, *) 'va_e: (i,j) = ', va_e(iwdg,jwdg)1108 ! END IF1109 ! END IF1110 1111 1062 1112 1063 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 1113 IF( ln_wd ) THEN 1114 hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:) 1115 hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:) 1116 ELSE 1117 hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:) 1118 hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:) 1119 END IF 1064 hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:) 1065 hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:) 1120 1066 hur_e(:,:) = ssumask(:,:) / ( hu_e(:,:) + 1._wp - ssumask(:,:) ) 1121 1067 hvr_e(:,:) = ssvmask(:,:) / ( hv_e(:,:) + 1._wp - ssvmask(:,:) ) … … 1151 1097 va_b (:,:) = va_b (:,:) + za1 * va_e (:,:) 1152 1098 ELSE ! Sum transports 1153 IF (.NOT.ln_ rwd) THEN1099 IF (.NOT.ln_wd_dl) THEN 1154 1100 ua_b (:,:) = ua_b (:,:) + za1 * ua_e (:,:) * hu_e (:,:) 1155 1101 va_b (:,:) = va_b (:,:) + za1 * va_e (:,:) * hv_e (:,:) … … 1185 1131 ENDIF 1186 1132 1187 IF ( ln_wd_diag ) THEN1188 WRITE(numout, *) 'ub2_b: (i,j) = ', ub2_b(iwdg,jwdg)1189 WRITE(numout, *) 'r1_hu_n: (i,j) = ', r1_hu_n(iwdg,jwdg)1190 WRITE(numout, *) 'zwx: (i,j) = ', zwx(iwdg,jwdg)1191 WRITE(numout, *) 'un_adv: (i,j) = ', un_adv(iwdg,jwdg)1192 END IF1193 1133 1194 1134 ! … … 1222 1162 ENDIF 1223 1163 1224 IF ( ln_wd_diag ) THEN1225 WRITE(numout, *) 'ua_b: (i,j) A = ', ua_b(iwdg,jwdg)1226 WRITE(numout, *) 'va_b: (i,j) B = ', va_b(iwdg,jwdg)1227 END IF1228 1229 ! temporary debugging code1230 IF ( ln_wd_diag ) THEN1231 WRITE(numout, *) 'ua: (i,j,k) B = ', ua(iwdg,jwdg,kwdg)1232 WRITE(numout, *) 'ua_b: (i,j) B = ', ua_b(iwdg,jwdg)1233 WRITE(numout, *) 'un: (i,j,k) = ', un(iwdg,jwdg,kwdg)1234 WRITE(numout, *) 'un_b: (i,j) = ', un_b(iwdg,jwdg)1235 WRITE(numout, *) 'un_adv: (i,j) = ', un_adv(iwdg,jwdg)1236 WRITE(numout, *) 'va: (i,j,k) = ', va(iwdg,jwdg,kwdg)1237 WRITE(numout, *) 'va_b: (i,j,k) = ', va_b(iwdg,jwdg)1238 WRITE(numout, *) 'vn: (i,j,k) = ', vn(iwdg,jwdg,kwdg)1239 WRITE(numout, *) 'vn_b: (i,j) = ', vn_b(iwdg,jwdg)1240 WRITE(numout, *) 'vn_adv: (i,j) = ', vn_adv(iwdg,jwdg)1241 END IF1242 1164 1243 1165 ! Correct velocities so that the barotropic velocity equals (un_adv, vn_adv) (in all cases) … … 1247 1169 END DO 1248 1170 1249 IF ( ln_ rwd .and. ln_rwd_bc) THEN1171 IF ( ln_wd_dl .and. ln_wd_dl_bc) THEN 1250 1172 DO jk = 1, jpkm1 1251 1173 un(:,:,jk) = ( un_adv(:,:) + zuwdav2(:,:)*(un(:,:,jk) - un_adv(:,:)) ) * umask(:,:,jk) … … 1254 1176 END IF 1255 1177 1256 IF ( ln_wd_diag ) THEN1257 WRITE(numout, *) 'ua: (i,j,k) = ', ua(iwdg,jwdg,kwdg)1258 WRITE(numout, *) 'ua_b: (i,j,k) = ', ua_b(iwdg,jwdg)1259 WRITE(numout, *) 'un: (i,j,k) = ', un(iwdg,jwdg,kwdg)1260 WRITE(numout, *) 'va: (i,j,k) = ', va(iwdg,jwdg,kwdg)1261 WRITE(numout, *) 'va_b: (i,j,k) = ', va_b(iwdg,jwdg)1262 WRITE(numout, *) 'vn: (i,j,k) = ', vn(iwdg,jwdg,kwdg)1263 END IF1264 1178 1265 1179 CALL iom_put( "ubar", un_adv(:,:) ) ! barotropic i-current … … 1290 1204 CALL wrk_dealloc( jpi,jpj, zsshu_a, zsshv_a ) 1291 1205 CALL wrk_dealloc( jpi,jpj, zhf ) 1292 IF( ln_wd ) CALL wrk_dealloc( jpi, jpj, zcpx, zcpy )1293 IF( ln_ rwd) CALL wrk_dealloc( jpi, jpj, ztwdmask, zuwdmask, zvwdmask, zuwdav2, zvwdav2 )1206 IF( ln_wd_il ) CALL wrk_dealloc( jpi, jpj, zcpx, zcpy ) 1207 IF( ln_wd_dl ) CALL wrk_dealloc( jpi, jpj, ztwdmask, zuwdmask, zvwdmask, zuwdav2, zvwdav2 ) 1294 1208 ! 1295 1209 IF ( ln_diatmb ) THEN
Note: See TracChangeset
for help on using the changeset viewer.
