- Timestamp:
- 2016-07-19T10:38:35+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
r4990 r6808 10 10 !! 3.4 ! 2011 (D. Storkey) rewrite in preparation for OBC-BDY merge 11 11 !!---------------------------------------------------------------------- 12 #if defined key_bdy && defined key_dynspg_flt12 #if defined key_bdy 13 13 !!---------------------------------------------------------------------- 14 !! 'key_bdy' AND unstructured open boundary conditions 15 !! 'key_dynspg_flt' filtered free surface 14 !! 'key_bdy' unstructured open boundary conditions 16 15 !!---------------------------------------------------------------------- 17 USE timing ! Timing 18 USE oce ! ocean dynamics and tracers 19 USE sbcisf ! ice shelf 20 USE dom_oce ! ocean space and time domain 21 USE phycst ! physical constants 22 USE bdy_oce ! ocean open boundary conditions 23 USE lib_mpp ! for mppsum 24 USE in_out_manager ! I/O manager 25 USE sbc_oce ! ocean surface boundary conditions 16 USE oce ! ocean dynamics and tracers 17 USE bdy_oce ! ocean open boundary conditions 18 USE sbc_oce ! ocean surface boundary conditions 19 USE dom_oce ! ocean space and time domain 20 USE phycst ! physical constants 21 USE sbcisf ! ice shelf 22 ! 23 USE in_out_manager ! I/O manager 24 USE lib_mpp ! for mppsum 25 USE timing ! Timing 26 USE lib_fortran ! Fortran routines library 26 27 27 28 IMPLICIT NONE 28 29 PRIVATE 29 30 30 PUBLIC bdy_vol ! routine called by dynspg_flt.h9031 PUBLIC bdy_vol ! called by ??? 31 32 32 !! * Substitutions33 # include "domzgr_substitute.h90"34 33 !!---------------------------------------------------------------------- 35 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)34 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 36 35 !! $Id$ 37 36 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 43 42 !! *** ROUTINE bdyvol *** 44 43 !! 45 !! ** Purpose : This routine is called in dynspg_flt to control46 !! the volume of the system. A correction velocity is calculated47 !! t o correct the total transport through the unstructured OBC.44 !! ** Purpose : This routine controls the volume of the system. 45 !! A correction velocity is calculated to correct the total transport 46 !! through the unstructured OBC. 48 47 !! The total depth used is constant (H0) to be consistent with the 49 !! linear free surface coded in OPA 8.2 48 !! linear free surface coded in OPA 8.2 <<<=== !!gm ???? true ???? 50 49 !! 51 50 !! ** Method : The correction velocity (zubtpecor here) is defined calculating … … 71 70 !! (set nn_volctl to 1 in tne namelist for this option) 72 71 !!---------------------------------------------------------------------- 73 INTEGER, INTENT( in) :: kt ! ocean time-step index74 ! !72 INTEGER, INTENT(in) :: kt ! ocean time-step index 73 ! 75 74 INTEGER :: ji, jj, jk, jb, jgrd 76 75 INTEGER :: ib_bdy, ii, ij … … 78 77 TYPE(OBC_INDEX), POINTER :: idx 79 78 !!----------------------------------------------------------------------------- 80 81 IF( nn_timing == 1 ) CALL timing_start('bdy_vol')82 79 ! 80 IF( nn_timing == 1 ) CALL timing_start('bdy_vol') 81 ! 83 82 IF( ln_vol ) THEN 84 83 ! 85 84 IF( kt == nit000 ) THEN 86 85 IF(lwp) WRITE(numout,*) … … 91 90 ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain 92 91 ! ----------------------------------------------------------------------- 93 z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+rdivisf*fwfisf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0 92 !!gm replace these lines : 93 z_cflxemp = SUM ( ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 94 94 IF( lk_mpp ) CALL mpp_sum( z_cflxemp ) ! sum over the global domain 95 !!gm by : 96 !!gm z_cflxemp = glob_sum( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 97 !!gm 95 98 96 99 ! Transport through the unstructured open boundary 97 100 ! ------------------------------------------------ 98 zubtpecor = 0. e0101 zubtpecor = 0._wp 99 102 DO ib_bdy = 1, nb_bdy 100 103 idx => idx_bdy(ib_bdy) 101 104 ! 102 105 jgrd = 2 ! cumulate u component contribution first 103 106 DO jb = 1, idx%nblenrim(jgrd) … … 105 108 ii = idx%nbi(jb,jgrd) 106 109 ij = idx%nbj(jb,jgrd) 107 zubtpecor = zubtpecor + idx%flagu(jb,jgrd) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(ii,ij,jk)110 zubtpecor = zubtpecor + idx%flagu(jb,jgrd) * ua(ii,ij, jk) * e2u(ii,ij) * e3u_n(ii,ij,jk) 108 111 END DO 109 112 END DO … … 113 116 ii = idx%nbi(jb,jgrd) 114 117 ij = idx%nbj(jb,jgrd) 115 zubtpecor = zubtpecor + idx%flagv(jb,jgrd) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(ii,ij,jk)118 zubtpecor = zubtpecor + idx%flagv(jb,jgrd) * va(ii,ij, jk) * e1v(ii,ij) * e3v_n(ii,ij,jk) 116 119 END DO 117 120 END DO 118 121 ! 119 122 END DO 120 123 IF( lk_mpp ) CALL mpp_sum( zubtpecor ) ! sum over the global domain … … 122 125 ! The normal velocity correction 123 126 ! ------------------------------ 124 IF( nn_volctl==1 ) THEN ; zubtpecor = ( zubtpecor - z_cflxemp ) / bdysurftot125 ELSE ; zubtpecor = zubtpecor/ bdysurftot127 IF( nn_volctl==1 ) THEN ; zubtpecor = ( zubtpecor - z_cflxemp ) / bdysurftot 128 ELSE ; zubtpecor = zubtpecor / bdysurftot 126 129 END IF 127 130 128 131 ! Correction of the total velocity on the unstructured boundary to respect the mass flux conservation 129 132 ! ------------------------------------------------------------- 130 ztranst = 0. e0133 ztranst = 0._wp 131 134 DO ib_bdy = 1, nb_bdy 132 135 idx => idx_bdy(ib_bdy) 133 136 ! 134 137 jgrd = 2 ! correct u component 135 138 DO jb = 1, idx%nblenrim(jgrd) … … 138 141 ij = idx%nbj(jb,jgrd) 139 142 ua(ii,ij,jk) = ua(ii,ij,jk) - idx%flagu(jb,jgrd) * zubtpecor * umask(ii,ij,jk) 140 ztranst = ztranst + idx%flagu(jb,jgrd) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(ii,ij,jk)143 ztranst = ztranst + idx%flagu(jb,jgrd) * ua(ii,ij,jk) * e2u(ii,ij) * e3u_n(ii,ij,jk) 141 144 END DO 142 145 END DO … … 147 150 ij = idx%nbj(jb,jgrd) 148 151 va(ii,ij,jk) = va(ii,ij,jk) -idx%flagv(jb,jgrd) * zubtpecor * vmask(ii,ij,jk) 149 ztranst = ztranst + idx%flagv(jb,jgrd) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(ii,ij,jk)152 ztranst = ztranst + idx%flagv(jb,jgrd) * va(ii,ij,jk) * e1v(ii,ij) * e3v_n(ii,ij,jk) 150 153 END DO 151 154 END DO 152 155 ! 153 156 END DO 154 157 IF( lk_mpp ) CALL mpp_sum( ztranst ) ! sum over the global domain … … 156 159 ! Check the cumulated transport through unstructured OBC once barotropic velocities corrected 157 160 ! ------------------------------------------------------ 158 IF( lwp .AND. MOD( kt, nwrite ) == 0 ) THEN161 IF( lwp .AND. MOD( kt, nwrite ) == 0 ) THEN 159 162 IF(lwp) WRITE(numout,*) 160 163 IF(lwp) WRITE(numout,*)'bdy_vol : time step :', kt … … 166 169 END IF 167 170 ! 168 IF( nn_timing == 1 ) CALL timing_stop('bdy_vol')171 IF( nn_timing == 1 ) CALL timing_stop('bdy_vol') 169 172 ! 170 173 END IF ! ln_vol 171 174 ! 172 175 END SUBROUTINE bdy_vol 173 176
Note: See TracChangeset
for help on using the changeset viewer.
