- Timestamp:
- 2010-10-06T16:19:27+02:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r1986_BDY_updates/NEMO/OPA_SRC/BDY/bdydyn.F90
r2093 r2168 36 36 37 37 !!---------------------------------------------------------------------- 38 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)38 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 39 39 !! $Id$ 40 40 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 41 41 !!---------------------------------------------------------------------- 42 43 42 CONTAINS 44 43 … … 56 55 INTEGER, INTENT( in ) :: kt ! Main time step counter 57 56 !! 58 INTEGER :: ib, ik, igrd! dummy loop indices59 INTEGER :: ii, ij ! 2D addresses60 REAL(wp) :: zwgt 57 INTEGER :: jb, jk ! dummy loop indices 58 INTEGER :: ii, ij, igrd ! local integers 59 REAL(wp) :: zwgt ! boundary weight 61 60 !!---------------------------------------------------------------------- 62 61 ! 63 IF(ln_bdy_dyn_frs) THEN ! If this is false, then this routine does nothing.64 62 IF(ln_bdy_dyn_frs) THEN ! If this is false, then this routine does nothing. 63 ! 65 64 IF( kt == nit000 ) THEN 66 65 IF(lwp) WRITE(numout,*) … … 70 69 ! 71 70 igrd = 2 ! Relaxation of zonal velocity 72 DO ib = 1, nblen(igrd)73 DO ik = 1, jpkm174 ii = nbi(ib,igrd)75 ij = nbj(ib,igrd)76 zwgt = nbw( ib,igrd)77 ua(ii,ij, ik) = ( ua(ii,ij,ik) * ( 1.- zwgt ) + ubdy(ib,ik) * zwgt ) * umask(ii,ij,ik)71 DO jb = 1, nblen(igrd) 72 DO jk = 1, jpkm1 73 ii = nbi(jb,igrd) 74 ij = nbj(jb,igrd) 75 zwgt = nbw(jb,igrd) 76 ua(ii,ij,jk) = ( ua(ii,ij,jk) * ( 1.- zwgt ) + ubdy(jb,jk) * zwgt ) * umask(ii,ij,jk) 78 77 END DO 79 78 END DO 80 79 ! 81 80 igrd = 3 ! Relaxation of meridional velocity 82 DO ib = 1, nblen(igrd)83 DO ik = 1, jpkm184 ii = nbi(ib,igrd)85 ij = nbj(ib,igrd)86 zwgt = nbw( ib,igrd)87 va(ii,ij, ik) = ( va(ii,ij,ik) * ( 1.- zwgt ) + vbdy(ib,ik) * zwgt ) * vmask(ii,ij,ik)81 DO jb = 1, nblen(igrd) 82 DO jk = 1, jpkm1 83 ii = nbi(jb,igrd) 84 ij = nbj(jb,igrd) 85 zwgt = nbw(jb,igrd) 86 va(ii,ij,jk) = ( va(ii,ij,jk) * ( 1.- zwgt ) + vbdy(jb,jk) * zwgt ) * vmask(ii,ij,jk) 88 87 END DO 89 88 END DO 90 ! 91 CALL lbc_lnk( ua, 'U', -1. ) ! Boundary points should be updated 92 CALL lbc_lnk( va, 'V', -1. ) ! 89 CALL lbc_lnk( ua, 'U', -1. ) ; CALL lbc_lnk( va, 'V', -1. ) ! Boundary points should be updated 93 90 ! 94 91 ENDIF ! ln_bdy_dyn_frs 95 92 ! 96 93 END SUBROUTINE bdy_dyn_frs 97 94 98 95 99 #if defined key_dynspg_exp || defined key_dynspg_ts 96 # if defined key_dynspg_exp || defined key_dynspg_ts 97 !!---------------------------------------------------------------------- 98 !! 'key_dynspg_exp' OR explicit sea surface height 99 !! 'key_dynspg_ts ' split-explicit sea surface height 100 !!---------------------------------------------------------------------- 101 100 102 !! Option to use Flather with dynspg_flt not coded yet... 103 101 104 SUBROUTINE bdy_dyn_fla( pssh ) 102 105 !!---------------------------------------------------------------------- … … 121 124 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pssh 122 125 123 INTEGER :: ib, igrd ! dummy loop indices126 INTEGER :: jb, igrd ! dummy loop indices 124 127 INTEGER :: ii, ij, iim1, iip1, ijm1, ijp1 ! 2D addresses 125 128 REAL(wp) :: zcorr ! Flather correction … … 136 139 igrd = 4 137 140 spgu(:,:) = 0.0 138 DO ib = 1, nblenrim(igrd)139 ii = nbi( ib,igrd)140 ij = nbj( ib,igrd)141 IF( ln_bdy_dyn_fla ) spgu(ii, ij) = sshbdy( ib)142 IF( ln_bdy_tides ) spgu(ii, ij) = spgu(ii, ij) + sshtide( ib)141 DO jb = 1, nblenrim(igrd) 142 ii = nbi(jb,igrd) 143 ij = nbj(jb,igrd) 144 IF( ln_bdy_dyn_fla ) spgu(ii, ij) = sshbdy(jb) 145 IF( ln_bdy_tides ) spgu(ii, ij) = spgu(ii, ij) + sshtide(jb) 143 146 END DO 144 147 ! … … 146 149 ! ! remember that flagu=-1 if normal velocity direction is outward 147 150 ! ! I think we should rather use after ssh ? 148 DO ib = 1, nblenrim(igrd)149 ii = nbi( ib,igrd)150 ij = nbj( ib,igrd)151 iim1 = ii + MAX( 0, INT( flagu( ib) ) ) ! T pts i-indice inside the boundary152 iip1 = ii - MIN( 0, INT( flagu( ib) ) ) ! T pts i-indice outside the boundary151 DO jb = 1, nblenrim(igrd) 152 ii = nbi(jb,igrd) 153 ij = nbj(jb,igrd) 154 iim1 = ii + MAX( 0, INT( flagu(jb) ) ) ! T pts i-indice inside the boundary 155 iip1 = ii - MIN( 0, INT( flagu(jb) ) ) ! T pts i-indice outside the boundary 153 156 ! 154 zcorr = - flagu( ib) * SQRT( grav * hur_e(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) )155 zforc = ubtbdy( ib) + utide(ib)157 zcorr = - flagu(jb) * SQRT( grav * hur_e(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) ) 158 zforc = ubtbdy(jb) + utide(jb) 156 159 ua_e(ii,ij) = zforc + zcorr * umask(ii,ij,1) 157 160 END DO … … 159 162 igrd = 6 ! Flather bc on v-velocity 160 163 ! ! remember that flagv=-1 if normal velocity direction is outward 161 DO ib = 1, nblenrim(igrd)162 ii = nbi( ib,igrd)163 ij = nbj( ib,igrd)164 ijm1 = ij + MAX( 0, INT( flagv( ib) ) ) ! T pts j-indice inside the boundary165 ijp1 = ij - MIN( 0, INT( flagv( ib) ) ) ! T pts j-indice outside the boundary164 DO jb = 1, nblenrim(igrd) 165 ii = nbi(jb,igrd) 166 ij = nbj(jb,igrd) 167 ijm1 = ij + MAX( 0, INT( flagv(jb) ) ) ! T pts j-indice inside the boundary 168 ijp1 = ij - MIN( 0, INT( flagv(jb) ) ) ! T pts j-indice outside the boundary 166 169 ! 167 zcorr = - flagv( ib) * SQRT( grav * hvr_e(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) )168 zforc = vbtbdy( ib) + vtide(ib)170 zcorr = - flagv(jb) * SQRT( grav * hvr_e(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) ) 171 zforc = vbtbdy(jb) + vtide(jb) 169 172 va_e(ii,ij) = zforc + zcorr * vmask(ii,ij,1) 170 173 END DO
Note: See TracChangeset
for help on using the changeset viewer.
