Changeset 1408
- Timestamp:
- 2009-04-17T11:59:49+02:00 (15 years ago)
- Location:
- branches/dev_004_VVL/NEMO/OPA_SRC
- Files:
-
- 16 edited
-
DOM/dom_oce.F90 (modified) (1 diff)
-
DOM/domain.F90 (modified) (14 diffs)
-
DOM/domvvl.F90 (modified) (8 diffs)
-
DOM/domzgr_substitute.h90 (modified) (1 diff)
-
DYN/dynnxt.F90 (modified) (11 diffs)
-
DYN/dynspg_exp.F90 (modified) (7 diffs)
-
DYN/dynspg_flt.F90 (modified) (10 diffs)
-
DYN/dynspg_ts.F90 (modified) (4 diffs)
-
DYN/dynvor.F90 (modified) (23 diffs)
-
DYN/wzvmod.F90 (modified) (14 diffs)
-
TRA/tranxt.F90 (modified) (9 diffs)
-
TRA/trazdf_exp.F90 (modified) (4 diffs)
-
TRA/trazdf_imp.F90 (modified) (13 diffs)
-
ZDF/zdfevd.F90 (modified) (7 diffs)
-
oce.F90 (modified) (3 diffs)
-
step.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_004_VVL/NEMO/OPA_SRC/DOM/dom_oce.F90
r1385 r1408 127 127 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 128 128 hur, hvr, & !: inverse of u and v-points ocean depth (1/m) 129 hu , hv !: depth at u- and v-points (meters) 129 hu , hv, & !: depth at u- and v-points (meters) 130 hu_0 , hv_0 !: refernce depth at u- and v-points (meters) 130 131 131 132 !! z-coordinate with full steps (also used in the other cases as reference z-coordinate) -
branches/dev_004_VVL/NEMO/OPA_SRC/DOM/domain.F90
r1335 r1408 4 4 !! Ocean initialization : domain initialization 5 5 !!============================================================================== 6 6 !! History : OPA ! 1990-10 (C. Levy - G. Madec) Original code 7 !! ! 1991-11 (G. Madec) 8 !! ! 1992-01 (M. Imbard) insert time step initialization 9 !! ! 1996-06 (G. Madec) generalized vertical coordinate 10 !! ! 1997-02 (G. Madec) creation of domwri.F 11 !! ! 2001-05 (E.Durand - G. Madec) insert closed sea 12 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module 13 !! 2.0 ! 2005-11 (V. Garnier) Surface pressure gradient organization 14 !!---------------------------------------------------------------------- 15 7 16 !!---------------------------------------------------------------------- 8 17 !! dom_init : initialize the space and time domain … … 10 19 !! dom_ctl : control print for the ocean domain 11 20 !!---------------------------------------------------------------------- 12 !! * Modules used13 21 USE oce ! 14 22 USE dom_oce ! ocean space and time domain … … 30 38 PRIVATE 31 39 32 !! * Routine accessibility 33 PUBLIC dom_init ! called by opa.F90 40 PUBLIC dom_init ! called by opa.F90 34 41 35 42 !! * Substitutions 36 43 # include "domzgr_substitute.h90" 37 !!---------------------------------------------------------------------- 38 !! OPA 9.0 , LOCEAN-IPSL (2005)44 !!------------------------------------------------------------------------- 45 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 39 46 !! $Id$ 40 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt41 !!---------------------------------------------------------------------- 47 !! Software is governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 48 !!------------------------------------------------------------------------- 42 49 43 50 CONTAINS … … 58 65 !! - dom_stp: defined the model time step 59 66 !! - dom_wri: create the meshmask file if nmsh=1 60 !! 61 !! History : 62 !! ! 90-10 (C. Levy - G. Madec) Original code 63 !! ! 91-11 (G. Madec) 64 !! ! 92-01 (M. Imbard) insert time step initialization 65 !! ! 96-06 (G. Madec) generalized vertical coordinate 66 !! ! 97-02 (G. Madec) creation of domwri.F 67 !! ! 01-05 (E.Durand - G. Madec) insert closed sea 68 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 69 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 70 !!---------------------------------------------------------------------- 71 !! * Local declarations 67 !!---------------------------------------------------------------------- 72 68 INTEGER :: jk ! dummy loop argument 73 69 INTEGER :: iconf = 0 ! temporary integers … … 90 86 CALL dom_msk ! Masks 91 87 92 IF( lk_vvl ) CALL dom_vvl _ini! Vertical variable mesh88 IF( lk_vvl ) CALL dom_vvl ! Vertical variable mesh 93 89 94 90 ! Local depth or Inverse of the local depth of the water column at u- and v-points 95 91 ! ------------------------------ 96 92 ! Ocean depth at U- and V-points 97 hu(:,:) = 0. 98 hv(:,:) = 0. 99 93 hu(:,:) = 0.e0 94 hv(:,:) = 0.e0 100 95 DO jk = 1, jpk 101 96 hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk) … … 105 100 hur(:,:) = fse3u(:,:,1) ! Lower bound : thickness of the first model level 106 101 hvr(:,:) = fse3v(:,:,1) 107 108 102 DO jk = 2, jpk ! Sum of the vertical scale factors 109 103 hur(:,:) = hur(:,:) + fse3u(:,:,jk) * umask(:,:,jk) 110 104 hvr(:,:) = hvr(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) 111 105 END DO 112 113 106 ! Compute and mask the inverse of the local depth 114 107 hur(:,:) = 1. / hur(:,:) * umask(:,:,1) 115 108 hvr(:,:) = 1. / hvr(:,:) * vmask(:,:,1) 116 109 117 118 110 CALL dom_stp ! Time step 119 111 … … 121 113 122 114 IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control 123 115 ! 124 116 END SUBROUTINE dom_init 125 117 … … 134 126 !! - namdom namelist 135 127 !! - namcla namelist 136 !! 137 !! History : 138 !! 9.0 ! 03-08 (G. Madec) Original code 139 !!---------------------------------------------------------------------- 140 !! * Modules used 128 !!---------------------------------------------------------------------- 141 129 USE ioipsl 142 130 NAMELIST/namrun/ no , cexper, cn_ocerst_in, cn_ocerst_out, ln_rstart, nrstdt, & … … 156 144 ENDIF 157 145 158 ! Namelist namrun : parameters of the run 159 REWIND( numnam ) 146 REWIND( numnam ) ! Namelist namrun : parameters of the run 160 147 READ ( numnam, namrun ) 161 162 148 IF(lwp) THEN 163 149 WRITE(numout,*) ' Namelist namrun' … … 228 214 ENDIF 229 215 230 ! Namelist namdom : space/time domain (bathymetry, mesh, timestep) 231 REWIND( numnam ) 216 REWIND( numnam ) ! Namelist namdom : space/time domain (bathymetry, mesh, timestep) 232 217 READ ( numnam, namdom ) 233 218 … … 252 237 ENDIF 253 238 254 ! Default values255 239 n_cla = 0 256 257 ! Namelist cross land advection 258 REWIND( numnam ) 240 REWIND( numnam ) ! Namelist cross land advection 259 241 READ ( numnam, namcla ) 260 242 IF(lwp) THEN … … 264 246 ENDIF 265 247 266 IF( nbit_cmp == 1 .AND. n_cla /= 0 ) THEN 267 CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require n_cla = 0' ) 268 END IF 269 248 IF( nbit_cmp == 1 .AND. n_cla /= 0 ) CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require n_cla = 0' ) 249 ! 270 250 END SUBROUTINE dom_nam 271 251 … … 278 258 !! 279 259 !! ** Method : compute and print extrema of masked scale factors 280 !! 281 !! History : 282 !! 8.5 ! 02-08 (G. Madec) Original code 283 !!---------------------------------------------------------------------- 284 !! * Local declarations 260 !!---------------------------------------------------------------------- 285 261 INTEGER :: iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2 286 262 INTEGER, DIMENSION(2) :: iloc ! 287 263 REAL(wp) :: ze1min, ze1max, ze2min, ze2max 288 264 !!---------------------------------------------------------------------- 289 290 ! Extrema of the scale factors291 265 292 266 IF(lwp)WRITE(numout,*) … … 325 299 WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2 326 300 ENDIF 327 301 ! 328 302 END SUBROUTINE dom_ctl 329 303 -
branches/dev_004_VVL/NEMO/OPA_SRC/DOM/domvvl.F90
r1389 r1408 4 4 !! Ocean : 5 5 !!====================================================================== 6 !! History : 9.0 !06-06 (B. Levier, L. Marie) original code7 !! " ! 07-07 (D. Storkey) Bug fixes and code for BDY option.6 !! History : 2.0 ! 2006-06 (B. Levier, L. Marie) original code 7 !! 3.1 ! 2009-02 (G. Madec, M. Leclair, R. Benshila) pure z* coordinate 8 8 !!---------------------------------------------------------------------- 9 9 #if defined key_vvl 10 10 !!---------------------------------------------------------------------- 11 11 !! 'key_vvl' variable volume 12 12 !!---------------------------------------------------------------------- 13 !! dom_vvl : defined coefficients to distribute ssh on each layers 13 14 !!---------------------------------------------------------------------- 14 !! dom_vvl : empty routine15 !! dom_vvl_ini : defined coefficients to distribute ssh on each layers16 !!----------------------------------------------------------------------17 !! * Modules used18 15 USE oce ! ocean dynamics and tracers 19 16 USE dom_oce ! ocean space and time domain 20 17 USE sbc_oce ! surface boundary condition: ocean 21 USE dynspg_oce ! surface pressure gradient variables22 18 USE phycst ! physical constants 23 19 USE in_out_manager ! I/O manager 24 20 USE lib_mpp ! distributed memory computing library 25 21 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 26 USE bdy_oce ! unstructured open boundary conditions27 22 28 23 IMPLICIT NONE 29 24 PRIVATE 30 25 31 !! * Routine accessibility 32 PUBLIC dom_vvl_ini ! called by dom_init.F90 33 PUBLIC dom_vvl ! called by istate.F90 and step.F90 26 PUBLIC dom_vvl ! called by domain.F90 34 27 35 !! * Module variables 36 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hu_0, hv_0 37 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 !: ??? 38 29 39 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 40 mut, muu, muv, muf !: 30 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: mut, muu, muv, muf !: ??? 41 31 42 32 REAL(wp), DIMENSION(jpk) :: r2dt ! vertical profile time-step, = 2 rdttra … … 47 37 # include "vectopt_loop_substitute.h90" 48 38 !!---------------------------------------------------------------------- 49 !! OPA 9.0 , LOCEAN-IPSL (2005)39 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 50 40 !! $Id$ 51 41 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 54 44 CONTAINS 55 45 56 #if defined key_vvl 57 58 SUBROUTINE dom_vvl_ini 46 SUBROUTINE dom_vvl 59 47 !!---------------------------------------------------------------------- 60 !! *** ROUTINE dom_vvl _ini***48 !! *** ROUTINE dom_vvl *** 61 49 !! 62 50 !! ** Purpose : compute coefficients muX at T-U-V-F points to spread … … 70 58 IF(lwp) THEN 71 59 WRITE(numout,*) 72 WRITE(numout,*) 'dom_vvl _ini: Variable volume activated'73 WRITE(numout,*) '~~~~~~~~ ~~~compute coef. used to spread ssh over each layers'60 WRITE(numout,*) 'dom_vvl : Variable volume activated' 61 WRITE(numout,*) '~~~~~~~~ compute coef. used to spread ssh over each layers' 74 62 ENDIF 75 63 … … 127 115 128 116 129 !!debug print130 ! ii=50 ; ij = 50131 ! do jk= 1, jpk132 ! WRITE(numout,*) 'domvvl GM : h0=', SUM( fse3t_0(ii,ij,1:jk) * tmask(ii,ij,1:jk) ), 'e3t0=', fse3t_0(ii,ij,jk), &133 ! & 'e3t =', fse3t_0(ii,ij,jk) * ( 1 + mut(ii,ij,jk) ), 'mut', mut(ii,ij,jk), &134 ! & 'h =', SUM( fse3t_0(ii,ij,1:jk) * ( 1 + mut(ii,ij,1:jk) ) * tmask(ii,ij,1:jk) )135 ! end do136 !!end debug print137 138 117 ! Reference ocean depth at U- and V-points 139 118 hu_0(:,:) = 0.e0 140 119 hv_0(:,:) = 0.e0 141 120 DO jk = 1, jpk 142 hu_0(:,:) = hu_0(:,:) + fse3u (:,:,jk) * umask(:,:,jk)143 hv_0(:,:) = hv_0(:,:) + fse3v (:,:,jk) * vmask(:,:,jk)121 hu_0(:,:) = hu_0(:,:) + fse3u_0(:,:,jk) * umask(:,:,jk) 122 hv_0(:,:) = hv_0(:,:) + fse3v_0(:,:,jk) * vmask(:,:,jk) 144 123 END DO 145 124 … … 149 128 zcoefu = 0.5 * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) ) 150 129 zcoefv = 0.5 * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) ) 151 zcoeff = 0.25 * fmask(ji,jj,1) 152 !!gm bug used of fmask, even if thereafter multiplied by muf which is correctly masked) 130 zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1) 153 131 sshu_b(ji,jj) = zcoefu * ( e1t(ji ,jj) * e2t(ji ,jj) * sshb(ji ,jj) & 154 132 & + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) ) … … 170 148 CALL lbc_lnk( sshf_b, 'F', 1. ) ; CALL lbc_lnk( sshf_n, 'F', 1. ) 171 149 ! 172 173 174 END SUBROUTINE dom_vvl_ini175 176 177 SUBROUTINE dom_vvl178 !!----------------------------------------------------------------------179 !! *** ROUTINE dom_vvl ***180 !!181 !! ** Purpose : compute ssh at U-V-F points, T-W scale factors and local182 !! depths at each time step.183 !!----------------------------------------------------------------------184 !! * Local declarations185 INTEGER :: ji, jj, jk ! dummy loop indices186 !!----------------------------------------------------------------------187 188 ! IF( kt == nit000 ) THEN189 ! IF(lwp) WRITE(numout,*)190 ! IF(lwp) WRITE(numout,*) 'dom_vvl : '191 ! IF(lwp) WRITE(numout,*) '~~~~~~~ '192 ! ENDIF193 194 WRITE(*,*) 'dom_vvl : empty routine, you should not be here'195 196 150 END SUBROUTINE dom_vvl 197 151 … … 200 154 !! Default option : Empty routine 201 155 !!---------------------------------------------------------------------- 202 SUBROUTINE dom_vvl_ini 203 END SUBROUTINE dom_vvl_ini 156 CONTAINS 204 157 SUBROUTINE dom_vvl 205 158 END SUBROUTINE dom_vvl -
branches/dev_004_VVL/NEMO/OPA_SRC/DOM/domzgr_substitute.h90
r1385 r1408 78 78 # define fse3uw_a(i,j,k) (fse3uw_0(i,j,k)*(1+sshu_a(i,j)*muu(i,j,k))) 79 79 # define fse3vw_a(i,j,k) (fse3vw_0(i,j,k)*(1+sshv_a(i,j)*muv(i,j,k))) 80 80 81 #else 81 82 ! z- or s-coordinate (1D or 3D + no time dependency) use reference in all cases -
branches/dev_004_VVL/NEMO/OPA_SRC/DYN/dynnxt.F90
r1390 r1408 15 15 !! 2.0 ! 2005-11 (V. Garnier) Surface pressure gradient organization 16 16 !! 2.3 ! 2007-07 (D. Storkey) Calls to BDY routines. 17 !! 3. 1 ! 2009-02 (G. Madec) re-introduce the vvl option17 !! 3.2 ! 2009-04 (G. Madec, R.Benshila)) re-introduce the vvl option 18 18 !!---------------------------------------------------------------------- 19 19 … … 21 21 !! dyn_nxt : update the horizontal velocity from the momentum trend 22 22 !!---------------------------------------------------------------------- 23 !! * Modules used24 23 USE oce ! ocean dynamics and tracers 25 24 USE dom_oce ! ocean space and time domain … … 42 41 PRIVATE 43 42 44 !! * Accessibility45 PUBLIC dyn_nxt ! routine called by step.F90 43 PUBLIC dyn_nxt ! routine called by step.F90 44 46 45 !! * Substitutions 47 46 # include "domzgr_substitute.h90" 48 !!---------------------------------------------------------------------- 49 !! OPA 9.0 , LOCEAN-IPSL (2005)47 !!------------------------------------------------------------------------- 48 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 50 49 !! $Id$ 51 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt52 !!---------------------------------------------------------------------- 50 !! Software is governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 51 !!------------------------------------------------------------------------- 53 52 54 53 CONTAINS … … 85 84 REAL(wp) :: ze3u_b, ze3u_n, ze3u_a ! - - 86 85 REAL(wp) :: ze3v_b, ze3v_n, ze3v_a ! - - 87 !!---------------------------------------------------------------------- 86 REAL(wp) :: zuf , zvf ! - - 87 !!---------------------------------------------------------------------- 88 88 89 89 IF( kt == nit000 ) THEN … … 100 100 101 101 ! Lateral boundary conditions on ( ua, va ) 102 CALL lbc_lnk( ua, 'U', -1. ) 103 CALL lbc_lnk( va, 'V', -1. ) 102 CALL lbc_lnk( ua, 'U', -1. ) ; CALL lbc_lnk( va, 'V', -1. ) 104 103 105 104 ! Next velocity … … 110 109 IF( lk_vvl ) THEN ! Varying levels 111 110 DO jk = 1, jpkm1 112 ua(:,:,jk) = ( ub(:,:,jk) * fse3u_b(:,:,jk) &111 ua(:,:,jk) = ( ub(:,:,jk) * fse3u_b(:,:,jk) & 113 112 & + z2dt * ua(:,:,jk) * fse3u_n(:,:,jk) ) & 114 113 & / fse3u_a(:,:,jk) * umask(:,:,jk) 115 va(:,:,jk) = ( vb(:,:,jk) * fse3v_b(:,:,jk) &114 va(:,:,jk) = ( vb(:,:,jk) * fse3v_b(:,:,jk) & 116 115 & + z2dt * va(:,:,jk) * fse3v_n(:,:,jk) ) & 117 116 & / fse3v_a(:,:,jk) * vmask(:,:,jk) … … 130 129 131 130 IF ( lk_dynspg_exp .OR. lk_dynspg_ts ) THEN 132 ! Flather boundary condition :131 ! Flather boundary condition : 133 132 ! - Update sea surface height on each open boundary 134 133 ! sshn (= after ssh) for explicit case … … 136 135 ! - Correct the barotropic velocities 137 136 CALL obc_dyn_bt( kt ) 138 139 ! Boundary conditions on sshn ( after ssh)137 ! 138 ! Boundary conditions on sshn ( after ssh) 140 139 CALL lbc_lnk( sshn, 'T', 1. ) 141 142 IF(ln_ctl) THEN ! print sum trends (used for debugging) 143 CALL prt_ctl(tab2d_1=sshn, clinfo1=' ssh : ', mask1=tmask) 144 ENDIF 145 146 IF ( ln_vol_cst ) CALL obc_vol( kt ) 147 140 ! 141 IF( ln_vol_cst ) CALL obc_vol( kt ) 142 ! 143 IF(ln_ctl) CALL prt_ctl( tab2d_1=sshn, clinfo1=' ssh : ', mask1=tmask ) 148 144 ENDIF 149 145 150 146 # elif defined key_bdy 151 147 ! Update (ua,va) along open boundaries (for exp or ts options). 152 IF ( lk_dynspg_exp .or. lk_dynspg_ts ) THEN153 148 IF( lk_dynspg_exp .OR. lk_dynspg_ts ) THEN 149 ! 154 150 CALL bdy_dyn_frs( kt ) 155 156 IF ( ln_bdy_fla ) THEN 157 158 ua_e(:,:)=0.0 159 va_e(:,:)=0.0 160 151 ! 152 IF( ln_bdy_fla ) THEN 153 ua_e(:,:) = 0.e0 154 va_e(:,:) = 0.e0 161 155 ! Set these variables for use in bdy_dyn_fla 162 156 hu_e(:,:) = hu(:,:) 163 157 hv_e(:,:) = hv(:,:) 164 165 DO jk = 1, jpkm1 166 !! Vertically integrated momentum trends 158 DO jk = 1, jpkm1 !! Vertically integrated momentum trends 167 159 ua_e(:,:) = ua_e(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 168 160 va_e(:,:) = va_e(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 169 161 END DO 170 171 162 DO jk = 1 , jpkm1 172 163 ua(:,:,jk) = ua(:,:,jk) - ua_e(:,:) * hur(:,:) 173 164 va(:,:,jk) = va(:,:,jk) - va_e(:,:) * hvr(:,:) 174 165 END DO 175 176 166 CALL bdy_dta_bt( kt+1, 0) 177 167 CALL bdy_dyn_fla 178 179 168 ENDIF 180 169 ! 181 170 DO jk = 1 , jpkm1 182 171 ua(:,:,jk) = ua(:,:,jk) + ua_e(:,:) * hur(:,:) 183 172 va(:,:,jk) = va(:,:,jk) + va_e(:,:) * hvr(:,:) 184 173 END DO 185 186 ENDIF 187 174 ENDIF 188 175 # endif 176 189 177 # if defined key_agrif 190 178 CALL Agrif_dyn( kt ) … … 196 184 IF( neuler == 0 .AND. kt == nit000 ) THEN 197 185 DO jk = 1, jpkm1 198 ub(:,:,jk) = un(:,:,jk)199 vb(:,:,jk) = vn(:,:,jk)200 186 un(:,:,jk) = ua(:,:,jk) 201 187 vn(:,:,jk) = va(:,:,jk) … … 230 216 END DO 231 217 ELSE ! Fixed levels 232 !RB_vvl : should be done as in tranxt ?233 218 DO jk = 1, jpkm1 ! filter applied on velocities 234 ub(:,:,jk) = atfp * ( ub(:,:,jk) + ua(:,:,jk) ) + atfp1 * un(:,:,jk) 235 vb(:,:,jk) = atfp * ( vb(:,:,jk) + va(:,:,jk) ) + atfp1 * vn(:,:,jk) 236 un(:,:,jk) = ua(:,:,jk) 237 vn(:,:,jk) = va(:,:,jk) 219 DO jj = 1, jpj 220 DO ji = 1, jpi 221 zuf = atfp * ( ub(ji,jj,jk) + ua(ji,jj,jk) ) + atfp1 * un(ji,jj,jk) 222 zvf = atfp * ( vb(ji,jj,jk) + va(ji,jj,jk) ) + atfp1 * vn(ji,jj,jk) 223 ub(ji,jj,jk) = zuf 224 vb(ji,jj,jk) = zvf 225 un(ji,jj,jk) = ua(ji,jj,jk) 226 vn(ji,jj,jk) = va(ji,jj,jk) 227 END DO 228 END DO 238 229 END DO 239 230 ENDIF 240 ENDIF241 242 IF(ln_ctl) THEN243 CALL prt_ctl(tab3d_1=un, clinfo1=' nxt - Un: ', mask1=umask, &244 & tab3d_2=vn, clinfo2=' Vn: ', mask2=vmask)245 231 ENDIF 246 232 … … 249 235 #endif 250 236 237 IF(ln_ctl) CALL prt_ctl( tab3d_1=un, clinfo1=' nxt - Un: ', mask1=umask, & 238 & tab3d_2=vn, clinfo2=' Vn: ' , mask2=vmask ) 239 ! 251 240 END SUBROUTINE dyn_nxt 252 241 -
branches/dev_004_VVL/NEMO/OPA_SRC/DYN/dynspg_exp.F90
r1390 r1408 4 4 !! Ocean dynamics: surface pressure gradient trend 5 5 !!====================================================================== 6 !! History : 9.0 ! 2005-11 (V. Garnier, G. Madec, L. Bessieres) Original code 7 !!---------------------------------------------------------------------- 6 8 #if defined key_dynspg_exp || defined key_esopa 7 9 !!---------------------------------------------------------------------- … … 12 14 !! volume case with vector optimization 13 15 !!---------------------------------------------------------------------- 14 !! * Modules used15 16 USE oce ! ocean dynamics and tracers 16 17 USE dom_oce ! ocean space and time domain … … 30 31 PRIVATE 31 32 32 !! * Accessibility 33 PUBLIC dyn_spg_exp ! routine called by step.F90 33 PUBLIC dyn_spg_exp ! routine called by step.F90 34 34 35 35 !! * Substitutions … … 37 37 # include "vectopt_loop_substitute.h90" 38 38 !!---------------------------------------------------------------------- 39 !! OPA 9.0 , LOCEAN-IPSL (2005)39 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 40 40 !! $Id$ 41 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt41 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 42 42 !!---------------------------------------------------------------------- 43 44 43 45 44 CONTAINS … … 62 61 !! 63 62 !! ** Action : - Update (ua,va) with the surf. pressure gradient trend 63 !!--------------------------------------------------------------------- 64 INTEGER, INTENT( in ) :: kt ! ocean time-step index 64 65 !! 65 !! References :66 !!67 !! History :68 !! 9.0 ! 05-11 (V. Garnier, G. Madec, L. Bessieres) Original code69 !!70 !!---------------------------------------------------------------------71 !! * Arguments72 INTEGER, INTENT( in ) :: kt ! ocean time-step index73 74 !! * Local declarations75 66 INTEGER :: ji, jj, jk ! dummy loop indices 76 67 !!---------------------------------------------------------------------- … … 86 77 ENDIF 87 78 88 ! 0. Initialization89 ! -----------------90 79 ! read or estimate sea surface height and vertically integrated velocities 91 80 IF( lk_obc ) CALL obc_dta_bt( kt, 0 ) 92 81 93 ! 1. Surface pressure gradient (now) 94 ! ---------------------------- 82 ! Surface pressure gradient (now) 95 83 DO jj = 2, jpjm1 96 84 DO ji = fs_2, fs_jpim1 ! vector opt. … … 100 88 END DO 101 89 102 ! 2. Add the surface pressure trend to the general trend 103 ! ------------------------------------------------------ 90 ! Add the surface pressure trend to the general trend 104 91 DO jk = 1, jpkm1 105 92 DO jj = 2, jpjm1 -
branches/dev_004_VVL/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r1390 r1408 4 4 !! Ocean dynamics: surface pressure gradient trend 5 5 !!====================================================================== 6 !! History 8.0 ! 98-05 (G. Roullet) free surface 7 !! ! 98-10 (G. Madec, M. Imbard) release 8.2 8 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 9 !! " " ! 02-11 (C. Talandier, A-M Treguier) Open boundaries 10 !! 9.0 ! 04-08 (C. Talandier) New trends organization 11 !! " " ! 05-11 (V. Garnier) Surface pressure gradient organization 12 !! " " ! 06-07 (S. Masson) distributed restart using iom 13 !! " " ! 05-01 (J.Chanut, A.Sellar) Calls to BDY routines. 6 !! History OPA ! 1998-05 (G. Roullet) free surface 7 !! ! 1998-10 (G. Madec, M. Imbard) release 8.2 8 !! NEMO O.1 ! 2002-08 (G. Madec) F90: Free form and module 9 !! - ! 2002-11 (C. Talandier, A-M Treguier) Open boundaries 10 !! 1.0 ! 2004-08 (C. Talandier) New trends organization 11 !! - ! 2005-11 (V. Garnier) Surface pressure gradient organization 12 !! 2.0 ! 2006-07 (S. Masson) distributed restart using iom 13 !! - ! 2006-08 (J.Chanut, A.Sellar) Calls to BDY routines. 14 !! 3.2 ! 2009-03 (G. Madec, M. Leclair, R. Benshila) introduce sshwzv module 14 15 !!---------------------------------------------------------------------- 15 16 #if defined key_dynspg_flt || defined key_esopa 16 17 !!---------------------------------------------------------------------- 17 18 !! 'key_dynspg_flt' filtered free surface 18 !!----------------------------------------------------------------------19 19 !!---------------------------------------------------------------------- 20 20 !! dyn_spg_flt : update the momentum trend with the surface pressure … … 53 53 PRIVATE 54 54 55 PUBLIC dyn_spg_flt ! routine called by step.F9056 PUBLIC flt_rst ! routine called by istate.F9055 PUBLIC dyn_spg_flt ! routine called by step.F90 56 PUBLIC flt_rst ! routine called by istate.F90 57 57 58 58 !! * Substitutions … … 60 60 # include "vectopt_loop_substitute.h90" 61 61 !!---------------------------------------------------------------------- 62 !! OPA 9.0 , LOCEAN-IPSL (2005)62 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 63 63 !! $Id$ 64 64 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 80 80 !! spgv = 1/rau0 d/dy(ps) = 1/e2v dj( sshn + rnu btda ) 81 81 !! where sshn is the free surface elevation and btda is the after 82 !! of the free surface elevation82 !! time derivative of the free surface elevation 83 83 !! -1- evaluate the surface presure trend (including the addi- 84 84 !! tional force) in three steps: … … 104 104 !! References : Roullet and Madec 1999, JGR. 105 105 !!--------------------------------------------------------------------- 106 !! * Modules used 107 USE oce , ONLY : zub => ta, & ! ta used as workspace 108 zvb => sa ! sa " " 109 110 INTEGER, INTENT( in ) :: kt ! ocean time-step index 111 INTEGER, INTENT( out ) :: kindic ! solver convergence flag (<0 if not converge) 106 USE oce, ONLY : zub => ta ! ta used as workspace 107 USE oce, ONLY : zvb => sa ! ta used as workspace 108 !! 109 INTEGER, INTENT( in ) :: kt ! ocean time-step index 110 INTEGER, INTENT( out ) :: kindic ! solver convergence flag (<0 if not converge) 112 111 !! 113 112 INTEGER :: ji, jj, jk ! dummy loop indices 114 REAL(wp) :: z2dt, z2dtg, zraur, znugdt , &! temporary scalars115 & znurau, zgcb, zbtd, &! " "116 &ztdgu, ztdgv ! " "113 REAL(wp) :: z2dt, z2dtg, zraur, znugdt ! temporary scalars 114 REAL(wp) :: znurau, zgcb, zbtd ! " " 115 REAL(wp) :: ztdgu, ztdgv ! " " 117 116 !!---------------------------------------------------------------------- 118 117 ! … … 130 129 ! when using agrif, sshn, gcx have to be read in istate 131 130 IF (.NOT. lk_agrif) CALL flt_rst( nit000, 'READ' ) ! read or initialize the following fields: 132 ! ! gcx, gcxb , sshb, sshn131 ! ! gcx, gcxb 133 132 ENDIF 134 133 … … 354 353 DO jj = 2, jpjm1 355 354 DO ji = fs_2, fs_jpim1 ! vector opt. 356 ua(ji,jj,jk) = ( ua(ji,jj,jk) + spgu(ji,jj)) * umask(ji,jj,jk)357 va(ji,jj,jk) = ( va(ji,jj,jk) + spgv(ji,jj)) * vmask(ji,jj,jk)355 ua(ji,jj,jk) = ( ua(ji,jj,jk) + spgu(ji,jj) ) * umask(ji,jj,jk) 356 va(ji,jj,jk) = ( va(ji,jj,jk) + spgv(ji,jj) ) * vmask(ji,jj,jk) 358 357 END DO 359 358 END DO … … 363 362 ! -------------------------------------------------- 364 363 IF( lrst_oce ) CALL flt_rst( kt, 'WRITE' ) 365 366 ! print sum trends (used for debugging)367 IF(ln_ctl) CALL prt_ctl( tab2d_1=sshn, clinfo1=' spg - ssh: ', mask1=tmask )368 364 ! 369 365 END SUBROUTINE dyn_spg_flt … … 386 382 CALL iom_get( numror, jpdom_autoglo, 'gcx' , gcx (1:jpi,1:jpj) ) 387 383 CALL iom_get( numror, jpdom_autoglo, 'gcxb', gcxb(1:jpi,1:jpj) ) 388 IF( neuler == 0 ) THEN 389 gcxb(:,:) = gcx (:,:) 390 ENDIF 384 IF( neuler == 0 ) gcxb(:,:) = gcx (:,:) 391 385 ELSE 392 386 gcx (:,:) = 0.e0 … … 396 390 ! Caution : extra-hallow 397 391 ! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) 398 CALL iom_rstput( kt, nitrst, numrow, 'gcx' , gcx (1:jpi,1:jpj) )392 CALL iom_rstput( kt, nitrst, numrow, 'gcx' , gcx (1:jpi,1:jpj) ) 399 393 CALL iom_rstput( kt, nitrst, numrow, 'gcxb', gcxb(1:jpi,1:jpj) ) 400 394 ENDIF -
branches/dev_004_VVL/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r1405 r1408 1 1 MODULE dynspg_ts 2 2 !!====================================================================== 3 !! History : 9.0 ! 04-12 (L. Bessieres, G. Madec) Original code4 !! " "! 05-11 (V. Garnier, G. Madec) optimization5 !! 9.0! 06-08 (S. Masson) distributed restart using iom6 !! " ! 08-01 (R. Benshila) change averaging method7 !! " ! 07-07 (D. Storkey) calls to BDY routines8 3 !! History : 1.0 ! 04-12 (L. Bessieres, G. Madec) Original code 4 !! - ! 05-11 (V. Garnier, G. Madec) optimization 5 !! - ! 06-08 (S. Masson) distributed restart using iom 6 !! 2.0 ! 07-07 (D. Storkey) calls to BDY routines 7 !! - ! 08-01 (R. Benshila) change averaging method 8 !!--------------------------------------------------------------------- 9 9 #if defined key_dynspg_ts || defined key_esopa 10 10 !!---------------------------------------------------------------------- … … 16 16 !! ts_rst : read/write the time-splitting restart fields in the ocean restart file 17 17 !!---------------------------------------------------------------------- 18 !! * Modules used19 18 USE oce ! ocean dynamics and tracers 20 19 USE dom_oce ! ocean space and time domain … … 46 45 PUBLIC ts_rst ! routine called by istate.F90 47 46 48 REAL(wp), DIMENSION(jpi,jpj) :: ftnw, ftne, & ! triad of coriolis parameter 49 & ftsw, ftse ! (only used with een vorticity scheme) 50 47 REAL(wp), DIMENSION(jpi,jpj) :: ftnw, ftne ! triad of coriolis parameter 48 REAL(wp), DIMENSION(jpi,jpj) :: ftsw, ftse ! (only used with een vorticity scheme) 51 49 52 50 !! * Substitutions 53 51 # include "domzgr_substitute.h90" 54 52 # include "vectopt_loop_substitute.h90" 55 !!---------------------------------------------------------------------- 56 !! OPA 9.0 , LOCEAN-IPSL (2005)53 !!------------------------------------------------------------------------- 54 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 57 55 !! $Id$ 58 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt59 !!---------------------------------------------------------------------- 56 !! Software is governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 57 !!------------------------------------------------------------------------- 60 58 61 59 CONTAINS … … 90 88 !!--------------------------------------------------------------------- 91 89 INTEGER, INTENT( in ) :: kt ! ocean time-step index 92 93 !! * Local declarations 90 !! 94 91 INTEGER :: ji, jj, jk, jit ! dummy loop indices 95 92 INTEGER :: icycle ! temporary scalar -
branches/dev_004_VVL/NEMO/OPA_SRC/DYN/dynvor.F90
r1383 r1408 5 5 !! planetary vorticity trends 6 6 !!====================================================================== 7 !! History : 1.0 ! 89-12 (P. Andrich) vor_ens: Original code 8 !! 5.0 ! 91-11 (G. Madec) vor_ene, vor_mix: Original code 9 !! 6.0 ! 96-01 (G. Madec) s-coord, suppress work arrays 10 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 11 !! 8.5 ! 04-02 (G. Madec) vor_een: Original code 12 !! 9.0 ! 03-08 (G. Madec) vor_ctl: Original code 13 !! 9.0 ! 05-11 (G. Madec) dyn_vor: Original code (new step architecture) 14 !! 9.0 ! 06-11 (G. Madec) flux form advection: add metric term 7 !! History : OPA ! 1989-12 (P. Andrich) vor_ens: Original code 8 !! 5.0 ! 1991-11 (G. Madec) vor_ene, vor_mix: Original code 9 !! 6.0 ! 1996-01 (G. Madec) s-coord, suppress work arrays 10 !! 8.5 ! 2002-08 (G. Madec) F90: Free form and module 11 !! NEMO 1.0 ! 2004-02 (G. Madec) vor_een: Original code 12 !! - ! 2003-08 (G. Madec) add vor_ctl 13 !! - ! 2005-11 (G. Madec) add dyn_vor (new step architecture) 14 !! 2.0 ! 2006-11 (G. Madec) flux form advection: add metric term 15 !! 3.2 ! 2009-04 (R. Benshila) vvl: correction of een scheme 15 16 !!---------------------------------------------------------------------- 16 17 … … 37 38 PUBLIC dyn_vor ! routine called by step.F90 38 39 39 ! !* Namelist nam_dynvor: vorticity term40 ! !!* Namelist nam_dynvor: vorticity term 40 41 LOGICAL, PUBLIC :: ln_dynvor_ene = .FALSE. !: energy conserving scheme 41 42 LOGICAL, PUBLIC :: ln_dynvor_ens = .TRUE. !: enstrophy conserving scheme … … 52 53 # include "vectopt_loop_substitute.h90" 53 54 !!---------------------------------------------------------------------- 54 !! OPA 9.0 , LOCEAN-IPSL (2006)55 !! NEMO/OPA 3,2 , LOCEAN-IPSL (2009) 55 56 !! $Id$ 56 57 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 174 175 IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' vor - Ua: ', mask1=umask, & 175 176 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 176 177 ! 177 178 END SUBROUTINE dyn_vor 178 179 … … 206 207 INTEGER , INTENT(in ) :: kt ! ocean time-step index 207 208 INTEGER , INTENT(in ) :: kvor ! =ncor (planetary) ; =ntot (total) ; 208 !! =nrvm (relative vorticity or metric)209 ! ! =nrvm (relative vorticity or metric) 209 210 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pua ! total u-trend 210 211 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pva ! total v-trend … … 222 223 ENDIF 223 224 224 ! Local constant initialization 225 zfact2 = 0.5 * 0.5 225 zfact2 = 0.5 * 0.5 ! Local constant initialization 226 226 227 227 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz ) … … 229 229 DO jk = 1, jpkm1 ! Horizontal slab 230 230 ! ! =============== 231 ! 231 232 ! Potential vorticity and horizontal fluxes 232 233 ! ----------------------------------------- … … 315 316 INTEGER, INTENT(in) :: kt ! ocean timestep index 316 317 !! 317 INTEGER :: ji, jj, jk ! dummy loop indices318 INTEGER :: ji, jj, jk ! dummy loop indices 318 319 REAL(wp) :: zfact1, zua, zcua, zx1, zy1 ! temporary scalars 319 320 REAL(wp) :: zfact2, zva, zcva, zx2, zy2 ! " " … … 327 328 ENDIF 328 329 329 ! Local constant initialization 330 zfact1 = 0.5 * 0.25 330 zfact1 = 0.5 * 0.25 ! Local constant initialization 331 331 zfact2 = 0.5 * 0.5 332 332 … … 335 335 DO jk = 1, jpkm1 ! Horizontal slab 336 336 ! ! =============== 337 337 ! 338 338 ! Relative and planetary potential vorticity and horizontal fluxes 339 339 ! ---------------------------------------------------------------- … … 438 438 ENDIF 439 439 440 ! Local constant initialization 441 zfact1 = 0.5 * 0.25 440 zfact1 = 0.5 * 0.25 ! Local constant initialization 442 441 443 442 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz ) … … 445 444 DO jk = 1, jpkm1 ! Horizontal slab 446 445 ! ! =============== 446 ! 447 447 ! Potential vorticity and horizontal fluxes 448 448 ! ----------------------------------------- … … 465 465 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 466 466 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 467 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) &467 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) & 468 468 & ) 469 469 END DO 470 470 END DO 471 471 END SELECT 472 472 ! 473 473 IF( ln_sco ) THEN 474 474 DO jj = 1, jpj ! caution: don't use (:,:) for this loop … … 487 487 END DO 488 488 ENDIF 489 489 ! 490 490 ! Compute and add the vorticity term trend 491 491 ! ---------------------------------------- … … 514 514 !! 515 515 !! ** Method : Trend evaluated using now fields (centered in time) 516 !! and the Arakawa and Lamb (19 XX) flux form formulation : conserves516 !! and the Arakawa and Lamb (1980) flux form formulation : conserves 517 517 !! both the horizontal kinetic energy and the potential enstrophy 518 !! when horizontal divergence is zero. 519 !! The trend of the vorticity term is given by: 520 !! * s-coordinate (ln_sco=T), the e3. are inside the derivatives: 521 !! * z-coordinate (default key), e3t=e3u=e3v, the trend becomes: 522 !! Add this trend to the general momentum trend (ua,va): 523 !! (ua,va) = (ua,va) + ( voru , vorv ) 518 !! when horizontal divergence is zero (see the NEMO documentation) 519 !! Add this trend to the general momentum trend (ua,va). 524 520 !! 525 521 !! ** Action : - Update (ua,va) with the now vorticity term trend … … 531 527 INTEGER , INTENT(in ) :: kt ! ocean time-step index 532 528 INTEGER , INTENT(in ) :: kvor ! =ncor (planetary) ; =ntot (total) ; 533 !! =nrvm (relative vorticity or metric)529 ! ! =nrvm (relative vorticity or metric) 534 530 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pua ! total u-trend 535 531 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pva ! total v-trend 536 532 !! 537 INTEGER :: ji, jj, jk! dummy loop indices533 INTEGER :: ji, jj, jk ! dummy loop indices 538 534 REAL(wp) :: zfac12, zua, zva ! temporary scalars 539 535 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zwz ! temporary 2D workspace 540 536 REAL(wp), DIMENSION(jpi,jpj) :: ztnw, ztne, ztsw, ztse ! temporary 3D workspace 537 #if defined key_vvl 538 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3f 539 #else 541 540 REAL(wp), DIMENSION(jpi,jpj,jpk), SAVE :: ze3f 541 #endif 542 542 !!---------------------------------------------------------------------- 543 543 … … 548 548 ENDIF 549 549 550 IF( kt == nit000 .OR. lk_vvl ) THEN 550 IF( kt == nit000 .OR. lk_vvl ) THEN ! reciprocal of e3 at F-point (masked averaging of e3t) 551 551 DO jk = 1, jpk 552 552 DO jj = 1, jpjm1 … … 561 561 ENDIF 562 562 563 ! Local constant initialization 564 zfac12 = 1.e0 / 12.e0 563 zfac12 = 1.e0 / 12.e0 ! Local constant initialization 565 564 566 565 … … 573 572 ! ----------------------------------------- 574 573 SELECT CASE( kvor ) ! vorticity considered 575 CASE ( 1 ) ; zwz(:,:) = ff(:,:) * ze3f(:,:,jk) ! planetary vorticity (Coriolis) 576 CASE ( 2 ) ; zwz(:,:) = rotn(:,:,jk) * ze3f(:,:,jk) ! relative vorticity 574 CASE ( 1 ) ! planetary vorticity (Coriolis) 575 zwz(:,:) = ff(:,:) * ze3f(:,:,jk) 576 CASE ( 2 ) ! relative vorticity 577 zwz(:,:) = rotn(:,:,jk) * ze3f(:,:,jk) 577 578 CASE ( 3 ) ! metric term 578 579 DO jj = 1, jpjm1 … … 583 584 END DO 584 585 END DO 585 CASE ( 4 ) ; zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) ) * ze3f(:,:,jk) ! total (relative + planetary vorticity) 586 CASE ( 4 ) ! total (relative + planetary vorticity) 587 zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) ) * ze3f(:,:,jk) 586 588 CASE ( 5 ) ! total (coriolis + metric) 587 589 DO jj = 1, jpjm1 … … 590 592 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 591 593 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 592 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) &594 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) & 593 595 & ) * ze3f(ji,jj,jk) 594 596 END DO … … 601 603 ! Compute and add the vorticity term trend 602 604 ! ---------------------------------------- 603 jj =2604 ztne(1,:) = 0 ; ztnw(1,:) = 0 ; ztse(1,:) = 0 ;ztsw(1,:) = 0605 jj = 2 606 ztne(1,:) = 0 ; ztnw(1,:) = 0 ; ztse(1,:) = 0 ; ztsw(1,:) = 0 605 607 DO ji = 2, jpi 606 608 ztne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) … … 638 640 !! 639 641 !! ** Purpose : Control the consistency between cpp options for 640 !! tracer advection schemes642 !! tracer advection schemes 641 643 !!---------------------------------------------------------------------- 642 644 INTEGER :: ioptio ! temporary integer -
branches/dev_004_VVL/NEMO/OPA_SRC/DYN/wzvmod.F90
r1390 r1408 1 1 MODULE wzvmod 2 !! MODULE sshwzv 2 3 !!============================================================================== 3 !! *** MODULE wzvmod***4 !! Ocean d iagnostic variable :vertical velocity4 !! *** MODULE sshwzv *** 5 !! Ocean dynamics : sea surface height and vertical velocity 5 6 !!============================================================================== 6 !! History : 5.0 ! 90-10 (C. Levy, G. Madec) Original code 7 !! 7.0 ! 96-01 (G. Madec) Statement function for e3 8 !! 8.5 ! 02-07 (G. Madec) Free form, F90 9 !! " ! 07-07 (D. Storkey) Zero zhdiv at open boundary (BDY) 10 !!---------------------------------------------------------------------- 11 !! wzv : empty routine 7 !! History : 3.1 ! 2009-02 (G. Madec, M. Leclair) Original code 8 !!---------------------------------------------------------------------- 9 10 !!---------------------------------------------------------------------- 12 11 !! ssh_wzv : after ssh & now vertical velocity 13 12 !! ssh_nxt : filter ans swap the ssh arrays 14 13 !! ssh_rst : read/write ssh restart fields in the ocean restart file 15 14 !!---------------------------------------------------------------------- 16 !! * Modules used17 15 USE oce ! ocean dynamics and tracers variables 18 16 USE dom_oce ! ocean space and time domain variables … … 24 22 USE prtctl ! Print control 25 23 USE phycst 26 USE bdy_oce ! unstructured open boundaries27 24 USE lbclnk ! ocean lateral boundary condition (or mpp link) 28 25 USE obc_par ! open boundary cond. parameter … … 32 29 PRIVATE 33 30 34 !! * Routine accessibility 35 PUBLIC wzv ! routine called by step.F90 and inidtr.F90 36 PUBLIC ssh_wzv 37 PUBLIC ssh_nxt 31 PUBLIC ssh_wzv ! called by step.F90 32 PUBLIC ssh_nxt ! called by step.F90 38 33 39 34 !! * Substitutions … … 42 37 43 38 !!---------------------------------------------------------------------- 44 !! OPA 9.0 , LOCEAN-IPSL (2005)39 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 45 40 !! $Id$ 46 41 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 48 43 49 44 CONTAINS 50 51 SUBROUTINE wzv( kt )52 !!----------------------------------------------------------------------53 !! *** ROUTINE wzv ***54 !!55 !! ** Purpose : Compute the now vertical velocity after the array swap56 !!57 !! ** Method : Using the incompressibility hypothesis, the vertical58 !! velocity is computed by integrating the horizontal divergence59 !! from the bottom to the surface.60 !! The boundary conditions are w=0 at the bottom (no flux) and,61 !! in regid-lid case, w=0 at the sea surface.62 !!63 !! ** action : wn array : the now vertical velocity64 !!----------------------------------------------------------------------65 INTEGER, INTENT(in) :: kt66 67 ! Empty routine68 69 WRITE(*,*) 'wzv : you should not be here : error ?'70 71 END SUBROUTINE wzv72 73 45 74 46 SUBROUTINE ssh_wzv( kt ) … … 90 62 !! if lk_vvl=T: sshu_a, sshv_a, sshf_a : after sea surface height 91 63 !! at u-, v-, f-point s 92 !! .._1 : now vertical coordinate arrays93 64 !! hu, hv, hur, hvr : ocean depth and its inverse at u-,v-points 94 65 !!---------------------------------------------------------------------- … … 103 74 IF( kt == nit000 ) THEN 104 75 IF(lwp) WRITE(numout,*) 105 IF(lwp) WRITE(numout,*) 'ssh_wzv : vertical velocity from continuity eq. (vvl option)'76 IF(lwp) WRITE(numout,*) 'ssh_wzv : after sea surface height and now vertical velocity ' 106 77 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 107 78 ! … … 152 123 153 124 ! ! Sea surface elevation time stepping 154 ssha(:,:) = ( sshb(:,:) - z2dt * ( zraur * emp(:,:) 125 ssha(:,:) = ( sshb(:,:) - z2dt * ( zraur * emp(:,:) + zhdiv(:,:) ) ) * tmask(:,:,1) 155 126 156 127 #if defined key_obc … … 158 129 IF ( Agrif_Root() ) THEN 159 130 # endif 160 ssha(:,:) = ssha(:,:) *obctmsk(:,:)161 CALL lbc_lnk( ssha,'T',1.) ! absolutly compulsory !! (jmm)131 ssha(:,:) = ssha(:,:) * obctmsk(:,:) 132 CALL lbc_lnk( ssha, 'T', 1. ) ! absolutly compulsory !! (jmm) 162 133 # if defined key_agrif 163 134 ENDIF … … 169 140 DO jj = 1, jpjm1 170 141 DO ji = 1, fs_jpim1 ! Vector Opt. 171 sshu_a(ji,jj) = 0.5 * umask(ji,jj,1) 172 & 173 & 174 sshv_a(ji,jj) = 0.5 * vmask(ji,jj,1) 175 & 176 & 177 !!gm bug used of fmask, even if thereafter multiplied by muf which is correctly masked)178 sshf_a(ji,jj) = 0.25 * fmask(ji,jj,1)* ( ssha(ji ,jj) + ssha(ji ,jj+1) &142 sshu_a(ji,jj) = 0.5 * umask(ji,jj,1) / ( e1u(ji ,jj) * e2u(ji ,jj) ) & 143 & * ( e1t(ji ,jj) * e2t(ji ,jj) * ssha(ji ,jj) & 144 & + e1t(ji+1,jj) * e2t(ji+1,jj) * ssha(ji+1,jj) ) 145 sshv_a(ji,jj) = 0.5 * vmask(ji,jj,1) / ( e1v(ji,jj ) * e2v(ji,jj ) ) & 146 & * ( e1t(ji,jj ) * e2t(ji,jj ) * ssha(ji,jj ) & 147 & + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha(ji,jj+1) ) 148 sshf_a(ji,jj) = 0.25 * umask(ji,jj,1) * umask (ji,jj+1,1) & ! Caution : fmask not used 149 & * ( ssha(ji ,jj) + ssha(ji ,jj+1) & 179 150 & + ssha(ji+1,jj) + ssha(ji+1,jj+1) ) 180 151 END DO … … 199 170 ! !------------------------------! 200 171 IF( lk_vvl ) THEN ! only in vvl case) 201 !! now local depth and scale factors (stored in fse3. arrays)172 ! ! now local depth and scale factors (stored in fse3. arrays) 202 173 DO jk = 1, jpkm1 203 174 fsdept(:,:,jk) = fsdept_n(:,:,jk) ! depths … … 217 188 hv(:,:) = hv_0(:,:) + sshv_n(:,:) 218 189 ! ! masked inverse of the ocean depth (at u- and v-points) 219 hur(:,:) = 1. / MAX( hu(:,:), fse3u_0(:,:,1) ) * umask(:,:,1) 220 hvr(:,:) = 1. / MAX( hv(:,:), fse3v_0(:,:,1) ) * vmask(:,:,1) 221 !!gm to be corrected (the above case does not work properly with 1 ocean level only) 222 ! hur(:,:) = 1. / MAX( hu(:,:), 1.e-15 ) * umask(:,:,1) 223 ! hvr(:,:) = 1. / MAX( hv(:,:), 1.e-15 ) * vmask(:,:,1) 224 !!gm 225 !!add end 190 hur(:,:) = umask(:,:,1) / ( hu(:,:) + 1.e0 - umask(:,:,1) ) 191 hvr(:,:) = vmask(:,:,1) / ( hv(:,:) + 1.e0 - vmask(:,:,1) ) 226 192 227 193 ENDIF … … 247 213 INTEGER, INTENT( in ) :: kt ! ocean time-step index 248 214 !! 249 INTEGER :: ji, jj , jk! dummy loop indices215 INTEGER :: ji, jj ! dummy loop indices 250 216 !!---------------------------------------------------------------------- 251 217 … … 330 296 ENDIF 331 297 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 332 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb 333 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , sshn 298 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb(:,:) ) 299 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , sshn(:,:) ) 334 300 ENDIF 335 301 ! -
branches/dev_004_VVL/NEMO/OPA_SRC/TRA/tranxt.F90
r1382 r1408 14 14 !! 2.0 ! 2006-02 (L. Debreu, C. Mazauric) Agrif implementation 15 15 !! 3.0 ! 2008-06 (G. Madec) time stepping always done in trazdf 16 !! 3.1 ! 2009-02 (G. Madec, R. Benshila) re-introduce the vvl option 16 17 !!---------------------------------------------------------------------- 17 18 18 19 !!---------------------------------------------------------------------- 19 20 !! tra_nxt : time stepping on temperature and salinity 21 !! tra_nxt_fix : time stepping on temperature and salinity : fixed volume case 22 !! tra_nxt_vvl : time stepping on temperature and salinity : variable volume case 20 23 !!---------------------------------------------------------------------- 21 24 USE oce ! ocean dynamics and tracers variables … … 127 130 #endif 128 131 129 ! trends diagnostics : Asselin filter trend : (tb filtered - tb)/2dt130 IF( l_trdtra ) THEN 132 ! trends computation 133 IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 131 134 DO jk = 1, jpkm1 132 135 zfact = 1.e0 / r2dt_t(jk) … … 136 139 CALL trd_mod( ztrdt, ztrds, jptra_trd_atf, 'TRA', kt ) 137 140 END IF 141 138 142 ! ! control print 139 143 IF(ln_ctl) CALL prt_ctl( tab3d_1=tn, clinfo1=' nxt - Tn: ', mask1=tmask, & … … 182 186 ! ! ----------------------- ! 183 187 ! 184 IF( neuler == 0 .AND. kt == nit000 ) THEN ! case of Euler time-stepping at first time-step 185 DO jk = 1, jpkm1 186 DO jj = 1, jpj 187 DO ji = 1, jpi 188 ztm = 0.25 * ( ta(ji,jj,jk) + 2. * tn(ji,jj,jk) + tb(ji,jj,jk) ) ! mean t 189 zsm = 0.25 * ( sa(ji,jj,jk) + 2. * sn(ji,jj,jk) + sb(ji,jj,jk) ) 190 tb(ji,jj,jk) = tn(ji,jj,jk) ! tb <-- tn 191 sb(ji,jj,jk) = sn(ji,jj,jk) 188 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step 189 DO jk = 1, jpkm1 ! (only swap) 190 DO jj = 1, jpj 191 DO ji = 1, jpi 192 192 tn(ji,jj,jk) = ta(ji,jj,jk) ! tb <-- tn 193 193 sn(ji,jj,jk) = sa(ji,jj,jk) 194 ta(ji,jj,jk) = ztm ! ta <-- mean t195 sa(ji,jj,jk) = zsm196 194 END DO 197 195 END DO … … 219 217 ! ! ----------------------- ! 220 218 ! 221 IF( neuler == 0 .AND. kt == nit000 ) THEN ! case of Euler time-stepping at first time-step 222 DO jk = 1, jpkm1 223 DO jj = 1, jpj 224 DO ji = 1, jpi 225 tb(ji,jj,jk) = tn(ji,jj,jk) ! tb <-- tn 226 sb(ji,jj,jk) = sn(ji,jj,jk) 219 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step 220 DO jk = 1, jpkm1 221 DO jj = 1, jpj 222 DO ji = 1, jpi 227 223 tn(ji,jj,jk) = ta(ji,jj,jk) ! tn <-- ta 228 224 sn(ji,jj,jk) = sa(ji,jj,jk) … … 234 230 DO jj = 1, jpj 235 231 DO ji = 1, jpi 236 !RBvvl for reproducibility 237 ! ztf = atfp * ( ta(ji,jj,jk) - 2.* tn(ji,jj,jk) + tb(ji,jj,jk) ) ! Asselin filter on t 238 ! zsf = atfp * ( sa(ji,jj,jk) - 2.* sn(ji,jj,jk) + sb(ji,jj,jk) ) 239 ! tb(ji,jj,jk) = tn(ji,jj,jk) + ztf ! tb <-- filtered tn 240 ! sb(ji,jj,jk) = sn(ji,jj,jk) + zsf 241 tb(ji,jj,jk) = atfp * ( tb(ji,jj,jk) + ta(ji,jj,jk) ) + atfp1 * tn(ji,jj,jk) 242 sb(ji,jj,jk) = atfp * ( sb(ji,jj,jk) + sa(ji,jj,jk) ) + atfp1 * sn(ji,jj,jk) 232 ztf = atfp * ( ta(ji,jj,jk) - 2.* tn(ji,jj,jk) + tb(ji,jj,jk) ) ! Asselin filter on t 233 zsf = atfp * ( sa(ji,jj,jk) - 2.* sn(ji,jj,jk) + sb(ji,jj,jk) ) 234 tb(ji,jj,jk) = tn(ji,jj,jk) + ztf ! tb <-- filtered tn 235 sb(ji,jj,jk) = sn(ji,jj,jk) + zsf 243 236 tn(ji,jj,jk) = ta(ji,jj,jk) ! tn <-- ta 244 237 sn(ji,jj,jk) = sa(ji,jj,jk) … … 295 288 ! ! ----------------------- ! 296 289 ! 297 IF( neuler == 0 .AND. kt == nit000 ) THEN 298 DO jk = 1, jpkm1 299 DO jj = 1, jpj 300 DO ji = 1, jpi 301 ze3t_b = fse3t_b(ji,jj,jk) 302 ze3t_n = fse3t_n(ji,jj,jk) 303 ze3t_a = fse3t_a(ji,jj,jk) 304 ! ! tracer content at Before, now and after 305 ztcb = tb(ji,jj,jk) * ze3t_b ; zscb = sb(ji,jj,jk) * ze3t_b 306 ztcn = tn(ji,jj,jk) * ze3t_n ; zscn = sn(ji,jj,jk) * ze3t_n 307 ztca = ta(ji,jj,jk) * ze3t_a ; zsca = sa(ji,jj,jk) * ze3t_a 308 ! 309 ! ! mean thickness and tracer 310 ze3mr= 1.e0 / ( ze3t_a + 2.* ze3t_n + ze3t_b ) 311 ztm = ze3mr * ( ztca + 2.* ztcn + ztcb ) 312 zsm = ze3mr * ( zsca + 2.* zscn + zscb ) 313 !!gm mean e3t have to be saved and used in dynhpg or it can be recomputed in dynhpg !! 314 !!gm e3t_m(ji,jj,jk) = 0.25 / ze3mr 315 ! ! swap of arrays 316 tb(ji,jj,jk) = tn(ji,jj,jk) ! tb <-- tn 317 sb(ji,jj,jk) = sn(ji,jj,jk) 290 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step 291 DO jk = 1, jpkm1 ! (only swap) 292 DO jj = 1, jpj 293 DO ji = 1, jpi 318 294 tn(ji,jj,jk) = ta(ji,jj,jk) ! tn <-- ta 319 295 sn(ji,jj,jk) = sa(ji,jj,jk) 320 ta(ji,jj,jk) = ztm ! ta <-- mean t321 sa(ji,jj,jk) = zsm322 296 END DO 323 297 END DO … … 369 343 DO jj = 1, jpj ! ONLY swap 370 344 DO ji = 1, jpi 371 tb(ji,jj,jk) = tn(ji,jj,jk) ! tb <-- tn372 sb(ji,jj,jk) = sn(ji,jj,jk)373 345 tn(ji,jj,jk) = ta(ji,jj,jk) ! tn <-- ta 374 346 sn(ji,jj,jk) = sa(ji,jj,jk) … … 394 366 zsc_f = atfp * ( zsca - 2.* zscn + zscb ) 395 367 ! 396 !!gm tmask useless below397 368 ! ! filtered tracer including the correction 398 ze3fr = tmask(ji,jj,jk)/ ( ze3t_n + ze3t_f )369 ze3fr = 1.e0 / ( ze3t_n + ze3t_f ) 399 370 ztf = ( ztcn + ztc_f ) * ze3fr 400 371 zsf = ( zscn + zsc_f ) * ze3fr -
branches/dev_004_VVL/NEMO/OPA_SRC/TRA/trazdf_exp.F90
r1362 r1408 42 42 # include "vectopt_loop_substitute.h90" 43 43 !!---------------------------------------------------------------------- 44 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)44 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 45 45 !! $Id$ 46 46 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 78 78 INTEGER :: ji, jj, jk, jl ! dummy loop indices 79 79 REAL(wp) :: zlavmr, zave3r, ze3tr ! temporary scalars 80 REAL(wp) :: zta, zsa, ze3tb , zcoef! temporary scalars80 REAL(wp) :: zta, zsa, ze3tb ! temporary scalars 81 81 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwx, zwy, zwz, zww ! 3D workspace 82 82 !!--------------------------------------------------------------------- … … 130 130 DO jj = 2, jpjm1 131 131 DO ji = fs_2, fs_jpim1 ! vector opt. 132 ze3tb = fse3t_b(ji,jj,jk) 132 ze3tb = fse3t_b(ji,jj,jk) / fse3t(ji,jj,jk) ! before e3t 133 133 zta = zwx(ji,jj,jk) - tb(ji,jj,jk) + p2dt(jk) * ta(ji,jj,jk) ! total trends * 2*rdt 134 134 zsa = zwz(ji,jj,jk) - sb(ji,jj,jk) + p2dt(jk) * sa(ji,jj,jk) 135 zcoef = 1.e0 / fse3t_n(ji,jj,jk) * tmask(ji,jj,jk) 136 !RBvvl : which e3t ? 137 ta(ji,jj,jk) = ( ze3tb * tb(ji,jj,jk) + fse3t(ji,jj,jk) * zta ) * zcoef 138 sa(ji,jj,jk) = ( ze3tb * sb(ji,jj,jk) + fse3t(ji,jj,jk) * zsa ) * zcoef 135 ta(ji,jj,jk) = ( ze3tb * tb(ji,jj,jk) + zta ) * tmask(ji,jj,jk) 136 sa(ji,jj,jk) = ( ze3tb * sb(ji,jj,jk) + zsa ) * tmask(ji,jj,jk) 139 137 END DO 140 138 END DO … … 144 142 DO jj = 2, jpjm1 145 143 DO ji = fs_2, fs_jpim1 ! vector opt. 146 ta(ji,jj,jk) = ( zwx(ji,jj,jk) + p2dt(jk) * ta(ji,jj,jk) ) * tmask(ji,jj,jk)147 sa(ji,jj,jk) = ( zwz(ji,jj,jk) + p2dt(jk) * sa(ji,jj,jk) ) * tmask(ji,jj,jk)144 ta(ji,jj,jk) = ( zwx(ji,jj,jk) + p2dt(jk) * ta(ji,jj,jk) ) * tmask(ji,jj,jk) 145 sa(ji,jj,jk) = ( zwz(ji,jj,jk) + p2dt(jk) * sa(ji,jj,jk) ) * tmask(ji,jj,jk) 148 146 END DO 149 147 END DO -
branches/dev_004_VVL/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r1362 r1408 1 1 MODULE trazdf_imp 2 !!====================================================================== ========2 !!====================================================================== 3 3 !! *** MODULE trazdf_imp *** 4 4 !! Ocean active tracers: vertical component of the tracer mixing trend 5 !!============================================================================== 6 !! History : 7 !! 6.0 ! 90-10 (B. Blanke) Original code 8 !! 7.0 ! 91-11 (G. Madec) 9 !! ! 92-06 (M. Imbard) correction on tracer trend loops 10 !! ! 96-01 (G. Madec) statement function for e3 11 !! ! 97-05 (G. Madec) vertical component of isopycnal 12 !! ! 97-07 (G. Madec) geopotential diffusion in s-coord 13 !! ! 00-08 (G. Madec) double diffusive mixing 14 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 15 !! 9.0 ! 06-11 (G. Madec) New step reorganisation 5 !!====================================================================== 6 !! History : OPA ! 1990-10 (B. Blanke) Original code 7 !! 7.0 ! 1991-11 (G. Madec) 8 !! ! 1992-06 (M. Imbard) correction on tracer trend loops 9 !! ! 1996-01 (G. Madec) statement function for e3 10 !! ! 1997-05 (G. Madec) vertical component of isopycnal 11 !! ! 1997-07 (G. Madec) geopotential diffusion in s-coord 12 !! ! 2000-08 (G. Madec) double diffusive mixing 13 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module 14 !! 2.0 ! 2006-11 (G. Madec) New step reorganisation 15 !! 3.2 ! 2009-03 (G. Madec) heat and salt content trends 16 !!---------------------------------------------------------------------- 17 16 18 !!---------------------------------------------------------------------- 17 19 !! tra_zdf_imp : Update the tracer trend with the diagonal vertical 18 20 !! part of the mixing tensor. 19 21 !!---------------------------------------------------------------------- 20 !! * Modules used21 22 USE oce ! ocean dynamics and tracers variables 22 23 USE dom_oce ! ocean space and time domain variables … … 36 37 PRIVATE 37 38 38 !! * Routine accessibility 39 PUBLIC tra_zdf_imp ! routine called by step.F90 39 PUBLIC tra_zdf_imp ! routine called by step.F90 40 40 41 41 !! * Substitutions … … 45 45 # include "vectopt_loop_substitute.h90" 46 46 !!---------------------------------------------------------------------- 47 !!---------------------------------------------------------------------- 48 !! OPA 9.0 , LOCEAN-IPSL (2005) 47 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 49 48 !! $Id$ 50 49 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 90 89 !! 91 90 !!--------------------------------------------------------------------- 92 !! * Modules used 93 USE oce , ONLY : zwd => ua, & ! ua used as workspace 94 zws => va ! va " " 95 !! * Arguments 96 INTEGER, INTENT( in ) :: kt ! ocean time-step index 97 REAL(wp), DIMENSION(jpk), INTENT( in ) :: & 98 p2dt ! vertical profile of tracer time-step 99 100 !! * Local declarations 101 INTEGER :: ji, jj, jk ! dummy loop indices 102 REAL(wp) :: zavi, zrhs, znvvl, & ! temporary scalars 103 ze3tb, ze3tn, ze3ta ! variable vertical scale factors 104 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 105 zwi, zwt, zavsi ! workspace arrays 91 USE oce , ONLY : zwd => ua ! ua used as workspace 92 USE oce , ONLY : zws => va ! va - - 93 !! 94 INTEGER , INTENT(in) :: kt ! ocean time-step index 95 REAL(wp), DIMENSION(jpk), INTENT(in) :: p2dt ! vertical profile of tracer time-step 96 !! 97 INTEGER :: ji, jj, jk ! dummy loop indices 98 REAL(wp) :: zavi, zrhs, znvvl ! temporary scalars 99 REAL(wp) :: ze3tb, ze3tn, ze3ta ! variable vertical scale factors 100 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi, zwt, zavsi ! workspace arrays 106 101 !!--------------------------------------------------------------------- 107 102 … … 169 164 DO jj = 2, jpjm1 170 165 DO ji = fs_2, fs_jpim1 ! vector opt. 171 ze3ta = ( 1. - znvvl ) + znvvl*fse3t_a(ji,jj,jk) ! after scale factor at T-point 172 ze3tn = ( 1. - znvvl )*fse3t_n(ji,jj,jk) + znvvl ! now scale factor at T-point 166 ze3ta = ( 1. - znvvl ) & ! after scale factor at T-point 167 & + znvvl * fse3t_a(ji,jj,jk) 168 ze3tn = znvvl & ! now scale factor at T-point 169 & + ( 1. - znvvl ) * fse3t_n(ji,jj,jk) 173 170 zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk ) / ( ze3tn * fse3w(ji,jj,jk ) ) 174 171 zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) ) … … 181 178 DO jj = 2, jpjm1 182 179 DO ji = fs_2, fs_jpim1 ! vector opt. 183 ze3ta = ( 1. - znvvl ) + znvvl*fse3t_a(ji,jj,1) ! after scale factor at T-point 180 ze3ta = ( 1. - znvvl ) & ! after scale factor at T-point 181 & + znvvl * fse3t_a(ji,jj,1) 184 182 zwi(ji,jj,1) = 0.e0 185 183 zwd(ji,jj,1) = ze3ta - zws(ji,jj,1) … … 225 223 DO jj = 2, jpjm1 226 224 DO ji = fs_2, fs_jpim1 227 ze3tb = ( 1. - znvvl ) + znvvl*fse3t_b(ji,jj,1) 228 !RBvvl which 229 ze3tn = ( 1. - znvvl ) + znvvl*fse3t(ji,jj,1) 225 ze3tb = ( 1. - znvvl ) + znvvl * fse3t_b(ji,jj,1) 226 ze3tn = ( 1. - znvvl ) + znvvl * fse3t(ji,jj,1) 230 227 ta(ji,jj,1) = ze3tb * tb(ji,jj,1) + p2dt(1) * ze3tn * ta(ji,jj,1) 231 228 END DO … … 234 231 DO jj = 2, jpjm1 235 232 DO ji = fs_2, fs_jpim1 236 ze3tb = ( 1. - znvvl ) + znvvl*fse3t_b(ji,jj,jk) 237 !RB_vvl 238 ze3tn = ( 1. - znvvl ) + znvvl*fse3t (ji,jj,jk) 233 ze3tb = ( 1. - znvvl ) + znvvl * fse3t_b(ji,jj,jk) 234 ze3tn = ( 1. - znvvl ) + znvvl * fse3t (ji,jj,jk) 239 235 zrhs = ze3tb * tb(ji,jj,jk) + p2dt(jk) * ze3tn * ta(ji,jj,jk) ! zrhs=right hand side 240 ta(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * ta(ji,jj,jk-1)236 ta(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * ta(ji,jj,jk-1) 241 237 END DO 242 238 END DO … … 269 265 DO jj = 2, jpjm1 270 266 DO ji = fs_2, fs_jpim1 ! vector opt. 271 ze3ta = ( 1. - znvvl ) + znvvl*fse3t_a(ji,jj,jk) ! after scale factor at T-point 272 ze3tn = ( 1. - znvvl )*fse3t_n(ji,jj,jk) + znvvl ! now scale factor at T-point 267 ze3ta = ( 1. - znvvl ) & ! after scale factor at T-point 268 & + znvvl * fse3t_a(ji,jj,jk) 269 ze3tn = znvvl & ! now scale factor at T-point 270 & + ( 1. - znvvl ) * fse3t_n(ji,jj,jk) 273 271 zwi(ji,jj,jk) = - p2dt(jk) * zavsi(ji,jj,jk ) / ( ze3tn * fse3w(ji,jj,jk ) ) 274 272 zws(ji,jj,jk) = - p2dt(jk) * zavsi(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) ) … … 281 279 DO jj = 2, jpjm1 282 280 DO ji = fs_2, fs_jpim1 ! vector opt. 283 ze3ta = ( 1. - znvvl ) + znvvl *fse3t_a(ji,jj,1)281 ze3ta = ( 1. - znvvl ) + znvvl * fse3t_a(ji,jj,1) 284 282 zwi(ji,jj,1) = 0.e0 285 283 zwd(ji,jj,1) = ze3ta - zws(ji,jj,1) … … 324 322 DO jj = 2, jpjm1 325 323 DO ji = fs_2, fs_jpim1 326 ze3tb = ( 1. - znvvl ) + znvvl*fse3t_b(ji,jj,1) ! before scale factor at T-point 327 ze3tn = ( 1. - znvvl ) + znvvl*fse3t(ji,jj,1) ! now scale factor at T-point 324 ze3tb = ( 1. - znvvl ) & ! before scale factor at T-point 325 & + znvvl * fse3t_b(ji,jj,1) 326 ze3tn = ( 1. - znvvl ) + znvvl * fse3t (ji,jj,1) ! now scale factor at T-point 328 327 sa(ji,jj,1) = ze3tb * sb(ji,jj,1) + p2dt(1) * ze3tn * sa(ji,jj,1) 329 328 END DO … … 332 331 DO jj = 2, jpjm1 333 332 DO ji = fs_2, fs_jpim1 334 ze3tb = ( 1. - znvvl ) + znvvl*fse3t_b(ji,jj,jk) ! before scale factor at T-point 335 ze3tn = ( 1. - znvvl ) + znvvl*fse3t(ji,jj,jk) ! now scale factor at T-point 333 ze3tb = ( 1. - znvvl ) & ! before scale factor at T-point 334 & + znvvl * fse3t_b(ji,jj,jk) 335 ze3tn = ( 1. - znvvl ) + znvvl * fse3t (ji,jj,jk) ! now scale factor at T-point 336 336 zrhs = ze3tb * sb(ji,jj,jk) + p2dt(jk) * ze3tn * sa(ji,jj,jk) ! zrhs=right hand side 337 337 sa(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *sa(ji,jj,jk-1) … … 355 355 END DO 356 356 END DO 357 357 ! 358 358 END SUBROUTINE tra_zdf_imp 359 359 -
branches/dev_004_VVL/NEMO/OPA_SRC/ZDF/zdfevd.F90
r1388 r1408 5 5 !! of vertical eddy mixing coefficient 6 6 !!====================================================================== 7 !! History : OPA ! 1997-06 (G. Madec, A. Lazar) Original code 8 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 9 !! - ! 2005-06 (C. Ethe) KPP parameterization 10 !! 3.2 ! 2009-03 (M. Leclair, G. Madec, R. Benshila) test on both before & after 11 !!---------------------------------------------------------------------- 7 12 8 13 !!---------------------------------------------------------------------- 9 !! zdf_evd : update momentum and tracer Kz at the location of 10 !! statically unstable portion of the water column 11 !! (called if ln_zdfevd=T) 14 !! zdf_evd : increase the momentum and tracer Kz at the location of 15 !! statically unstable portion of the water column (ln_zdfevd=T) 12 16 !!---------------------------------------------------------------------- 13 !! * Modules used14 17 USE oce ! ocean dynamics and tracers variables 15 18 USE dom_oce ! ocean space and time domain variables … … 22 25 PRIVATE 23 26 24 !! * Routine accessibility 25 PUBLIC zdf_evd ! called by step.F90 27 PUBLIC zdf_evd ! called by step.F90 26 28 27 29 !! * Substitutions 28 30 # include "domzgr_substitute.h90" 29 31 !!---------------------------------------------------------------------- 30 !! OPA 9.0 , LOCEAN-IPSL (2005)31 !! $Id $32 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt32 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 33 !! $Id:$ 34 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 33 35 !!---------------------------------------------------------------------- 34 36 … … 48 50 !! ** Action : Update avt, avmu, avmv in statically instable cases 49 51 !! and avt_evd which is avt due to convection 50 !! References : 51 !! Lazar, A., these de l'universite Paris VI, France, 1997 52 !! History : 53 !! 7.0 ! 97-06 (G. Madec, A. Lazar) Original code 54 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module 55 !! 9.0 ! 05-06 (C. Ethe) KPP parameterization 52 !! References : Lazar, A., these de l'universite Paris VI, France, 1997 56 53 !!---------------------------------------------------------------------- 57 !! * Arguments58 54 INTEGER, INTENT( in ) :: kt ! ocean time-step indexocean time step 59 60 !! * Local declarations 55 !! 61 56 INTEGER :: ji, jj, jk ! dummy loop indices 62 57 !!---------------------------------------------------------------------- … … 80 75 ! ! =============== 81 76 #if defined key_vectopt_loop 82 !!! WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd ! agissant sur T SEUL! 83 jj = 1 ! big loop forced 84 DO ji = jpi+2, jpij 85 # if defined key_zdfkpp 86 !! no implicit mixing in the boundary layer with KPP 87 IF( ( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) .AND. ( fsdepw(ji,jj,jk) > hkpp(ji,jj) ) ) THEN 88 # else 89 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN 90 # endif 91 avt (ji ,jj ,jk) = avevd * tmask(ji ,jj ,jk) 92 avmu(ji ,jj ,jk) = avevd * umask(ji ,jj ,jk) 93 avmu(ji-1,jj ,jk) = avevd * umask(ji-1,jj ,jk) 94 avmv(ji ,jj ,jk) = avevd * vmask(ji ,jj ,jk) 95 avmv(ji ,jj-1,jk) = avevd * vmask(ji ,jj-1,jk) 96 ENDIF 97 END DO 77 DO jj = 1, 1 ! big loop forced 78 DO ji = jpi+2, jpij 98 79 #else 99 80 DO jj = 2, jpj ! no vector opt. 100 81 DO ji = 2, jpi 101 # if defined key_zdfkpp 82 #endif 83 #if defined key_zdfkpp 102 84 !! no implicit mixing in the boundary layer with KPP 103 IF( ( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) .AND. ( fsdepw(ji,jj,jk) > hkpp(ji,jj) ) ) THEN104 # 105 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN106 # 85 IF( ( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) .AND. ( fsdepw(ji,jj,jk) > hkpp(ji,jj) ) ) THEN 86 #else 87 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN 88 #endif 107 89 avt (ji ,jj ,jk) = avevd * tmask(ji ,jj ,jk) 108 90 avmu(ji ,jj ,jk) = avevd * umask(ji ,jj ,jk) … … 113 95 END DO 114 96 END DO 115 #endif116 97 ! ! =============== 117 98 END DO ! End of slab … … 130 111 !!! WHERE( rn2(:,:,jk) <= -1.e-12 ) avt(:,:,jk) = tmask(:,:,jk) * avevd ! agissant sur T SEUL! 131 112 #if defined key_vectopt_loop 132 jj = 1 ! big loop forced 133 DO ji = 1, jpij 134 # if defined key_zdfkpp 135 !! no implicit mixing in the boundary layer with KPP 136 IF( ( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) .AND. ( fsdepw(ji,jj,jk) > hkpp(ji,jj) ) ) & 137 # else 138 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) & 139 # endif 140 avt(ji,jj,jk) = avevd * tmask(ji,jj,jk) 141 END DO 113 DO jj = 1, 1 ! big loop forced 114 DO ji = 1, jpij 142 115 #else 143 116 DO jj = 1, jpj ! loop over the whole domain (no lbc_lnk call) 144 117 DO ji = 1, jpi 145 # if defined key_zdfkpp 118 #endif 119 #if defined key_zdfkpp 146 120 !! no implicit mixing in the boundary layer with KPP 147 121 IF( ( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) .AND. ( fsdepw(ji,jj,jk) > hkpp(ji,jj) ) ) & 148 # 122 #else 149 123 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) & 150 # 124 #endif 151 125 avt(ji,jj,jk) = avevd * tmask(ji,jj,jk) 152 126 END DO 153 127 END DO 154 #endif155 128 ! ! =============== 156 129 END DO ! End of slab … … 159 132 160 133 ! update of avt_evd and avmu_evd 161 avt_evd (:,:,:) = avt (:,:,:) - avt_evd(:,:,:)162 avmu_evd (:,:,:) = avmu(:,:,:) - avmu_evd(:,:,:)134 avt_evd (:,:,:) = avt (:,:,:) - avt_evd (:,:,:) 135 avmu_evd(:,:,:) = avmu(:,:,:) - avmu_evd(:,:,:) 163 136 164 137 END SUBROUTINE zdf_evd -
branches/dev_004_VVL/NEMO/OPA_SRC/oce.F90
r1388 r1408 4 4 !! Ocean : dynamics and active tracers defined in memory 5 5 !!====================================================================== 6 !! History : 7 !! 8.5 ! 02-11 (G. Madec) F90: Free form and module8 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization6 !! History : 0.1 ! 2002-11 (G. Madec) F90: Free form and module 7 !! 1.0 ! 2005-11 (V. Garnier) Surface pressure gradient organization 8 !! 3.1 ! 2009-02 (G. Madec, M. Leclair) pure z* coordinate 9 9 !!---------------------------------------------------------------------- 10 !! OPA 9.0 , LOCEAN-IPSL (2005)11 !! $Id$12 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt13 !!----------------------------------------------------------------------14 !! * Modules used15 10 USE par_oce ! ocean parameters 16 11 … … 20 15 !! Physics and algorithm flags 21 16 !! --------------------------- 22 LOGICAL, PUBLIC :: l_traldf_rot = .FALSE. !: rotated laplacian operator for lateral diffusion 17 LOGICAL, PUBLIC :: l_traldf_rot = .FALSE. !: rotated laplacian operator for lateral diffusion 23 18 LOGICAL, PUBLIC :: ln_dynhpg_imp = .FALSE. !: semi-implicite hpg flag 24 19 INTEGER, PUBLIC :: nn_dynhpg_rst = 0 !: add dynhpg implicit variables in restart ot not 25 20 26 !! dynamics and tracer fields 27 !! -------------------------- 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 29 ! before ! now ! after ! ! the after trends becomes the fields 30 ! fields ! fields ! trends ! ! only in dyn(tra)_zdf and dyn(tra)_nxt 31 ub , un , ua , & !: i-horizontal velocity (m/s) 32 vb , vn , va , & !: j-horizontal velocity (m/s) 33 wn , & !: vertical velocity (m/s) 34 rotb , rotn , & !: relative vorticity (1/s) 35 hdivb , hdivn , & !: horizontal divergence (1/s) 36 tb , tn , ta , & !: potential temperature (celcius) 37 sb , sn , sa !: salinity (psu) 38 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 39 rhd , & !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 40 rhop, & !: potential volumic mass (kg/m3) 41 rn2, & !: now brunt-vaisala frequency (1/s2) 42 rn2b !: before brunt-vaisala frequency (1/s2) 21 !! dynamics and tracer fields ! before ! now ! after ! the after trends becomes the fields 22 !! -------------------------- ! fields ! fields ! trends ! only after tra_zdf and dyn_spg 23 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: ub , un , ua !: i-horizontal velocity [m/s] 24 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: vb , vn , va !: j-horizontal velocity [m/s] 25 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: wn !: vertical velocity [m/s] 26 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rotb , rotn !: relative vorticity [s-1] 27 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: hdivb , hdivn !: horizontal divergence [s-1] 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: tb , tn , ta !: potential temperature [Celcius] 29 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: sb , sn , sa !: salinity [psu] 30 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rn2b , rn2 !: brunt-vaisala frequency**2 [s-2] 31 ! 32 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 [no units] 33 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rhop !: potential volumic mass [kg/m3] 43 34 44 45 !! advection scheme choice 46 !! ----------------------- 47 CHARACTER(len=3), PUBLIC :: l_adv !: 'ce2' centre scheme used 48 ! !: 'tvd' TVD scheme used 49 ! !: 'mus' MUSCL scheme used 50 ! !: 'mu2' MUSCL2 scheme used 35 !! advection scheme choice 36 !! ----------------------- 37 CHARACTER(len=3), PUBLIC :: l_adv !: flag for the advection scheme used (= 'ce2', 'tvd', 'mus' or ...) 51 38 52 39 !! surface pressure gradient 53 40 !! ------------------------- 54 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 55 spgu, spgv !: horizontal surface pressure gradient 41 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: spgu, spgv !: horizontal surface pressure gradient 56 42 57 43 !! interpolated gradient (only used in zps case) 58 44 !! --------------------- 59 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 60 gtu, gsu, gru, & !: t-, s- and rd horizontal gradient at u- and 61 gtv, gsv, grv !: v-points at bottom ocean level 45 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: gtu, gsu, gru !: horizontal gradient of T, S and rd at bottom u-point 46 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: gtv, gsv, grv !: horizontal gradient of T, S and rd at bottom v-point 62 47 63 48 !! free surface ! before ! now ! after ! … … 68 53 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sshf_b , sshf_n , sshf_a !: sea surface height at f-point [m] 69 54 70 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sshbb !: before before & after sea surface height at t-point71 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sshn_f !: filtered now sea surface height at t-point72 73 55 #if defined key_dynspg_rl || defined key_esopa 74 56 !! rigid-lid formulation 75 57 !! --------------------- 76 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 77 bsfb, bsfn, & !: before, now barotropic streamfunction (m3/s) 78 bsfd !: now trend of barotropic streamfunction (m3/s2) 58 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: bsfb, bsfn !: before, now barotropic streamfunction (m3/s) 59 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: bsfd !: now trend of barotropic streamfunction (m3/s2) 79 60 #endif 80 61 !!---------------------------------------------------------------------- 62 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2008) 63 !! $Id:$ 64 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 65 !!====================================================================== 81 66 END MODULE oce -
branches/dev_004_VVL/NEMO/OPA_SRC/step.F90
r1388 r1408 4 4 !! Time-stepping : manager of the ocean, tracer and ice time stepping 5 5 !!====================================================================== 6 !! History : ! 91-03 (G. Madec) Original code 7 !! ! 92-06 (M. Imbard) add a first output record 8 !! ! 96-04 (G. Madec) introduction of dynspg 9 !! ! 96-04 (M.A. Foujols) introduction of passive tracer 10 !! 8.0 ! 97-06 (G. Madec) new architecture of call 11 !! 8.2 ! 97-06 (G. Madec, M. Imbard, G. Roullet) free surface 12 !! 8.2 ! 99-02 (G. Madec, N. Grima) hpg implicit 13 !! 8.2 ! 00-07 (J-M Molines, M. Imbard) Open Bondary Conditions 14 !! 9.0 ! 02-06 (G. Madec) free form, suppress macro-tasking 15 !! " " ! 04-08 (C. Talandier) New trends organization 16 !! " " ! 05-01 (C. Ethe) Add the KPP closure scheme 17 !! " " ! 05-11 (V. Garnier) Surface pressure gradient organization 18 !! " " ! 05-11 (G. Madec) Reorganisation of tra and dyn calls 19 !! " " ! 06-01 (L. Debreu, C. Mazauric) Agrif implementation 20 !! " " ! 06-07 (S. Masson) restart using iom 21 !! " " ! 06-08 (G. Madec) surface module 22 !! " " ! 07-07 (J. Chanut, A. Sellar) Unstructured open boundaries (BDY) 6 !! History : OPA ! 1991-03 (G. Madec) Original code 7 !! ! 1991-11 (G. Madec) 8 !! ! 1992-06 (M. Imbard) add a first output record 9 !! ! 1996-04 (G. Madec) introduction of dynspg 10 !! ! 1996-04 (M.A. Foujols) introduction of passive tracer 11 !! 8.0 ! 1997-06 (G. Madec) new architecture of call 12 !! 8.2 ! 1997-06 (G. Madec, M. Imbard, G. Roullet) free surface 13 !! - ! 1999-02 (G. Madec, N. Grima) hpg implicit 14 !! - ! 2000-07 (J-M Molines, M. Imbard) Open Bondary Conditions 15 !! NEMO 1.0 ! 2002-06 (G. Madec) free form, suppress macro-tasking 16 !! - ! 2004-08 (C. Talandier) New trends organization 17 !! ! 2005-01 (C. Ethe) Add the KPP closure scheme 18 !! ! 2005-11 (G. Madec) Reorganisation of tra and dyn calls 19 !! ! 2006-01 (L. Debreu, C. Mazauric) Agrif implementation 20 !! ! 2006-07 (S. Masson) restart using iom 21 !! 3.2 ! 2009-02 (G. Madec, R. Benshila) reintroduicing z*-coordinate 23 22 !!---------------------------------------------------------------------- 24 23 … … 116 115 USE restart ! ocean restart (rst_wri routine) 117 116 USE prtctl ! Print control (prt_ctl routine) 118 USE domvvl ! variable volume (dom_vvl routine)119 117 120 118 #if defined key_agrif … … 140 138 #if defined key_agrif 141 139 SUBROUTINE stp( ) 140 INTEGER :: kstp ! ocean time-step index 142 141 #else 143 142 SUBROUTINE stp( kstp ) 143 INTEGER, INTENT(in) :: kstp ! ocean time-step index 144 144 #endif 145 145 !!---------------------------------------------------------------------- … … 159 159 !! -8- Outputs and diagnostics 160 160 !!---------------------------------------------------------------------- 161 !! * Arguments162 #if defined key_agrif163 INTEGER :: kstp ! ocean time-step index164 #else165 INTEGER, INTENT(in) :: kstp ! ocean time-step index166 #endif167 161 INTEGER :: jk ! dummy loop indice 168 162 INTEGER :: indic ! error indicator if < 0 … … 202 196 203 197 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 204 ! Computation of diagnostic variables 205 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 206 ! N.B. ua, va, ta, sa arrays are used as workspace in this section 207 !----------------------------------------------------------------------- 198 ! Ocean dynamics : ssh, wn, hdiv, rot ! 199 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 208 200 CALL div_cur( kstp ) ! Horizontal divergence & Relative vorticity 209 201 IF( n_cla == 1 ) CALL div_cla( kstp ) ! Cross Land Advection (Update Hor. divergence) … … 213 205 ! Ocean physics update 214 206 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 207 ! N.B. ua, va, ta, sa arrays are used as workspace in this section 208 !----------------------------------------------------------------------- 215 209 #if defined key_zdftke2 216 210 IF ( ln_dynhpg_imp ) THEN 217 211 !----------------------------------------------------------------------- 218 212 ! LATERAL PHYSICS 219 !-----------------------------------------------------------------------220 ! N.B. ua, va, ta, sa arrays are used as workspace in this section221 213 !----------------------------------------------------------------------- 222 214 CALL zdf_mxl( kstp ) ! mixed layer depth … … 229 221 !----------------------------------------------------------------------- 230 222 ! VERTICAL PHYSICS 231 !-----------------------------------------------------------------------232 ! N.B. ua, va, ta, sa arrays are used as workspace in this section233 223 !----------------------------------------------------------------------- 234 224 IF( neuler == 0 .AND. kstp == nit000 ) THEN … … 273 263 !----------------------------------------------------------------------- 274 264 ! LATERAL PHYSICS 275 !-----------------------------------------------------------------------276 ! N.B. ua, va, ta, sa arrays are used as workspace in this section277 265 !----------------------------------------------------------------------- 278 266 IF( lk_ldfslp ) CALL ldf_slp( kstp, rhd, rn2b ) ! before slope of the lateral mixing
Note: See TracChangeset
for help on using the changeset viewer.
