Changeset 703 for trunk/NEMO/OPA_SRC/DOM
- Timestamp:
- 2007-10-10T10:14:32+02:00 (17 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/DOM/closea.F90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DOM/closea.F90
r699 r703 2 2 !!====================================================================== 3 3 !! *** MODULE closea *** 4 !! Closed Seas : 4 !! Closed Seas : specific treatments associated with closed seas 5 5 !!====================================================================== 6 !! History : 8.2 ! 00-05 (O. Marti) Original code 7 !! 8.5 ! 02-06 (E. Durand, G. Madec) F90 8 !! 9.0 ! 06-07 (G. Madec) add clo_rnf, clo_ups, clo_bat 9 !!---------------------------------------------------------------------- 6 10 7 11 !!---------------------------------------------------------------------- 8 12 !! dom_clo : modification of the ocean domain for closed seas cases 9 !! flx_clo : Special handling of closed seas 10 !!---------------------------------------------------------------------- 11 !! * Modules used 13 !! sbc_clo : Special handling of closed seas 14 !! clo_rnf : set close sea outflows as river mouths (see sbcrnf) 15 !! clo_ups : set mixed centered/upstream scheme in closed sea (see traadv_cen2) 16 !! clo_bat : set to zero a field over closed sea (see domzrg) 17 !!---------------------------------------------------------------------- 12 18 USE oce ! dynamics and tracers 13 19 USE dom_oce ! ocean space and time domain 14 20 USE in_out_manager ! I/O manager 15 USE ocesbc ! ocean surface boundary conditions (fluxes) 16 USE flxrnf ! runoffs 21 USE sbc_oce ! ocean surface boundary conditions 17 22 USE lib_mpp ! distributed memory computing library 18 23 USE lbclnk ! ??? … … 21 26 PRIVATE 22 27 23 !! * Accessibility 24 PUBLIC dom_clo ! routine called by dom_init 25 PUBLIC flx_clo ! routine called by step 26 27 !! * Share module variables 28 INTEGER, PUBLIC, PARAMETER :: & !: 29 jpncs = 4 !: number of closed sea 30 INTEGER, PUBLIC :: & !!: namclo : closed seas and lakes 31 nclosea = 0 !: = 0 no closed sea or lake 32 ! ! = 1 closed sea or lake in the domain 33 INTEGER, PUBLIC, DIMENSION (jpncs) :: & !: 34 ncstt, & !: Type of closed sea 35 ncsi1, ncsj1, & !: closed sea limits 36 ncsi2, ncsj2, & !: 37 ncsnr !: number of point where run-off pours 38 INTEGER, PUBLIC, DIMENSION (jpncs,4) :: & 39 ncsir, ncsjr !: Location of run-off 40 41 !! * Module variable 42 REAL(wp), DIMENSION (jpncs+1) :: & 43 surf ! closed sea surface 28 PUBLIC dom_clo ! routine called by domain module 29 PUBLIC sbc_clo ! routine called by step module 30 PUBLIC clo_rnf ! routine called by sbcrnf module 31 PUBLIC clo_ups ! routine called in traadv_cen2(_jki) module 32 PUBLIC clo_bat ! routine called in domzgr module 33 34 !!* Namelist namclo : closed seas and lakes 35 INTEGER, PUBLIC :: nclosea = 0 !: = 0 no closed sea or lake 36 ! ! = 1 closed sea or lake in the domain 37 38 INTEGER, PUBLIC, PARAMETER :: jpncs = 4 !: number of closed sea 39 INTEGER, PUBLIC, DIMENSION(jpncs) :: ncstt !: Type of closed sea 40 INTEGER, PUBLIC, DIMENSION(jpncs) :: ncsi1, ncsj1 !: south-west closed sea limits (i,j) 41 INTEGER, PUBLIC, DIMENSION(jpncs) :: ncsi2, ncsj2 !: north-east closed sea limits (i,j) 42 INTEGER, PUBLIC, DIMENSION(jpncs) :: ncsnr !: number of point where run-off pours 43 INTEGER, PUBLIC, DIMENSION(jpncs,4) :: ncsir, ncsjr !: Location of runoff 44 45 REAL(wp), DIMENSION (jpncs+1) :: surf ! closed sea surface 44 46 45 47 !! * Substitutions 46 48 # include "vectopt_loop_substitute.h90" 47 49 !!---------------------------------------------------------------------- 48 !! OPA 9.0 , LOCEAN-IPSL (200 5)50 !! OPA 9.0 , LOCEAN-IPSL (2006) 49 51 !! $Id$ 50 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt52 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 51 53 !!---------------------------------------------------------------------- 52 54 … … 60 62 !! 61 63 !! ** Method : if a closed sea is located only in a model grid point 62 !! just the thermodynamic processes are applied. 63 !! 64 !! ** Action : ncsi1(), ncsj1() : south-west closed sea limits (i,j) 65 !! ncsi2(), ncsj2() : north-east Closed sea limits (i,j) 66 !! ncsir(), ncsjr() : Location of runoff 67 !! ncsnr : number of point where run-off pours 68 !! ncstt : Type of closed sea 69 !! =0 spread over the world ocean 70 !! =2 put at location runoff 71 !! 72 !! History : 73 !! ! 01-04 (E. Durand) Original code 74 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module 75 !!---------------------------------------------------------------------- 76 !! * Local variables 64 !! just the thermodynamic processes are applied. 65 !! 66 !! ** Action : ncsi1(), ncsj1() : south-west closed sea limits (i,j) 67 !! ncsi2(), ncsj2() : north-east Closed sea limits (i,j) 68 !! ncsir(), ncsjr() : Location of runoff 69 !! ncsnr : number of point where run-off pours 70 !! ncstt : Type of closed sea 71 !! =0 spread over the world ocean 72 !! =2 put at location runoff 73 !!---------------------------------------------------------------------- 77 74 INTEGER :: jc ! dummy loop indices 78 75 !!---------------------------------------------------------------------- … … 90 87 91 88 IF( cp_cfg == "orca" ) THEN 92 89 ! 93 90 SELECT CASE ( jp_cfg ) 94 91 ! ! ======================= 95 92 CASE ( 2 ) ! ORCA_R2 configuration 96 93 ! ! ======================= 97 98 94 ! ! Caspian Sea 99 95 ncsnr(1) = 1 ; ncstt(1) = 0 ! spread over the globe … … 116 112 ncsi2(4) = 6 ; ncsj2(4) = 112 117 113 ncsir(4,1) = 171 ; ncsjr(4,1) = 106 118 119 114 ! ! ======================= 120 115 CASE ( 4 ) ! ORCA_R4 configuration 121 116 ! ! ======================= 122 123 117 ! ! Caspian Sea 124 118 ncsnr(1) = 1 ; ncstt(1) = 0 … … 144 138 ncsi2(4) = 76 ; ncsj2(4) = 61 145 139 ncsir(4,1) = 84 ; ncsjr(4,1) = 59 146 147 140 ! ! ======================= 148 141 CASE ( 025 ) ! ORCA_R025 configuration … … 157 150 ncsi2(2) = 1304 ; ncsj2(2) = 747 158 151 ncsir(2,1) = 1 ; ncsjr(2,1) = 1 159 152 ! 160 153 END SELECT 161 154 ! 162 155 ENDIF 163 156 … … 171 164 ncsj2(jc) = mj1( ncsj2(jc) ) 172 165 END DO 173 174 166 ! 175 167 END SUBROUTINE dom_clo 176 168 177 169 178 SUBROUTINE flx_clo( kt )179 !!--------------------------------------------------------------------- 180 !! *** ROUTINE flx_clo ***170 SUBROUTINE sbc_clo( kt ) 171 !!--------------------------------------------------------------------- 172 !! *** ROUTINE sbc_clo *** 181 173 !! 182 174 !! ** Purpose : Special handling of closed seas … … 186 178 !! put as run-off in open ocean. 187 179 !! 188 !! ** Action : 189 !! 190 !! History : 191 !! 8.2 ! 00-05 (O. Marti) Original code 192 !! 8.5 ! 02-07 (G. Madec) Free form, F90 193 !!---------------------------------------------------------------------- 194 !! * Arguments 195 INTEGER, INTENT (in) :: kt 196 197 !! * Local declarations 198 REAL(wp), DIMENSION (jpncs) :: zemp 199 INTEGER :: ji, jj, jc, jn 200 REAL(wp) :: zze2 201 !!---------------------------------------------------------------------- 202 203 ! 1 - Initialisation 204 ! ------------------ 205 206 IF( kt == nit000 ) THEN 180 !! ** Action : emp, emps updated surface freshwater fluxes at kt 181 !!---------------------------------------------------------------------- 182 INTEGER, INTENT(in) :: kt ! ocean model time step 183 ! 184 INTEGER :: ji, jj, jc, jn ! dummy loop indices 185 REAL(wp) :: zze2 186 REAL(wp), DIMENSION (jpncs) :: zemp 187 !!---------------------------------------------------------------------- 188 ! 189 ! !------------------! 190 IF( kt == nit000 ) THEN ! Initialisation ! 191 ! !------------------! 207 192 IF(lwp) WRITE(numout,*) 208 IF(lwp) WRITE(numout,*)' flx_clo : closed seas '193 IF(lwp) WRITE(numout,*)'sbc_clo : closed seas ' 209 194 IF(lwp) WRITE(numout,*)'~~~~~~~' 210 195 … … 216 201 DO jj = ncsj1(jc), ncsj2(jc) 217 202 DO ji = ncsi1(jc), ncsi2(jc) 218 ! surface of closed seas 219 surf(jc) = surf(jc) + e1t(ji,jj)*e2t(ji,jj)*tmask_i(ji,jj) 220 ! upstream in closed seas 221 upsadv(ji,jj) = 0.5 203 surf(jc) = surf(jc) + e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) ! surface of closed seas 222 204 END DO 223 205 END DO 224 ! upstream at closed sea outflow225 IF( ncstt(jc) >= 1 ) THEN226 DO jn = 1, 4227 ji = mi0( ncsir(jc,jn) )228 jj = mj0( ncsjr(jc,jn) )229 upsrnfh(ji,jj) = MAX( upsrnfh(ji,jj), 1.0 )230 END DO231 ENDIF232 206 END DO 233 207 IF( lk_mpp ) CALL mpp_sum ( surf, jpncs+1 ) ! mpp: sum over all the global domain … … 235 209 IF(lwp) WRITE(numout,*)' Closed sea surfaces' 236 210 DO jc = 1, jpncs 237 IF(lwp) WRITE(numout,FMT='(1I3,4I4,5X,F16.2)') & 238 jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc) 211 IF(lwp)WRITE(numout,FMT='(1I3,4I4,5X,F16.2)') jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc) 239 212 END DO 240 213 … … 243 216 surf(jpncs+1) = surf(jpncs+1) - surf(jc) 244 217 END DO 245 218 ! 246 219 ENDIF 247 248 ! 2 - Computation 249 ! --------------- 250 zemp = 0.e0 251 220 ! !--------------------! 221 ! ! update emp, emps ! 222 zemp = 0.e0 !--------------------! 252 223 DO jc = 1, jpncs 253 224 DO jj = ncsj1(jc), ncsj2(jc) … … 257 228 END DO 258 229 END DO 259 IF( lk_mpp ) CALL mpp_sum ( zemp , jpncs ) ! mpp: sum over all the global domain230 IF( lk_mpp ) CALL mpp_sum ( zemp(:) , jpncs ) ! mpp: sum over all the global domain 260 231 261 232 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! Black Sea case for ORCA_R2 configuration … … 266 237 267 238 DO jc = 1, jpncs 268 239 ! 269 240 IF( ncstt(jc) == 0 ) THEN 270 241 ! water/evap excess is shared by all open ocean … … 303 274 ENDIF 304 275 ENDIF 305 276 ! 306 277 DO jj = ncsj1(jc), ncsj2(jc) 307 278 DO ji = ncsi1(jc), ncsi2(jc) … … 310 281 END DO 311 282 END DO 312 283 ! 313 284 END DO 314 315 316 ! 5. Boundary condition on emp and emps 317 ! ------------------------------------- 285 ! 318 286 CALL lbc_lnk( emp , 'T', 1. ) 319 287 CALL lbc_lnk( emps, 'T', 1. ) 320 321 END SUBROUTINE flx_clo 288 ! 289 END SUBROUTINE sbc_clo 290 291 292 SUBROUTINE clo_rnf( p_rnfmsk ) 293 !!--------------------------------------------------------------------- 294 !! *** ROUTINE sbc_rnf *** 295 !! 296 !! ** Purpose : allow the treatment of closed sea outflow grid-points 297 !! to be the same as river mouth grid-points 298 !! 299 !! ** Method : set to 1 the runoff mask (mskrnf, see sbcrnf module) 300 !! at the closed sea outflow grid-point. 301 !! 302 !! ** Action : update (p_)mskrnf (set 1 at closed sea outflow) 303 !!---------------------------------------------------------------------- 304 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: p_rnfmsk ! river runoff mask (rnfmsk array) 305 ! 306 INTEGER :: jc, jn ! dummy loop indices 307 INTEGER :: ii, ij ! temporary integer 308 !!---------------------------------------------------------------------- 309 ! 310 DO jc = 1, jpncs 311 IF( ncstt(jc) >= 1 ) THEN ! runoff mask set to 1 at closed sea outflows 312 DO jn = 1, 4 313 ii = mi0( ncsir(jc,jn) ) 314 ij = mj0( ncsjr(jc,jn) ) 315 p_rnfmsk(ii,ij) = MAX( p_rnfmsk(ii,ij), 1.0 ) 316 END DO 317 ENDIF 318 END DO 319 ! 320 END SUBROUTINE clo_rnf 321 322 323 SUBROUTINE clo_ups( p_upsmsk ) 324 !!--------------------------------------------------------------------- 325 !! *** ROUTINE sbc_rnf *** 326 !! 327 !! ** Purpose : allow the treatment of closed sea outflow grid-points 328 !! to be the same as river mouth grid-points 329 !! 330 !! ** Method : set to 0.5 the upstream mask (upsmsk, see traadv_cen2 331 !! module) over the closed seas. 332 !! 333 !! ** Action : update (p_)upsmsk (set 0.5 over closed seas) 334 !!---------------------------------------------------------------------- 335 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: p_upsmsk ! upstream mask (upsmsk array) 336 ! 337 INTEGER :: jc, ji, jj ! dummy loop indices 338 !!---------------------------------------------------------------------- 339 ! 340 DO jc = 1, jpncs 341 DO jj = ncsj1(jc), ncsj2(jc) 342 DO ji = ncsi1(jc), ncsi2(jc) 343 p_upsmsk(ji,jj) = 0.5 ! mixed upstream/centered scheme over closed seas 344 END DO 345 END DO 346 END DO 347 ! 348 END SUBROUTINE clo_ups 349 350 351 SUBROUTINE clo_bat( pbat, kbat ) 352 !!--------------------------------------------------------------------- 353 !! *** ROUTINE clo_bat *** 354 !! 355 !! ** Purpose : suppress closed sea from the domain 356 !! 357 !! ** Method : set to 0 the meter and level bathymetry (given in 358 !! arguments) over the closed seas. 359 !! 360 !! ** Action : set pbat=0 and kbat=0 over closed seas 361 !!---------------------------------------------------------------------- 362 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pbat ! bathymetry in meters (bathy array) 363 INTEGER , DIMENSION(jpi,jpj), INTENT(inout) :: kbat ! bathymetry in levels (mbathy array) 364 ! 365 INTEGER :: jc, ji, jj ! dummy loop indices 366 !!---------------------------------------------------------------------- 367 ! 368 DO jc = 1, jpncs 369 DO jj = ncsj1(jc), ncsj2(jc) 370 DO ji = ncsi1(jc), ncsi2(jc) 371 pbat(ji,jj) = 0.e0 372 kbat(ji,jj) = 0 373 END DO 374 END DO 375 END DO 376 ! 377 END SUBROUTINE clo_bat 322 378 323 379 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
