Changeset 3294 for trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
r2528 r3294 3 3 !! *** MODULE bdyvol *** 4 4 !! Ocean dynamic : Volume constraint when unstructured boundary 5 !! and Free surface are used5 !! and filtered free surface are used 6 6 !!====================================================================== 7 7 !! History : 1.0 ! 2005-01 (J. Chanut, A. Sellar) Original code 8 8 !! - ! 2006-01 (J. Chanut) Bug correction 9 9 !! 3.0 ! 2008-04 (NEMO team) add in the reference version 10 !! 3.4 ! 2011 (D. Storkey) rewrite in preparation for OBC-BDY merge 10 11 !!---------------------------------------------------------------------- 11 12 #if defined key_bdy && defined key_dynspg_flt … … 14 15 !! 'key_dynspg_flt' filtered free surface 15 16 !!---------------------------------------------------------------------- 17 USE timing ! Timing 16 18 USE oce ! ocean dynamics and tracers 17 19 USE dom_oce ! ocean space and time domain … … 71 73 !! 72 74 INTEGER :: ji, jj, jk, jb, jgrd 73 INTEGER :: i i, ij75 INTEGER :: ib_bdy, ii, ij 74 76 REAL(wp) :: zubtpecor, z_cflxemp, ztranst 77 TYPE(OBC_INDEX), POINTER :: idx 75 78 !!----------------------------------------------------------------------------- 79 80 IF( nn_timing == 1 ) CALL timing_start('bdy_vol') 76 81 77 82 IF( ln_vol ) THEN … … 91 96 ! ------------------------------------------------ 92 97 zubtpecor = 0.e0 93 jgrd = 2 ! cumulate u component contribution first 94 DO jb = 1, nblenrim(jgrd) 95 DO jk = 1, jpkm1 96 ii = nbi(jb,jgrd) 97 ij = nbj(jb,jgrd) 98 zubtpecor = zubtpecor + flagu(jb) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 98 DO ib_bdy = 1, nb_bdy 99 idx => idx_bdy(ib_bdy) 100 101 jgrd = 2 ! cumulate u component contribution first 102 DO jb = 1, idx%nblenrim(jgrd) 103 DO jk = 1, jpkm1 104 ii = idx%nbi(jb,jgrd) 105 ij = idx%nbj(jb,jgrd) 106 zubtpecor = zubtpecor + idx%flagu(jb) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 107 END DO 99 108 END DO 100 END DO101 jgrd = 3 ! then add v component contribution102 DO jb = 1, nblenrim(jgrd)103 DO jk = 1, jpkm1104 ii = nbi(jb,jgrd)105 ij = nbj(jb,jgrd)106 zubtpecor = zubtpecor + flagv(jb) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(ii,ij,jk)109 jgrd = 3 ! then add v component contribution 110 DO jb = 1, idx%nblenrim(jgrd) 111 DO jk = 1, jpkm1 112 ii = idx%nbi(jb,jgrd) 113 ij = idx%nbj(jb,jgrd) 114 zubtpecor = zubtpecor + idx%flagv(jb) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(ii,ij,jk) 115 END DO 107 116 END DO 117 108 118 END DO 109 119 IF( lk_mpp ) CALL mpp_sum( zubtpecor ) ! sum over the global domain … … 118 128 ! ------------------------------------------------------------- 119 129 ztranst = 0.e0 120 jgrd = 2 ! correct u component 121 DO jb = 1, nblenrim(jgrd) 122 DO jk = 1, jpkm1 123 ii = nbi(jb,jgrd) 124 ij = nbj(jb,jgrd) 125 ua(ii,ij,jk) = ua(ii,ij,jk) - flagu(jb) * zubtpecor * umask(ii,ij,jk) 126 ztranst = ztranst + flagu(jb) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 130 DO ib_bdy = 1, nb_bdy 131 idx => idx_bdy(ib_bdy) 132 133 jgrd = 2 ! correct u component 134 DO jb = 1, idx%nblenrim(jgrd) 135 DO jk = 1, jpkm1 136 ii = idx%nbi(jb,jgrd) 137 ij = idx%nbj(jb,jgrd) 138 ua(ii,ij,jk) = ua(ii,ij,jk) - idx%flagu(jb) * zubtpecor * umask(ii,ij,jk) 139 ztranst = ztranst + idx%flagu(jb) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 140 END DO 127 141 END DO 128 END DO129 jgrd = 3 ! correct v component130 DO jb = 1, nblenrim(jgrd)131 DO jk = 1, jpkm1132 ii = nbi(jb,jgrd)133 ij = nbj(jb,jgrd)134 va(ii,ij,jk) = va(ii,ij,jk) -flagv(jb) * zubtpecor * vmask(ii,ij,jk)135 ztranst = ztranst + flagv(jb) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(ii,ij,jk)142 jgrd = 3 ! correct v component 143 DO jb = 1, idx%nblenrim(jgrd) 144 DO jk = 1, jpkm1 145 ii = idx%nbi(jb,jgrd) 146 ij = idx%nbj(jb,jgrd) 147 va(ii,ij,jk) = va(ii,ij,jk) -idx%flagv(jb) * zubtpecor * vmask(ii,ij,jk) 148 ztranst = ztranst + idx%flagv(jb) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(ii,ij,jk) 149 END DO 136 150 END DO 151 137 152 END DO 138 153 IF( lk_mpp ) CALL mpp_sum( ztranst ) ! sum over the global domain … … 149 164 IF(lwp) WRITE(numout,*)' cumulated transport ztranst =', ztranst , '(m3/s)' 150 165 END IF 166 ! 167 IF( nn_timing == 1 ) CALL timing_stop('bdy_vol') 151 168 ! 152 169 END IF ! ln_vol
Note: See TracChangeset
for help on using the changeset viewer.