- Timestamp:
- 2010-10-11T18:51:54+02:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r2191_3partymerge2010/NEMO/OPA_SRC/BDY/bdydyn.F90
r1740 r2207 8 8 !! 3.0 ! 2008-04 (NEMO team) add in the reference version 9 9 !! 3.2 ! 2008-04 (R. Benshila) consider velocity instead of transport 10 !! 3.3 ! 2010-09 (E.O'Dea) modifications for Shelf configurations 11 !! 3.3 ! 2010-09 (D.Storkey) add ice boundary conditions 10 12 !!---------------------------------------------------------------------- 11 13 #if defined key_bdy … … 34 36 35 37 !!---------------------------------------------------------------------- 36 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)38 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 37 39 !! $Id$ 38 40 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 39 41 !!---------------------------------------------------------------------- 40 41 42 CONTAINS 42 43 … … 54 55 INTEGER, INTENT( in ) :: kt ! Main time step counter 55 56 !! 56 INTEGER :: ib, ik, igrd! dummy loop indices57 INTEGER :: ii, ij ! 2D addresses58 REAL(wp) :: zwgt 57 INTEGER :: jb, jk ! dummy loop indices 58 INTEGER :: ii, ij, igrd ! local integers 59 REAL(wp) :: zwgt ! boundary weight 59 60 !!---------------------------------------------------------------------- 60 61 ! 61 IF(ln_bdy_dyn_frs) THEN ! If this is false, then this routine does nothing.62 62 IF(ln_bdy_dyn_frs) THEN ! If this is false, then this routine does nothing. 63 ! 63 64 IF( kt == nit000 ) THEN 64 65 IF(lwp) WRITE(numout,*) … … 68 69 ! 69 70 igrd = 2 ! Relaxation of zonal velocity 70 DO ib = 1, nblen(igrd)71 DO ik = 1, jpkm172 ii = nbi(ib,igrd)73 ij = nbj(ib,igrd)74 zwgt = nbw( ib,igrd)75 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) 76 77 END DO 77 78 END DO 78 79 ! 79 80 igrd = 3 ! Relaxation of meridional velocity 80 DO ib = 1, nblen(igrd)81 DO ik = 1, jpkm182 ii = nbi(ib,igrd)83 ij = nbj(ib,igrd)84 zwgt = nbw( ib,igrd)85 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) 86 87 END DO 87 88 END DO 88 ! 89 CALL lbc_lnk( ua, 'U', -1. ) ! Boundary points should be updated 90 CALL lbc_lnk( va, 'V', -1. ) ! 89 CALL lbc_lnk( ua, 'U', -1. ) ; CALL lbc_lnk( va, 'V', -1. ) ! Boundary points should be updated 91 90 ! 92 91 ENDIF ! ln_bdy_dyn_frs 93 92 ! 94 93 END SUBROUTINE bdy_dyn_frs 95 94 96 95 97 #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 98 102 !! Option to use Flather with dynspg_flt not coded yet... 103 99 104 SUBROUTINE bdy_dyn_fla( pssh ) 100 105 !!---------------------------------------------------------------------- … … 119 124 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pssh 120 125 121 INTEGER :: ib, igrd ! dummy loop indices126 INTEGER :: jb, igrd ! dummy loop indices 122 127 INTEGER :: ii, ij, iim1, iip1, ijm1, ijp1 ! 2D addresses 123 128 REAL(wp) :: zcorr ! Flather correction … … 132 137 133 138 ! Fill temporary array with ssh data (here spgu): 134 igrd = 1139 igrd = 4 135 140 spgu(:,:) = 0.0 136 DO ib = 1, nblenrim(igrd)137 ii = nbi( ib,igrd)138 ij = nbj( ib,igrd)139 IF( ln_bdy_dyn_fla ) spgu(ii, ij) = sshbdy( ib)140 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) 141 146 END DO 142 147 ! 143 igrd = 2! Flather bc on u-velocity;148 igrd = 5 ! Flather bc on u-velocity; 144 149 ! ! remember that flagu=-1 if normal velocity direction is outward 145 150 ! ! I think we should rather use after ssh ? 146 DO ib = 1, nblenrim(igrd)147 ii = nbi( ib,igrd)148 ij = nbj( ib,igrd)149 iim1 = ii + MAX( 0, INT( flagu( ib) ) ) ! T pts i-indice inside the boundary150 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 151 156 ! 152 zcorr = - flagu( ib) * SQRT( grav * hur_e(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) )153 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) 154 159 ua_e(ii,ij) = zforc + zcorr * umask(ii,ij,1) 155 160 END DO 156 161 ! 157 igrd = 3! Flather bc on v-velocity162 igrd = 6 ! Flather bc on v-velocity 158 163 ! ! remember that flagv=-1 if normal velocity direction is outward 159 DO ib = 1, nblenrim(igrd)160 ii = nbi( ib,igrd)161 ij = nbj( ib,igrd)162 ijm1 = ij + MAX( 0, INT( flagv( ib) ) ) ! T pts j-indice inside the boundary163 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 164 169 ! 165 zcorr = - flagv( ib) * SQRT( grav * hvr_e(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) )166 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) 167 172 va_e(ii,ij) = zforc + zcorr * vmask(ii,ij,1) 168 173 END DO 174 CALL lbc_lnk( ua_e, 'U', -1. ) ! Boundary points should be updated 175 CALL lbc_lnk( va_e, 'V', -1. ) ! 169 176 ! 170 177 ENDIF ! ln_bdy_dyn_fla .or. ln_bdy_tides
Note: See TracChangeset
for help on using the changeset viewer.