- Timestamp:
- 2013-04-09T18:34:38+02:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r3680 r3865 126 126 REAL(wp), POINTER, DIMENSION(:,:) :: zua, zva, zun, zvn, zun_e, zvn_e, zub_e, zvb_e 127 127 REAL(wp), POINTER, DIMENSION(:,:) :: zcu, zcv, zwx, zwy, zbfru, zbfrv, zu_sum, zv_sum 128 REAL(wp), POINTER, DIMENSION(:,:) :: zhu_b, zhv_b 128 129 !!---------------------------------------------------------------------- 129 130 ! … … 133 134 CALL wrk_alloc( jpi, jpj, zua, zva, zun, zvn, zun_e, zvn_e, zub_e, zvb_e ) 134 135 CALL wrk_alloc( jpi, jpj, zcu, zcv, zwx, zwy, zbfru, zbfrv, zu_sum, zv_sum ) 136 CALL wrk_alloc( jpi, jpj, zhu_b, zhv_b ) 135 137 ! 136 138 IF( kt == nit000 ) THEN !* initialisation … … 199 201 #endif 200 202 ! ! now trend 201 zua(ji,jj) = zua(ji,jj) + fse3u 202 zva(ji,jj) = zva(ji,jj) + fse3v 203 zua(ji,jj) = zua(ji,jj) + fse3u_n(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 204 zva(ji,jj) = zva(ji,jj) + fse3v_n(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 203 205 ! ! now velocity 204 zun(ji,jj) = zun(ji,jj) + fse3u 205 zvn(ji,jj) = zvn(ji,jj) + fse3v 206 zun(ji,jj) = zun(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) 207 zvn(ji,jj) = zvn(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) 206 208 ! 207 209 #if defined key_vvl … … 215 217 END DO 216 218 END DO 219 220 ! before inverse water column height at u- and v- points 221 IF( lk_vvl ) THEN 222 zhu_b(:,:) = 0. 223 zhv_b(:,:) = 0. 224 DO jk = 1, jpk 225 zhu_b(:,:) = zhu_b(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) 226 zhv_b(:,:) = zhv_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) 227 END DO 228 zhu_b(:,:) = umask(:,:,1) / ( zhu_b(:,:) + 1. - umask(:,:,1) ) 229 zhv_b(:,:) = vmask(:,:,1) / ( zhv_b(:,:) + 1. - vmask(:,:,1) ) 230 ELSE 231 zhu_b(:,:) = hur(:,:) 232 zhv_b(:,:) = hvr(:,:) 233 ENDIF 217 234 218 235 ! !* baroclinic momentum trend (remove the vertical mean trend) … … 355 372 vb_b(:,:) = vb_b(:,:) * hvr(:,:) 356 373 ENDIF 374 ub_b(:,:) = ub_b(:,:) * zhu_b(:,:) 375 vb_b(:,:) = vb_b(:,:) * zhv_b(:,:) 357 376 358 377 ! ----------------------------------------------------------------------- … … 683 702 CALL wrk_dealloc( jpi, jpj, zua, zva, zun, zvn, zun_e, zvn_e, zub_e, zvb_e ) 684 703 CALL wrk_dealloc( jpi, jpj, zcu, zcv, zwx, zwy, zbfru, zbfrv, zu_sum, zv_sum ) 704 CALL wrk_dealloc( jpi, jpj, zhu_b, zhv_b ) 685 705 ! 686 706 IF( nn_timing == 1 ) CALL timing_stop('dyn_spg_ts') … … 698 718 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 699 719 ! 720 REAL(wp), POINTER, DIMENSION(:,:) :: zzhu_b, zzhv_b 700 721 INTEGER :: ji, jk ! dummy loop indices 701 722 !!---------------------------------------------------------------------- … … 706 727 CALL iom_get( numror, jpdom_autoglo, 'vn_b' , vn_b (:,:) ) ! from barotropic loop 707 728 ELSE 729 CALL wrk_alloc( jpi, jpj, zzhu_b, zzhv_b ) 708 730 un_b (:,:) = 0._wp 709 731 vn_b (:,:) = 0._wp … … 712 734 DO jk = 1, jpkm1 713 735 DO ji = 1, jpij 714 un_b(ji,1) = un_b(ji,1) + fse3u (ji,1,jk) * un(ji,1,jk)715 vn_b(ji,1) = vn_b(ji,1) + fse3v (ji,1,jk) * vn(ji,1,jk)736 un_b(ji,1) = un_b(ji,1) + fse3u_n(ji,1,jk) * un(ji,1,jk) 737 vn_b(ji,1) = vn_b(ji,1) + fse3v_n(ji,1,jk) * vn(ji,1,jk) 716 738 END DO 717 739 END DO 718 740 ELSE ! No vector opt. 719 741 DO jk = 1, jpkm1 720 un_b(:,:) = un_b(:,:) + fse3u (:,:,jk) * un(:,:,jk)721 vn_b(:,:) = vn_b(:,:) + fse3v (:,:,jk) * vn(:,:,jk)742 un_b(:,:) = un_b(:,:) + fse3u_n(:,:,jk) * un(:,:,jk) 743 vn_b(:,:) = vn_b(:,:) + fse3v_n(:,:,jk) * vn(:,:,jk) 722 744 END DO 723 745 ENDIF … … 747 769 748 770 IF( lk_vvl ) THEN 749 ub_b (:,:) = ub_b(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1._wp - umask(:,:,1) ) 750 vb_b (:,:) = vb_b(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1._wp - vmask(:,:,1) ) 751 ELSE 771 CALL wrk_alloc( jpi, jpj, zzhu_b, zzhv_b ) 772 ub_b (:,:) = 0. 773 vb_b (:,:) = 0. 774 zzhu_b(:,:) = 0. 775 zzhv_b(:,:) = 0. 776 ! vertical sum 777 IF( lk_vopt_loop ) THEN ! vector opt., forced unroll 778 DO jk = 1, jpkm1 779 DO ji = 1, jpij 780 ub_b (ji,1) = ub_b (ji,1) + fse3u_b(ji,1,jk) * ub (ji,1,jk) 781 vb_b (ji,1) = vb_b (ji,1) + fse3v_b(ji,1,jk) * vb (ji,1,jk) 782 zzhu_b(ji,1) = zhu_b(ji,1) + fse3u_b(ji,1,jk) * umask(ji,1,jk) 783 zzhv_b(ji,1) = zhv_b(ji,1) + fse3v_b(ji,1,jk) * vmask(ji,1,jk) 784 END DO 785 END DO 786 ELSE ! No vector opt. 787 DO jk = 1, jpkm1 788 ub_b (:,:) = ub_b (:,:) + fse3u_b(:,:,jk) * ub (:,:,jk) 789 vb_b (:,:) = vb_b (:,:) + fse3v_b(:,:,jk) * vb (:,:,jk) 790 zzhu_b(:,:) = zzhu_b(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) 791 zzhv_b(:,:) = zzhv_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) 792 END DO 793 ENDIF 794 ub_b(:,:) = ub_b(:,:) / ( zzhu_b(:,:) + 1. - umask(:,:,1) ) 795 vb_b(:,:) = vb_b(:,:) / ( zzhv_b(:,:) + 1. - vmask(:,:,1) ) 796 CALL wrk_dealloc( jpi, jpj, zzhu_b, zzhv_b ) 797 ELSE 798 ub_b (:,:) = 0.e0 799 vb_b (:,:) = 0.e0 800 ! vertical sum 801 IF( lk_vopt_loop ) THEN ! vector opt., forced unroll 802 DO jk = 1, jpkm1 803 DO ji = 1, jpij 804 ub_b(ji,1) = ub_b(ji,1) + fse3u_b(ji,1,jk) * ub(ji,1,jk) 805 vb_b(ji,1) = vb_b(ji,1) + fse3v_b(ji,1,jk) * vb(ji,1,jk) 806 END DO 807 END DO 808 ELSE ! No vector opt. 809 DO jk = 1, jpkm1 810 ub_b(:,:) = ub_b(:,:) + fse3u_b(:,:,jk) * ub(:,:,jk) 811 vb_b(:,:) = vb_b(:,:) + fse3v_b(:,:,jk) * vb(:,:,jk) 812 END DO 813 ENDIF 752 814 ub_b(:,:) = ub_b(:,:) * hur(:,:) 753 815 vb_b(:,:) = vb_b(:,:) * hvr(:,:)
Note: See TracChangeset
for help on using the changeset viewer.
