Changeset 1566 for trunk/NEMO/OPA_SRC/DOM/dommsk.F90
- Timestamp:
- 2009-07-31T16:34:08+02:00 (15 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/DOM/dommsk.F90 (modified) (21 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DOM/dommsk.F90
r1528 r1566 1 1 MODULE dommsk 2 !!====================================================================== ========2 !!====================================================================== 3 3 !! *** MODULE dommsk *** 4 4 !! Ocean initialization : domain land/sea mask 5 !!============================================================================== 5 !!====================================================================== 6 !! History : OPA ! 1987-07 (G. Madec) Original code 7 !! - ! 1993-03 (M. Guyon) symetrical conditions (M. Guyon) 8 !! - ! 1996-01 (G. Madec) suppression of common work arrays 9 !! - ! 1996-05 (G. Madec) mask computed from tmask and sup- 10 !! ! pression of the double computation of bmask 11 !! - ! 1997-02 (G. Madec) mesh information put in domhgr.F 12 !! - ! 1997-07 (G. Madec) modification of mbathy and fmask 13 !! - ! 1998-05 (G. Roullet) free surface 14 !! - ! 2000-03 (G. Madec) no slip accurate 15 !! - ! 2001-09 (J.-M. Molines) Open boundaries 16 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module 17 !! - ! 2005-11 (V. Garnier) Surface pressure gradient organization 18 !! 3.2 ! 2009-07 (R. Benshila) Suppression of rigid-lid option 19 !!---------------------------------------------------------------------- 6 20 7 21 !!---------------------------------------------------------------------- 8 22 !! dom_msk : compute land/ocean mask 9 !! dom_msk_nsa : update land/ocean mask when no-slip accurate 10 !! option is used. 11 !!---------------------------------------------------------------------- 12 !! * Modules used 23 !! dom_msk_nsa : update land/ocean mask when no-slip accurate option is used. 24 !!---------------------------------------------------------------------- 13 25 USE oce ! ocean dynamics and tracers 14 26 USE dom_oce ! ocean space and time domain … … 22 34 PRIVATE 23 35 24 !! * Routine accessibility 25 PUBLIC dom_msk ! routine called by inidom.F90 26 27 !! * Module variables 28 REAL(wp) :: & 29 shlat = 2. ! type of lateral boundary condition on velocity (namelist namlbc) 36 PUBLIC dom_msk ! routine called by inidom.F90 37 38 REAL(wp) :: shlat = 2. ! type of lateral boundary condition on velocity (namelist namlbc) 30 39 31 40 !! * Substitutions 32 41 # include "vectopt_loop_substitute.h90" 33 !!---------------------------------------------------------------------- -----------34 !! OPA 9.0 , LOCEAN-IPSL (2005)42 !!---------------------------------------------------------------------- 43 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) 35 44 !! $Id$ 36 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt37 !!---------------------------------------------------------------------- -----------45 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 46 !!---------------------------------------------------------------------- 38 47 39 48 CONTAINS … … 93 102 !! (note that the minimum value of mbathy is 2). 94 103 !! 95 !! ** Action : 96 !! tmask : land/ocean mask at t-point (=0. or 1.) 97 !! umask : land/ocean mask at u-point (=0. or 1.) 98 !! vmask : land/ocean mask at v-point (=0. or 1.) 99 !! fmask : land/ocean mask at f-point (=0. or 1.) 104 !! ** Action : tmask : land/ocean mask at t-point (=0. or 1.) 105 !! umask : land/ocean mask at u-point (=0. or 1.) 106 !! vmask : land/ocean mask at v-point (=0. or 1.) 107 !! fmask : land/ocean mask at f-point (=0. or 1.) 100 108 !! =shlat along lateral boundaries 101 !! bmask : land/ocean mask at barotropic stream 102 !! function point (=0. or 1.) and set to 103 !! 0 along lateral boundaries 104 !! mbathy : number of non-zero w-levels 105 !! 106 !! History : 107 !! ! 87-07 (G. Madec) Original code 108 !! ! 91-12 (G. Madec) 109 !! ! 92-06 (M. Imbard) 110 !! ! 93-03 (M. Guyon) symetrical conditions (M. Guyon) 111 !! ! 96-01 (G. Madec) suppression of common work arrays 112 !! ! 96-05 (G. Madec) mask computed from tmask and sup- 113 !! pression of the double computation of bmask 114 !! ! 97-02 (G. Madec) mesh information put in domhgr.F 115 !! ! 97-07 (G. Madec) modification of mbathy and fmask 116 !! ! 98-05 (G. Roullet) free surface 117 !! ! 00-03 (G. Madec) no slip accurate 118 !! ! 01-09 (J.-M. Molines) Open boundaries 119 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 120 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 109 !! bmask : land/ocean mask at barotropic stream 110 !! function point (=0. or 1.) and set to 0 along lateral boundaries 111 !! mbathy : number of non-zero w-levels 121 112 !!---------------------------------------------------------------------- 122 113 INTEGER :: ji, jj, jk ! dummy loop indices … … 129 120 !!--------------------------------------------------------------------- 130 121 131 ! Namelist namlbc : lateral momentum boundary condition 132 REWIND( numnam ) 122 REWIND( numnam ) ! Namelist namlbc : lateral momentum boundary condition 133 123 READ ( numnam, namlbc ) 134 IF(lwp) THEN 124 125 IF(lwp) THEN ! control print 135 126 WRITE(numout,*) 136 127 WRITE(numout,*) 'dommsk : ocean mask ' 137 128 WRITE(numout,*) '~~~~~~' 138 WRITE(numout,*) ' Namelist namlbc' 139 WRITE(numout,*) ' lateral momentum boundary cond. shlat = ',shlat 140 ENDIF 141 142 IF ( shlat == 0. ) THEN 143 IF(lwp) WRITE(numout,*) ' ocean lateral free-slip ' 144 ELSEIF ( shlat == 2. ) THEN 145 IF(lwp) WRITE(numout,*) ' ocean lateral no-slip ' 146 ELSEIF ( 0. < shlat .AND. shlat < 2. ) THEN 147 IF(lwp) WRITE(numout,*) ' ocean lateral partial-slip ' 148 ELSEIF ( 2. < shlat ) THEN 149 IF(lwp) WRITE(numout,*) ' ocean lateral strong-slip ' 129 WRITE(numout,*) ' Namelist namlbc' 130 WRITE(numout,*) ' lateral momentum boundary cond. shlat = ',shlat 131 ENDIF 132 133 IF( shlat == 0. ) THEN ; IF(lwp) WRITE(numout,*) ' ocean lateral free-slip ' 134 ELSEIF ( shlat == 2. ) THEN ; IF(lwp) WRITE(numout,*) ' ocean lateral no-slip ' 135 ELSEIF ( 0. < shlat .AND. shlat < 2. ) THEN ; IF(lwp) WRITE(numout,*) ' ocean lateral partial-slip ' 136 ELSEIF ( 2. < shlat ) THEN ; IF(lwp) WRITE(numout,*) ' ocean lateral strong-slip ' 150 137 ELSE 151 138 WRITE(ctmp1,*) ' shlat is negative = ', shlat … … 155 142 ! 1. Ocean/land mask at t-point (computed from mbathy) 156 143 ! ----------------------------- 157 ! Tmask has already the right boundary conditions since mbathy is ok158 144 ! N.B. tmask has already the right boundary conditions since mbathy is ok 145 ! 159 146 tmask(:,:,:) = 0.e0 160 147 DO jk = 1, jpk 161 148 DO jj = 1, jpj 162 149 DO ji = 1, jpi 163 IF( FLOAT( mbathy(ji,jj)-jk )+.1 >= 0.e0 ) tmask(ji,jj,jk) = 1.e0150 IF( REAL( mbathy(ji,jj) - jk ) +.1 >= 0.e0 ) tmask(ji,jj,jk) = 1.e0 164 151 END DO 165 152 END DO 166 153 END DO 167 154 155 !!gm ???? 168 156 #if defined key_zdfkpp 169 157 IF( cp_cfg == 'orca' ) THEN … … 184 172 ENDIF 185 173 #endif 174 !!gm end 186 175 187 176 ! Interior domain mask (used for global sum) 188 177 ! -------------------- 189 190 178 tmask_i(:,:) = tmask(:,:,1) 191 179 iif = jpreci ! ??? … … 200 188 201 189 ! north fold mask 190 ! --------------- 202 191 tpol(1:jpiglo) = 1.e0 203 192 fpol(1:jpiglo) = 1.e0 … … 205 194 tpol(jpiglo/2+1:jpiglo) = 0.e0 206 195 fpol( 1 :jpiglo) = 0.e0 207 ! T-point pivot: only half of the nlcj-1 row 208 IF( mjg(nlej) == jpjglo ) THEN 196 IF( mjg(nlej) == jpjglo ) THEN ! only half of the nlcj-1 row 209 197 DO ji = iif+1, iil-1 210 198 tmask_i(ji,nlej-1) = tmask_i(ji,nlej-1) * tpol(mig(ji)) … … 219 207 ! 2. Ocean/land mask at u-, v-, and z-points (computed from tmask) 220 208 ! ------------------------------------------- 221 222 ! Computation223 209 DO jk = 1, jpk 224 210 DO jj = 1, jpjm1 … … 233 219 END DO 234 220 END DO 235 236 ! Lateral boundary conditions 237 CALL lbc_lnk( umask, 'U', 1. ) 221 CALL lbc_lnk( umask, 'U', 1. ) ! Lateral boundary conditions 238 222 CALL lbc_lnk( vmask, 'V', 1. ) 239 223 CALL lbc_lnk( fmask, 'F', 1. ) … … 242 226 ! 4. ocean/land mask for the elliptic equation 243 227 ! -------------------------------------------- 244 245 ! Computation246 228 bmask(:,:) = tmask(:,:,1) ! elliptic equation is written at t-point 247 248 ! Boundary conditions249 ! cyclic east-west : bmask must be set to 0. on rows 1 and jpi229 ! 230 ! ! Boundary conditions 231 ! ! cyclic east-west : bmask must be set to 0. on rows 1 and jpi 250 232 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN 251 233 bmask( 1 ,:) = 0.e0 252 234 bmask(jpi,:) = 0.e0 253 235 ENDIF 254 255 ! south symmetric : bmask must be set to 0. on row 1 256 IF( nperio == 2 ) THEN 236 IF( nperio == 2 ) THEN ! south symmetric : bmask must be set to 0. on row 1 257 237 bmask(:, 1 ) = 0.e0 258 238 ENDIF 259 260 ! north fold : 261 IF( nperio == 3 .OR. nperio == 4 ) THEN 262 ! T-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj and on half jpjglo-1 row 263 DO ji = 1, jpi 239 ! ! north fold : 240 IF( nperio == 3 .OR. nperio == 4 ) THEN ! T-pt pivot : bmask set to 0. on row jpj and on half jpjglo-1 row 241 DO ji = 1, jpi 264 242 ii = ji + nimpp - 1 265 243 bmask(ji,jpj-1) = bmask(ji,jpj-1) * tpol(ii) … … 267 245 END DO 268 246 ENDIF 269 IF( nperio == 5 .OR. nperio == 6 ) THEN 270 ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj 247 IF( nperio == 5 .OR. nperio == 6 ) THEN ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj 271 248 bmask(:,jpj) = 0.e0 272 249 ENDIF 273 274 ! Mpp boundary conditions: bmask is set to zero on the overlap 275 ! region for all elliptic solvers 276 277 IF( lk_mpp ) THEN 250 ! 251 IF( lk_mpp ) THEN ! mpp specificities 252 ! ! bmask is set to zero on the overlap region 278 253 IF( nbondi /= -1 .AND. nbondi /= 2 ) bmask( 1 :jpreci,:) = 0.e0 279 254 IF( nbondi /= 1 .AND. nbondi /= 2 ) bmask(nlci:jpi ,:) = 0.e0 280 255 IF( nbondj /= -1 .AND. nbondj /= 2 ) bmask(:, 1 :jprecj) = 0.e0 281 256 IF( nbondj /= 1 .AND. nbondj /= 2 ) bmask(:,nlcj:jpj ) = 0.e0 282 283 ! north fold : bmask must be set to 0. on rows jpj-1 and jpj 284 IF( npolj == 3 .OR. npolj == 4 ) THEN 257 ! 258 IF( npolj == 3 .OR. npolj == 4 ) THEN ! north fold : bmask must be set to 0. on rows jpj-1 and jpj 285 259 DO ji = 1, nlci 286 260 ii = ji + nimpp - 1 … … 289 263 END DO 290 264 ENDIF 291 IF( npolj == 5 .OR. npolj == 6 ) THEN 265 IF( npolj == 5 .OR. npolj == 6 ) THEN ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj 292 266 DO ji = 1, nlci 293 267 bmask(ji,nlcj ) = 0.e0 … … 299 273 ! mask for second order calculation of vorticity 300 274 ! ---------------------------------------------- 301 302 275 CALL dom_msk_nsa 303 276 304 277 305 278 ! Lateral boundary conditions on velocity (modify fmask) 306 ! --------------------------------------- 307 279 ! --------------------------------------- 308 280 DO jk = 1, jpk 309 310 zwf(:,:) = fmask(:,:,jk) 311 281 zwf(:,:) = fmask(:,:,jk) 312 282 DO jj = 2, jpjm1 313 283 DO ji = fs_2, fs_jpim1 ! vector opt. … … 318 288 END DO 319 289 END DO 320 321 290 DO jj = 2, jpjm1 322 291 IF( fmask(1,jj,jk) == 0. ) THEN … … 326 295 fmask(jpi,jj,jk) = shlat * MIN( 1., MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 327 296 ENDIF 328 END DO 329 297 END DO 330 298 DO ji = 2, jpim1 331 299 IF( fmask(ji,1,jk) == 0. ) THEN … … 337 305 END DO 338 306 END DO 339 340 341 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 342 ! ! ======================= 343 ! Increased lateral friction in ! ORCA_R2 configuration 344 ! the vicinity of some straits ! ======================= 345 ! 307 ! 308 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA_R2 configuration 309 ! ! Increased lateral friction near of some straits 346 310 IF( n_cla == 0 ) THEN 347 311 ! ! Gibraltar strait : partial slip (fmask=0.5) … … 365 329 ! 366 330 ENDIF 367 368 ! Lateral boundary conditions on fmask369 CALL lbc_lnk( fmask, 'F', 1. ) 331 ! 332 CALL lbc_lnk( fmask, 'F', 1. ) ! Lateral boundary conditions on fmask 333 370 334 371 335 ! Mbathy set to the number of w-level (minimum value 2) … … 377 341 END DO 378 342 379 ! Control print 380 ! ------------- 381 IF( nprint == 1 .AND. lwp ) THEN 343 IF( nprint == 1 .AND. lwp ) THEN ! Control print 382 344 imsk(:,:) = INT( tmask_i(:,:) ) 383 345 WRITE(numout,*) ' tmask_i : ' … … 423 385 & 1, jpj, 1, 1, numout ) 424 386 ENDIF 425 387 ! 426 388 END SUBROUTINE dom_msk 427 389 … … 441 403 !! ** Action : 442 404 !! 443 !! History :444 !! ! 00-03 (G. Madec) no slip accurate445 405 !!---------------------------------------------------------------------- 446 406 INTEGER :: ji, jj, jk, jl ! dummy loop indices 447 INTEGER :: ine, inw, ins, inn, itest, ierror, iind, ijnd 407 INTEGER :: ine, inw, ins, inn, itest, ierror, iind, ijnd 408 REAL(wp) :: zaa 448 409 INTEGER, DIMENSION(jpi*jpj*jpk,3) :: icoord 449 REAL(wp) :: zaa450 410 !!--------------------------------------------------------------------- 451 411
Note: See TracChangeset
for help on using the changeset viewer.
