- Timestamp:
- 2016-03-29T11:24:48+02:00 (8 years ago)
- Location:
- branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/OFF_SRC
- Files:
-
- 3 edited
-
domrea.F90 (modified) (31 diffs)
-
dtadyn.F90 (modified) (18 diffs)
-
nemogcm.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/OFF_SRC/domrea.F90
r6401 r6404 4 4 !! Ocean initialization : domain initialization 5 5 !!============================================================================== 6 !! History : OPA ! 1990-10 (C. Levy - G. Madec) Original code 7 !! ! 1992-01 (M. Imbard) insert time step initialization 8 !! ! 1996-06 (G. Madec) generalized vertical coordinate 9 !! ! 1997-02 (G. Madec) creation of domwri.F 10 !! ! 2001-05 (E.Durand - G. Madec) insert closed sea 11 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module 12 !!---------------------------------------------------------------------- 6 13 7 14 !!---------------------------------------------------------------------- … … 10 17 !! dom_ctl : control print for the ocean domain 11 18 !!---------------------------------------------------------------------- 12 !! * Modules used13 19 USE oce ! 20 USE trc_oce ! shared ocean/biogeochemical variables 14 21 USE dom_oce ! ocean space and time domain 15 22 USE phycst ! physical constants 23 USE domstp ! domain: set the time-step 24 ! 16 25 USE in_out_manager ! I/O manager 17 26 USE lib_mpp ! distributed memory computing library 18 19 USE domstp ! domain: set the time-step20 21 27 USE lbclnk ! lateral boundary condition - MPP exchanges 22 USE trc_oce ! shared ocean/biogeochemical variables23 28 USE wrk_nemo 24 29 … … 26 31 PRIVATE 27 32 28 !! * Routine accessibility 29 PUBLIC dom_rea ! called by opa.F90 33 PUBLIC dom_rea ! called by nemogcm.F90 30 34 31 35 !! * Substitutions 32 # include "domzgr_substitute.h90"33 36 # include "vectopt_loop_substitute.h90" 34 37 !!---------------------------------------------------------------------- 35 !! NEMO/OFF 3. 3 , NEMO Consortium (2010)38 !! NEMO/OFF 3.7 , NEMO Consortium (2015) 36 39 !! $Id$ 37 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 38 41 !!---------------------------------------------------------------------- 39 40 42 CONTAINS 41 43 … … 51 53 !! - dom_stp: defined the model time step 52 54 !! - dom_rea: read the meshmask file if nmsh=1 53 !! 54 !! History : 55 !! ! 90-10 (C. Levy - G. Madec) Original code 56 !! ! 91-11 (G. Madec) 57 !! ! 92-01 (M. Imbard) insert time step initialization 58 !! ! 96-06 (G. Madec) generalized vertical coordinate 59 !! ! 97-02 (G. Madec) creation of domwri.F 60 !! ! 01-05 (E.Durand - G. Madec) insert closed sea 61 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 62 !!---------------------------------------------------------------------- 63 !! * Local declarations 64 INTEGER :: jk ! dummy loop argument 65 INTEGER :: iconf = 0 ! temporary integers 66 !!---------------------------------------------------------------------- 67 55 !!---------------------------------------------------------------------- 56 INTEGER :: jk ! dummy loop index 57 INTEGER :: iconf = 0 ! local integers 58 !!---------------------------------------------------------------------- 59 ! 68 60 IF(lwp) THEN 69 61 WRITE(numout,*) … … 71 63 WRITE(numout,*) '~~~~~~~~' 72 64 ENDIF 73 74 CALL dom_nam ! read namelist ( namrun, namdom , namcla)65 ! 66 CALL dom_nam ! read namelist ( namrun, namdom ) 75 67 CALL dom_zgr ! Vertical mesh and bathymetry option 76 68 CALL dom_grd ! Create a domain file 77 78 ! 79 ! - ML - Used in dom_vvl_sf_nxt and lateral diffusion routines 80 ! but could be usefull in many other routines 81 e12t (:,:) = e1t(:,:) * e2t(:,:) 82 e1e2t (:,:) = e1t(:,:) * e2t(:,:) 83 e12u (:,:) = e1u(:,:) * e2u(:,:) 84 e12v (:,:) = e1v(:,:) * e2v(:,:) 85 e12f (:,:) = e1f(:,:) * e2f(:,:) 86 r1_e12t (:,:) = 1._wp / e12t(:,:) 87 r1_e12u (:,:) = 1._wp / e12u(:,:) 88 r1_e12v (:,:) = 1._wp / e12v(:,:) 89 r1_e12f (:,:) = 1._wp / e12f(:,:) 90 re2u_e1u(:,:) = e2u(:,:) / e1u(:,:) 91 re1v_e2v(:,:) = e1v(:,:) / e2v(:,:) 92 ! 93 hu(:,:) = 0._wp ! Ocean depth at U- and V-points 94 hv(:,:) = 0._wp 95 DO jk = 1, jpk 96 hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 97 hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 69 ! 70 ! ! associated horizontal metrics 71 ! 72 r1_e1t(:,:) = 1._wp / e1t(:,:) ; r1_e2t (:,:) = 1._wp / e2t(:,:) 73 r1_e1u(:,:) = 1._wp / e1u(:,:) ; r1_e2u (:,:) = 1._wp / e2u(:,:) 74 r1_e1v(:,:) = 1._wp / e1v(:,:) ; r1_e2v (:,:) = 1._wp / e2v(:,:) 75 r1_e1f(:,:) = 1._wp / e1f(:,:) ; r1_e2f (:,:) = 1._wp / e2f(:,:) 76 ! 77 !!gm BUG if scale factor reduction !!!! 78 e1e2t (:,:) = e1t(:,:) * e2t(:,:) ; r1_e1e2t(:,:) = 1._wp / e1e2t(:,:) 79 e1e2u (:,:) = e1u(:,:) * e2u(:,:) ; r1_e1e2u(:,:) = 1._wp / e1e2u(:,:) 80 e1e2v (:,:) = e1v(:,:) * e2v(:,:) ; r1_e1e2v(:,:) = 1._wp / e1e2v(:,:) 81 e1e2f (:,:) = e1f(:,:) * e2f(:,:) ; r1_e1e2f(:,:) = 1._wp / e1e2f(:,:) 82 ! 83 e2_e1u(:,:) = e2u(:,:) / e1u(:,:) 84 e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 85 ! 86 hu_n(:,:) = e3u_n(:,:,1) * umask(:,:,1) ! Ocean depth at U- and V-points 87 hv_n(:,:) = e3v_n(:,:,1) * vmask(:,:,1) 88 DO jk = 2, jpk 89 hu_n(:,:) = hu_n(:,:) + e3u_n(:,:,jk) * umask(:,:,jk) 90 hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk) 98 91 END DO 99 92 ! ! Inverse of the local depth 100 hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1)101 hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1)102 93 r1_hu_n(:,:) = 1._wp / ( hu_n(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1) 94 r1_hv_n(:,:) = 1._wp / ( hv_n(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1) 95 ! 103 96 CALL dom_stp ! Time step 104 97 CALL dom_msk ! Masks 105 98 CALL dom_ctl ! Domain control 106 99 ! 107 100 END SUBROUTINE dom_rea 101 108 102 109 103 SUBROUTINE dom_nam … … 115 109 !! ** input : - namrun namelist 116 110 !! - namdom namelist 117 !! - namcla namelist118 111 !!---------------------------------------------------------------------- 119 112 USE ioipsl 120 INTEGER :: ios ! Local integer output status for namelist read 121 NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, & 122 & nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl, & 123 & nn_it000, nn_itend , nn_date0 , nn_leapy , nn_istate , nn_stock , & 124 & nn_write, ln_dimgnnn, ln_mskland , ln_cfmeta , ln_clobber, nn_chunksz, nn_euler 125 NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh , rn_hmin, & 126 & nn_acc , rn_atfp , rn_rdt , rn_rdtmin , & 127 & rn_rdtmax, rn_rdth , nn_baro , nn_closea , ln_crs, & 128 & jphgr_msh, & 113 INTEGER :: ios ! Local integer output status for namelist read 114 ! 115 NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, & 116 & nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl, & 117 & nn_it000, nn_itend , nn_date0 , nn_time0, nn_leapy , nn_istate , nn_stock , & 118 & nn_write, ln_iscpl , ln_mskland , ln_cfmeta , ln_clobber, nn_chunksz, nn_euler 119 NAMELIST/namdom/ nn_bathy , rn_bathy , rn_e3zps_min, rn_e3zps_rat , nn_msh , rn_hmin , rn_isfhmin,& 120 & rn_atfp , rn_rdt , nn_baro , nn_closea , ln_crs , jphgr_msh, & 129 121 & ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, & 130 122 & ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, & 131 123 & ppa2, ppkth2, ppacr2 132 NAMELIST/namcla/ nn_cla133 124 #if defined key_netcdf4 134 125 NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip … … 161 152 WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock 162 153 WRITE(numout,*) ' frequency of output file nn_write = ', nn_write 163 WRITE(numout,*) ' multi file dimgout ln_dimgnnn = ', ln_dimgnnn164 154 WRITE(numout,*) ' mask land points ln_mskland = ', ln_mskland 165 155 WRITE(numout,*) ' additional CF standard metadata ln_cfmeta = ', ln_cfmeta … … 178 168 nstocklist = nn_stocklist 179 169 nwrite = nn_write 180 181 170 ! 182 171 ! ! control of output frequency 183 172 IF ( nstock == 0 .OR. nstock > nitend ) THEN … … 194 183 ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 195 184 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 196 adatrj = ( REAL( nit000-1, wp ) * rdt tra(1)) / rday185 adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 197 186 198 187 #if defined key_agrif … … 239 228 WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp 240 229 WRITE(numout,*) ' time-splitting: nb of sub time-step nn_baro = ', nn_baro 241 WRITE(numout,*) ' acceleration of converge nn_acc = ', nn_acc242 WRITE(numout,*) ' nn_acc=1: surface tracer rdt rn_rdtmin = ', rn_rdtmin243 WRITE(numout,*) ' bottom tracer rdt rdtmax = ', rn_rdtmax244 WRITE(numout,*) ' depth of transition rn_rdth = ', rn_rdth245 230 WRITE(numout,*) ' suppression of closed seas (=0) nn_closea = ', nn_closea 246 231 WRITE(numout,*) ' type of horizontal mesh jphgr_msh = ', jphgr_msh … … 268 253 e3zps_rat = rn_e3zps_rat 269 254 nmsh = nn_msh 270 nacc = nn_acc271 255 atfp = rn_atfp 272 256 rdt = rn_rdt 273 rdtmin = rn_rdtmin274 rdtmax = rn_rdtmin275 rdth = rn_rdth276 277 REWIND( numnam_ref ) ! Namelist namcla in reference namelist : Cross land advection278 READ ( numnam_ref, namcla, IOSTAT = ios, ERR = 905)279 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp )280 281 REWIND( numnam_cfg ) ! Namelist namcla in configuration namelist : Cross land advection282 READ ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 )283 906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp )284 IF(lwm) WRITE( numond, namcla )285 286 IF(lwp) THEN287 WRITE(numout,*)288 WRITE(numout,*) ' Namelist namcla'289 WRITE(numout,*) ' cross land advection nn_cla = ', nn_cla290 ENDIF291 292 257 #if defined key_netcdf4 293 258 ! ! NetCDF 4 case ("key_netcdf4" defined) … … 321 286 END SUBROUTINE dom_nam 322 287 288 323 289 SUBROUTINE dom_zgr 324 290 !!---------------------------------------------------------------------- … … 341 307 INTEGER :: ios 342 308 !! 343 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav 309 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav, ln_linssh 344 310 !!---------------------------------------------------------------------- 345 311 … … 362 328 WRITE(numout,*) ' s- or hybrid z-s-coordinate ln_sco = ', ln_sco 363 329 WRITE(numout,*) ' ice shelf cavity ln_isfcav = ', ln_isfcav 330 WRITE(numout,*) ' Linear free surface ln_linssh = ', ln_linssh 364 331 ENDIF 365 332 … … 374 341 END SUBROUTINE dom_zgr 375 342 343 376 344 SUBROUTINE dom_ctl 377 345 !!---------------------------------------------------------------------- … … 382 350 !! ** Method : compute and print extrema of masked scale factors 383 351 !! 384 !! History : 385 !! 8.5 ! 02-08 (G. Madec) Original code 386 !!---------------------------------------------------------------------- 387 !! * Local declarations 352 !!---------------------------------------------------------------------- 388 353 INTEGER :: iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2 389 354 INTEGER, DIMENSION(2) :: iloc ! … … 421 386 ijma2 = iloc(2) + njmpp - 1 422 387 ENDIF 423 388 ! 424 389 IF(lwp) THEN 425 390 WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1 … … 428 393 WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2 429 394 ENDIF 430 395 ! 431 396 END SUBROUTINE dom_ctl 397 432 398 433 399 SUBROUTINE dom_grd … … 538 504 CALL iom_get( inum2, jpdom_data, 'facvolt', facvol ) 539 505 #endif 540 541 506 ! ! horizontal mesh (inum3) 542 507 CALL iom_get( inum3, jpdom_data, 'glamt', glamt ) … … 578 543 CALL iom_get( inum4, jpdom_unknown, 'esigw', esigw ) 579 544 580 CALL iom_get( inum4, jpdom_data, 'e3t_0', fse3t_n(:,:,:) ) ! scale factors581 CALL iom_get( inum4, jpdom_data, 'e3u_0', fse3u_n(:,:,:) )582 CALL iom_get( inum4, jpdom_data, 'e3v_0', fse3v_n(:,:,:) )583 CALL iom_get( inum4, jpdom_data, 'e3w_0', fse3w_n(:,:,:) )545 CALL iom_get( inum4, jpdom_data, 'e3t_0', e3t_0(:,:,:) ) ! scale factors 546 CALL iom_get( inum4, jpdom_data, 'e3u_0', e3u_0(:,:,:) ) 547 CALL iom_get( inum4, jpdom_data, 'e3v_0', e3v_0(:,:,:) ) 548 CALL iom_get( inum4, jpdom_data, 'e3w_0', e3w_0(:,:,:) ) 584 549 585 550 CALL iom_get( inum4, jpdom_unknown, 'gdept_1d', gdept_1d ) ! depth … … 595 560 ! 596 561 IF( nmsh <= 6 ) THEN ! 3D vertical scale factors 597 CALL iom_get( inum4, jpdom_data, 'e3t_0', fse3t_n(:,:,:) )598 CALL iom_get( inum4, jpdom_data, 'e3u_0', fse3u_n(:,:,:) )599 CALL iom_get( inum4, jpdom_data, 'e3v_0', fse3v_n(:,:,:) )600 CALL iom_get( inum4, jpdom_data, 'e3w_0', fse3w_n(:,:,:) )562 CALL iom_get( inum4, jpdom_data, 'e3t_0', e3t_0(:,:,:) ) 563 CALL iom_get( inum4, jpdom_data, 'e3u_0', e3u_0(:,:,:) ) 564 CALL iom_get( inum4, jpdom_data, 'e3v_0', e3v_0(:,:,:) ) 565 CALL iom_get( inum4, jpdom_data, 'e3w_0', e3w_0(:,:,:) ) 601 566 ELSE ! 2D bottom scale factors 602 567 CALL iom_get( inum4, jpdom_data, 'e3t_ps', e3tp ) … … 604 569 ! ! deduces the 3D scale factors 605 570 DO jk = 1, jpk 606 fse3t_n(:,:,jk) = e3t_1d(jk) ! set to the ref. factors607 fse3u_n(:,:,jk) = e3t_1d(jk)608 fse3v_n(:,:,jk) = e3t_1d(jk)609 fse3w_n(:,:,jk) = e3w_1d(jk)571 e3t_0(:,:,jk) = e3t_1d(jk) ! set to the ref. factors 572 e3u_0(:,:,jk) = e3t_1d(jk) 573 e3v_0(:,:,jk) = e3t_1d(jk) 574 e3w_0(:,:,jk) = e3w_1d(jk) 610 575 END DO 611 576 DO jj = 1,jpj ! adjust the deepest values 612 577 DO ji = 1,jpi 613 578 ik = mbkt(ji,jj) 614 fse3t_n(ji,jj,ik) = e3tp(ji,jj) * tmask(ji,jj,1) + e3t_1d(1) * ( 1._wp - tmask(ji,jj,1) )615 fse3w_n(ji,jj,ik) = e3wp(ji,jj) * tmask(ji,jj,1) + e3w_1d(1) * ( 1._wp - tmask(ji,jj,1) )579 e3t_0(ji,jj,ik) = e3tp(ji,jj) * tmask(ji,jj,1) + e3t_1d(1) * ( 1._wp - tmask(ji,jj,1) ) 580 e3w_0(ji,jj,ik) = e3wp(ji,jj) * tmask(ji,jj,1) + e3w_1d(1) * ( 1._wp - tmask(ji,jj,1) ) 616 581 END DO 617 582 END DO … … 619 584 DO jj = 1, jpjm1 620 585 DO ji = 1, jpim1 621 fse3u_n(ji,jj,jk) = MIN( fse3t_n(ji,jj,jk), fse3t_n(ji+1,jj,jk) )622 fse3v_n(ji,jj,jk) = MIN( fse3t_n(ji,jj,jk), fse3t_n(ji,jj+1,jk) )586 e3u_0(ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) ) 587 e3v_0(ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) ) 623 588 END DO 624 589 END DO 625 590 END DO 626 CALL lbc_lnk( fse3u_n(:,:,:) , 'U', 1._wp ) ; CALL lbc_lnk( fse3uw_n(:,:,:), 'U', 1._wp ) ! lateral boundary conditions627 CALL lbc_lnk( fse3v_n(:,:,:) , 'V', 1._wp ) ; CALL lbc_lnk( fse3vw_n(:,:,:), 'V', 1._wp )591 CALL lbc_lnk( e3u_0(:,:,:) , 'U', 1._wp ) ; CALL lbc_lnk( e3uw_0(:,:,:), 'U', 1._wp ) ! lateral boundary conditions 592 CALL lbc_lnk( e3v_0(:,:,:) , 'V', 1._wp ) ; CALL lbc_lnk( e3vw_0(:,:,:), 'V', 1._wp ) 628 593 ! 629 594 DO jk = 1, jpk ! set to z-scale factor if zero (i.e. along closed boundaries) 630 WHERE( fse3u_n(:,:,jk) == 0._wp ) fse3u_n(:,:,jk) = e3t_1d(jk)631 WHERE( fse3v_n(:,:,jk) == 0._wp ) fse3v_n(:,:,jk) = e3t_1d(jk)595 WHERE( e3u_0(:,:,jk) == 0._wp ) e3u_0(:,:,jk) = e3t_1d(jk) 596 WHERE( e3v_0(:,:,jk) == 0._wp ) e3v_0(:,:,jk) = e3t_1d(jk) 632 597 END DO 633 598 END IF 634 599 635 600 IF( iom_varid( inum4, 'gdept_0', ldstop = .FALSE. ) > 0 ) THEN ! 3D depth of t- and w-level 636 CALL iom_get( inum4, jpdom_data, 'gdept_0', fsdept_n(:,:,:) )637 CALL iom_get( inum4, jpdom_data, 'gdepw_0', fsdepw_n(:,:,:) )601 CALL iom_get( inum4, jpdom_data, 'gdept_0', gdept_0(:,:,:) ) 602 CALL iom_get( inum4, jpdom_data, 'gdepw_0', gdepw_0(:,:,:) ) 638 603 ELSE ! 2D bottom depth 639 604 CALL iom_get( inum4, jpdom_data, 'hdept', zprt ) … … 641 606 ! 642 607 DO jk = 1, jpk ! deduces the 3D depth 643 fsdept_n(:,:,jk) = gdept_1d(jk)644 fsdepw_n(:,:,jk) = gdepw_1d(jk)608 gdept_0(:,:,jk) = gdept_1d(jk) 609 gdepw_0(:,:,jk) = gdepw_1d(jk) 645 610 END DO 646 611 DO jj = 1, jpj … … 648 613 ik = mbkt(ji,jj) 649 614 IF( ik > 0 ) THEN 650 fsdepw_n(ji,jj,ik+1) = zprw(ji,jj)651 fsdept_n(ji,jj,ik ) = zprt(ji,jj)652 fsdept_n(ji,jj,ik+1) = fsdept_n(ji,jj,ik) + fse3t_n(ji,jj,ik)615 gdepw_0(ji,jj,ik+1) = zprw(ji,jj) 616 gdept_0(ji,jj,ik ) = zprt(ji,jj) 617 gdept_0(ji,jj,ik+1) = gdept_0(ji,jj,ik) + e3t_0(ji,jj,ik) 653 618 ENDIF 654 619 END DO … … 664 629 CALL iom_get( inum4, jpdom_unknown, 'e3w_1d' , e3w_1d ) 665 630 DO jk = 1, jpk 666 fse3t_n(:,:,jk) = e3t_1d(jk) ! set to the ref. factors667 fse3u_n(:,:,jk) = e3t_1d(jk)668 fse3v_n(:,:,jk) = e3t_1d(jk)669 fse3w_n(:,:,jk) = e3w_1d(jk)670 fsdept_n(:,:,jk) = gdept_1d(jk)671 fsdepw_n(:,:,jk) = gdepw_1d(jk)631 e3t_0(:,:,jk) = e3t_1d(jk) ! set to the ref. factors 632 e3u_0(:,:,jk) = e3t_1d(jk) 633 e3v_0(:,:,jk) = e3t_1d(jk) 634 e3w_0(:,:,jk) = e3w_1d(jk) 635 gdept_0(:,:,jk) = gdept_1d(jk) 636 gdepw_0(:,:,jk) = gdepw_1d(jk) 672 637 END DO 673 638 ENDIF 639 640 ! 641 ! !== time varying part of coordinate system ==! 642 ! 643 ! before ! now ! after ! 644 ; gdept_b = gdept_0 ; gdept_n = gdept_0 ! --- ! depth of grid-points 645 ; gdepw_b = gdepw_0 ; gdepw_n = gdepw_0 ! --- ! 646 ; ; gde3w_n = gde3w_0 ! --- ! 647 ! 648 ; e3t_b = e3t_0 ; e3t_n = e3t_0 ; e3t_a = e3t_0 ! scale factors 649 ; e3u_b = e3u_0 ; e3u_n = e3u_0 ; e3u_a = e3u_0 ! 650 ; e3v_b = e3v_0 ; e3v_n = e3v_0 ; e3v_a = e3v_0 ! 651 ; ; e3f_n = e3f_0 ! --- ! 652 ; e3w_b = e3w_0 ; e3w_n = e3w_0 ! --- ! 653 ; e3uw_b = e3uw_0 ; e3uw_n = e3uw_0 ! --- ! 654 ; e3vw_b = e3vw_0 ; e3vw_n = e3vw_0 ! --- ! 655 ! 674 656 675 657 !!gm BUG in s-coordinate this does not work! … … 701 683 & e2t (1,jj), e2u (1,jj), & 702 684 & e2v (1,jj), jj = 1, jpj, 10 ) 703 ENDIF704 705 706 IF( nprint == 1 .AND. lwp ) THEN707 WRITE(numout,*) ' e1u e2u '708 CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )709 CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )710 WRITE(numout,*) ' e1v e2v '711 CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )712 CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )713 685 ENDIF 714 686 … … 756 728 !! (min value = 1 over land) 757 729 !!---------------------------------------------------------------------- 758 !759 730 INTEGER :: ji, jj ! dummy loop indices 760 731 REAL(wp), POINTER, DIMENSION(:,:) :: zmbk … … 785 756 END SUBROUTINE zgr_bot_level 786 757 758 787 759 SUBROUTINE dom_msk 788 760 !!--------------------------------------------------------------------- … … 799 771 !! tpol : ??? 800 772 !!---------------------------------------------------------------------- 801 ! 802 INTEGER :: ji, jj, jk ! dummy loop indices 803 INTEGER :: iif, iil, ijf, ijl ! local integers 773 INTEGER :: ji, jj, jk ! dummy loop indices 774 INTEGER :: iif, iil, ijf, ijl ! local integers 804 775 INTEGER, POINTER, DIMENSION(:,:) :: imsk 805 !806 776 !!--------------------------------------------------------------------- 807 777 … … 839 809 DO jj = 1, jpjm1 840 810 DO ji = 1, fs_jpim1 ! vector loop 841 umask_i(ji,jj) = ssmask(ji,jj) * ssmask(ji+1,jj ) * MIN(1._wp,SUM(umask(ji,jj,:)))842 vmask_i(ji,jj) = ssmask(ji,jj) * ssmask(ji ,jj+1) * MIN(1._wp,SUM(vmask(ji,jj,:)))811 ssumask(ji,jj) = ssmask(ji,jj) * ssmask(ji+1,jj ) * MIN(1._wp,SUM(umask(ji,jj,:))) 812 ssvmask(ji,jj) = ssmask(ji,jj) * ssmask(ji ,jj+1) * MIN(1._wp,SUM(vmask(ji,jj,:))) 843 813 END DO 844 814 DO ji = 1, jpim1 ! NO vector opt. 845 fmask_i(ji,jj) = ssmask(ji,jj ) * ssmask(ji+1,jj ) &815 ssfmask(ji,jj) = ssmask(ji,jj ) * ssmask(ji+1,jj ) & 846 816 & * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 847 817 END DO 848 818 END DO 849 CALL lbc_lnk( umask_i, 'U', 1._wp ) ! Lateral boundary conditions850 CALL lbc_lnk( vmask_i, 'V', 1._wp )851 CALL lbc_lnk( fmask_i, 'F', 1._wp )819 CALL lbc_lnk( ssumask, 'U', 1._wp ) ! Lateral boundary conditions 820 CALL lbc_lnk( ssvmask, 'V', 1._wp ) 821 CALL lbc_lnk( ssfmask, 'F', 1._wp ) 852 822 853 823 ! 3. Ocean/land mask at wu-, wv- and w points 854 824 !---------------------------------------------- 855 wmask (:,:,1) = tmask(:,:,1) ! ????????856 wumask(:,:,1) = umask(:,:,1) ! ????????857 wvmask(:,:,1) = vmask(:,:,1) ! ????????858 DO jk =2,jpk859 wmask (:,:,jk) =tmask(:,:,jk) * tmask(:,:,jk-1)860 wumask(:,:,jk) =umask(:,:,jk) * umask(:,:,jk-1)861 wvmask(:,:,jk) =vmask(:,:,jk) * vmask(:,:,jk-1)825 wmask (:,:,1) = tmask(:,:,1) ! surface value 826 wumask(:,:,1) = umask(:,:,1) 827 wvmask(:,:,1) = vmask(:,:,1) 828 DO jk = 2, jpk ! deeper value 829 wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1) 830 wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1) 831 wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1) 862 832 END DO 863 !864 IF( nprint == 1 .AND. lwp ) THEN ! Control print865 imsk(:,:) = INT( tmask_i(:,:) )866 WRITE(numout,*) ' tmask_i : '867 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)868 WRITE (numout,*)869 WRITE (numout,*) ' dommsk: tmask for each level'870 WRITE (numout,*) ' ----------------------------'871 DO jk = 1, jpk872 imsk(:,:) = INT( tmask(:,:,jk) )873 WRITE(numout,*)874 WRITE(numout,*) ' level = ',jk875 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)876 END DO877 ENDIF878 833 ! 879 834 CALL wrk_dealloc( jpi, jpj, imsk ) -
branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r6401 r6404 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 … … 452 397 END DO 453 398 ! 454 IF( l k_ldfslp .AND. .NOT.lk_c1d ) THEN ! slopes399 IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN ! slopes 455 400 IF( sf_dyn(jf_tem)%ln_tint ) THEN ! time interpolation 456 401 ALLOCATE( uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2), & … … 479 424 END SUBROUTINE dta_dyn_init 480 425 426 481 427 SUBROUTINE dta_dyn_wzv( pu, pv, pw ) 482 428 !!---------------------------------------------------------------------- … … 507 453 DO jj = 2, jpjm1 508 454 DO ji = fs_2, fs_jpim1 ! vector opt. 509 zu = pu(ji ,jj ,jk) * umask(ji ,jj ,jk) * e2u(ji ,jj ) * fse3u(ji ,jj ,jk) 510 zu1 = pu(ji-1,jj ,jk) * umask(ji-1,jj ,jk) * e2u(ji-1,jj ) * fse3u(ji-1,jj ,jk) 511 zv = pv(ji ,jj ,jk) * vmask(ji ,jj ,jk) * e1v(ji ,jj ) * fse3v(ji ,jj ,jk) 512 zv1 = pv(ji ,jj-1,jk) * vmask(ji ,jj-1,jk) * e1v(ji ,jj-1) * fse3v(ji ,jj-1,jk) 513 zet = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 514 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) 515 460 END DO 516 461 END DO 517 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 ! 518 466 CALL lbc_lnk( zhdiv, 'T', 1. ) ! Lateral boundary conditions on zhdiv 519 !520 467 ! computation of vertical velocity from the bottom 521 468 pw(:,:,jpk) = 0._wp 522 469 DO jk = jpkm1, 1, -1 523 pw(:,:,jk) = pw(:,:,jk+1) - fse3t(:,:,jk) * zhdiv(:,:,jk)470 pw(:,:,jk) = pw(:,:,jk+1) - e3t_n(:,:,jk) * zhdiv(:,:,jk) 524 471 END DO 525 472 ! … … 540 487 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: pwslpj ! meridional diapycnal slopes 541 488 !!--------------------------------------------------------------------- 542 #if defined key_ldfslp && ! defined key_c1d 543 CALL eos ( pts, rhd, rhop, gdept_0(:,:,:) )544 CALL eos_rab( pts, rab_n ) ! now local thermal/haline expension ratio at T-points545 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 546 493 547 494 ! Partial steps: before Horizontal DErivative … … 550 497 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 551 498 IF( ln_zps .AND. ln_isfcav) & 552 & CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv, & ! Partial steps for top cell (ISF) 553 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & 554 & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the first ocean level 555 556 rn2b(:,:,:) = rn2(:,:,:) ! need for zdfmxl 557 CALL zdf_mxl( kt ) ! mixed layer depth 558 CALL ldf_slp( kt, rhd, rn2 ) ! slopes 559 puslp (:,:,:) = uslp (:,:,:) 560 pvslp (:,:,:) = vslp (:,:,:) 561 pwslpi(:,:,:) = wslpi(:,:,:) 562 pwslpj(:,:,:) = wslpj(:,:,:) 563 #else 564 puslp (:,:,:) = 0. ! to avoid warning when compiling 565 pvslp (:,:,:) = 0. 566 pwslpi(:,:,:) = 0. 567 pwslpj(:,:,:) = 0. 568 #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 569 515 ! 570 516 END SUBROUTINE dta_dyn_slp -
branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
r6401 r6404 26 26 USE traqsr ! solar radiation penetration (tra_qsr_init routine) 27 27 USE trabbl ! bottom boundary layer (tra_bbl_init routine) 28 USE traldf ! lateral physics (tra_ldf_init routine) 28 29 USE zdfini ! vertical physics: initialization 29 30 USE sbcmod ! surface boundary condition (sbc_init routine) … … 51 52 USE trcrst 52 53 USE diaptr ! Need to initialise this as some variables are used in if statements later 54 USE sbc_oce, ONLY: ln_rnf 55 USE sbcrnf 53 56 54 57 IMPLICIT NONE … … 93 96 ! !-----------------------! 94 97 istp = nit000 98 ! 99 ! Initialize arrays of runoffs structures and read data from the namelist 100 IF ( ln_rnf ) CALL sbc_rnf(istp) 95 101 ! 96 102 CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) … … 147 153 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 148 154 & nn_isplt, nn_jsplt, nn_jctls, nn_jctle, & 149 & nn_bench, nn_timing 155 & nn_bench, nn_timing, nn_diacfl 150 156 NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & 151 157 & jpizoom, jpjzoom, jperio, ln_use_jattr … … 283 289 CALL sbc_init ! Forcings : surface module 284 290 285 #if ! defined key_degrad286 291 CALL ldf_tra_init ! Lateral ocean tracer physics 287 #endif 288 IF( lk_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 292 CALL ldf_eiv_init ! Eddy induced velocity param 293 CALL tra_ldf_init ! lateral mixing 294 IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 289 295 290 296 CALL tra_qsr_init ! penetrative solar radiation qsr … … 444 450 USE dom_oce, ONLY: dom_oce_alloc 445 451 USE zdf_oce, ONLY: zdf_oce_alloc 446 USE ldftra_oce, ONLY: ldftra_oce_alloc447 452 USE trc_oce, ONLY: trc_oce_alloc 448 453 ! … … 453 458 ierr = ierr + dia_wri_alloc () 454 459 ierr = ierr + dom_oce_alloc () ! ocean domain 455 ierr = ierr + ldftra_oce_alloc() ! ocean lateral physics : tracers456 460 ierr = ierr + zdf_oce_alloc () ! ocean vertical physics 457 461 !
Note: See TracChangeset
for help on using the changeset viewer.
