Changeset 1566 for trunk/NEMO/OPA_SRC/DOM
- Timestamp:
- 2009-07-31T16:34:08+02:00 (15 years ago)
- Location:
- trunk/NEMO/OPA_SRC/DOM
- Files:
-
- 4 edited
-
domcfg.F90 (modified) (9 diffs)
-
dommsk.F90 (modified) (21 diffs)
-
domvvl.F90 (modified) (7 diffs)
-
domzgr.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DOM/domcfg.F90
r1528 r1566 4 4 !! Ocean initialization : domain configuration initialization 5 5 !!============================================================================== 6 !! History : 1.0 ! 2003-09 (G. Madec) Original code 7 !! 3.2 ! 2009-07 (R. Benshila) Suppression of rigid-lid option 8 !!---------------------------------------------------------------------- 6 9 7 10 !!---------------------------------------------------------------------- 8 11 !! dom_cfg : initialize the domain configuration 9 12 !!---------------------------------------------------------------------- 10 !! * Modules used11 13 USE dom_oce ! ocean space and time domain 12 14 USE phycst ! physical constants … … 17 19 PRIVATE 18 20 19 !! * Routine accessibility20 PUBLIC dom_cfg ! called by opa.F90 21 PUBLIC dom_cfg ! called by opa.F90 22 21 23 !!---------------------------------------------------------------------- 22 !! OPA 9.0 , LOCEAN-IPSL (2005)24 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) 23 25 !! $Id$ 24 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt26 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 25 27 !!---------------------------------------------------------------------- 26 28 … … 33 35 !! ** Purpose : set the domain configuration 34 36 !! 35 !! ** Method :36 !!37 !! History :38 !! 9.0 ! 03-09 (G. Madec) Original code39 !!----------------------------------------------------------------------40 !! * Local declarations41 37 !!---------------------------------------------------------------------- 42 38 43 IF(lwp) THEN 39 IF(lwp) THEN ! Control print 44 40 WRITE(numout,*) 45 41 WRITE(numout,*) 'dom_cfg : set the ocean configuration' 46 WRITE(numout,*) '~~~~~~~ ocean model configuration used :', & 47 & ' cp_cfg = ', cp_cfg, ' jp_cfg = ', jp_cfg 42 WRITE(numout,*) '~~~~~~~ ' 43 WRITE(numout,*) ' ocean model configuration used : cp_cfg = ', cp_cfg, ' jp_cfg = ', jp_cfg 44 ! 45 WRITE(numout,*) ' global domain lateral boundaries' 46 ! 47 IF( jperio == 0 ) WRITE(numout,*) ' jperio= 0, closed' 48 IF( jperio == 1 ) WRITE(numout,*) ' jperio= 1, cyclic east-west' 49 IF( jperio == 2 ) WRITE(numout,*) ' jperio= 2, equatorial symmetric' 50 IF( jperio == 3 ) WRITE(numout,*) ' jperio= 3, north fold with T-point pivot' 51 IF( jperio == 4 ) WRITE(numout,*) ' jperio= 4, cyclic east-west and north fold with T-point pivot' 52 IF( jperio == 5 ) WRITE(numout,*) ' jperio= 5, north fold with F-point pivot' 53 IF( jperio == 6 ) WRITE(numout,*) ' jperio= 6, cyclic east-west and north fold with F-point pivot' 48 54 ENDIF 49 50 ! Global domain boundary conditions 51 ! --------------------------------- 52 IF(lwp) THEN 53 WRITE(numout,*) ' global domain lateral boundaries' 54 55 IF( jperio == 0 ) WRITE(numout,*) ' jperio= 0, closed' 56 IF( jperio == 1 ) WRITE(numout,*) ' jperio= 1, cyclic east-west' 57 IF( jperio == 2 ) WRITE(numout,*) ' jperio= 2, equatorial symmetric' 58 IF( jperio == 3 ) WRITE(numout,*) ' jperio= 3, north fold with T-point pivot' 59 IF( jperio == 4 ) WRITE(numout,*) ' jperio= 4, cyclic east-west and', & 60 ' north fold with T-point pivot' 61 IF( jperio == 5 ) WRITE(numout,*) ' jperio= 5, north fold with F-point pivot' 62 IF( jperio == 6 ) WRITE(numout,*) ' jperio= 6, cyclic east-west and', & 63 ' north fold with F-point pivot' 64 ENDIF 65 IF( jperio < 0 .OR. jperio > 6 ) CALL ctl_stop( 'jperio is out of range' ) 66 67 ! global domain versus zoom and/or local domain 68 ! --------------------------------------------- 69 70 CALL dom_glo 71 55 ! 56 IF( jperio < 0 .OR. jperio > 6 ) CALL ctl_stop( 'jperio is out of range' ) 57 ! 58 CALL dom_glo ! global domain versus zoom and/or local domain 59 ! 72 60 END SUBROUTINE dom_cfg 73 61 … … 84 72 !! - mi0 , mi1 : 85 73 !! - mj0, , mj1 : 86 !!87 !! History :88 !! 8.5 ! 02-08 (G. Madec) Original code89 74 !!---------------------------------------------------------------------- 90 !! * Local declarations 91 INTEGER :: ji, jj ! dummy loop argument 75 INTEGER :: ji, jj ! dummy loop argument 92 76 !!---------------------------------------------------------------------- 93 77 94 ! Local domain 95 ! ============ 96 97 ! local domain indices ==> data domain indices 98 DO ji = 1, jpi 78 ! ! ============== ! 79 ! ! Local domain ! 80 ! ! ============== ! 81 DO ji = 1, jpi ! local domain indices ==> data domain indices 99 82 mig(ji) = ji + jpizoom - 1 + nimpp - 1 100 83 END DO … … 102 85 mjg(jj) = jj + jpjzoom - 1 + njmpp - 1 103 86 END DO 104 105 ! data domain indices ==> local domain indices106 ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the107 ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.87 ! 88 ! ! data domain indices ==> local domain indices 89 ! ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 90 ! !local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. 108 91 DO ji = 1, jpidta 109 92 mi0(ji) = MAX( 1, MIN( ji - jpizoom + 1 - nimpp + 1, jpi+1 ) ) … … 115 98 END DO 116 99 117 IF(lwp) THEN 100 IF(lwp) THEN ! control print 118 101 WRITE(numout,*) 119 102 WRITE(numout,*) 'dom_glo : domain: data / local ' … … 149 132 25 FORMAT( 100(10x,19i4,/) ) 150 133 151 ! Zoom domain152 ! ===========153 154 ! zoom control134 ! ! ============== ! 135 ! ! Zoom domain ! 136 ! ! ============== ! 137 ! ! zoom control 155 138 IF( jpiglo + jpizoom - 1 > jpidta .OR. & 156 139 jpjglo + jpjzoom - 1 > jpjdta ) & 157 140 & CALL ctl_stop( ' global or zoom domain exceed the data domain ! ' ) 158 141 159 ! set zoom flag160 IF 142 ! ! set zoom flag 143 IF( jpiglo < jpidta .OR. jpjglo < jpjdta ) lzoom = .TRUE. 161 144 162 ! set zoom type flags145 ! ! set zoom type flags 163 146 IF( lzoom .AND. jpizoom /= 1 ) lzoom_w = .TRUE. ! 164 147 IF( lzoom .AND. jpjzoom /= 1 ) lzoom_s = .TRUE. … … 180 163 & CALL ctl_stop( ' Your zoom choice is inconsistent with North fold boundary condition' ) 181 164 182 ! Pre-defined arctic/antarctic zoom of ORCA configuration flag165 ! ! Pre-defined arctic/antarctic zoom of ORCA configuration flag 183 166 IF( cp_cfg == "orca" ) THEN 184 167 SELECT CASE ( jp_cfg ) 185 ! ! =======================186 168 CASE ( 2 ) ! ORCA_R2 configuration 187 ! ! =======================188 169 IF( jpiglo == 142 .AND. jpjglo == 53 .AND. & 189 170 & jpizoom == 21 .AND. jpjzoom == 97 ) lzoom_arct = .TRUE. 190 171 IF( jpiglo == jpidta .AND. jpjglo == 50 .AND. & 191 172 & jpizoom == 1 .AND. jpjzoom == 1 ) lzoom_anta = .TRUE. 192 ! ! =======================173 ! 193 174 CASE ( 05 ) ! ORCA_R05 configuration 194 ! ! =======================195 175 IF( jpiglo == 562 .AND. jpjglo == 202 .AND. & 196 176 & jpizoom == 81 .AND. jpjzoom == 301 ) lzoom_arct = .TRUE. … … 204 184 ! 205 185 ENDIF 206 186 ! 207 187 END SUBROUTINE dom_glo 208 188 -
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 -
trunk/NEMO/OPA_SRC/DOM/domvvl.F90
r1528 r1566 24 24 PRIVATE 25 25 26 PUBLIC dom_vvl! called by domain.F9026 PUBLIC dom_vvl ! called by domain.F90 27 27 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ee_t, ee_u, ee_v, ee_f !: ??? 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ee_t, ee_u, ee_v, ee_f !: ??? 29 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: mut, muu, muv, muf !: ??? 29 30 30 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: mut, muu, muv, muf !: ??? 31 32 REAL(wp), DIMENSION(jpk) :: r2dt ! vertical profile time-step, = 2 rdttra 33 ! ! except at nit000 (=rdttra) if neuler=0 31 REAL(wp), DIMENSION(jpk) :: r2dt ! vertical profile time-step, = 2 rdttra 32 ! ! except at nit000 (=rdttra) if neuler=0 34 33 35 34 !! * Substitutions … … 50 49 !! ** Purpose : compute coefficients muX at T-U-V-F points to spread 51 50 !! ssh over the whole water column (scale factors) 52 !!53 51 !!---------------------------------------------------------------------- 54 52 INTEGER :: ji, jj, jk … … 62 60 ENDIF 63 61 64 #if defined key_zco 65 CALL ctl_stop( 'dom_vvl_ini : options key_zco is incompatible with variable volume option key_vvl') 66 #endif 62 IF( lk_zco ) CALL ctl_stop( 'dom_vvl : key_zco is incompatible with variable volume option key_vvl') 67 63 68 64 fsdept(:,:,:) = gdept (:,:,:) … … 77 73 fse3vw(:,:,:) = e3vw (:,:,:) 78 74 79 ! mu computation 80 ! -------------- 81 ! define ee_t, u, v and f as in sigma coordinate (ee_t = 1/ht, ...) 82 ee_t(:,:) = fse3t_0(:,:,1) ! Lower bound : thickness of the first model level 75 ! !== mu computation ==! 76 ee_t(:,:) = fse3t_0(:,:,1) ! Lower bound : thickness of the first model level 83 77 ee_u(:,:) = fse3u_0(:,:,1) 84 78 ee_v(:,:) = fse3v_0(:,:,1) 85 79 ee_f(:,:) = fse3f_0(:,:,1) 86 DO jk = 2, jpkm1 ! Sum of the masked vertical scale factors80 DO jk = 2, jpkm1 ! Sum of the masked vertical scale factors 87 81 ee_t(:,:) = ee_t(:,:) + fse3t_0(:,:,jk) * tmask(:,:,jk) 88 82 ee_u(:,:) = ee_u(:,:) + fse3u_0(:,:,jk) * umask(:,:,jk) … … 92 86 END DO 93 87 END DO 94 ! ! Compute and mask the inverse of the local depth at T, U, V and F points88 ! ! Compute and mask the inverse of the local depth at T, U, V and F points 95 89 ee_t(:,:) = 1. / ee_t(:,:) * tmask(:,:,1) 96 90 ee_u(:,:) = 1. / ee_u(:,:) * umask(:,:,1) 97 91 ee_v(:,:) = 1. / ee_v(:,:) * vmask(:,:,1) 98 DO jj = 1, jpjm1 ! f-point case fmask cannot be used92 DO jj = 1, jpjm1 ! f-point case fmask cannot be used 99 93 ee_f(:,jj) = 1. / ee_f(:,jj) * umask(:,jj,1) * umask(:,jj+1,1) 100 94 END DO 101 CALL lbc_lnk( ee_f, 'F', 1. ) ! lateral boundary condition on ee_f95 CALL lbc_lnk( ee_f, 'F', 1. ) ! lateral boundary condition on ee_f 102 96 ! 103 DO jk = 1, jpk 104 mut(:,:,jk) = ee_t(:,:) * tmask(:,:,jk) !at T levels105 muu(:,:,jk) = ee_u(:,:) * umask(:,:,jk) !at T levels106 muv(:,:,jk) = ee_v(:,:) * vmask(:,:,jk) !at T levels97 DO jk = 1, jpk ! mu coefficients 98 mut(:,:,jk) = ee_t(:,:) * tmask(:,:,jk) ! T-point at T levels 99 muu(:,:,jk) = ee_u(:,:) * umask(:,:,jk) ! U-point at T levels 100 muv(:,:,jk) = ee_v(:,:) * vmask(:,:,jk) ! V-point at T levels 107 101 END DO 108 DO jk = 1, jpk 109 DO jj = 1, jpjm1 ! f-point : fmask=shlat at coasts, use the product of umask102 DO jk = 1, jpk ! F-point : fmask=shlat at coasts, use the product of umask 103 DO jj = 1, jpjm1 110 104 muf(:,jj,jk) = ee_f(:,jj) * umask(:,jj,jk) * umask(:,jj+1,jk) ! at T levels 111 105 END DO 112 106 muf(:,jpj,jk) = 0.e0 113 107 END DO 114 CALL lbc_lnk( muf, 'F', 1. ) ! lateral boundary condition on ee_f108 CALL lbc_lnk( muf, 'F', 1. ) ! lateral boundary condition 115 109 116 110 117 ! Reference ocean depth at U- and V-points 118 hu_0(:,:) = 0.e0 111 hu_0(:,:) = 0.e0 ! Reference ocean depth at U- and V-points 119 112 hv_0(:,:) = 0.e0 120 113 DO jk = 1, jpk … … 123 116 END DO 124 117 125 ! before and now Sea Surface Height at u-, v-, f-points 126 DO jj = 1, jpjm1 118 DO jj = 1, jpjm1 ! initialise before and now Sea Surface Height at u-, v-, f-points 127 119 DO ji = 1, jpim1 128 120 zcoefu = 0.5 * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) ) … … 143 135 END DO 144 136 END DO 145 ! Boundaries conditions 146 CALL lbc_lnk( sshu_b, 'U', 1. ) ; CALL lbc_lnk( sshu_n, 'U', 1. ) 137 CALL lbc_lnk( sshu_b, 'U', 1. ) ; CALL lbc_lnk( sshu_n, 'U', 1. ) ! lateral boundary conditions 147 138 CALL lbc_lnk( sshv_b, 'V', 1. ) ; CALL lbc_lnk( sshv_n, 'V', 1. ) 148 139 CALL lbc_lnk( sshf_b, 'F', 1. ) ; CALL lbc_lnk( sshf_n, 'F', 1. ) -
trunk/NEMO/OPA_SRC/DOM/domzgr.F90
r1528 r1566 4 4 !! Ocean initialization : domain initialization 5 5 !!============================================================================== 6 !! History : OPA ! 1995-12 (G. Madec) Original code : s vertical coordinate 7 !! ! 1997-07 (G. Madec) lbc_lnk call 8 !! ! 1997-04 (J.-O. Beismann) 9 !! 8.5 ! 2002-09 (A. Bozec, G. Madec) F90: Free form and module 10 !! - ! 2002-09 (A. de Miranda) rigid-lid + islands 11 !! NEMO 1.0 ! 2003-08 (G. Madec) F90: Free form and module 12 !! - ! 2005-10 (A. Beckmann) modifications for hybrid s-ccordinates & new stretching function 13 !! 2.0 ! 2006-04 (R. Benshila, G. Madec) add zgr_zco 14 !! 3.0 ! 2008-06 (G. Madec) insertion of domzgr_zps.h90 & conding style 6 !! History : OPA ! 1995-12 (G. Madec) Original code : s vertical coordinate 7 !! ! 1997-07 (G. Madec) lbc_lnk call 8 !! ! 1997-04 (J.-O. Beismann) 9 !! 8.5 ! 2002-09 (A. Bozec, G. Madec) F90: Free form and module 10 !! - ! 2002-09 (A. de Miranda) rigid-lid + islands 11 !! NEMO 1.0 ! 2003-08 (G. Madec) F90: Free form and module 12 !! - ! 2005-10 (A. Beckmann) modifications for hybrid s-ccordinates & new stretching function 13 !! 2.0 ! 2006-04 (R. Benshila, G. Madec) add zgr_zco 14 !! 3.0 ! 2008-06 (G. Madec) insertion of domzgr_zps.h90 & conding style 15 !! 3.2 ! 2009-07 (R. Benshila) Suppression of rigid-lid option 15 16 !!---------------------------------------------------------------------- 16 17 … … 623 624 ENDIF 624 625 625 ! Set to zero mbathy over islands if necessary626 IF(lwp) WRITE(numout,*)627 IF(lwp) WRITE(numout,*) ' mbathy set to 0 over islands'628 IF(lwp) WRITE(numout,*) ' ----------------------------'629 !630 mbathy(:,:) = MAX( 0, mbathy(:,:) )631 !632 626 ! Boundary condition on mbathy 633 627 IF( .NOT.lk_mpp ) THEN … … 655 649 ENDIF 656 650 657 ! control print 658 IF( lwp .AND. nprint == 1 ) THEN 651 IF( lwp .AND. nprint == 1 ) THEN ! control print 659 652 WRITE(numout,*) 660 653 WRITE(numout,*) ' bathymetric field : number of non-zero T-levels ' … … 1027 1020 REAL(wp), INTENT(in ) :: bb ! Stretching coefficient 1028 1021 REAL(wp) :: pf1 ! sigma value 1029 1030 !!---------------------------------------------------------------------- 1031 ! 1032 IF ( theta == 0 ) then !uniform sigma 1033 pf1 = -(pk1-0.5)/REAL(jpkm1) 1034 ELSE ! stretched sigma 1022 !!---------------------------------------------------------------------- 1023 ! 1024 IF ( theta == 0 ) then ! uniform sigma 1025 pf1 = -(pk1-0.5) / REAL( jpkm1 ) 1026 ELSE ! stretched sigma 1035 1027 pf1 = (1.0-bb) * (sinh( theta*(-(pk1-0.5)/REAL(jpkm1)) ) ) / sinh(theta) + & 1036 1037 1038 ENDIF 1039 1028 & bb * ( (tanh( theta*( (-(pk1-0.5)/REAL(jpkm1)) + 0.5) ) - tanh(0.5*theta) ) / & 1029 & (2*tanh(0.5*theta) ) ) 1030 ENDIF 1031 ! 1040 1032 END FUNCTION fssig1 1041 1033 … … 1078 1070 REAL(wp), DIMENSION(jpi,jpj) :: zenv, ztmp, zmsk ! 2D workspace 1079 1071 REAL(wp), DIMENSION(jpi,jpj) :: zri , zrj , zhbat ! - - 1080 1081 LOGICAL :: ln_s_sigma = .false. !use hybrid s_sigma coordinates & stretching function fssig1,used with ln_sco = .true.1072 !! 1073 LOGICAL :: ln_s_sigma = .false. !use hybrid s_sigma coordinates & stretching function fssig1,used with ln_sco = .true. 1082 1074 REAL(wp) :: bb = 0.8 ! stretching parameter for song and haidvogel stretching, bb=0; top only, bb =1; top and bottom 1083 1075 REAL(wp) :: hc = 150 ! Critical depth for s-sigma coordinates 1084 1076 !!gm never do that !!!! ==> Pb at compilation phase on several computer 1085 1077 REAL(wp), DIMENSION(jpi,jpj,jpk) :: gsigw3 = 0.0d0 1086 1078 REAL(wp), DIMENSION(jpi,jpj,jpk) :: gsigt3 = 0.0d0 … … 1093 1085 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigwu3 = 0.0d0 1094 1086 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigwv3 = 0.0d0 1087 !!gm end 1095 1088 !! 1096 1089 NAMELIST/nam_zgr_sco/ sbot_max, sbot_min, theta, thetb, r_max, ln_s_sigma, bb, hc
Note: See TracChangeset
for help on using the changeset viewer.
