- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OFF/dtadyn.F90 (modified) (42 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OFF/dtadyn.F90
r10425 r13463 13 13 !! 3.3 ! 2010-11 (C. Ethe) Full reorganization of the off-line: phasing with the on-line 14 14 !! 3.4 ! 2011-05 (C. Ethe) Use of fldread 15 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) split dta_dyn_sf_swp -> dta_dyn_sf_atf and dta_dyn_sf_interp 15 16 !!---------------------------------------------------------------------- 16 17 … … 22 23 USE c1d ! 1D configuration: lk_c1d 23 24 USE dom_oce ! ocean domain: variables 25 #if ! defined key_qco 24 26 USE domvvl ! variable volume 27 #else 28 USE domqco 29 #endif 25 30 USE zdf_oce ! ocean vertical physics: variables 26 31 USE sbc_oce ! surface module: variables … … 46 51 PRIVATE 47 52 48 PUBLIC dta_dyn_init ! called by opa.F90 49 PUBLIC dta_dyn ! called by step.F90 50 PUBLIC dta_dyn_sed_init ! called by opa.F90 51 PUBLIC dta_dyn_sed ! called by step.F90 52 PUBLIC dta_dyn_swp ! called by step.F90 53 PUBLIC dta_dyn_init ! called by nemo_init 54 PUBLIC dta_dyn ! called by nemo_gcm 55 PUBLIC dta_dyn_sed_init ! called by nemo_init 56 PUBLIC dta_dyn_sed ! called by nemo_gcm 57 PUBLIC dta_dyn_atf ! called by nemo_gcm 58 #if ! defined key_qco 59 PUBLIC dta_dyn_sf_interp ! called by nemo_gcm 60 #endif 53 61 54 62 CHARACTER(len=100) :: cn_dir !: Root directory for location of ssr files … … 63 71 INTEGER , SAVE :: jf_uwd ! index of u-transport 64 72 INTEGER , SAVE :: jf_vwd ! index of v-transport 65 INTEGER , SAVE :: jf_wwd ! index of v-transport73 INTEGER , SAVE :: jf_wwd ! index of w-transport 66 74 INTEGER , SAVE :: jf_avt ! index of Kz 67 75 INTEGER , SAVE :: jf_mld ! index of mixed layer deptht … … 87 95 INTEGER, SAVE :: nprevrec, nsecdyn 88 96 97 !! * Substitutions 98 # include "do_loop_substitute.h90" 89 99 !!---------------------------------------------------------------------- 90 100 !! NEMO/OFF 4.0 , NEMO Consortium (2018) … … 94 104 CONTAINS 95 105 96 SUBROUTINE dta_dyn( kt )106 SUBROUTINE dta_dyn( kt, Kbb, Kmm, Kaa ) 97 107 !!---------------------------------------------------------------------- 98 108 !! *** ROUTINE dta_dyn *** … … 105 115 !! - interpolates data if needed 106 116 !!---------------------------------------------------------------------- 107 INTEGER, INTENT(in) :: kt ! ocean time-step index 117 INTEGER, INTENT(in) :: kt ! ocean time-step index 118 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 108 119 ! 109 120 INTEGER :: ji, jj, jk … … 117 128 ! 118 129 IF( kt == nit000 ) THEN ; nprevrec = 0 119 ELSE ; nprevrec = sf_dyn(jf_tem)%nrec _a(2)130 ELSE ; nprevrec = sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%naa) 120 131 ENDIF 121 132 CALL fld_read( kt, 1, sf_dyn ) != read data at kt time step ==! 122 133 ! 123 IF( l_ldfslp .AND. .NOT.lk_c1d ) CALL dta_dyn_slp( kt ) ! Computation of slopes124 ! 125 ts n(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:) ! temperature126 ts n(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:) ! salinity134 IF( l_ldfslp .AND. .NOT.lk_c1d ) CALL dta_dyn_slp( kt, Kbb, Kmm ) ! Computation of slopes 135 ! 136 ts(:,:,:,jp_tem,Kmm) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:) ! temperature 137 ts(:,:,:,jp_sal,Kmm) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:) ! salinity 127 138 wndm(:,:) = sf_dyn(jf_wnd)%fnow(:,:,1) * tmask(:,:,1) ! wind speed - needed for gas exchange 128 139 fmmflx(:,:) = sf_dyn(jf_fmf)%fnow(:,:,1) * tmask(:,:,1) ! downward salt flux (v3.5+) … … 132 143 IF( ln_dynrnf ) THEN 133 144 rnf (:,:) = sf_dyn(jf_rnf)%fnow(:,:,1) * tmask(:,:,1) ! E-P 134 IF( ln_dynrnf_depth .AND. .NOT. ln_linssh ) CALL dta_dyn_hrnf 135 ENDIF 136 ! 137 u n(:,:,:) = sf_dyn(jf_uwd)%fnow(:,:,:) * umask(:,:,:) ! effective u-transport138 v n(:,:,:) = sf_dyn(jf_vwd)%fnow(:,:,:) * vmask(:,:,:) ! effective v-transport139 w n(:,:,:) = sf_dyn(jf_wwd)%fnow(:,:,:) * tmask(:,:,:) ! effective v-transport145 IF( ln_dynrnf_depth .AND. .NOT. ln_linssh ) CALL dta_dyn_hrnf(Kmm) 146 ENDIF 147 ! 148 uu(:,:,:,Kmm) = sf_dyn(jf_uwd)%fnow(:,:,:) * umask(:,:,:) ! effective u-transport 149 vv(:,:,:,Kmm) = sf_dyn(jf_vwd)%fnow(:,:,:) * vmask(:,:,:) ! effective v-transport 150 ww(:,:,:) = sf_dyn(jf_wwd)%fnow(:,:,:) * tmask(:,:,:) ! effective v-transport 140 151 ! 141 152 IF( .NOT.ln_linssh ) THEN … … 144 155 emp_b (:,:) = sf_dyn(jf_empb)%fnow(:,:,1) * tmask(:,:,1) ! E-P 145 156 zemp (:,:) = ( 0.5_wp * ( emp(:,:) + emp_b(:,:) ) + rnf(:,:) + fwbcorr ) * tmask(:,:,1) 146 CALL dta_dyn_ssh( kt, zhdivtr, sshb, zemp, ssha, e3t_a(:,:,:) ) != ssh, vertical scale factor & vertical transport 157 #if defined key_qco 158 CALL dta_dyn_ssh( kt, zhdivtr, ssh(:,:,Kbb), zemp, ssh(:,:,Kaa) ) 159 CALL dom_qco_r3c( ssh(:,:,Kaa), r3t(:,:,Kaa), r3u(:,:,Kaa), r3v(:,:,Kaa) ) 160 #else 161 CALL dta_dyn_ssh( kt, zhdivtr, ssh(:,:,Kbb), zemp, ssh(:,:,Kaa), e3t(:,:,:,Kaa) ) != ssh, vertical scale factor 162 #endif 147 163 DEALLOCATE( zemp , zhdivtr ) 148 164 ! Write in the tracer restart file … … 152 168 IF(lwp) WRITE(numout,*) 'dta_dyn_ssh : ssh field written in tracer restart file at it= ', kt,' date= ', ndastp 153 169 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 154 CALL iom_rstput( kt, nitrst, numrtw, 'sshn', ssh a)155 CALL iom_rstput( kt, nitrst, numrtw, 'sshb', ssh n)170 CALL iom_rstput( kt, nitrst, numrtw, 'sshn', ssh(:,:,Kaa) ) 171 CALL iom_rstput( kt, nitrst, numrtw, 'sshb', ssh(:,:,Kmm) ) 156 172 ENDIF 157 173 ENDIF 158 174 ! 159 CALL eos ( ts n, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop160 CALL eos_rab( ts n, rab_n) ! now local thermal/haline expension ratio at T-points161 CALL bn2 ( ts n, rab_n, rn2 )! before Brunt-Vaisala frequency need for zdfmxl162 163 rn2b(:,:,:) = rn2(:,:,:) ! need for zdfmxl164 CALL zdf_mxl( kt )! In any case, we need mxl175 CALL eos ( ts(:,:,:,:,Kmm), rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop 176 CALL eos_rab( ts(:,:,:,:,Kmm), rab_n, Kmm ) ! now local thermal/haline expension ratio at T-points 177 CALL bn2 ( ts(:,:,:,:,Kmm), rab_n, rn2, Kmm ) ! before Brunt-Vaisala frequency need for zdfmxl 178 179 rn2b(:,:,:) = rn2(:,:,:) ! needed for zdfmxl 180 CALL zdf_mxl( kt, Kmm ) ! In any case, we need mxl 165 181 ! 166 182 hmld(:,:) = sf_dyn(jf_mld)%fnow(:,:,1) * tmask(:,:,1) ! mixed layer depht … … 174 190 ! 175 191 ! 176 CALL eos( ts n, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop177 ! 178 IF( ln_ctl) THEN! print control179 CALL prt_ctl(tab3d_1=ts n(:,:,:,jp_tem), clinfo1=' tn - : ', mask1=tmask, kdim=jpk )180 CALL prt_ctl(tab3d_1=ts n(:,:,:,jp_sal), clinfo1=' sn - : ', mask1=tmask, kdim=jpk )181 CALL prt_ctl(tab3d_1=u n , clinfo1=' un- : ', mask1=umask, kdim=jpk )182 CALL prt_ctl(tab3d_1=v n , clinfo1=' vn- : ', mask1=vmask, kdim=jpk )183 CALL prt_ctl(tab3d_1=w n , clinfo1=' wn- : ', mask1=tmask, kdim=jpk )192 CALL eos( ts(:,:,:,:,Kmm), rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop 193 ! 194 IF(sn_cfctl%l_prtctl) THEN ! print control 195 CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' tn - : ', mask1=tmask, kdim=jpk ) 196 CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sn - : ', mask1=tmask, kdim=jpk ) 197 CALL prt_ctl(tab3d_1=uu(:,:,:,Kmm) , clinfo1=' uu(:,:,:,Kmm) - : ', mask1=umask, kdim=jpk ) 198 CALL prt_ctl(tab3d_1=vv(:,:,:,Kmm) , clinfo1=' vv(:,:,:,Kmm) - : ', mask1=vmask, kdim=jpk ) 199 CALL prt_ctl(tab3d_1=ww , clinfo1=' ww - : ', mask1=tmask, kdim=jpk ) 184 200 CALL prt_ctl(tab3d_1=avt , clinfo1=' kz - : ', mask1=tmask, kdim=jpk ) 185 201 CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp - u : ', tab3d_2=vslp, clinfo2=' v : ', kdim=jpk) … … 192 208 193 209 194 SUBROUTINE dta_dyn_init 210 SUBROUTINE dta_dyn_init( Kbb, Kmm, Kaa ) 195 211 !!---------------------------------------------------------------------- 196 212 !! *** ROUTINE dta_dyn_init *** … … 199 215 !! ** Method : - read the data namdta_dyn namelist 200 216 !!---------------------------------------------------------------------- 217 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 218 ! 201 219 INTEGER :: ierr, ierr0, ierr1, ierr2, ierr3 ! return error code 202 220 INTEGER :: ifpr ! dummy loop indice … … 225 243 !!---------------------------------------------------------------------- 226 244 ! 227 REWIND( numnam_ref ) ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data228 245 READ ( numnam_ref, namdta_dyn, IOSTAT = ios, ERR = 901) 229 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdta_dyn in reference namelist', lwp ) 230 REWIND( numnam_cfg ) ! Namelist namdta_dyn in configuration namelist : Offline: init. of dynamical data 246 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdta_dyn in reference namelist' ) 231 247 READ ( numnam_cfg, namdta_dyn, IOSTAT = ios, ERR = 902 ) 232 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdta_dyn in configuration namelist' , lwp)248 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdta_dyn in configuration namelist' ) 233 249 IF(lwm) WRITE ( numond, namdta_dyn ) 234 250 ! ! store namelist information in an array … … 278 294 ! ! fill sf with slf_i and control print 279 295 CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' ) 296 sf_dyn(jf_uwd)%cltype = 'U' ; sf_dyn(jf_uwd)%zsgn = -1._wp 297 sf_dyn(jf_vwd)%cltype = 'V' ; sf_dyn(jf_vwd)%zsgn = -1._wp 298 ! 299 IF( ln_trabbl ) THEN 300 sf_dyn(jf_ubl)%cltype = 'U' ; sf_dyn(jf_ubl)%zsgn = 1._wp 301 sf_dyn(jf_vbl)%cltype = 'V' ; sf_dyn(jf_vbl)%zsgn = 1._wp 302 END IF 280 303 ! 281 304 ! Open file for each variable to get his number of dimension 282 305 DO ifpr = 1, jfld 283 CALL fld_clopn( sf_dyn(ifpr), nyear, nmonth, nday ) 306 CALL fld_def( sf_dyn(ifpr) ) 307 CALL iom_open( sf_dyn(ifpr)%clname, sf_dyn(ifpr)%num ) 284 308 idv = iom_varid( sf_dyn(ifpr)%num , slf_d(ifpr)%clvar ) ! id of the variable sdjf%clvar 285 309 idimv = iom_file ( sf_dyn(ifpr)%num )%ndims(idv) ! number of dimension for variable sdjf%clvar 286 IF( sf_dyn(ifpr)%num /= 0 ) CALL iom_close( sf_dyn(ifpr)%num )! close file if already open310 CALL iom_close( sf_dyn(ifpr)%num ) ! close file if already open 287 311 ierr1=0 288 312 IF( idimv == 3 ) THEN ! 2D variable … … 312 336 IF( .NOT. sf_dyn(jf_uwd)%ln_clim .AND. ln_rsttr .AND. & ! Restart: read in restart file 313 337 iom_varid( numrtr, 'sshn', ldstop = .FALSE. ) > 0 ) THEN 314 IF(lwp) WRITE(numout,*) ' ssh nforcing fields read in the restart file for initialisation'315 CALL iom_get( numrtr, jpdom_auto glo, 'sshn', sshn(:,:) )316 CALL iom_get( numrtr, jpdom_auto glo, 'sshb', sshb(:,:) )338 IF(lwp) WRITE(numout,*) ' ssh(:,:,Kmm) forcing fields read in the restart file for initialisation' 339 CALL iom_get( numrtr, jpdom_auto, 'sshn', ssh(:,:,Kmm) ) 340 CALL iom_get( numrtr, jpdom_auto, 'sshb', ssh(:,:,Kbb) ) 317 341 ELSE 318 IF(lwp) WRITE(numout,*) ' ssh nforcing fields read in the restart file for initialisation'342 IF(lwp) WRITE(numout,*) ' ssh(:,:,Kmm) forcing fields read in the restart file for initialisation' 319 343 CALL iom_open( 'restart', inum ) 320 CALL iom_get( inum, jpdom_auto glo, 'sshn', sshn(:,:) )321 CALL iom_get( inum, jpdom_auto glo, 'sshb', sshb(:,:) )344 CALL iom_get( inum, jpdom_auto, 'sshn', ssh(:,:,Kmm) ) 345 CALL iom_get( inum, jpdom_auto, 'sshb', ssh(:,:,Kbb) ) 322 346 CALL iom_close( inum ) ! close file 323 347 ENDIF 324 348 ! 349 #if defined key_qco 350 CALL dom_qco_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb) ) 351 CALL dom_qco_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm) ) 352 #else 325 353 DO jk = 1, jpkm1 326 e3t _n(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + sshn(:,:) * tmask(:,:,1) / ( ht_0(:,:) + 1.0 - tmask(:,:,1)) )354 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + ssh(:,:,Kmm) * r1_ht_0(:,:) * tmask(:,:,jk) ) 327 355 ENDDO 328 e3t _a(:,:,jpk) = e3t_0(:,:,jpk)356 e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk) 329 357 330 358 ! Horizontal scale factor interpolations 331 359 ! -------------------------------------- 332 CALL dom_vvl_interpol( e3t _n(:,:,:), e3u_n(:,:,:), 'U' )333 CALL dom_vvl_interpol( e3t _n(:,:,:), e3v_n(:,:,:), 'V' )360 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 361 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 334 362 335 363 ! Vertical scale factor interpolations 336 364 ! ------------------------------------ 337 CALL dom_vvl_interpol( e3t _n(:,:,:), e3w_n(:,:,:), 'W' )338 339 e3t _b(:,:,:) = e3t_n(:,:,:)340 e3u _b(:,:,:) = e3u_n(:,:,:)341 e3v _b(:,:,:) = e3v_n(:,:,:)365 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w(:,:,:,Kmm), 'W' ) 366 !!gm this should be computed from ssh(Kbb) 367 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 368 e3u(:,:,:,Kbb) = e3u(:,:,:,Kmm) 369 e3v(:,:,:,Kbb) = e3v(:,:,:,Kmm) 342 370 343 371 ! t- and w- points depth 344 372 ! ---------------------- 345 gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 346 gdepw_n(:,:,1) = 0.0_wp 347 348 DO jk = 2, jpk 349 DO jj = 1,jpj 350 DO ji = 1,jpi 351 ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere 352 ! tmask = wmask, ie everywhere expect at jk = mikt 353 ! 1 for jk = 354 ! mikt 355 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 356 gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 357 gdept_n(ji,jj,jk) = zcoef * ( gdepw_n(ji,jj,jk ) + 0.5 * e3w_n(ji,jj,jk)) & 358 & + (1-zcoef) * ( gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk)) 359 END DO 360 END DO 361 END DO 362 363 gdept_b(:,:,:) = gdept_n(:,:,:) 364 gdepw_b(:,:,:) = gdepw_n(:,:,:) 373 gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 374 gdepw(:,:,1,Kmm) = 0.0_wp 375 376 DO_3D( 1, 1, 1, 1, 2, jpk ) 377 ! zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) ! 0 everywhere 378 ! tmask = wmask, ie everywhere expect at jk = mikt 379 ! 1 for jk = 380 ! mikt 381 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 382 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 383 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm)) & 384 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm)) 385 END_3D 386 387 gdept(:,:,:,Kbb) = gdept(:,:,:,Kmm) 388 gdepw(:,:,:,Kbb) = gdepw(:,:,:,Kmm) 365 389 ! 366 390 ENDIF 391 #endif 367 392 ! 368 393 IF( ln_dynrnf .AND. ln_dynrnf_depth ) THEN ! read depht over which runoffs are distributed … … 370 395 IF(lwp) WRITE(numout,*) ' read in the file depht over which runoffs are distributed' 371 396 CALL iom_open ( "runoffs", inum ) ! open file 372 CALL iom_get ( inum, jpdom_ data, 'rodepth', h_rnf ) ! read the river mouth array397 CALL iom_get ( inum, jpdom_global, 'rodepth', h_rnf ) ! read the river mouth array 373 398 CALL iom_close( inum ) ! close file 374 399 ! 375 400 nk_rnf(:,:) = 0 ! set the number of level over which river runoffs are applied 376 DO jj = 1, jpj 377 DO ji = 1, jpi 378 IF( h_rnf(ji,jj) > 0._wp ) THEN 379 jk = 2 380 DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ; jk = jk + 1 381 END DO 382 nk_rnf(ji,jj) = jk 383 ELSEIF( h_rnf(ji,jj) == -1._wp ) THEN ; nk_rnf(ji,jj) = 1 384 ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN ; nk_rnf(ji,jj) = mbkt(ji,jj) 385 ELSE 386 CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999' ) 387 WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj) 388 ENDIF 401 DO_2D( 1, 1, 1, 1 ) 402 IF( h_rnf(ji,jj) > 0._wp ) THEN 403 jk = 2 404 DO WHILE ( jk /= mbkt(ji,jj) .AND. gdept_0(ji,jj,jk) < h_rnf(ji,jj) ) ; jk = jk + 1 405 END DO 406 nk_rnf(ji,jj) = jk 407 ELSEIF( h_rnf(ji,jj) == -1._wp ) THEN ; nk_rnf(ji,jj) = 1 408 ELSEIF( h_rnf(ji,jj) == -999._wp ) THEN ; nk_rnf(ji,jj) = mbkt(ji,jj) 409 ELSE 410 CALL ctl_stop( 'sbc_rnf_init: runoff depth not positive, and not -999 or -1, rnf value in file fort.999' ) 411 WRITE(999,*) 'ji, jj, h_rnf(ji,jj) :', ji, jj, h_rnf(ji,jj) 412 ENDIF 413 END_2D 414 !!st pourquoi on n'utilise pas le gde3w ici plutôt que de faire une boucle ? 415 DO_2D( 1, 1, 1, 1 ) 416 h_rnf(ji,jj) = 0._wp 417 DO jk = 1, nk_rnf(ji,jj) 418 h_rnf(ji,jj) = h_rnf(ji,jj) + e3t(ji,jj,jk,Kmm) 389 419 END DO 390 END DO 391 DO jj = 1, jpj ! set the associated depth 392 DO ji = 1, jpi 393 h_rnf(ji,jj) = 0._wp 394 DO jk = 1, nk_rnf(ji,jj) 395 h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk) 396 END DO 397 END DO 398 END DO 420 END_2D 399 421 ELSE ! runoffs applied at the surface 400 422 nk_rnf(:,:) = 1 401 h_rnf (:,:) = e3t _n(:,:,1)423 h_rnf (:,:) = e3t(:,:,1,Kmm) 402 424 ENDIF 403 425 nkrnf_max = MAXVAL( nk_rnf(:,:) ) … … 411 433 IF(lwp) WRITE(numout,*) ' ' 412 434 ! 413 CALL dta_dyn( nit000 )435 CALL dta_dyn( nit000, Kbb, Kmm, Kaa ) 414 436 ! 415 437 END SUBROUTINE dta_dyn_init 416 438 417 SUBROUTINE dta_dyn_sed( kt ) 439 440 SUBROUTINE dta_dyn_sed( kt, Kmm ) 418 441 !!---------------------------------------------------------------------- 419 442 !! *** ROUTINE dta_dyn *** … … 427 450 !!---------------------------------------------------------------------- 428 451 INTEGER, INTENT(in) :: kt ! ocean time-step index 452 INTEGER, INTENT(in) :: Kmm ! ocean time level index 429 453 ! 430 454 !!---------------------------------------------------------------------- … … 435 459 ! 436 460 IF( kt == nit000 ) THEN ; nprevrec = 0 437 ELSE ; nprevrec = sf_dyn(jf_tem)%nrec _a(2)461 ELSE ; nprevrec = sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%naa) 438 462 ENDIF 439 463 CALL fld_read( kt, 1, sf_dyn ) != read data at kt time step ==! 440 464 ! 441 ts n(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:) ! temperature442 ts n(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:) ! salinity443 ! 444 CALL eos ( ts n, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop445 446 IF( ln_ctl) THEN! print control447 CALL prt_ctl(tab3d_1=ts n(:,:,:,jp_tem), clinfo1=' tn - : ', mask1=tmask, kdim=jpk )448 CALL prt_ctl(tab3d_1=ts n(:,:,:,jp_sal), clinfo1=' sn - : ', mask1=tmask, kdim=jpk )465 ts(:,:,:,jp_tem,Kmm) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:) ! temperature 466 ts(:,:,:,jp_sal,Kmm) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:) ! salinity 467 ! 468 CALL eos ( ts(:,:,:,:,Kmm), rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop 469 470 IF(sn_cfctl%l_prtctl) THEN ! print control 471 CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' tn - : ', mask1=tmask, kdim=jpk ) 472 CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sn - : ', mask1=tmask, kdim=jpk ) 449 473 ENDIF 450 474 ! … … 454 478 455 479 456 SUBROUTINE dta_dyn_sed_init 480 SUBROUTINE dta_dyn_sed_init( Kmm ) 457 481 !!---------------------------------------------------------------------- 458 482 !! *** ROUTINE dta_dyn_init *** … … 461 485 !! ** Method : - read the data namdta_dyn namelist 462 486 !!---------------------------------------------------------------------- 487 INTEGER, INTENT( in ) :: Kmm ! ocean time level index 488 ! 463 489 INTEGER :: ierr, ierr0, ierr1, ierr2, ierr3 ! return error code 464 490 INTEGER :: ifpr ! dummy loop indice … … 475 501 !!---------------------------------------------------------------------- 476 502 ! 477 REWIND( numnam_ref ) ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data478 503 READ ( numnam_ref, namdta_dyn, IOSTAT = ios, ERR = 901) 479 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdta_dyn in reference namelist', lwp ) 480 REWIND( numnam_cfg ) ! Namelist namdta_dyn in configuration namelist : Offline: init. of dynamical data 504 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdta_dyn in reference namelist' ) 481 505 READ ( numnam_cfg, namdta_dyn, IOSTAT = ios, ERR = 902 ) 482 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdta_dyn in configuration namelist' , lwp)506 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdta_dyn in configuration namelist' ) 483 507 IF(lwm) WRITE ( numond, namdta_dyn ) 484 508 ! ! store namelist information in an array … … 508 532 ! Open file for each variable to get his number of dimension 509 533 DO ifpr = 1, jfld 510 CALL fld_clopn( sf_dyn(ifpr), nyear, nmonth, nday ) 534 CALL fld_def( sf_dyn(ifpr) ) 535 CALL iom_open( sf_dyn(ifpr)%clname, sf_dyn(ifpr)%num ) 511 536 idv = iom_varid( sf_dyn(ifpr)%num , slf_d(ifpr)%clvar ) ! id of the variable sdjf%clvar 512 537 idimv = iom_file ( sf_dyn(ifpr)%num )%ndims(idv) ! number of dimension for variable sdjf%clvar 513 IF( sf_dyn(ifpr)%num /= 0 ) CALL iom_close( sf_dyn(ifpr)%num )! close file if already open538 CALL iom_close( sf_dyn(ifpr)%num ) ! close file if already open 514 539 ierr1=0 515 540 IF( idimv == 3 ) THEN ! 2D variable … … 525 550 END DO 526 551 ! 527 CALL dta_dyn_sed( nit000 )552 CALL dta_dyn_sed( nit000, Kmm ) 528 553 ! 529 554 END SUBROUTINE dta_dyn_sed_init 530 555 531 SUBROUTINE dta_dyn_swp( kt ) 556 557 SUBROUTINE dta_dyn_atf( kt, Kbb, Kmm, Kaa ) 532 558 !!--------------------------------------------------------------------- 533 559 !! *** ROUTINE dta_dyn_swp *** 534 560 !! 535 !! ** Purpose : Swap and the data and compute the vertical scale factor 536 !! at U/V/W pointand the depht 537 !!--------------------------------------------------------------------- 538 INTEGER, INTENT(in) :: kt ! time step 561 !! ** Purpose : Asselin time filter of now SSH 562 !!--------------------------------------------------------------------- 563 INTEGER, INTENT(in) :: kt ! time step 564 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices 565 ! 566 !!--------------------------------------------------------------------- 567 568 IF( kt == nit000 ) THEN 569 IF(lwp) WRITE(numout,*) 570 IF(lwp) WRITE(numout,*) 'dta_dyn_atf : Asselin time filter of sea surface height' 571 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 572 ENDIF 573 574 ssh(:,:,Kmm) = ssh(:,:,Kmm) + rn_atfp * ( ssh(:,:,Kbb) - 2 * ssh(:,:,Kmm) + ssh(:,:,Kaa)) 575 576 !! Do we also need to time filter e3t?? 577 ! 578 END SUBROUTINE dta_dyn_atf 579 580 581 #if ! defined key_qco 582 SUBROUTINE dta_dyn_sf_interp( kt, Kmm ) 583 !!--------------------------------------------------------------------- 584 !! *** ROUTINE dta_dyn_sf_interp *** 585 !! 586 !! ** Purpose : Calculate scale factors at U/V/W points and depths 587 !! given the after e3t field 588 !!--------------------------------------------------------------------- 589 INTEGER, INTENT(in) :: kt ! time step 590 INTEGER, INTENT(in) :: Kmm ! ocean time level indices 539 591 ! 540 592 INTEGER :: ji, jj, jk … … 542 594 !!--------------------------------------------------------------------- 543 595 544 IF( kt == nit000 ) THEN545 IF(lwp) WRITE(numout,*)546 IF(lwp) WRITE(numout,*) 'ssh_swp : Asselin time filter and swap of sea surface height'547 IF(lwp) WRITE(numout,*) '~~~~~~~ '548 ENDIF549 550 sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:)) ! before <-- now filtered551 sshn(:,:) = ssha(:,:)552 553 e3t_n(:,:,:) = e3t_a(:,:,:)554 555 ! Reconstruction of all vertical scale factors at now and before time steps556 ! =============================================================================557 558 596 ! Horizontal scale factor interpolations 559 597 ! -------------------------------------- 560 CALL dom_vvl_interpol( e3t _n(:,:,:), e3u_n(:,:,:), 'U' )561 CALL dom_vvl_interpol( e3t _n(:,:,:), e3v_n(:,:,:), 'V' )598 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 599 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 562 600 563 601 ! Vertical scale factor interpolations 564 602 ! ------------------------------------ 565 CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W' ) 566 567 e3t_b(:,:,:) = e3t_n(:,:,:) 568 e3u_b(:,:,:) = e3u_n(:,:,:) 569 e3v_b(:,:,:) = e3v_n(:,:,:) 603 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W' ) 570 604 571 605 ! t- and w- points depth 572 606 ! ---------------------- 573 gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 574 gdepw_n(:,:,1) = 0.0_wp 575 ! 576 DO jk = 2, jpk 577 DO jj = 1,jpj 578 DO ji = 1,jpi 579 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 580 gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 581 gdept_n(ji,jj,jk) = zcoef * ( gdepw_n(ji,jj,jk ) + 0.5 * e3w_n(ji,jj,jk)) & 582 & + (1-zcoef) * ( gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk)) 583 END DO 584 END DO 585 END DO 586 ! 587 gdept_b(:,:,:) = gdept_n(:,:,:) 588 gdepw_b(:,:,:) = gdepw_n(:,:,:) 589 ! 590 END SUBROUTINE dta_dyn_swp 591 607 gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 608 gdepw(:,:,1,Kmm) = 0.0_wp 609 ! 610 DO_3D( 1, 1, 1, 1, 2, jpk ) 611 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 612 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 613 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm)) & 614 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm)) 615 END_3D 616 ! 617 END SUBROUTINE dta_dyn_sf_interp 618 #endif 619 592 620 593 621 SUBROUTINE dta_dyn_ssh( kt, phdivtr, psshb, pemp, pssha, pe3ta ) … … 595 623 !! *** ROUTINE dta_dyn_wzv *** 596 624 !! 597 !! ** Purpose : compute the after ssh (ssh a) and the now vertical velocity625 !! ** Purpose : compute the after ssh (ssh(:,:,Kaa)) and the now vertical velocity 598 626 !! 599 627 !! ** Method : Using the incompressibility hypothesis, … … 608 636 !! The boundary conditions are w=0 at the bottom (no flux) 609 637 !! 610 !! ** action : ssh a / e3t_a / wn638 !! ** action : ssh(:,:,Kaa) / e3t(:,:,k,Kaa) / ww 611 639 !! 612 640 !! Reference : Leclair, M., and G. Madec, 2009, Ocean Modelling. … … 624 652 !!---------------------------------------------------------------------- 625 653 ! 626 z2dt = 2._wp * r dt654 z2dt = 2._wp * rn_Dt 627 655 ! 628 656 zhdiv(:,:) = 0._wp … … 631 659 END DO 632 660 ! ! Sea surface elevation time-stepping 633 pssha(:,:) = ( psshb(:,:) - z2dt * ( r1_r au0 * pemp(:,:) + zhdiv(:,:) ) ) * ssmask(:,:)634 ! !635 !! After acale factors at t-points ( z_star coordinate )661 pssha(:,:) = ( psshb(:,:) - z2dt * ( r1_rho0 * pemp(:,:) + zhdiv(:,:) ) ) * ssmask(:,:) 662 ! 663 IF( PRESENT( pe3ta ) ) THEN ! After acale factors at t-points ( z_star coordinate ) 636 664 DO jk = 1, jpkm1 637 pe3ta(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + pssha(:,:) * tmask(:,:,1) / ( ht_0(:,:) + 1.0 - tmask(:,:,1)) )665 pe3ta(:,:,jk) = e3t_0(:,:,jk) * ( 1._wp + pssha(:,:) * r1_ht_0(:,:) * tmask(:,:,jk) ) 638 666 END DO 667 ENDIF 639 668 ! 640 669 END SUBROUTINE dta_dyn_ssh 641 670 642 671 643 SUBROUTINE dta_dyn_hrnf 672 SUBROUTINE dta_dyn_hrnf( Kmm ) 644 673 !!---------------------------------------------------------------------- 645 674 !! *** ROUTINE sbc_rnf *** … … 654 683 !!---------------------------------------------------------------------- 655 684 !! 656 INTEGER :: ji, jj, jk ! dummy loop indices 657 !!---------------------------------------------------------------------- 658 ! 659 DO jj = 1, jpj ! update the depth over which runoffs are distributed 660 DO ji = 1, jpi 661 h_rnf(ji,jj) = 0._wp 662 DO jk = 1, nk_rnf(ji,jj) ! recalculates h_rnf to be the depth in metres 663 h_rnf(ji,jj) = h_rnf(ji,jj) + e3t_n(ji,jj,jk) ! to the bottom of the relevant grid box 664 END DO 665 END DO 666 END DO 685 INTEGER, INTENT(in) :: Kmm ! ocean time level index 686 ! 687 INTEGER :: ji, jj, jk ! dummy loop indices 688 !!---------------------------------------------------------------------- 689 ! 690 !!st code dupliqué même remarque que plus haut pourquoi ne pas utiliser gdepw ? 691 DO_2D( 1, 1, 1, 1 ) 692 h_rnf(ji,jj) = 0._wp 693 DO jk = 1, nk_rnf(ji,jj) ! recalculates h_rnf to be the depth in metres 694 h_rnf(ji,jj) = h_rnf(ji,jj) + e3t(ji,jj,jk,Kmm) ! to the bottom of the relevant grid box 695 END DO 696 END_2D 667 697 ! 668 698 END SUBROUTINE dta_dyn_hrnf … … 670 700 671 701 672 SUBROUTINE dta_dyn_slp( kt )702 SUBROUTINE dta_dyn_slp( kt, Kbb, Kmm ) 673 703 !!--------------------------------------------------------------------- 674 704 !! *** ROUTINE dta_dyn_slp *** … … 678 708 !!--------------------------------------------------------------------- 679 709 INTEGER, INTENT(in) :: kt ! time step 710 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 680 711 ! 681 712 INTEGER :: ji, jj ! dummy loop indices … … 687 718 !!--------------------------------------------------------------------- 688 719 ! 689 IF( sf_dyn(jf_tem)%ln_tint ) THEN ! Computes slopes (here avt is used as workspace) 720 IF( sf_dyn(jf_tem)%ln_tint ) THEN ! Computes slopes (here avt is used as workspace) 721 ! 690 722 IF( kt == nit000 ) THEN 691 723 IF(lwp) WRITE(numout,*) ' Compute new slopes at kt = ', kt 692 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:, 1) * tmask(:,:,:) ! temperature693 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:, 1) * tmask(:,:,:) ! salinity694 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:, 1) * tmask(:,:,:) ! vertical diffusive coef.695 CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj )724 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,sf_dyn(jf_tem)%nbb) * tmask(:,:,:) ! temperature 725 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,sf_dyn(jf_sal)%nbb) * tmask(:,:,:) ! salinity 726 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:,sf_dyn(jf_avt)%nbb) * tmask(:,:,:) ! vertical diffusive coef. 727 CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 696 728 uslpdta (:,:,:,1) = zuslp (:,:,:) 697 729 vslpdta (:,:,:,1) = zvslp (:,:,:) … … 699 731 wslpjdta(:,:,:,1) = zwslpj(:,:,:) 700 732 ! 701 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:, 2) * tmask(:,:,:) ! temperature702 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:, 2) * tmask(:,:,:) ! salinity703 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:, 2) * tmask(:,:,:) ! vertical diffusive coef.704 CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj )733 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,sf_dyn(jf_tem)%naa) * tmask(:,:,:) ! temperature 734 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,sf_dyn(jf_sal)%naa) * tmask(:,:,:) ! salinity 735 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:,sf_dyn(jf_avt)%naa) * tmask(:,:,:) ! vertical diffusive coef. 736 CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 705 737 uslpdta (:,:,:,2) = zuslp (:,:,:) 706 738 vslpdta (:,:,:,2) = zvslp (:,:,:) … … 710 742 ! 711 743 iswap = 0 712 IF( sf_dyn(jf_tem)%nrec _a(2) - nprevrec /= 0 ) iswap = 1713 IF( nsecdyn > sf_dyn(jf_tem)%nrec _b(2) .AND. iswap == 1 ) THEN ! read/update the after data744 IF( sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%naa) - nprevrec /= 0 ) iswap = 1 745 IF( nsecdyn > sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%nbb) .AND. iswap == 1 ) THEN ! read/update the after data 714 746 IF(lwp) WRITE(numout,*) ' Compute new slopes at kt = ', kt 715 747 uslpdta (:,:,:,1) = uslpdta (:,:,:,2) ! swap the data … … 718 750 wslpjdta(:,:,:,1) = wslpjdta(:,:,:,2) 719 751 ! 720 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:, 2) * tmask(:,:,:) ! temperature721 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:, 2) * tmask(:,:,:) ! salinity722 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:, 2) * tmask(:,:,:) ! vertical diffusive coef.723 CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj )752 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,sf_dyn(jf_tem)%naa) * tmask(:,:,:) ! temperature 753 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,sf_dyn(jf_sal)%naa) * tmask(:,:,:) ! salinity 754 avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:,sf_dyn(jf_avt)%naa) * tmask(:,:,:) ! vertical diffusive coef. 755 CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 724 756 ! 725 757 uslpdta (:,:,:,2) = zuslp (:,:,:) … … 732 764 ! 733 765 IF( sf_dyn(jf_tem)%ln_tint ) THEN 734 ztinta = REAL( nsecdyn - sf_dyn(jf_tem)%nrec _b(2), wp ) &735 & / REAL( sf_dyn(jf_tem)%nrec _a(2) - sf_dyn(jf_tem)%nrec_b(2), wp )766 ztinta = REAL( nsecdyn - sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%nbb), wp ) & 767 & / REAL( sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%naa) - sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%nbb), wp ) 736 768 ztintb = 1. - ztinta 737 769 IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN ! Computes slopes (here avt is used as workspace) … … 745 777 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:) ! salinity 746 778 avt(:,:,:) = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:) ! vertical diffusive coef. 747 CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj )779 CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 748 780 ! 749 781 IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN ! Computes slopes (here avt is used as workspace) … … 758 790 759 791 760 SUBROUTINE compute_slopes( kt, pts, puslp, pvslp, pwslpi, pwslpj )792 SUBROUTINE compute_slopes( kt, pts, puslp, pvslp, pwslpi, pwslpj, Kbb, Kmm ) 761 793 !!--------------------------------------------------------------------- 762 794 !! *** ROUTINE dta_dyn_slp *** … … 770 802 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: pwslpi ! zonal diapycnal slopes 771 803 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: pwslpj ! meridional diapycnal slopes 804 INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices 772 805 !!--------------------------------------------------------------------- 773 806 ! 774 807 IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN ! Computes slopes (here avt is used as workspace) 775 808 CALL eos ( pts, rhd, rhop, gdept_0(:,:,:) ) 776 CALL eos_rab( pts, rab_n ) ! now local thermal/haline expension ratio at T-points777 CALL bn2 ( pts, rab_n, rn2 ) ! now Brunt-Vaisala809 CALL eos_rab( pts, rab_n, Kmm ) ! now local thermal/haline expension ratio at T-points 810 CALL bn2 ( pts, rab_n, rn2, Kmm ) ! now Brunt-Vaisala 778 811 779 812 ! Partial steps: before Horizontal DErivative 780 813 IF( ln_zps .AND. .NOT. ln_isfcav) & 781 & CALL zps_hde ( kt, jpts, pts, gtsu, gtsv, & ! Partial steps: before horizontal gradient814 & CALL zps_hde ( kt, Kmm, jpts, pts, gtsu, gtsv, & ! Partial steps: before horizontal gradient 782 815 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 783 816 IF( ln_zps .AND. ln_isfcav) & 784 & CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF)817 & CALL zps_hde_isf( kt, Kmm, jpts, pts, gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF) 785 818 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the first ocean level 786 819 787 rn2b(:,:,:) = rn2(:,:,:) ! need for zdfmxl788 CALL zdf_mxl( kt )! mixed layer depth789 CALL ldf_slp( kt, rhd, rn2 ) ! slopes820 rn2b(:,:,:) = rn2(:,:,:) ! needed for zdfmxl 821 CALL zdf_mxl( kt, Kmm ) ! mixed layer depth 822 CALL ldf_slp( kt, rhd, rn2, Kbb, Kmm ) ! slopes 790 823 puslp (:,:,:) = uslp (:,:,:) 791 824 pvslp (:,:,:) = vslp (:,:,:)
Note: See TracChangeset
for help on using the changeset viewer.
