- Timestamp:
- 2016-07-19T10:38:35+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r5385 r6808 26 26 USE trc_oce ! share ocean/biogeo variables 27 27 USE phycst ! physical constants 28 USE ldftra ! lateral diffusivity coefficients 28 29 USE trabbl ! active tracer: bottom boundary layer 29 30 USE ldfslp ! lateral diffusion: iso-neutral slopes 30 USE ldfeiv ! eddy induced velocity coef.31 USE ldftra_oce ! ocean tracer lateral physics32 31 USE zdfmxl ! vertical physics: mixed layer depth 33 32 USE eosbn2 ! equation of state - Brunt Vaisala frequency … … 40 39 USE fldread ! read input fields 41 40 USE timing ! Timing 41 USE wrk_nemo 42 42 43 43 IMPLICIT NONE … … 50 50 LOGICAL :: ln_dynwzv !: vertical velocity read in a file (T) or computed from u/v (F) 51 51 LOGICAL :: ln_dynbbl !: bbl coef read in a file (T) or computed (F) 52 LOGICAL :: ln_degrad !: degradation option enabled or not53 52 LOGICAL :: ln_dynrnf !: read runoff data in file (T) or set to zero (F) 54 53 55 INTEGER , PARAMETER :: jpfld = 21! maximum number of fields to read54 INTEGER , PARAMETER :: jpfld = 15 ! maximum number of fields to read 56 55 INTEGER , SAVE :: jf_tem ! index of temperature 57 56 INTEGER , SAVE :: jf_sal ! index of salinity … … 68 67 INTEGER , SAVE :: jf_ubl ! index of u-bbl coef 69 68 INTEGER , SAVE :: jf_vbl ! index of v-bbl coef 70 INTEGER , SAVE :: jf_ahu ! index of u-diffusivity coef71 INTEGER , SAVE :: jf_ahv ! index of v-diffusivity coef72 INTEGER , SAVE :: jf_ahw ! index of w-diffusivity coef73 INTEGER , SAVE :: jf_eiu ! index of u-eiv74 INTEGER , SAVE :: jf_eiv ! index of v-eiv75 INTEGER , SAVE :: jf_eiw ! index of w-eiv76 69 INTEGER , SAVE :: jf_fmf ! index of downward salt flux 77 70 … … 92 85 93 86 !! * Substitutions 94 # include "domzgr_substitute.h90"95 87 # include "vectopt_loop_substitute.h90" 96 88 !!---------------------------------------------------------------------- … … 112 104 !! - interpolates data if needed 113 105 !!---------------------------------------------------------------------- 114 ! 115 USE oce, ONLY: zts => tsa 106 USE oce, ONLY: zts => tsa 116 107 USE oce, ONLY: zuslp => ua , zvslp => va 117 USE oce, ONLY: zwslpi => rotb , zwslpj => rotn 118 USE oce, ONLY: zu => ub , zv => vb, zw => hdivb 108 USE oce, ONLY: zu => ub , zv => vb, zw => rke 119 109 ! 120 110 INTEGER, INTENT(in) :: kt ! ocean time-step index 111 ! 112 REAL(wp), DIMENSION(jpi,jpj,jpk ) :: zwslpi, zwslpj 113 ! REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts 114 ! REAL(wp), DIMENSION(jpi,jpj,jpk ) :: zuslp, zvslp, zwslpi, zwslpj 115 ! REAL(wp), DIMENSION(jpi,jpj,jpk ) :: zu, zv, zw 116 ! 121 117 ! 122 118 INTEGER :: ji, jj ! dummy loop indices … … 138 134 CALL fld_read( kt, 1, sf_dyn ) !== read data at kt time step ==! 139 135 ! 140 IF( l k_ldfslp .AND. .NOT.lk_c1d .AND. sf_dyn(jf_tem)%ln_tint ) THEN ! Computes slopes (here avt is used as workspace)136 IF( l_ldfslp .AND. .NOT.lk_c1d .AND. sf_dyn(jf_tem)%ln_tint ) THEN ! Computes slopes (here avt is used as workspace) 141 137 zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,1) * tmask(:,:,:) ! temperature 142 138 zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,1) * tmask(:,:,:) ! salinity … … 162 158 ENDIF 163 159 ! 164 IF( l k_ldfslp .AND. .NOT.lk_c1d ) THEN ! Computes slopes (here avt is used as workspace)160 IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN ! Computes slopes (here avt is used as workspace) 165 161 iswap_tem = 0 166 162 IF( kt /= nit000 .AND. ( sf_dyn(jf_tem)%nrec_a(2) - nrecprev_tem ) /= 0 ) iswap_tem = 1 … … 267 263 rnf (:,:) = sf_dyn(jf_rnf)%fnow(:,:,1) * tmask(:,:,1) ! river runoffs 268 264 265 ! ! update eddy diffusivity coeff. and/or eiv coeff. at kt 266 IF( l_ldftra_time .OR. l_ldfeiv_time ) CALL ldf_tra( kt ) 269 267 ! ! bbl diffusive coef 270 268 #if defined key_trabbl && ! defined key_c1d … … 276 274 CALL bbl( kt, nit000, 'TRC') 277 275 END IF 278 #endif279 #if ( ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv ) && ! defined key_c1d280 aeiw(:,:) = sf_dyn(jf_eiw)%fnow(:,:,1) * tmask(:,:,1) ! w-eiv281 ! ! Computes the horizontal values from the vertical value282 DO jj = 2, jpjm1283 DO ji = fs_2, fs_jpim1 ! vector opt.284 aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj ) ) ! Average the diffusive coefficient at u- v- points285 aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji ,jj+1) ) ! at u- v- points286 END DO287 END DO288 CALL lbc_lnk( aeiu, 'U', 1. ) ; CALL lbc_lnk( aeiv, 'V', 1. ) ! lateral boundary condition289 #endif290 291 #if defined key_degrad && ! defined key_c1d292 ! ! degrad option : diffusive and eiv coef are 3D293 ahtu(:,:,:) = sf_dyn(jf_ahu)%fnow(:,:,:) * umask(:,:,:)294 ahtv(:,:,:) = sf_dyn(jf_ahv)%fnow(:,:,:) * vmask(:,:,:)295 ahtw(:,:,:) = sf_dyn(jf_ahw)%fnow(:,:,:) * tmask(:,:,:)296 # if defined key_traldf_eiv297 aeiu(:,:,:) = sf_dyn(jf_eiu)%fnow(:,:,:) * umask(:,:,:)298 aeiv(:,:,:) = sf_dyn(jf_eiv)%fnow(:,:,:) * vmask(:,:,:)299 aeiw(:,:,:) = sf_dyn(jf_eiw)%fnow(:,:,:) * tmask(:,:,:)300 # endif301 276 #endif 302 277 ! … … 339 314 TYPE(FLD_N), DIMENSION(jpfld) :: slf_d ! array of namelist informations on the fields to read 340 315 TYPE(FLD_N) :: sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, sn_rnf ! informations about the fields to be read 341 TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl ! " " 342 TYPE(FLD_N) :: sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw, sn_fmf ! " " 343 !!---------------------------------------------------------------------- 344 ! 345 NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_degrad, ln_dynrnf, & 316 TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl, sn_fmf ! " " 317 NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_dynrnf, & 346 318 & sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, sn_rnf, & 347 & sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl, &348 & sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw, sn_fmf319 & sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl, sn_fmf 320 !!---------------------------------------------------------------------- 349 321 ! 350 322 REWIND( numnam_ref ) ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data … … 365 337 WRITE(numout,*) ' vertical velocity read from file (T) or computed (F) ln_dynwzv = ', ln_dynwzv 366 338 WRITE(numout,*) ' bbl coef read from file (T) or computed (F) ln_dynbbl = ', ln_dynbbl 367 WRITE(numout,*) ' degradation option enabled (T) or not (F) ln_degrad = ', ln_degrad368 339 WRITE(numout,*) ' river runoff option enabled (T) or not (F) ln_dynrnf = ', ln_dynrnf 369 340 WRITE(numout,*) 370 341 ENDIF 371 342 ! 372 IF( ln_degrad .AND. .NOT.lk_degrad ) THEN373 CALL ctl_warn( 'dta_dyn_init: degradation option requires key_degrad activated ; force ln_degrad to false' )374 ln_degrad = .FALSE.375 ENDIF376 343 IF( ln_dynbbl .AND. ( .NOT.lk_trabbl .OR. lk_c1d ) ) THEN 377 344 CALL ctl_warn( 'dta_dyn_init: bbl option requires key_trabbl activated ; force ln_dynbbl to false' ) … … 391 358 jf_rnf = jfld + 1 ; jfld = jf_rnf 392 359 slf_d(jf_rnf) = sn_rnf 360 ! Activate runoff key of sbc_oce 361 ln_rnf = .true. 362 WRITE(numout,*) 'dta_dyn : Activate the runoff data structure from ocean core ( force ln_rnf = .true.) ' 363 WRITE(numout,*) 393 364 ELSE 394 365 rnf (:,:) = 0._wp 395 366 ENDIF 396 367 397 ! 398 IF( .NOT.ln_degrad ) THEN ! no degrad option 399 IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN ! eiv & bbl 400 jf_ubl = jfld + 1 ; jf_vbl = jfld + 2 ; jf_eiw = jfld + 3 ; jfld = jf_eiw 401 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl ; slf_d(jf_eiw) = sn_eiw 402 ENDIF 403 IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN ! no eiv & bbl 368 IF( ln_dynbbl ) THEN ! eiv & bbl 404 369 jf_ubl = jfld + 1 ; jf_vbl = jfld + 2 ; jfld = jf_vbl 405 370 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl 406 ENDIF 407 IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN ! eiv & no bbl 408 jf_eiw = jfld + 1 ; jfld = jf_eiw ; slf_d(jf_eiw) = sn_eiw 409 ENDIF 410 ELSE 411 jf_ahu = jfld + 1 ; jf_ahv = jfld + 2 ; jf_ahw = jfld + 3 ; jfld = jf_ahw 412 slf_d(jf_ahu) = sn_ahu ; slf_d(jf_ahv) = sn_ahv ; slf_d(jf_ahw) = sn_ahw 413 IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN ! eiv & bbl 414 jf_ubl = jfld + 1 ; jf_vbl = jfld + 2 ; 415 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl 416 jf_eiu = jfld + 3 ; jf_eiv = jfld + 4 ; jf_eiw = jfld + 5 ; jfld = jf_eiw 417 slf_d(jf_eiu) = sn_eiu ; slf_d(jf_eiv) = sn_eiv ; slf_d(jf_eiw) = sn_eiw 418 ENDIF 419 IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN ! no eiv & bbl 420 jf_ubl = jfld + 1 ; jf_vbl = jfld + 2 ; jfld = jf_vbl 421 slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl 422 ENDIF 423 IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN ! eiv & no bbl 424 jf_eiu = jfld + 1 ; jf_eiv = jfld + 2 ; jf_eiw = jfld + 3 ; jfld = jf_eiw 425 slf_d(jf_eiu) = sn_eiu ; slf_d(jf_eiv) = sn_eiv ; slf_d(jf_eiw) = sn_eiw 426 ENDIF 427 ENDIF 428 371 ENDIF 372 373 429 374 ALLOCATE( sf_dyn(jfld), STAT=ierr ) ! set sf structure 430 375 IF( ierr > 0 ) THEN 431 376 CALL ctl_stop( 'dta_dyn: unable to allocate sf structure' ) ; RETURN 432 377 ENDIF 378 ! ! fill sf with slf_i and control print 379 CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' ) 433 380 ! Open file for each variable to get his number of dimension 434 381 DO ifpr = 1, jfld 435 CALL iom_open( TRIM( cn_dir )//TRIM( slf_d(ifpr)%clname ), inum ) 436 idv = iom_varid( inum , slf_d(ifpr)%clvar ) ! id of the variable sdjf%clvar 437 idimv = iom_file ( inum )%ndims(idv) ! number of dimension for variable sdjf%clvar 438 IF( inum /= 0 ) CALL iom_close( inum ) ! close file if already open 382 CALL fld_clopn( sf_dyn(ifpr), nyear, nmonth, nday ) 383 idv = iom_varid( sf_dyn(ifpr)%num , slf_d(ifpr)%clvar ) ! id of the variable sdjf%clvar 384 idimv = iom_file ( sf_dyn(ifpr)%num )%ndims(idv) ! number of dimension for variable sdjf%clvar 385 IF( sf_dyn(ifpr)%num /= 0 ) CALL iom_close( sf_dyn(ifpr)%num ) ! close file if already open 386 ierr1=0 439 387 IF( idimv == 3 ) THEN ! 2D variable 440 388 ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,1) , STAT=ierr0 ) … … 448 396 ENDIF 449 397 END DO 450 ! ! fill sf with slf_i and control print 451 CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' ) 452 ! 453 IF( lk_ldfslp .AND. .NOT.lk_c1d ) THEN ! slopes 398 ! 399 IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN ! slopes 454 400 IF( sf_dyn(jf_tem)%ln_tint ) THEN ! time interpolation 455 401 ALLOCATE( uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2), & … … 478 424 END SUBROUTINE dta_dyn_init 479 425 426 480 427 SUBROUTINE dta_dyn_wzv( pu, pv, pw ) 481 428 !!---------------------------------------------------------------------- … … 506 453 DO jj = 2, jpjm1 507 454 DO ji = fs_2, fs_jpim1 ! vector opt. 508 zu = pu(ji ,jj ,jk) * umask(ji ,jj ,jk) * e2u(ji ,jj ) * fse3u(ji ,jj ,jk) 509 zu1 = pu(ji-1,jj ,jk) * umask(ji-1,jj ,jk) * e2u(ji-1,jj ) * fse3u(ji-1,jj ,jk) 510 zv = pv(ji ,jj ,jk) * vmask(ji ,jj ,jk) * e1v(ji ,jj ) * fse3v(ji ,jj ,jk) 511 zv1 = pv(ji ,jj-1,jk) * vmask(ji ,jj-1,jk) * e1v(ji ,jj-1) * fse3v(ji ,jj-1,jk) 512 zet = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 513 zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet 455 zu = pu(ji ,jj ,jk) * umask(ji ,jj ,jk) * e2u(ji ,jj ) * e3u_n(ji ,jj ,jk) 456 zu1 = pu(ji-1,jj ,jk) * umask(ji-1,jj ,jk) * e2u(ji-1,jj ) * e3u_n(ji-1,jj ,jk) 457 zv = pv(ji ,jj ,jk) * vmask(ji ,jj ,jk) * e1v(ji ,jj ) * e3v_n(ji ,jj ,jk) 458 zv1 = pv(ji ,jj-1,jk) * vmask(ji ,jj-1,jk) * e1v(ji ,jj-1) * e3v_n(ji ,jj-1,jk) 459 zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 514 460 END DO 515 461 END DO 516 462 END DO 463 ! ! update the horizontal divergence with the runoff inflow 464 IF( ln_dynrnf ) zhdiv(:,:,1) = zhdiv(:,:,1) - rnf(:,:) * r1_rau0 / e3t_n(:,:,1) 465 ! 517 466 CALL lbc_lnk( zhdiv, 'T', 1. ) ! Lateral boundary conditions on zhdiv 518 !519 467 ! computation of vertical velocity from the bottom 520 468 pw(:,:,jpk) = 0._wp 521 469 DO jk = jpkm1, 1, -1 522 pw(:,:,jk) = pw(:,:,jk+1) - fse3t(:,:,jk) * zhdiv(:,:,jk)470 pw(:,:,jk) = pw(:,:,jk+1) - e3t_n(:,:,jk) * zhdiv(:,:,jk) 523 471 END DO 524 472 ! … … 539 487 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: pwslpj ! meridional diapycnal slopes 540 488 !!--------------------------------------------------------------------- 541 #if defined key_ldfslp && ! defined key_c1d 542 CALL eos ( pts, rhd, rhop, gdept_0(:,:,:) )543 CALL eos_rab( pts, rab_n ) ! now local thermal/haline expension ratio at T-points544 CALL bn2 ( pts, rab_n, rn2 ) ! now Brunt-Vaisala489 IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN ! Computes slopes (here avt is used as workspace) 490 CALL eos ( pts, rhd, rhop, gdept_0(:,:,:) ) 491 CALL eos_rab( pts, rab_n ) ! now local thermal/haline expension ratio at T-points 492 CALL bn2 ( pts, rab_n, rn2 ) ! now Brunt-Vaisala 545 493 546 494 ! Partial steps: before Horizontal DErivative … … 549 497 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 550 498 IF( ln_zps .AND. ln_isfcav) & 551 & CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv, & ! Partial steps for top cell (ISF) 552 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & 553 & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the first ocean level 554 555 rn2b(:,:,:) = rn2(:,:,:) ! need for zdfmxl 556 CALL zdf_mxl( kt ) ! mixed layer depth 557 CALL ldf_slp( kt, rhd, rn2 ) ! slopes 558 puslp (:,:,:) = uslp (:,:,:) 559 pvslp (:,:,:) = vslp (:,:,:) 560 pwslpi(:,:,:) = wslpi(:,:,:) 561 pwslpj(:,:,:) = wslpj(:,:,:) 562 #else 563 puslp (:,:,:) = 0. ! to avoid warning when compiling 564 pvslp (:,:,:) = 0. 565 pwslpi(:,:,:) = 0. 566 pwslpj(:,:,:) = 0. 567 #endif 499 & CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF) 500 & rhd, gru , grv , grui, grvi ) ! of t, s, rd at the first ocean level 501 502 rn2b(:,:,:) = rn2(:,:,:) ! need for zdfmxl 503 CALL zdf_mxl( kt ) ! mixed layer depth 504 CALL ldf_slp( kt, rhd, rn2 ) ! slopes 505 puslp (:,:,:) = uslp (:,:,:) 506 pvslp (:,:,:) = vslp (:,:,:) 507 pwslpi(:,:,:) = wslpi(:,:,:) 508 pwslpj(:,:,:) = wslpj(:,:,:) 509 ELSE 510 puslp (:,:,:) = 0. ! to avoid warning when compiling 511 pvslp (:,:,:) = 0. 512 pwslpi(:,:,:) = 0. 513 pwslpj(:,:,:) = 0. 514 ENDIF 568 515 ! 569 516 END SUBROUTINE dta_dyn_slp
Note: See TracChangeset
for help on using the changeset viewer.
