Changeset 9212 for branches/2017
- Timestamp:
- 2018-01-12T10:11:52+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r9169 r9212 85 85 INTEGER, SAVE :: nprevrec, nsecdyn 86 86 87 88 87 !!---------------------------------------------------------------------- 89 !! NEMO/OFF 3.3 , NEMO Consortium (2010)88 !! NEMO/OFF 4.0 , NEMO Consortium (2017) 90 89 !! $Id$ 91 90 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 104 103 !! - interpolates data if needed 105 104 !!---------------------------------------------------------------------- 106 USE oce, ONLY: zhdivtr => ua107 105 INTEGER, INTENT(in) :: kt ! ocean time-step index 106 ! 108 107 INTEGER :: ji, jj, jk 109 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zemp 108 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zemp 109 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zhdivtr 110 110 !!---------------------------------------------------------------------- 111 111 ! … … 138 138 ! 139 139 IF( .NOT.ln_linssh ) THEN 140 ALLOCATE( zemp(jpi,jpj) )141 zhdivtr(:,:,:) = sf_dyn(jf_div)%fnow(:,:,:) * tmask(:,:,:) ! effective u-transport142 emp_b (:,:)= sf_dyn(jf_empb)%fnow(:,:,1) * tmask(:,:,1) ! E-P143 zemp (:,:) = 0.5_wp * ( emp(:,:) + emp_b(:,:) ) + rnf(:,:) + fwbcorr* tmask(:,:,1)140 ALLOCATE( zemp(jpi,jpj) , zhdivtr(jpi,jpj,jpk) ) 141 zhdivtr(:,:,:) = sf_dyn(jf_div)%fnow(:,:,:) * tmask(:,:,:) ! effective u-transport 142 emp_b (:,:) = sf_dyn(jf_empb)%fnow(:,:,1) * tmask(:,:,1) ! E-P 143 zemp (:,:) = ( 0.5_wp * ( emp(:,:) + emp_b(:,:) ) + rnf(:,:) + fwbcorr ) * tmask(:,:,1) 144 144 CALL dta_dyn_ssh( kt, zhdivtr, sshb, zemp, ssha, e3t_a(:,:,:) ) != ssh, vertical scale factor & vertical transport 145 DEALLOCATE( zemp )145 DEALLOCATE( zemp , zhdivtr ) 146 146 ! Write in the tracer restart file 147 ! ******************************* 147 ! ********************************* 148 148 IF( lrst_trc ) THEN 149 149 IF(lwp) WRITE(numout,*) 150 IF(lwp) WRITE(numout,*) 'dta_dyn_ssh : ssh field written in tracer restart file ', & 151 & 'at it= ', kt,' date= ', ndastp 152 IF(lwp) WRITE(numout,*) '~~~~' 150 IF(lwp) WRITE(numout,*) 'dta_dyn_ssh : ssh field written in tracer restart file at it= ', kt,' date= ', ndastp 151 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 153 152 CALL iom_rstput( kt, nitrst, numrtw, 'sshn', ssha ) 154 153 CALL iom_rstput( kt, nitrst, numrtw, 'sshb', sshn ) … … 202 201 !! ** Purpose : Initialisation of the dynamical data 203 202 !! ** Method : - read the data namdta_dyn namelist 204 !!205 !! ** Action : - read parameters206 203 !!---------------------------------------------------------------------- 207 204 INTEGER :: ierr, ierr0, ierr1, ierr2, ierr3 ! return error code … … 222 219 TYPE(FLD_N) :: sn_ubl, sn_vbl, sn_rnf ! " " 223 220 TYPE(FLD_N) :: sn_div ! informations about the fields to be read 224 225 !!---------------------------------------------------------------------- 226 ! 221 !! 227 222 NAMELIST/namdta_dyn/cn_dir, ln_dynrnf, ln_dynrnf_depth, fwbcorr, & 228 & sn_uwd, sn_vwd, sn_wwd, sn_emp, &229 & sn_avt, sn_tem, sn_sal, sn_mld , sn_qsr , &230 & sn_wnd, sn_ice, sn_fmf, &231 & sn_ubl, sn_vbl, sn_rnf, &223 & sn_uwd, sn_vwd, sn_wwd, sn_emp, & 224 & sn_avt, sn_tem, sn_sal, sn_mld , sn_qsr , & 225 & sn_wnd, sn_ice, sn_fmf, & 226 & sn_ubl, sn_vbl, sn_rnf, & 232 227 & sn_empb, sn_div 228 !!---------------------------------------------------------------------- 233 229 ! 234 230 REWIND( numnam_ref ) ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data … … 252 248 ENDIF 253 249 ! 254 255 250 jf_uwd = 1 ; jf_vwd = 2 ; jf_wwd = 3 ; jf_emp = 4 ; jf_avt = 5 256 251 jf_tem = 6 ; jf_sal = 7 ; jf_mld = 8 ; jf_qsr = 9 257 252 jf_wnd = 10 ; jf_ice = 11 ; jf_fmf = 12 ; jfld = jf_fmf 258 259 253 ! 260 254 slf_d(jf_uwd) = sn_uwd ; slf_d(jf_vwd) = sn_vwd ; slf_d(jf_wwd) = sn_wwd … … 263 257 slf_d(jf_qsr) = sn_qsr ; slf_d(jf_wnd) = sn_wnd ; slf_d(jf_ice) = sn_ice 264 258 slf_d(jf_fmf) = sn_fmf 265 266 259 ! 267 260 IF( .NOT.ln_linssh ) THEN 268 jf_div = jfld + 1 ; jf_empb = jfld + 2 ;jfld = jf_empb269 slf_d(jf_div) = sn_div; slf_d(jf_empb) = sn_empb261 jf_div = jfld + 1 ; jf_empb = jfld + 2 ; jfld = jf_empb 262 slf_d(jf_div) = sn_div ; slf_d(jf_empb) = sn_empb 270 263 ENDIF 271 264 ! 272 265 IF( ln_trabbl ) THEN 273 jf_ubl = jfld + 1 ; jf_vbl = jfld + 2 ;jfld = jf_vbl274 slf_d(jf_ubl) = sn_ubl; slf_d(jf_vbl) = sn_vbl266 jf_ubl = jfld + 1 ; jf_vbl = jfld + 2 ; jfld = jf_vbl 267 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl 275 268 ENDIF 276 269 ! 277 270 IF( ln_dynrnf ) THEN 278 jf_rnf = jfld + 1; jfld = jf_rnf279 271 jf_rnf = jfld + 1 ; jfld = jf_rnf 272 slf_d(jf_rnf) = sn_rnf 280 273 ELSE 281 274 rnf(:,:) = 0._wp 282 275 ENDIF 283 276 284 285 277 ALLOCATE( sf_dyn(jfld), STAT=ierr ) ! set sf structure 286 278 IF( ierr > 0 ) THEN … … 426 418 END SUBROUTINE dta_dyn_init 427 419 420 428 421 SUBROUTINE dta_dyn_swp( kt ) 429 422 !!--------------------------------------------------------------------- 430 423 !! *** ROUTINE dta_dyn_swp *** 431 424 !! 432 !! ** Purpose : Swap and the data and compute the vertical scale factor at U/V/W point 433 !! and the depht 434 !! 425 !! ** Purpose : Swap and the data and compute the vertical scale factor 426 !! at U/V/W pointand the depht 435 427 !!--------------------------------------------------------------------- 436 428 INTEGER, INTENT(in) :: kt ! time step 429 ! 437 430 INTEGER :: ji, jj, jk 438 431 REAL(wp) :: zcoef 439 !440 432 !!--------------------------------------------------------------------- 441 433 … … 471 463 gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 472 464 gdepw_n(:,:,1) = 0.0_wp 473 465 ! 474 466 DO jk = 2, jpk 475 467 DO jj = 1,jpj 476 468 DO ji = 1,jpi 477 478 479 480 481 482 483 484 469 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 470 gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 471 gdept_n(ji,jj,jk) = zcoef * ( gdepw_n(ji,jj,jk ) + 0.5 * e3w_n(ji,jj,jk)) & 472 & + (1-zcoef) * ( gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk)) 473 END DO 474 END DO 475 END DO 476 ! 485 477 gdept_b(:,:,:) = gdept_n(:,:,:) 486 478 gdepw_b(:,:,:) = gdepw_n(:,:,:) 487 488 479 ! 489 480 END SUBROUTINE dta_dyn_swp 481 490 482 491 483 SUBROUTINE dta_dyn_ssh( kt, phdivtr, psshb, pemp, pssha, pe3ta ) … … 510 502 !! Reference : Leclair, M., and G. Madec, 2009, Ocean Modelling. 511 503 !!---------------------------------------------------------------------- 512 !! * Arguments513 504 INTEGER, INTENT(in ) :: kt ! time-step 514 505 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: phdivtr ! horizontal divergence transport … … 517 508 REAL(wp), DIMENSION(jpi,jpj) , OPTIONAL, INTENT(inout) :: pssha ! after ssh 518 509 REAL(wp), DIMENSION(jpi,jpj,jpk), OPTIONAL, INTENT(out) :: pe3ta ! after vertical scale factor 519 ! ! * Local declarations510 ! 520 511 INTEGER :: jk 521 512 REAL(wp), DIMENSION(jpi,jpj) :: zhdiv 522 513 REAL(wp) :: z2dt 523 514 !!---------------------------------------------------------------------- 524 525 515 ! 526 516 z2dt = 2._wp * rdt … … 577 567 !! 578 568 !!--------------------------------------------------------------------- 579 USE oce, ONLY: zts => tsa580 !581 569 INTEGER, INTENT(in) :: kt ! time step 582 570 ! … … 585 573 REAL(wp) :: ztintb ! ratio applied to before records when doing time interpolation 586 574 INTEGER :: iswap 587 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zuslp, zvslp, zwslpi, zwslpj 575 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zuslp, zvslp, zwslpi, zwslpj 576 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts 588 577 !!--------------------------------------------------------------------- 589 578 ! … … 658 647 END SUBROUTINE dta_dyn_slp 659 648 649 660 650 SUBROUTINE compute_slopes( kt, pts, puslp, pvslp, pwslpi, pwslpj ) 661 651 !!--------------------------------------------------------------------- 662 652 !! *** ROUTINE dta_dyn_slp *** 663 653 !! 664 !! ** Purpose : Computation of slope 665 !! 654 !! ** Purpose : Computation of slope 666 655 !!--------------------------------------------------------------------- 667 656 INTEGER , INTENT(in ) :: kt ! time step … … 672 661 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: pwslpj ! meridional diapycnal slopes 673 662 !!--------------------------------------------------------------------- 663 ! 674 664 IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN ! Computes slopes (here avt is used as workspace) 675 665 CALL eos ( pts, rhd, rhop, gdept_0(:,:,:) ) … … 700 690 ! 701 691 END SUBROUTINE compute_slopes 692 702 693 !!====================================================================== 703 694 END MODULE dtadyn
Note: See TracChangeset
for help on using the changeset viewer.