Changeset 719 for trunk/NEMO/OPA_SRC/DOM/closea.F90
- Timestamp:
- 2007-10-16T16:59:56+02:00 (17 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/DOM/closea.F90 (modified) (16 diffs, 1 prop)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DOM/closea.F90
- Property svn:keywords changed from Id to Author Date Id Revision
r703 r719 2 2 !!====================================================================== 3 3 !! *** MODULE closea *** 4 !! Closed Seas : specific treatments associated with closed seas4 !! Closed Seas : 5 5 !!====================================================================== 6 !! History : 8.2 ! 00-05 (O. Marti) Original code7 !! 8.5 ! 02-06 (E. Durand, G. Madec) F908 !! 9.0 ! 06-07 (G. Madec) add clo_rnf, clo_ups, clo_bat9 !!----------------------------------------------------------------------10 6 11 7 !!---------------------------------------------------------------------- 12 8 !! dom_clo : modification of the ocean domain for closed seas cases 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) 9 !! flx_clo : Special handling of closed seas 17 10 !!---------------------------------------------------------------------- 11 !! * Modules used 18 12 USE oce ! dynamics and tracers 19 13 USE dom_oce ! ocean space and time domain 20 14 USE in_out_manager ! I/O manager 21 USE sbc_oce ! ocean surface boundary conditions 15 USE ocesbc ! ocean surface boundary conditions (fluxes) 16 USE flxrnf ! runoffs 22 17 USE lib_mpp ! distributed memory computing library 23 18 USE lbclnk ! ??? … … 26 21 PRIVATE 27 22 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 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 46 44 47 45 !! * Substitutions 48 46 # include "vectopt_loop_substitute.h90" 49 47 !!---------------------------------------------------------------------- 50 !! OPA 9.0 , LOCEAN-IPSL (200 6)51 !! $ Id$52 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)48 !! OPA 9.0 , LOCEAN-IPSL (2005) 49 !! $Header$ 50 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 53 51 !!---------------------------------------------------------------------- 54 52 … … 62 60 !! 63 61 !! ** Method : if a closed sea is located only in a model grid point 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 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 73 75 !!---------------------------------------------------------------------- 76 !! * Local variables 74 77 INTEGER :: jc ! dummy loop indices 75 78 !!---------------------------------------------------------------------- … … 87 90 88 91 IF( cp_cfg == "orca" ) THEN 89 !92 90 93 SELECT CASE ( jp_cfg ) 91 94 ! ! ======================= 92 95 CASE ( 2 ) ! ORCA_R2 configuration 93 96 ! ! ======================= 97 94 98 ! ! Caspian Sea 95 99 ncsnr(1) = 1 ; ncstt(1) = 0 ! spread over the globe … … 112 116 ncsi2(4) = 6 ; ncsj2(4) = 112 113 117 ncsir(4,1) = 171 ; ncsjr(4,1) = 106 118 114 119 ! ! ======================= 115 120 CASE ( 4 ) ! ORCA_R4 configuration 116 121 ! ! ======================= 122 117 123 ! ! Caspian Sea 118 124 ncsnr(1) = 1 ; ncstt(1) = 0 … … 138 144 ncsi2(4) = 76 ; ncsj2(4) = 61 139 145 ncsir(4,1) = 84 ; ncsjr(4,1) = 59 146 140 147 ! ! ======================= 141 148 CASE ( 025 ) ! ORCA_R025 configuration … … 150 157 ncsi2(2) = 1304 ; ncsj2(2) = 747 151 158 ncsir(2,1) = 1 ; ncsjr(2,1) = 1 152 ! 159 153 160 END SELECT 154 ! 161 155 162 ENDIF 156 163 … … 164 171 ncsj2(jc) = mj1( ncsj2(jc) ) 165 172 END DO 166 ! 173 174 167 175 END SUBROUTINE dom_clo 168 176 169 177 170 SUBROUTINE sbc_clo( kt )178 SUBROUTINE flx_clo( kt ) 171 179 !!--------------------------------------------------------------------- 172 !! *** ROUTINE sbc_clo ***180 !! *** ROUTINE flx_clo *** 173 181 !! 174 182 !! ** Purpose : Special handling of closed seas … … 178 186 !! put as run-off in open ocean. 179 187 !! 180 !! ** Action : emp, emps updated surface freshwater fluxes at kt 188 !! ** Action : 189 !! 190 !! History : 191 !! 8.2 ! 00-05 (O. Marti) Original code 192 !! 8.5 ! 02-07 (G. Madec) Free form, F90 181 193 !!---------------------------------------------------------------------- 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 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 187 201 !!---------------------------------------------------------------------- 188 ! 189 ! !------------------! 190 IF( kt == nit000 ) THEN ! Initialisation ! 191 ! !------------------! 202 203 ! 1 - Initialisation 204 ! ------------------ 205 206 IF( kt == nit000 ) THEN 192 207 IF(lwp) WRITE(numout,*) 193 IF(lwp) WRITE(numout,*)' sbc_clo : closed seas '208 IF(lwp) WRITE(numout,*)'flx_clo : closed seas ' 194 209 IF(lwp) WRITE(numout,*)'~~~~~~~' 195 210 … … 201 216 DO jj = ncsj1(jc), ncsj2(jc) 202 217 DO ji = ncsi1(jc), ncsi2(jc) 203 surf(jc) = surf(jc) + e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) ! surface of closed seas 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 204 222 END DO 205 223 END DO 224 ! upstream at closed sea outflow 225 IF( ncstt(jc) >= 1 ) THEN 226 DO jn = 1, 4 227 ji = mi0( ncsir(jc,jn) ) 228 jj = mj0( ncsjr(jc,jn) ) 229 upsrnfh(ji,jj) = MAX( upsrnfh(ji,jj), 1.0 ) 230 END DO 231 ENDIF 206 232 END DO 207 233 IF( lk_mpp ) CALL mpp_sum ( surf, jpncs+1 ) ! mpp: sum over all the global domain … … 209 235 IF(lwp) WRITE(numout,*)' Closed sea surfaces' 210 236 DO jc = 1, jpncs 211 IF(lwp)WRITE(numout,FMT='(1I3,4I4,5X,F16.2)') jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc) 237 IF(lwp) WRITE(numout,FMT='(1I3,4I4,5X,F16.2)') & 238 jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc) 212 239 END DO 213 240 … … 216 243 surf(jpncs+1) = surf(jpncs+1) - surf(jc) 217 244 END DO 218 !245 219 246 ENDIF 220 ! !--------------------! 221 ! ! update emp, emps ! 222 zemp = 0.e0 !--------------------! 247 248 ! 2 - Computation 249 ! --------------- 250 zemp = 0.e0 251 223 252 DO jc = 1, jpncs 224 253 DO jj = ncsj1(jc), ncsj2(jc) … … 228 257 END DO 229 258 END DO 230 IF( lk_mpp ) CALL mpp_sum ( zemp (:), jpncs ) ! mpp: sum over all the global domain259 IF( lk_mpp ) CALL mpp_sum ( zemp , jpncs ) ! mpp: sum over all the global domain 231 260 232 261 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! Black Sea case for ORCA_R2 configuration … … 237 266 238 267 DO jc = 1, jpncs 239 ! 268 240 269 IF( ncstt(jc) == 0 ) THEN 241 270 ! water/evap excess is shared by all open ocean … … 274 303 ENDIF 275 304 ENDIF 276 ! 305 277 306 DO jj = ncsj1(jc), ncsj2(jc) 278 307 DO ji = ncsi1(jc), ncsi2(jc) … … 281 310 END DO 282 311 END DO 283 ! 312 284 313 END DO 285 ! 314 315 316 ! 5. Boundary condition on emp and emps 317 ! ------------------------------------- 286 318 CALL lbc_lnk( emp , 'T', 1. ) 287 319 CALL lbc_lnk( emps, 'T', 1. ) 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 320 321 END SUBROUTINE flx_clo 378 322 379 323 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
