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