- Timestamp:
- 2012-11-16T17:18:17+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_MERCATOR_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90
r3294 r3583 23 23 USE in_out_manager ! I/O manager 24 24 25 25 26 IMPLICIT NONE 26 27 PRIVATE 27 28 28 29 PUBLIC bdy_tra ! routine called in tranxt.F90 30 PUBLIC bdy_tra_dmp ! routine called in step.F90 29 31 30 32 !!---------------------------------------------------------------------- … … 53 55 CASE(jp_frs) 54 56 CALL bdy_tra_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 57 CASE(2) 58 CALL bdy_tra_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 59 CASE(3) 60 CALL bdy_tra_nmn( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 61 CASE(4) 62 CALL bdy_tra_rnf( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 55 63 CASE DEFAULT 56 64 CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 57 65 END SELECT 58 66 ENDDO 67 ! 68 ! Boundary points should be updated 69 IF (nb_bdy>0) CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. ) 70 IF (nb_bdy>0) CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 59 71 60 72 END SUBROUTINE bdy_tra … … 90 102 END DO 91 103 ! 92 CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. ) ; CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) ! Boundary points should be updated93 !94 104 IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 95 105 ! … … 97 107 ! 98 108 END SUBROUTINE bdy_tra_frs 99 109 110 SUBROUTINE bdy_tra_spe( idx, dta, kt ) 111 !!---------------------------------------------------------------------- 112 !! *** SUBROUTINE bdy_tra_frs *** 113 !! 114 !! ** Purpose : Apply a specified value for tracers at open boundaries. 115 !! 116 !!---------------------------------------------------------------------- 117 INTEGER, INTENT(in) :: kt 118 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 119 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 120 !! 121 REAL(wp) :: zwgt ! boundary weight 122 INTEGER :: ib, ik, igrd ! dummy loop indices 123 INTEGER :: ii, ij ! 2D addresses 124 !!---------------------------------------------------------------------- 125 ! 126 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_spe') 127 ! 128 igrd = 1 ! Everything is at T-points here 129 DO ib = 1, idx%nblenrim(igrd) 130 ii = idx%nbi(ib,igrd) 131 ij = idx%nbj(ib,igrd) 132 DO ik = 1, jpkm1 133 tsa(ii,ij,ik,jp_tem) = dta%tem(ib,ik) * tmask(ii,ij,ik) 134 tsa(ii,ij,ik,jp_sal) = dta%sal(ib,ik) * tmask(ii,ij,ik) 135 END DO 136 END DO 137 ! 138 IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 139 ! 140 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_spe') 141 ! 142 END SUBROUTINE bdy_tra_spe 143 144 SUBROUTINE bdy_tra_nmn( idx, dta, kt ) 145 !!---------------------------------------------------------------------- 146 !! *** SUBROUTINE bdy_tra_nmn *** 147 !! 148 !! ** Purpose : Duplicate the value for tracers at open boundaries. 149 !! 150 !!---------------------------------------------------------------------- 151 INTEGER, INTENT(in) :: kt 152 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 153 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 154 !! 155 REAL(wp) :: zwgt ! boundary weight 156 INTEGER :: ib, ik, igrd ! dummy loop indices 157 INTEGER :: ii, ij,zcoef, zcoef1,zcoef2, ip, jp ! 2D addresses 158 !!---------------------------------------------------------------------- 159 ! 160 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_nmn') 161 ! 162 igrd = 1 ! Everything is at T-points here 163 DO ib = 1, idx%nblenrim(igrd) 164 ii = idx%nbi(ib,igrd) 165 ij = idx%nbj(ib,igrd) 166 DO ik = 1, jpkm1 167 ! search the sense of the gradient 168 zcoef1 = bdytmask(ii-1,ij ) + bdytmask(ii+1,ij ) 169 zcoef2 = bdytmask(ii ,ij-1) + bdytmask(ii ,ij+1) 170 IF ( zcoef1+zcoef2 == 0) THEN 171 ! corner 172 zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) + tmask(ii,ij-1,ik) + tmask(ii,ij+1,ik) 173 tsa(ii,ij,ik,jp_tem) = tsa(ii-1,ij ,ik,jp_tem) * tmask(ii-1,ij ,ik) + & 174 & tsa(ii+1,ij ,ik,jp_tem) * tmask(ii+1,ij ,ik) + & 175 & tsa(ii ,ij-1,ik,jp_tem) * tmask(ii ,ij-1,ik) + & 176 & tsa(ii ,ij+1,ik,jp_tem) * tmask(ii ,ij+1,ik) 177 tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 178 tsa(ii,ij,ik,jp_sal) = tsa(ii-1,ij ,ik,jp_sal) * tmask(ii-1,ij ,ik) + & 179 & tsa(ii+1,ij ,ik,jp_sal) * tmask(ii+1,ij ,ik) + & 180 & tsa(ii ,ij-1,ik,jp_sal) * tmask(ii ,ij-1,ik) + & 181 & tsa(ii ,ij+1,ik,jp_sal) * tmask(ii ,ij+1,ik) 182 tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 183 ELSE 184 ip = bdytmask(ii+1,ij ) - bdytmask(ii-1,ij ) 185 jp = bdytmask(ii ,ij+1) - bdytmask(ii ,ij-1) 186 tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii+ip,ij+jp,ik) 187 tsa(ii,ij,ik,jp_sal) = tsa(ii+ip,ij+jp,ik,jp_sal) * tmask(ii+ip,ij+jp,ik) 188 ENDIF 189 END DO 190 END DO 191 ! 192 IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 193 ! 194 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_nmn') 195 ! 196 END SUBROUTINE bdy_tra_nmn 197 198 SUBROUTINE bdy_tra_rnf( idx, dta, kt ) 199 !!---------------------------------------------------------------------- 200 !! *** SUBROUTINE bdy_tra_rnf *** 201 !! 202 !! ** Purpose : Apply the runoff values for tracers at open boundaries: 203 !! - specified to 0.1 PSU for the salinity 204 !! - duplicate the value for the temperature 205 !! 206 !!---------------------------------------------------------------------- 207 INTEGER, INTENT(in) :: kt 208 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 209 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 210 !! 211 REAL(wp) :: zwgt ! boundary weight 212 INTEGER :: ib, ik, igrd ! dummy loop indices 213 INTEGER :: ii, ij, ip, jp ! 2D addresses 214 !!---------------------------------------------------------------------- 215 ! 216 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_rnf') 217 ! 218 igrd = 1 ! Everything is at T-points here 219 DO ib = 1, idx%nblenrim(igrd) 220 ii = idx%nbi(ib,igrd) 221 ij = idx%nbj(ib,igrd) 222 DO ik = 1, jpkm1 223 ip = bdytmask(ii+1,ij ) - bdytmask(ii-1,ij ) 224 jp = bdytmask(ii ,ij+1) - bdytmask(ii ,ij-1) 225 tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii,ij,ik) 226 tsa(ii,ij,ik,jp_sal) = 0.1 * tmask(ii,ij,ik) 227 END DO 228 END DO 229 ! 230 IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 231 ! 232 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_rnf') 233 ! 234 END SUBROUTINE bdy_tra_rnf 235 236 SUBROUTINE bdy_tra_dmp( kt ) 237 !!---------------------------------------------------------------------- 238 !! *** SUBROUTINE bdy_tra_dmp *** 239 !! 240 !! ** Purpose : Apply damping for tracers at open boundaries. 241 !! 242 !!---------------------------------------------------------------------- 243 INTEGER, INTENT(in) :: kt 244 !! 245 REAL(wp) :: zwgt ! boundary weight 246 REAL(wp) :: zta, zsa, ztime 247 INTEGER :: ib, ik, igrd ! dummy loop indices 248 INTEGER :: ii, ij ! 2D addresses 249 INTEGER :: ib_bdy ! Loop index 250 !!---------------------------------------------------------------------- 251 ! 252 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_dmp') 253 ! 254 DO ib_bdy=1, nb_bdy 255 IF ( ln_tra_dmp(ib_bdy) ) THEN 256 igrd = 1 ! Everything is at T-points here 257 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 258 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 259 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 260 zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd) 261 DO ik = 1, jpkm1 262 zta = zwgt * ( dta_bdy(ib_bdy)%tem(ib,ik) - tsb(ii,ij,ik,jp_tem) ) * tmask(ii,ij,ik) 263 zsa = zwgt * ( dta_bdy(ib_bdy)%sal(ib,ik) - tsb(ii,ij,ik,jp_sal) ) * tmask(ii,ij,ik) 264 tsa(ii,ij,ik,jp_tem) = tsa(ii,ij,ik,jp_tem) + zta 265 tsa(ii,ij,ik,jp_sal) = tsa(ii,ij,ik,jp_sal) + zsa 266 END DO 267 END DO 268 ENDIF 269 ENDDO 270 ! 271 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_dmp') 272 ! 273 END SUBROUTINE bdy_tra_dmp 274 100 275 #else 101 276 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
