Changeset 497
- Timestamp:
- 2006-09-12T13:03:53+02:00 (18 years ago)
- Location:
- trunk/NEMO/OFF_SRC
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OFF_SRC/DOM/dom_oce.F90
r361 r497 83 83 ff !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 84 84 85 85 86 !!---------------------------------------------------------------------- 86 87 !! vertical coordinate and scale factors 87 88 !! -------------------------------------- 88 89 89 REAL(wp), PUBLIC :: & !!: * namelist namdom * 90 e3zps_min = 5.0, & !: miminum thickness for partial steps (meters) 91 e3zps_rat = 0.1 !: minimum thickness ration for partial steps 90 LOGICAL, PUBLIC :: & !!: namzgr : vertical coordinate 91 ln_zco = .TRUE. , & !: z-coordinate - full step 92 ln_zps = .FALSE. , & !: z-coordinate - partial step 93 ln_sco = .FALSE. !: s-coordinate or hybrid z-s coordinate 92 94 93 !! z-coordinate (default option) (also used in the other cases 94 !! ----------------------------- as reference z-coordinate) 95 #if defined key_zco 96 LOGICAL, PUBLIC, PARAMETER :: lk_zco = .TRUE. !: z-coordinate flag (1D arrays) 97 #else 98 LOGICAL, PUBLIC, PARAMETER :: lk_zco = .FALSE. !: z-coordinate flag (3D arrays) 99 100 !! All coordinates 101 !! --------------- 102 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 103 gdep3w , & !: depth of T-points (sum of e3w) (m) 104 gdept , gdepw , & !: analytical depth at T-W points (m) 105 e3v , e3f , & !: analytical vertical scale factors at V--F 106 e3t , e3u , & !: T--U points (m) 107 e3vw , & !: analytical vertical scale factors at VW-- 108 e3w , e3uw !: W--UW points (m) 109 #endif 110 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 111 hur, hvr, & !: inverse of u and v-points ocean depth (1/m) 112 hu , hv !: depth at u- and v-points (meters) 113 114 !! z-coordinate with full steps (also used in the other cases as reference z-coordinate) 115 !! =-----------------====------ 95 116 REAL(wp), PUBLIC, DIMENSION(jpk) :: & !: 96 gdept , gdepw,& !: reference depth of t- and w-points (m)97 e3t , e3w!: reference vertical scale factors at T- and W-pts (m)117 gdept_0, gdepw_0, & !: reference depth of t- and w-points (m) 118 e3t_0 , e3w_0 !: reference vertical scale factors at T- and W-pts (m) 98 119 99 #if defined key_partial_steps 100 !! Partial steps ('key_partial_steps') 101 !! ----------------------------------- 102 LOGICAL, PUBLIC, PARAMETER :: lk_zps = .TRUE. !: partial steps flag 103 LOGICAL, PUBLIC, PARAMETER :: lk_sco = .FALSE. !: s-coordinate flag 104 LOGICAL, PUBLIC, PARAMETER :: lk_zco = .FALSE. !: z-coordinate flag 105 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 106 gdep3w, & !: ??? 107 gdept_ps, gdepw_ps, & !: depth of t- and w-points (m) 108 e3t_ps, e3u_ps, e3v_ps, & !: vertical scale factors at t-, u-, w-, 109 e3w_ps, e3f_ps, & !: w- and f- points (m) 110 e3uw_ps, e3vw_ps !: uw- and vw- points (m) 120 !! z-coordinate with partial steps 121 !! =-----------------=======------ 122 REAL(wp), PUBLIC :: & !!: * namelist namdom * 123 e3zps_min = 5.0_wp, & !: miminum thickness for partial steps (meters) 124 e3zps_rat = 0.1_wp !: minimum thickness ration for partial steps 111 125 112 126 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 113 127 hdept, hdepw, e3tp, e3wp !: ??? 114 128 115 #elif defined key_s_coord 116 !! s-coordinate ('key_s_coord') 117 !! ---------------------------- 118 LOGICAL, PUBLIC, PARAMETER :: lk_zps = .FALSE. !: partial steps flag 119 LOGICAL, PUBLIC, PARAMETER :: lk_sco = .TRUE. !: s-coordinate flag 120 LOGICAL, PUBLIC, PARAMETER :: lk_zco = .FALSE. !: z-coordinate flag 121 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 122 hbatt, hbatu, & !: ocean depth at the vertical of t-, u-, v- 123 hbatv !: and f-point (m) 124 129 !! s-coordinate and hybrid z-s-coordinate 130 !! =----------------======--------------- 125 131 REAL(wp), PUBLIC, DIMENSION(jpk) :: & !: 126 gsigt, gsigw , & !: model level depth coefficient at t-, w-levels 127 gsi3w, & !: model level depth coefficient at w-level 128 ! defined as the sum of e3w scale factors 132 gsigt, gsigw , & !: model level depth coefficient at t-, w-levels (analytic) 133 gsi3w , & !: model level depth coefficient at w-level (sum of gsigw) 129 134 esigt, esigw !: vertical scale factor coef. at t-, w-levels 130 135 131 #else 132 !! z-coordinate (Default option) 133 !! ----------------------------- 134 LOGICAL, PUBLIC, PARAMETER :: lk_zps = .FALSE. !: partial steps flag 135 LOGICAL, PUBLIC, PARAMETER :: lk_sco = .FALSE. !: s-coordinate flag 136 LOGICAL, PUBLIC, PARAMETER :: lk_zco = .TRUE. !: s-coordinate flag 137 #endif 136 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 137 hbatv , hbatf , & !: ocean depth at the vertical of V--F 138 hbatt , hbatu , & !: T--U points (m) 139 scosrf, scobot, & !: ocean surface and bottom topographies (if deviating from coordinate surfaces in HYBRID) 140 hifv , hiff , & !: interface depth between stretching at V--F 141 hift , hifu !: and quasi-uniform spacing T--U points (m) 142 143 138 144 !!---------------------------------------------------------------------- 139 145 !! masks, bathymetry … … 180 186 ! ! parameterize exchanges through straits 181 187 188 #if defined key_off_degrad 189 !! ------------------------------------------------ 190 !! Degradation method 191 !! -------------------------------------------------- 192 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: & 193 facvol !! volume for degraded regions 194 #endif 195 182 196 !!---------------------------------------------------------------------- 183 197 END MODULE dom_oce -
trunk/NEMO/OFF_SRC/DOM/domain.F90
r343 r497 29 29 PUBLIC dom_init ! called by opa.F90 30 30 31 !! * Module variables 32 REAL(wp) :: & !!: Namelist nam_zgr_sco 33 sbot_min = 300. , & !: minimum depth of s-bottom surface (>0) (m) 34 sbot_max = 5250. , & !: maximum depth of s-bottom surface (= ocean depth) (>0) (m) 35 theta = 6.0 , & !: surface control parameter (0<=theta<=20) 36 thetb = 0.75, & !: bottom control parameter (0<=thetb<= 1) 37 r_max = 0.15 !: maximum cut-off r-value allowed (0<r_max<1) 38 39 31 40 !! * Substitutions 32 41 # include "domzgr_substitute.h90" … … 98 107 !! * Modules used 99 108 USE ioipsl 100 NAMELIST/namrun/ no , cexper , ln_rstart , nrstdt , nit000, & 109 INTEGER :: ioptio = 0 ! temporary integer 110 111 NAMELIST/nam_run/ no , cexper , ln_rstart , nrstdt , nit000, & 101 112 & nitend, ndate0 , nleapy , ninist , nstock, & 102 113 & nprint, nwrite , nrunoff , ln_ctl , nictls, nictle, & 103 114 & njctls, njctle , nbench , isplt , jsplt 104 115 105 NAMELIST/namdom/ e3zps_min, e3zps_rat, nmsh , & 116 NAMELIST/nam_zgr/ ln_zco, ln_zps, ln_sco 117 118 NAMELIST/nam_dom/ e3zps_min, e3zps_rat, nmsh , & 106 119 & nacc , atfp , rdt , rdtmin , rdtmax, & 107 120 & rdth 108 121 109 NAMELIST/nam cla/ n_cla122 NAMELIST/nam_cla/ n_cla 110 123 !!---------------------------------------------------------------------- 111 124 … … 118 131 ! Namelist namrun : parameters of the run 119 132 REWIND( numnam ) 120 READ ( numnam, nam run )133 READ ( numnam, nam_run ) 121 134 122 135 IF(lwp) THEN … … 256 269 ENDIF 257 270 271 ! Read Namelist nam_zgr : vertical coordinate' 272 ! --------------------- 273 REWIND ( numnam ) 274 READ ( numnam, nam_zgr ) 275 276 ! Parameter control and print 277 ! --------------------------- 278 ! Control print 279 IF(lwp) THEN 280 WRITE(numout,*) 281 WRITE(numout,*) 'Namelist namzgr : vertical coordinate' 282 WRITE(numout,*) '~~~~~~~' 283 WRITE(numout,*) ' Namelist nam_zgr : set vertical coordinate' 284 WRITE(numout,*) ' z-coordinate - full steps ln_zco = ', ln_zco 285 WRITE(numout,*) ' z-coordinate - partial steps ln_zps = ', ln_zps 286 WRITE(numout,*) ' s- or hybrid z-s-coordinate ln_sco = ', ln_sco 287 ENDIF 288 289 ! Check Vertical coordinate options 290 ioptio = 0 291 IF( ln_zco ) ioptio = ioptio + 1 292 IF( ln_zps ) ioptio = ioptio + 1 293 IF( ln_sco ) ioptio = ioptio + 1 294 IF ( ioptio /= 1 ) CALL ctl_stop( ' none or several vertical coordinate options used' ) 295 296 IF( ln_zco ) THEN 297 IF(lwp) WRITE(numout,*) ' z-coordinate with reduced incore memory requirement' 298 IF( ln_zps .OR. ln_sco ) CALL ctl_stop( ' reduced memory with zps or sco option is impossible' ) 299 ENDIF 300 301 258 302 ! Namelist namdom : space/time domain (bathymetry, mesh, timestep) 259 303 REWIND( numnam ) 260 READ ( numnam, nam dom )304 READ ( numnam, nam_dom ) 261 305 262 306 IF(lwp) THEN … … 285 329 ! Namelist cross land advection 286 330 REWIND( numnam ) 287 READ ( numnam, nam cla )331 READ ( numnam, nam_cla ) 288 332 IF(lwp) THEN 289 333 WRITE(numout,*) -
trunk/NEMO/OFF_SRC/DOM/domcfg.F90
r343 r497 14 14 USE lib_mpp ! distributed memory computing library 15 15 16 16 17 IMPLICIT NONE 17 18 PRIVATE … … 20 21 PUBLIC dom_cfg ! called by opa.F90 21 22 !!---------------------------------------------------------------------- 22 !! OPA 9.0 , LOCEAN-IPSL (2005)23 !! $Header$24 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt23 !! OPA 9.0 , LOCEAN-IPSL (2005) 24 !! $Header$ 25 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 25 26 !!---------------------------------------------------------------------- 26 27 … … 64 65 ' north fold with F-point pivot' 65 66 ENDIF 66 IF( jperio < 0 .OR. jperio > 6 ) THEN 67 IF(lwp) WRITE(numout,cform_err) 68 IF(lwp) WRITE(numout,*) 'jperio is out of range' 69 nstop = nstop + 1 70 ENDIF 71 67 IF( jperio < 0 .OR. jperio > 6 ) CALL ctl_stop( 'jperio is out of range' ) 72 68 73 69 ! global domain versus zoom and/or local domain … … 144 140 WRITE(numout,25) (mi1(ji),ji = 1,jpidta) 145 141 WRITE(numout,*) 146 WRITE(numout,*) ' conversion local ==> data i-index domain'142 WRITE(numout,*) ' conversion local ==> data j-index domain' 147 143 WRITE(numout,25) (mjg(jj),jj = 1,jpj) 148 144 WRITE(numout,*) 149 WRITE(numout,*) ' conversion data ==> local i-index domain'145 WRITE(numout,*) ' conversion data ==> local j-index domain' 150 146 WRITE(numout,*) ' starting index' 151 147 WRITE(numout,25) (mj0(jj),jj = 1,jpjdta) … … 160 156 ! zoom control 161 157 IF( jpiglo + jpizoom - 1 > jpidta .OR. & 162 jpjglo + jpjzoom - 1 > jpjdta ) THEN 163 IF(lwp)WRITE(numout,cform_err) 164 IF(lwp)WRITE(numout,*)' global or zoom domain exceed the data domain ! ' 165 nstop = nstop + 1 166 ENDIF 158 jpjglo + jpjzoom - 1 > jpjdta ) & 159 & CALL ctl_stop( ' global or zoom domain exceed the data domain ! ' ) 167 160 168 161 ! set zoom flag … … 184 177 WRITE(numout,*) ' lzoom_n = ', lzoom_n, ' (T = forced closed North boundary)' 185 178 ENDIF 186 IF( ( lzoom_e .OR. lzoom_w ) .AND. ( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) ) THEN 187 IF(lwp)WRITE(numout,cform_err) 188 IF(lwp)WRITE(numout,*)' Your zoom choice is inconsistent with east-west cyclic boundary condition' 189 nstop = nstop + 1 190 ENDIF 191 IF( lzoom_n .AND. ( 3 <= jperio .AND. jperio <= 6 ) ) THEN 192 IF(lwp)WRITE(numout,cform_err) 193 IF(lwp)WRITE(numout,*)' Your zoom choice is inconsistent with North fold boundary condition' 194 nstop = nstop + 1 195 ENDIF 179 IF( ( lzoom_e .OR. lzoom_w ) .AND. ( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) ) & 180 & CALL ctl_stop( ' Your zoom choice is inconsistent with east-west cyclic boundary condition' ) 181 IF( lzoom_n .AND. ( 3 <= jperio .AND. jperio <= 6 ) ) & 182 & CALL ctl_stop( ' Your zoom choice is inconsistent with North fold boundary condition' ) 183 196 184 197 185 ! Pre-defined arctic/antarctic zoom of ORCA configuration flag -
trunk/NEMO/OFF_SRC/DOM/domrea_dimg.h90
r343 r497 71 71 irecl8 = jpi*jpj*wp 72 72 ios1 = 0 ; ios2 = 0 73 IF (l k_zps ) ios1= 174 IF (l k_sco ) ios2= 173 IF (ln_zps ) ios1= 1 74 IF (ln_sco ) ios2= 1 75 75 76 76 SELECT CASE (nmsh ) … … 262 262 mbathy=zprt*tmask(:,:,1)+1 263 263 264 #if defined key_s_coord 265 ! 266 ! hbat 267 irec = irecv(inum4) + (narea - 1 ) 268 READ(inum4,REC=irec) hbatt(:,:) 269 irecv(inum4) = irecv(inum4) + jpnij 270 271 irec = irecv(inum4) + (narea - 1 ) 272 READ(inum4,REC=irec) hbatu(:,:) 273 irecv(inum4) = irecv(inum4) + jpnij 274 275 irec = irecv(inum4) + (narea - 1 ) 276 READ(inum4,REC=irec) hbatv(:,:) 277 irecv(inum4) = irecv(inum4) + jpnij 278 279 irec = irecv(inum4) + (narea - 1 ) 280 READ(inum4,REC=irec) hbatf(:,:) 281 irecv(inum4) = irecv(inum4) + jpnij 282 ! 283 ! gsig and esig ( as vectors of jpk per record ) 284 irec = irecv(inum4) + (narea - 1 ) 285 READ(inum4,REC=irec) gsigt(:) 286 irecv(inum4) = irecv(inum4) + jpnij 287 288 irec = irecv(inum4) + (narea - 1 ) 289 READ(inum4,REC=irec) gsigw(:) 290 irecv(inum4) = irecv(inum4) + jpnij 291 292 irec = irecv(inum4) + (narea - 1 ) 293 READ(inum4,REC=irec) gsi3w(:) 294 irecv(inum4) = irecv(inum4) + jpnij 295 296 irec = irecv(inum4) + (narea - 1 ) 297 READ(inum4,REC=irec) esigt(:) 298 irecv(inum4) = irecv(inum4) + jpnij 299 300 irec = irecv(inum4) + (narea - 1 ) 301 READ(inum4,REC=irec) esigw(:) 302 irecv(inum4) = irecv(inum4) + jpnij 303 304 # elif defined key_partial_steps 305 ! 306 ! hdep 307 irec = irecv(inum4) + (narea - 1 ) 308 READ(inum4,REC=irec) hdept(:,:) 309 irecv(inum4) = irecv(inum4) + jpnij 310 311 irec = irecv(inum4) + (narea - 1 ) 312 READ(inum4,REC=irec) hdepw(:,:) 313 irecv(inum4) = irecv(inum4) + jpnij 314 ! 315 ! e3t_ps (3D) 316 DO jk=1,jpk 317 irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 318 READ(inum4,REC=irec) e3t_ps(:,:,jk) 319 END DO 320 irecv(inum4) = irecv(inum4) + jpk * jpnij 321 322 ! e3u_ps e3v_ps e3w_ps (3D) 323 DO jk=1,jpk 324 irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 325 READ(inum4,REC=irec) e3u_ps(:,:,jk) 326 END DO 327 irecv(inum4) = irecv(inum4) + jpk * jpnij 328 329 DO jk=1,jpk 330 irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 331 READ(inum4,REC=irec) e3v_ps(:,:,jk) 332 END DO 333 irecv(inum4) = irecv(inum4) + jpk * jpnij 334 335 DO jk=1,jpk 336 irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 337 READ(inum4,REC=irec) e3w_ps(:,:,jk) 338 END DO 339 irecv(inum4) = irecv(inum4) + jpk * jpnij 340 ! 341 ! 342 ! gdep 343 irec = irecv(inum4) + (narea - 1 ) 344 READ(inum4,REC=irec) gdept(:) 345 irecv(inum4) = irecv(inum4) + jpnij 346 347 irec = irecv(inum4) + (narea - 1 ) 348 READ(inum4,REC=irec) gdepw(:) 349 irecv(inum4) = irecv(inum4) + jpnij 350 ! 351 ! e3 352 irec = irecv(inum4) + (narea - 1 ) 353 READ(inum4,REC=irec) e3t(:) 354 irecv(inum4) = irecv(inum4) + jpnij 355 356 irec = irecv(inum4) + (narea - 1 ) 357 READ(inum4,REC=irec) e3w(:) 264 #if ! defined key_zco 265 IF( ln_sco ) THEN ! s-coordinate 266 ! 267 ! hbat 268 irec = irecv(inum4) + (narea - 1 ) 269 READ(inum4,REC=irec) hbatt(:,:) 270 irecv(inum4) = irecv(inum4) + jpnij 271 272 irec = irecv(inum4) + (narea - 1 ) 273 READ(inum4,REC=irec) hbatu(:,:) 274 irecv(inum4) = irecv(inum4) + jpnij 275 276 irec = irecv(inum4) + (narea - 1 ) 277 READ(inum4,REC=irec) hbatv(:,:) 278 irecv(inum4) = irecv(inum4) + jpnij 279 280 irec = irecv(inum4) + (narea - 1 ) 281 READ(inum4,REC=irec) hbatf(:,:) 282 irecv(inum4) = irecv(inum4) + jpnij 283 ! 284 ! gsig and esig ( as vectors of jpk per record ) 285 irec = irecv(inum4) + (narea - 1 ) 286 READ(inum4,REC=irec) gsigt(:) 287 irecv(inum4) = irecv(inum4) + jpnij 288 289 irec = irecv(inum4) + (narea - 1 ) 290 READ(inum4,REC=irec) gsigw(:) 291 irecv(inum4) = irecv(inum4) + jpnij 292 293 irec = irecv(inum4) + (narea - 1 ) 294 READ(inum4,REC=irec) gsi3w(:) 295 irecv(inum4) = irecv(inum4) + jpnij 296 297 irec = irecv(inum4) + (narea - 1 ) 298 READ(inum4,REC=irec) esigt(:) 299 irecv(inum4) = irecv(inum4) + jpnij 300 301 irec = irecv(inum4) + (narea - 1 ) 302 READ(inum4,REC=irec) esigw(:) 303 irecv(inum4) = irecv(inum4) + jpnij 304 305 ! e3 (3D) 306 DO jk=1,jpk 307 irec = irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 308 READ(inum4,REC=irec) e3t(:,:,jk) 309 ENDIF 310 irecv(inum4) = irecv(inum4) + jpk * jpnij 311 312 DO jk=1,jpk 313 irec = irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 314 READ(inum4,REC=irec) e3u(:,:,jk) 315 ENDIF 316 irecv(inum4) = irecv(inum4) + jpk * jpnij 317 318 DO jk=1,jpk 319 irec = irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 320 READ(inum4,REC=irec) e3v(:,:,jk) 321 ENDIF 322 irecv(inum4) = irecv(inum4) + jpk * jpnij 323 324 DO jk=1,jpk 325 irec = irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 326 READ(inum4,REC=irec) e3w(:,:,jk) 327 ENDIF 328 irecv(inum4) = irecv(inum4) + jpk * jpnij 329 330 ! gdep 331 irec = irecv(inum4) + (narea - 1 ) 332 READ(inum4,REC=irec) gdept_0(:) 333 irecv(inum4) = irecv(inum4) + jpnij 334 335 irec = irecv(inum4) + (narea - 1 ) 336 READ(inum4,REC=irec) gdepw_0(:) 337 irecv(inum4) = irecv(inum4) + jpnij 338 ! 339 ENDIF 340 341 IF( ln_zps ) THEN 342 ! 343 ! hdep 344 irec = irecv(inum4) + (narea - 1 ) 345 READ(inum4,REC=irec) hdept(:,:) 346 irecv(inum4) = irecv(inum4) + jpnij 347 348 irec = irecv(inum4) + (narea - 1 ) 349 READ(inum4,REC=irec) hdepw(:,:) 350 irecv(inum4) = irecv(inum4) + jpnij 351 ! 352 ! e3t_ps (3D) 353 DO jk=1,jpk 354 irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 355 READ(inum4,REC=irec) e3t(:,:,jk) 356 END DO 357 irecv(inum4) = irecv(inum4) + jpk * jpnij 358 359 ! e3u_ps e3v_ps e3w_ps (3D) 360 DO jk=1,jpk 361 irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 362 READ(inum4,REC=irec) e3u(:,:,jk) 363 END DO 364 irecv(inum4) = irecv(inum4) + jpk * jpnij 365 366 DO jk=1,jpk 367 irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 368 READ(inum4,REC=irec) e3v(:,:,jk) 369 END DO 370 irecv(inum4) = irecv(inum4) + jpk * jpnij 371 372 DO jk=1,jpk 373 irec=irecv(inum4) + (jk -1 ) + jpk * (narea - 1 ) 374 READ(inum4,REC=irec) e3w(:,:,jk) 375 END DO 376 irecv(inum4) = irecv(inum4) + jpk * jpnij 377 ! 378 ! 379 ! gdep 380 irec = irecv(inum4) + (narea - 1 ) 381 READ(inum4,REC=irec) gdept_0(:) 382 irecv(inum4) = irecv(inum4) + jpnij 383 384 irec = irecv(inum4) + (narea - 1 ) 385 READ(inum4,REC=irec) gdepw_0(:) 386 irecv(inum4) = irecv(inum4) + jpnij 387 ! 388 ! e3 389 irec = irecv(inum4) + (narea - 1 ) 390 READ(inum4,REC=irec) e3t_0(:) 391 irecv(inum4) = irecv(inum4) + jpnij 392 393 irec = irecv(inum4) + (narea - 1 ) 394 READ(inum4,REC=irec) e3w_0(:) 395 ENDIF 358 396 #else 359 !360 ! gdep361 irec = irecv(inum4) + (narea - 1 )362 READ(inum4,REC=irec) gdept(:)363 irecv(inum4) = irecv(inum4) + jpnij364 365 irec = irecv(inum4) + (narea - 1 )366 READ(inum4,REC=irec) gdepw(:)367 irecv(inum4) = irecv(inum4) + jpnij368 !369 ! e3370 irec = irecv(inum4) + (narea - 1 )371 READ(inum4,REC=irec) e3t(:)372 irecv(inum4) = irecv(inum4) + jpnij373 374 irec = irecv(inum4) + (narea - 1 )375 READ(inum4,REC=irec) e3w(:)376 irecv(inum4) = irecv(inum4) + jpnij397 ! 398 ! gdep 399 irec = irecv(inum4) + (narea - 1 ) 400 READ(inum4,REC=irec) gdept_0(:) 401 irecv(inum4) = irecv(inum4) + jpnij 402 403 irec = irecv(inum4) + (narea - 1 ) 404 READ(inum4,REC=irec) gdepw_0(:) 405 irecv(inum4) = irecv(inum4) + jpnij 406 ! 407 ! e3 408 irec = irecv(inum4) + (narea - 1 ) 409 READ(inum4,REC=irec) e3t_0(:) 410 irecv(inum4) = irecv(inum4) + jpnij 411 412 irec = irecv(inum4) + (narea - 1 ) 413 READ(inum4,REC=irec) e3w_0(:) 414 irecv(inum4) = irecv(inum4) + jpnij 377 415 ! 378 416 #endif -
trunk/NEMO/OFF_SRC/DOM/domrea_fdir.h90
r343 r497 77 77 ! 4. depth and vertical scale factors 78 78 ! ----------------------------------- 79 #if defined key_s_coord 80 clfield='HBATT' ; READ(inum) clfield, hbatt 81 clfield='HBATU' ; READ(inum) clfield, hbatu 82 clfield='HBATV' ; READ(inum) clfield, hbatv 83 clfield='HBATF' ; READ(inum) clfield, hbatf 84 clfield='GSIGT' ; READ(inum) clfield, gsigt 85 clfield='GSIGW' ; READ(inum) clfield, gsigw 86 clfield='GSI3W' ; READ(inum) clfield, gsi3w 87 clfield='ESIGT' ; READ(inum) clfield, esigt 88 clfield='ESIGW' ; READ(inum) clfield, esigw 79 #if ! defined key_zco 80 IF( ln_sco ) THEN 81 clfield='HBATT' ; READ(inum) clfield, hbatt 82 clfield='HBATU' ; READ(inum) clfield, hbatu 83 clfield='HBATV' ; READ(inum) clfield, hbatv 84 clfield='HBATF' ; READ(inum) clfield, hbatf 85 clfield='GSIGT' ; READ(inum) clfield, gsigt 86 clfield='GSIGW' ; READ(inum) clfield, gsigw 87 clfield='GSI3W' ; READ(inum) clfield, gsi3w 88 clfield='ESIGT' ; READ(inum) clfield, esigt 89 clfield='ESIGW' ; READ(inum) clfield, esigw 90 ENDIF 89 91 #else 90 92 clfield='GDEPT' ; READ(inum) clfield, gdept -
trunk/NEMO/OFF_SRC/DOM/domstp.F90
r343 r497 7 7 !!---------------------------------------------------------------------- 8 8 !! dom_stp : ocean time domain initialization 9 !!---------------------------------------------------------------------- 10 !! History : 11 !! ! 90-10 (O. Marti) Original code 12 !! ! 96-01 (G. Madec) terrain following coordinates 13 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 9 14 !!---------------------------------------------------------------------- 10 15 !! * Modules used … … 22 27 # include "domzgr_substitute.h90" 23 28 !!---------------------------------------------------------------------- 24 !! OPA 9.0 , LOCEAN-IPSL (2005)25 !! $Header$26 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt29 !! OPA 9.0 , LOCEAN-IPSL (2005) 30 !! $Header$ 31 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 27 32 !!---------------------------------------------------------------------- 28 33 … … 56 61 !! References : 57 62 !! Bryan, K., 1984, J. Phys. Oceanogr., 14, 666-673. 58 !!59 !! History :60 !! ! 90-10 (O. Marti) Original code61 !! ! 96-01 (G. Madec) terrain following coordinates62 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module63 63 !!---------------------------------------------------------------------- 64 !! * Local declarations65 64 INTEGER :: jk ! dummy loop indice 66 65 !!---------------------------------------------------------------------- … … 77 76 atfp1 = 1. - 2. * atfp 78 77 79 80 78 SELECT CASE ( nacc ) 81 79 … … 90 88 IF(lwp) WRITE(numout,*)' accelerating the convergence' 91 89 IF(lwp) WRITE(numout,*)' dynamics time step = ', rdt/3600., ' hours' 92 #if defined key_s_coord 93 IF( rdtmin /= rdtmax ) THEN 94 IF(lwp) WRITE(numout,cform_err) 95 IF(lwp) WRITE(numout,*)' depth dependent acceleration of & 96 &convergence not implemented in s-coordinates' 97 nstop = nstop + 1 98 ENDIF 99 #endif 100 #if defined key_partial_steps 101 IF( rdtmin /= rdtmax ) THEN 102 IF(lwp) WRITE(numout,cform_err) 103 IF(lwp) WRITE(numout,*)' depth dependent acceleration of & 104 &convergence not implemented for partial steps case' 105 nstop = nstop + 1 106 ENDIF 107 #endif 90 IF( ln_sco .AND. rdtmin /= rdtmax ) & 91 & CALL ctl_stop ( ' depth dependent acceleration of convergence not implemented in s-coordinates' ) 108 92 IF(lwp) WRITE(numout,*)' tracers time step : dt (hours) level' 109 93 110 94 DO jk = 1, jpk 111 IF( fsdept(1,1,jk) <= rdth ) rdttra(jk) = rdtmin112 IF( fsdept(1,1,jk) > rdth ) THEN95 IF( gdept_0(jk) <= rdth ) rdttra(jk) = rdtmin 96 IF( gdept_0(jk) > rdth ) THEN 113 97 rdttra(jk) = rdtmin + ( rdtmax - rdtmin ) & 114 * ( EXP( ( fsdept(1,1,jk ) - rdth ) / rdth ) - 1. ) &115 / ( EXP( ( fsdept(1,1,jpk) - rdth ) / rdth ) - 1. )98 * ( EXP( ( gdept_0(jk ) - rdth ) / rdth ) - 1. ) & 99 / ( EXP( ( gdept_0(jpk) - rdth ) / rdth ) - 1. ) 116 100 ENDIF 117 IF(lwp) WRITE(numout, 9200) rdttra(jk)/3600., jk101 IF(lwp) WRITE(numout,"(36x,f5.2,5x,i3)") rdttra(jk)/3600., jk 118 102 END DO 119 9200 FORMAT(36x,f5.2,' ',i3)120 103 121 104 CASE DEFAULT ! E R R O R 122 105 123 IF(lwp) WRITE(numout,cform_err) 124 IF(lwp) WRITE(numout,*) ' nacc value e r r o r, nacc= ',nacc 125 IF(lwp) WRITE(numout,*) ' we stop' 126 nstop = nstop + 1 106 WRITE(ctmp1,*) ' nacc value e r r o r, nacc= ',nacc 107 CALL ctl_stop( ctmp1 ) 127 108 128 109 END SELECT -
trunk/NEMO/OFF_SRC/DOM/domzgr_substitute.h90
r343 r497 5 5 !! factors depending on the vertical coord. used, using CPP macro. 6 6 !!---------------------------------------------------------------------- 7 !! OPA 9.0 , LOCEAN-IPSL (2005)8 !! $Header$9 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt10 7 !!---------------------------------------------------------------------- 11 #if defined key_s_coord 12 !! s-coord: substitution fsdep.(,,) ==> hbat.(,) * gsig.() 13 !! fse3.(,,) ==> hbat.(,) * esig.() 14 # define fsdept(i,j,k) hbatt(i,j)*gsigt(k) 15 # define fsdepu(i,j,k) hbatu(i,j)*gsigt(k) 16 # define fsdepv(i,j,k) hbatv(i,j)*gsigt(k) 17 # define fsdepf(i,j,k) hbatf(i,j)*gsigt(k) 18 # define fsdepw(i,j,k) hbatt(i,j)*gsigw(k) 19 # define fsdepuw(i,j,k) hbatu(i,j)*gsi3w(k) 20 # define fsdepvw(i,j,k) hbatv(i,j)*gsi3w(k) 21 # define fsde3w(i,j,k) hbatt(i,j)*gsi3w(k) 22 # define fse3t(i,j,k) hbatt(i,j)*esigt(k) 23 # define fse3u(i,j,k) hbatu(i,j)*esigt(k) 24 # define fse3v(i,j,k) hbatv(i,j)*esigt(k) 25 # define fse3f(i,j,k) hbatf(i,j)*esigt(k) 26 # define fse3w(i,j,k) hbatt(i,j)*esigw(k) 27 # define fse3uw(i,j,k) hbatu(i,j)*esigw(k) 28 # define fse3vw(i,j,k) hbatv(i,j)*esigw(k) 29 #elif defined key_partial_steps 30 !! z-coord: substitution fsdep.(,,) ==> gdep._ps() 31 !! fse3.(,,) ==> e3._ps() 32 # define fsdept(i,j,k) gdept_ps(i,j,k) 33 # define fsdepw(i,j,k) gdepw_ps(i,j,k) 34 # define fsde3w(i,j,k) gdep3w(i,j,k) 35 # define fsdepuw(i,j,k) gdepw(k) 36 # define fsdepvw(i,j,k) gdepw(k) 37 # define fse3t(i,j,k) e3t_ps(i,j,k) 38 # define fse3u(i,j,k) e3u_ps(i,j,k) 39 # define fse3v(i,j,k) e3v_ps(i,j,k) 40 # define fse3f(i,j,k) e3f_ps(i,j,k) 41 # define fse3w(i,j,k) e3w_ps(i,j,k) 42 # define fse3uw(i,j,k) e3uw_ps(i,j,k) 43 # define fse3vw(i,j,k) e3vw_ps(i,j,k) 8 !! OPA 9.0 , LOCEAN-IPSL (2005) 9 !! 10 !! History : 11 !! 9.0 ! 05-10 (A. Beckmann, G. Madec) generalisation to all coord. 12 !!---------------------------------------------------------------------- 13 #if defined key_zco 14 # define fsdept(i,j,k) gdept_0(k) 15 16 # define fsdepw(i,j,k) gdepw_0(k) 17 # define fsde3w(i,j,k) gdepw_0(k) 18 19 # define fse3t(i,j,k) e3t_0(k) 20 # define fse3u(i,j,k) e3t_0(k) 21 # define fse3v(i,j,k) e3t_0(k) 22 # define fse3f(i,j,k) e3t_0(k) 23 24 # define fse3w(i,j,k) e3w_0(k) 25 # define fse3uw(i,j,k) e3w_0(k) 26 # define fse3vw(i,j,k) e3w_0(k) 44 27 #else 45 !! z-coord: substitution fsdep.(,,) ==> gdep() 46 !! fse3.(,,) ==> e3.() 47 # define fsdept(i,j,k) gdept(k) 48 # define fsdepu(i,j,k) gdept(k) 49 # define fsdepv(i,j,k) gdept(k) 50 # define fsdepf(i,j,k) gdept(k) 51 # define fsdepw(i,j,k) gdepw(k) 52 # define fsdepuw(i,j,k) gdepw(k) 53 # define fsdepvw(i,j,k) gdepw(k) 54 # define fse3t(i,j,k) e3t(k) 55 # define fse3u(i,j,k) e3t(k) 56 # define fse3v(i,j,k) e3t(k) 57 # define fse3f(i,j,k) e3t(k) 58 # define fse3w(i,j,k) e3w(k) 59 # define fse3uw(i,j,k) e3w(k) 60 # define fse3vw(i,j,k) e3w(k) 28 # define fsdept(i,j,k) gdept(i,j,k) 29 30 # define fsdepw(i,j,k) gdepw(i,j,k) 31 # define fsde3w(i,j,k) gdep3w(i,j,k) 32 33 # define fse3t(i,j,k) e3t(i,j,k) 34 # define fse3u(i,j,k) e3u(i,j,k) 35 # define fse3v(i,j,k) e3v(i,j,k) 36 # define fse3f(i,j,k) e3f(i,j,k) 37 38 # define fse3w(i,j,k) e3w(i,j,k) 39 # define fse3uw(i,j,k) e3uw(i,j,k) 40 # define fse3vw(i,j,k) e3vw(i,j,k) 61 41 #endif -
trunk/NEMO/OFF_SRC/LDF/ldfslp.F90
r343 r497 20 20 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 21 21 USE in_out_manager ! I/O manager 22 USE prtctl ! Print control 22 23 23 24 IMPLICIT NONE … … 46 47 # include "vectopt_loop_substitute.h90" 47 48 !!---------------------------------------------------------------------- 48 !! OPA 9.0 , LOCEAN-IPSL (2005) 49 !! $Header$ 50 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 49 !! OPA 9.0 , LOCEAN-IPSL (2005) 51 50 !!---------------------------------------------------------------------- 52 51 … … 69 68 !! of 10cm/s) 70 69 !! A horizontal shapiro filter is applied to the slopes 71 !! 'key_s_coord' defined:add to the previously computed slopes70 !! ln_sco=T, s-coordinate, add to the previously computed slopes 72 71 !! the slope of the model level surface. 73 72 !! macro-tasked on horizontal slab (jk-loop) (2, jpk-1) 74 73 !! [slopes already set to zero at level 1, and to zero or the ocean 75 !! bottom slope ( 'key_s_coord' defined) at level jpk in inildf]74 !! bottom slope (ln_sco=T) at level jpk in inildf] 76 75 !! 77 76 !! ** Action : - uslp, wslpi, and vslp, wslpj, the i- and j-slopes … … 83 82 !! 8.1 ! 99-10 (A. Jouzeau) NEW profile 84 83 !! 8.5 ! 99-10 (G. Madec) Free form, F90 84 !! 9.0 ! 05-10 (A. Beckmann) correction for s-coordinates 85 85 !!---------------------------------------------------------------------- 86 86 !! * Modules used … … 97 97 !! * Local declarations 98 98 INTEGER :: ji, jj, jk ! dummy loop indices 99 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integer 100 #if defined key_partial_steps 101 INTEGER :: iku, ikv ! temporary integers 102 #endif 99 INTEGER :: ii0, ii1, ij0, ij1, & ! temporary integer 100 & iku, ikv ! " " 103 101 REAL(wp) :: & 104 zeps, zmg, zm05g, zcoef1, zcoef2, & ! temporary scalars 105 zau, zbu, zav, zbv, & 106 zai, zbi, zaj, zbj, & 107 zcofu, zcofv, zcofw, & 108 z1u, z1v, z1wu, z1wv, & 102 zeps, zmg, zm05g, & ! temporary scalars 103 zcoef1, zcoef2, zcoef3, & ! 104 zau, zbu, zav, zbv, & 105 zai, zbi, zaj, zbj, & 106 zcofu, zcofv, zcofw, & 107 z1u, z1v, z1wu, z1wv, & 109 108 zalpha 110 109 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zww … … 138 137 END DO 139 138 140 #if defined key_partial_steps 141 ! partial steps correction at the bottom ocean level (zps_hde routine) 142 # if defined key_vectopt_loop && ! defined key_autotasking 143 jj = 1 144 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 139 IF( ln_zps ) THEN ! partial steps correction at the bottom ocean level (zps_hde routine) 140 # if defined key_vectopt_loop && ! defined key_mpp_omp 141 jj = 1 142 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 145 143 # else 146 DO jj = 1, jpjm1147 DO ji = 1, jpim1148 # endif 149 ! last ocean level150 iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj) ) - 1151 ikv = MIN ( mbathy(ji,jj), mbathy(ji,jj+1) ) - 1152 zgru(ji,jj,iku) = gru(ji,jj)153 zgrv(ji,jj,ikv) = grv(ji,jj)154 # if ! defined key_vectopt_loop || defined key_ autotasking155 END DO156 # endif 157 END DO158 #endif 144 DO jj = 1, jpjm1 145 DO ji = 1, jpim1 146 # endif 147 ! last ocean level 148 iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj) ) - 1 149 ikv = MIN ( mbathy(ji,jj), mbathy(ji,jj+1) ) - 1 150 zgru(ji,jj,iku) = gru(ji,jj) 151 zgrv(ji,jj,ikv) = grv(ji,jj) 152 # if ! defined key_vectopt_loop || defined key_mpp_omp 153 END DO 154 # endif 155 END DO 156 ENDIF 159 157 160 158 ! Slopes of isopycnal surfaces just below the mixed layer … … 203 201 ! uslp and vslp output in zwz and zww, resp. 204 202 zalpha = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 205 #if defined key_s_coord206 203 zwz (ji,jj,jk) = ( zau / ( zbu - zeps ) * ( 1. - zalpha) & 207 & + zalpha * uslpml(ji,jj) & 208 & * ( fsdepu(ji,jj,jk) - .5*fse3u(ji,jj,1) ) & 209 & / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5. ) ) & 210 & * umask(ji,jj,jk) 204 & + zalpha * uslpml(ji,jj) & 205 & * 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) ) & 206 & / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5. ) ) * umask(ji,jj,jk) 211 207 zalpha = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 212 208 zww (ji,jj,jk) = ( zav / ( zbv - zeps ) * ( 1. - zalpha) & 213 & + zalpha * vslpml(ji,jj) & 214 & * ( fsdepv(ji,jj,jk) - .5*fse3v(ji,jj,1) ) & 215 & / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) & 216 & * vmask(ji,jj,jk) 217 #else 218 ! z-coord and partial steps slope computed in the same way 219 zwz (ji,jj,jk) = ( zau / ( zbu - zeps ) * ( 1. - zalpha) & 220 & + zalpha * uslpml(ji,jj) & 221 & * ( fsdept(ji,jj,jk) - .5*fse3u(ji,jj,1)) & 222 & / MAX (hmlpt(ji,jj),hmlpt(ji+1,jj),5.) ) & 223 & * umask (ji,jj,jk) 224 zalpha = MAX(omlmask(ji,jj,jk),omlmask(ji,jj+1,jk)) 225 zww (ji,jj,jk) = ( zav / ( zbv - zeps ) * ( 1. - zalpha) & 226 & + zalpha * vslpml(ji,jj) & 227 & * ( fsdept(ji,jj,jk) - .5*fse3v(ji,jj,1)) & 228 & / MAX(hmlpt(ji,jj),hmlpt(ji,jj+1),5.) ) & 229 & * vmask (ji,jj,jk) 230 #endif 209 & + zalpha * vslpml(ji,jj) & 210 & * 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) ) & 211 & / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) 231 212 END DO 232 213 END DO … … 292 273 END DO 293 274 END DO 294 295 296 IF( lk_sco ) THEN297 ! Add the slope of level surfaces298 ! -----------------------------------299 ! 'key_s_coord' defined but not 'key_traldfiso' the computation is done300 ! in inildf, ldfslp never called301 ! 'key_s_coord' and 'key_traldfiso' defined, the slope of level surfaces302 ! is added to the slope of isopycnal surfaces.303 ! c a u t i o n : minus sign as fsdep has positive value304 305 DO jj = 2, jpjm1306 DO ji = fs_2, fs_jpim1 ! vector opt.307 uslp(ji,jj,jk) = uslp(ji,jj,jk) - 1. / e1u(ji,jj) &308 & * ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) )309 vslp(ji,jj,jk) = vslp(ji,jj,jk) - 1. / e2v(ji,jj) &310 & * ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) )311 END DO312 END DO313 ENDIF314 275 315 276 … … 354 315 zbj = MIN( zwy (ji,jj,jk), -100.*ABS(zaj), -7.e+3/fse3w(ji,jj,jk)*ABS(zaj) ) 355 316 ! wslpi and wslpj output in zwz and zww, resp. 356 zalpha = MAX(omlmask(ji,jj,jk),omlmask(ji,jj,jk-1)) 357 zwz(ji,jj,jk) = ( zai / ( zbi - zeps) * ( 1. - zalpha ) & 358 & + zalpha * wslpiml(ji,jj) & 359 & * fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj),10. ) ) & 360 & * tmask (ji,jj,jk) 361 zww(ji,jj,jk) = ( zaj / ( zbj - zeps) * ( 1. - zalpha ) & 362 & + zalpha * wslpjml(ji,jj) & 363 & * fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj),10. ) ) & 364 & * tmask (ji,jj,jk) 317 zalpha = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) 318 zcoef3 = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10. ) 319 zwz(ji,jj,jk) = ( zai / ( zbi - zeps) * ( 1. - zalpha ) & 320 & + zcoef3 * wslpiml(ji,jj) * zalpha ) * tmask (ji,jj,jk) 321 zww(ji,jj,jk) = ( zaj / ( zbj - zeps) * ( 1. - zalpha ) & 322 & + zcoef3 * wslpjml(ji,jj) * zalpha ) * tmask (ji,jj,jk) 365 323 END DO 366 324 END DO … … 424 382 END DO 425 383 426 IF( lk_sco ) THEN427 428 ! Slope of level surfaces429 ! -----------------------430 ! 'key_s_coord' defined but not 'key_traldfiso' the computation is done431 ! in inildf, ldfslp never called432 ! 'key_s_coord' and 'key_traldfiso' defined, the slope of level surfaces433 ! is added to the slope of isopycnal surfaces.434 435 DO jj = 2, jpjm1436 DO ji = fs_2, fs_jpim1 ! vector opt.437 wslpi(ji,jj,jk) = wslpi(ji,jj,jk) - 1. / e1t(ji,jj) &438 & * ( fsdepuw(ji+1,jj,jk) - fsdepuw(ji,jj,jk) )439 wslpj(ji,jj,jk) = wslpj(ji,jj,jk) - 1. / e2t(ji,jj) &440 & * ( fsdepvw(ji,jj+1,jk) - fsdepvw(ji,jj,jk) )441 END DO442 END DO443 ENDIF444 384 445 385 ! III. Specific grid points … … 474 414 ! III Lateral boundary conditions on all slopes (uslp , vslp, 475 415 ! ------------------------------- wslpi, wslpj ) 476 CALL lbc_lnk( uslp , 'U', -1. ) 477 CALL lbc_lnk( vslp , 'V', -1. ) 478 CALL lbc_lnk( wslpi, 'W', -1. ) 479 CALL lbc_lnk( wslpj, 'W', -1. ) 416 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) 417 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 418 419 IF(ln_ctl) THEN 420 CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp - u : ', tab3d_2=vslp, clinfo2=' v : ', kdim=jpk) 421 CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk) 422 ENDIF 480 423 481 424 END SUBROUTINE ldf_slp … … 546 489 ! mask for mixed layer 547 490 DO jk = 1, jpk 548 # if defined key_vectopt_loop && ! defined key_ autotasking491 # if defined key_vectopt_loop && ! defined key_mpp_omp 549 492 jj = 1 550 493 DO ji = 1, jpij ! vector opt. (forced unrolling) … … 560 503 omlmask(ji,jj,jk) = 0.e0 561 504 ENDIF 562 # if ! defined key_vectopt_loop || defined key_ autotasking505 # if ! defined key_vectopt_loop || defined key_mpp_omp 563 506 END DO 564 507 # endif … … 578 521 zwy(:,jpj) = 0.e0 579 522 zwy(jpi,:) = 0.e0 580 # if defined key_vectopt_loop && ! defined key_ autotasking523 # if defined key_vectopt_loop && ! defined key_mpp_omp 581 524 jj = 1 582 525 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) … … 591 534 & * ( pn2(ji,jj,ik) + pn2(ji,jj,ik+1) ) & 592 535 & / MAX( tmask(ji,jj,ik) + tmask (ji,jj,ik+1), 1. ) 593 # if ! defined key_vectopt_loop || defined key_ autotasking536 # if ! defined key_vectopt_loop || defined key_mpp_omp 594 537 END DO 595 538 # endif … … 599 542 600 543 ! Slope at u points 601 # if defined key_vectopt_loop && ! defined key_ autotasking544 # if defined key_vectopt_loop && ! defined key_mpp_omp 602 545 jj = 1 603 546 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) … … 616 559 ! uslpml 617 560 uslpml (ji,jj) = zau / ( zbu - zeps ) * umask (ji,jj,ik) 618 # if ! defined key_vectopt_loop || defined key_ autotasking561 # if ! defined key_vectopt_loop || defined key_mpp_omp 619 562 END DO 620 563 # endif … … 628 571 zwy ( :, jpj) = 0.e0 629 572 zwy ( jpi, :) = 0.e0 630 # if defined key_vectopt_loop && ! defined key_ autotasking573 # if defined key_vectopt_loop && ! defined key_mpp_omp 631 574 jj = 1 632 575 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) … … 640 583 & * ( pn2(ji,jj,ik) + pn2(ji,jj,ik+1) ) & 641 584 & / MAX( tmask(ji,jj,ik) + tmask (ji,jj,ik+1), 1. ) 642 # if ! defined key_vectopt_loop || defined key_ autotasking585 # if ! defined key_vectopt_loop || defined key_mpp_omp 643 586 END DO 644 587 # endif … … 649 592 650 593 ! Slope at v points 651 # if defined key_vectopt_loop && ! defined key_ autotasking594 # if defined key_vectopt_loop && ! defined key_mpp_omp 652 595 jj = 1 653 596 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) … … 666 609 ! vslpml 667 610 vslpml (ji,jj) = zav / ( zbv - zeps ) * vmask (ji,jj,ik) 668 # if ! defined key_vectopt_loop || defined key_ autotasking611 # if ! defined key_vectopt_loop || defined key_mpp_omp 669 612 END DO 670 613 # endif … … 680 623 ! Local vertical density gradient evaluated from N^2 681 624 ! zwy = d/dz(prd)= - mk ( prd ) / grav * pn2 -- at w point 682 # if defined key_vectopt_loop && ! defined key_ autotasking625 # if defined key_vectopt_loop && ! defined key_mpp_omp 683 626 jj = 1 684 627 DO ji = 1, jpij ! vector opt. (forced unrolling) … … 692 635 zwy (ji,jj) = zm05g * pn2 (ji,jj,ik) * & 693 636 & ( prd (ji,jj,ik) + prd (ji,jj,ikm1) + 2. ) 694 # if ! defined key_vectopt_loop || defined key_ autotasking637 # if ! defined key_vectopt_loop || defined key_mpp_omp 695 638 END DO 696 639 # endif … … 698 641 699 642 ! Slope at w point 700 # if defined key_vectopt_loop && ! defined key_ autotasking643 # if defined key_vectopt_loop && ! defined key_mpp_omp 701 644 jj = 1 702 645 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) … … 728 671 wslpiml (ji,jj) = zai / ( zbi - zeps) * tmask (ji,jj,ik) 729 672 wslpjml (ji,jj) = zaj / ( zbj - zeps) * tmask (ji,jj,ik) 730 # if ! defined key_vectopt_loop || defined key_ autotasking673 # if ! defined key_vectopt_loop || defined key_mpp_omp 731 674 END DO 732 675 # endif … … 780 723 781 724 IF( ln_traldf_hor ) THEN 725 IF(lwp) THEN 726 WRITE(numout,*) ' Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 727 ENDIF 782 728 783 729 ! geopotential diffusion in s-coordinates on tracers and/or momentum … … 790 736 DO jj = 2, jpjm1 791 737 DO ji = fs_2, fs_jpim1 ! vector opt. 792 uslp (ji,jj,jk) = -1. / e1u(ji,jj) * umask(ji,jj,jk) & 793 & * ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) ) 794 vslp (ji,jj,jk) = -1. / e2v(ji,jj) * vmask(ji,jj,jk) & 795 & * ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) 796 wslpi(ji,jj,jk) = -1. / e1t(ji,jj) * tmask(ji,jj,jk) & 797 & * ( fsdepuw(ji+1,jj,jk) - fsdepuw(ji,jj,jk) ) 798 wslpj(ji,jj,jk) = -1. / e2t(ji,jj) * tmask(ji,jj,jk) & 799 & * ( fsdepvw(ji,jj+1,jk) - fsdepvw(ji,jj,jk) ) 738 uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * umask(ji,jj,jk) 739 vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * vmask(ji,jj,jk) 740 wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5 741 wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5 800 742 END DO 801 743 END DO … … 803 745 804 746 ! Lateral boundary conditions on the slopes 805 CALL lbc_lnk( uslp , 'U', -1. ) 806 CALL lbc_lnk( vslp , 'V', -1. ) 807 CALL lbc_lnk( wslpi, 'W', -1. ) 808 CALL lbc_lnk( wslpj, 'W', -1. ) 747 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) 748 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 809 749 ENDIF 810 750 -
trunk/NEMO/OFF_SRC/LDF/ldftra_oce.F90
r343 r497 45 45 l_traldf_iso_zps !: iso-neutral laplacian (partial steps) 46 46 47 #if defined key_traldf_c3d 47 #if defined key_traldf_c3d || defined key_off_degrad 48 48 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: ** 3D coefficients ** 49 49 #elif defined key_traldf_c2d … … 63 63 LOGICAL, PUBLIC, PARAMETER :: lk_traldf_eiv = .TRUE. !: eddy induced velocity flag 64 64 65 # if defined key_traldf_c3d 65 # if defined key_traldf_c3d || defined key_off_degrad 66 66 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: ** 3D coefficients ** 67 67 # elif defined key_traldf_c2d
Note: See TracChangeset
for help on using the changeset viewer.