Changeset 9043
- Timestamp:
- 2017-12-14T12:49:18+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r9037 r9043 87 87 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ftsw, ftse ! (only used with een vorticity scheme) 88 88 89 REAL(wp) :: z1_12 = 1._wp / 12._wp ! local ratios90 REAL(wp) :: z1_8 = 0.125_wp !91 REAL(wp) :: z1_4 = 0.25_wp !92 REAL(wp) :: z1_2 = 0.5_wp !89 REAL(wp) :: r1_12 = 1._wp / 12._wp ! local ratios 90 REAL(wp) :: r1_8 = 0.125_wp ! 91 REAL(wp) :: r1_4 = 0.25_wp ! 92 REAL(wp) :: r1_2 = 0.5_wp ! 93 93 94 94 !! * Substitutions … … 157 157 INTEGER :: ikbu, iktu, noffset ! local integers 158 158 INTEGER :: ikbv, iktv ! - - 159 REAL(wp) :: z1_2dt_b, z2dt_bf ! local scalars159 REAL(wp) :: r1_2dt_b, z2dt_bf ! local scalars 160 160 REAL(wp) :: zx1, zx2, zu_spg, zhura ! - - 161 161 REAL(wp) :: zy1, zy2, zv_spg, zhvra ! - - … … 193 193 ELSE ; z2dt_bf = 2.0_wp * rdt 194 194 ENDIF 195 z1_2dt_b = 1.0_wp / z2dt_bf195 r1_2dt_b = 1.0_wp / z2dt_bf 196 196 ! 197 197 ll_init = ln_bt_av ! if no time averaging, then no specific restart … … 390 390 zx2 = ( zwx(ji ,jj) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 391 391 ! energy conserving formulation for planetary vorticity term 392 zu_trd(ji,jj) = z1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 )393 zv_trd(ji,jj) = - z1_4 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 )392 zu_trd(ji,jj) = r1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 393 zv_trd(ji,jj) = - r1_4 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) 394 394 END DO 395 395 END DO … … 398 398 DO jj = 2, jpjm1 399 399 DO ji = fs_2, fs_jpim1 ! vector opt. 400 zy1 = z1_8 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) &400 zy1 = r1_8 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 401 401 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 402 zx1 = - z1_8 * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) &402 zx1 = - r1_8 * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 403 403 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 404 404 zu_trd(ji,jj) = zy1 * ( zwz(ji ,jj-1) + zwz(ji,jj) ) … … 410 410 DO jj = 2, jpjm1 411 411 DO ji = fs_2, fs_jpim1 ! vector opt. 412 zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) &412 zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) & 413 413 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) & 414 414 & + ftse(ji,jj ) * zwy(ji ,jj-1) & 415 415 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 416 zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) &416 zv_trd(ji,jj) = - r1_12 * r1_e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 417 417 & + ftse(ji,jj+1) * zwx(ji ,jj+1) & 418 418 & + ftnw(ji,jj ) * zwx(ji-1,jj ) & … … 585 585 END DO 586 586 ELSE 587 zztmp = r1_rau0 * z1_2587 zztmp = r1_rau0 * r1_2 588 588 DO jj = 2, jpjm1 589 589 DO ji = fs_2, fs_jpim1 ! vector opt. … … 605 605 END DO 606 606 ELSE 607 zztmp = grav * z1_2607 zztmp = grav * r1_2 608 608 DO jj = 2, jpjm1 609 609 DO ji = fs_2, fs_jpim1 ! vector opt. … … 624 624 zssh_frc(:,:) = r1_rau0 * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) 625 625 ELSE 626 zztmp = r1_rau0 * z1_2626 zztmp = r1_rau0 * r1_2 627 627 zssh_frc(:,:) = zztmp * ( emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) & 628 628 & + fwfisf(:,:) + fwfisf_b(:,:) ) … … 762 762 DO jj = 2, jpjm1 ! Sea Surface Height at u- & v-points 763 763 DO ji = 2, fs_jpim1 ! Vector opt. 764 zwx(ji,jj) = z1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) &764 zwx(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) & 765 765 & * ( e1e2t(ji ,jj) * zsshp2_e(ji ,jj) & 766 766 & + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) ) 767 zwy(ji,jj) = z1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj) &767 zwy(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj) & 768 768 & * ( e1e2t(ji,jj ) * zsshp2_e(ji,jj ) & 769 769 & + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) ) … … 873 873 DO jj = 2, jpjm1 874 874 DO ji = 2, jpim1 ! NO Vector Opt. 875 zsshu_a(ji,jj) = z1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) &875 zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) & 876 876 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 877 877 & + e1e2t(ji+1,jj ) * ssha_e(ji+1,jj ) ) 878 zsshv_a(ji,jj) = z1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj) &878 zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj) & 879 879 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 880 880 & + e1e2t(ji ,jj+1) * ssha_e(ji ,jj+1) ) … … 961 961 DO jj = 2, jpjm1 962 962 DO ji = 2, jpim1 963 zx1 = z1_2 * ssumask(ji ,jj) * r1_e1e2u(ji ,jj) &963 zx1 = r1_2 * ssumask(ji ,jj) * r1_e1e2u(ji ,jj) & 964 964 & * ( e1e2t(ji ,jj ) * zsshp2_e(ji ,jj) & 965 965 & + e1e2t(ji+1,jj ) * zsshp2_e(ji+1,jj ) ) 966 zy1 = z1_2 * ssvmask(ji ,jj) * r1_e1e2v(ji ,jj ) &966 zy1 = r1_2 * ssvmask(ji ,jj) * r1_e1e2v(ji ,jj ) & 967 967 & * ( e1e2t(ji ,jj ) * zsshp2_e(ji ,jj ) & 968 968 & + e1e2t(ji ,jj+1) * zsshp2_e(ji ,jj+1) ) … … 988 988 zx1 = ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj) 989 989 zx2 = ( zwx(ji ,jj ) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 990 zu_trd(ji,jj) = z1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 )991 zv_trd(ji,jj) =- z1_4 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 )990 zu_trd(ji,jj) = r1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 991 zv_trd(ji,jj) =-r1_4 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) 992 992 END DO 993 993 END DO … … 996 996 DO jj = 2, jpjm1 997 997 DO ji = fs_2, fs_jpim1 ! vector opt. 998 zy1 = z1_8 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) &998 zy1 = r1_8 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 999 999 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 1000 zx1 = - z1_8 * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) &1000 zx1 = - r1_8 * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 1001 1001 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 1002 1002 zu_trd(ji,jj) = zy1 * ( zwz(ji ,jj-1) + zwz(ji,jj) ) … … 1008 1008 DO jj = 2, jpjm1 1009 1009 DO ji = fs_2, fs_jpim1 ! vector opt. 1010 zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) &1010 zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) & 1011 1011 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) & 1012 1012 & + ftse(ji,jj ) * zwy(ji ,jj-1) & 1013 1013 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 1014 zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) &1014 zv_trd(ji,jj) = - r1_12 * r1_e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 1015 1015 & + ftse(ji,jj+1) * zwx(ji ,jj+1) & 1016 1016 & + ftnw(ji,jj ) * zwx(ji-1,jj ) & … … 1174 1174 zwy(:,:) = vn_adv(:,:) 1175 1175 IF( .NOT.( kt == nit000 .AND. neuler==0 ) ) THEN 1176 un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) - atfp * un_bf(:,:) )1177 vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) - atfp * vn_bf(:,:) )1176 un_adv(:,:) = r1_2 * ( ub2_b(:,:) + zwx(:,:) - atfp * un_bf(:,:) ) 1177 vn_adv(:,:) = r1_2 * ( vb2_b(:,:) + zwy(:,:) - atfp * vn_bf(:,:) ) 1178 1178 ! 1179 1179 ! Update corrective fluxes for next time step: … … 1194 1194 IF( ln_dynadv_vec .OR. ln_linssh ) THEN 1195 1195 DO jk=1,jpkm1 1196 ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * z1_2dt_b1197 va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * z1_2dt_b1196 ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * r1_2dt_b 1197 va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * r1_2dt_b 1198 1198 END DO 1199 1199 ELSE … … 1201 1201 DO jj = 1, jpjm1 1202 1202 DO ji = 1, jpim1 ! NO Vector Opt. 1203 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) &1203 zsshu_a(ji,jj) = r1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) & 1204 1204 & * ( e1e2t(ji ,jj) * ssha(ji ,jj) & 1205 1205 & + e1e2t(ji+1,jj) * ssha(ji+1,jj) ) 1206 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) &1206 zsshv_a(ji,jj) = r1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) & 1207 1207 & * ( e1e2t(ji,jj ) * ssha(ji,jj ) & 1208 1208 & + e1e2t(ji,jj+1) * ssha(ji,jj+1) ) … … 1212 1212 ! 1213 1213 DO jk=1,jpkm1 1214 ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b1215 va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * z1_2dt_b1214 ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * r1_2dt_b 1215 va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * r1_2dt_b 1216 1216 END DO 1217 1217 ! Save barotropic velocities not transport:
Note: See TracChangeset
for help on using the changeset viewer.
