- Timestamp:
- 2016-11-28T17:04:10+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OFF_SRC/domrea.F90
r5836 r7351 34 34 35 35 !! * Substitutions 36 # include "domzgr_substitute.h90"37 36 # include "vectopt_loop_substitute.h90" 38 37 !!---------------------------------------------------------------------- … … 76 75 r1_e1f(:,:) = 1._wp / e1f(:,:) ; r1_e2f (:,:) = 1._wp / e2f(:,:) 77 76 ! 77 !!gm BUG if scale factor reduction !!!! 78 78 e1e2t (:,:) = e1t(:,:) * e2t(:,:) ; r1_e1e2t(:,:) = 1._wp / e1e2t(:,:) 79 79 e1e2u (:,:) = e1u(:,:) * e2u(:,:) ; r1_e1e2u(:,:) = 1._wp / e1e2u(:,:) … … 84 84 e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 85 85 ! 86 hu (:,:) = 0._wp! Ocean depth at U- and V-points87 hv (:,:) = 0._wp88 DO jk = 1, jpk89 hu (:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)90 hv (:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)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) 91 91 END DO 92 92 ! ! Inverse of the local depth 93 hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1)94 hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1)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 95 ! 96 96 CALL dom_stp ! Time step … … 113 113 INTEGER :: ios ! Local integer output status for namelist read 114 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_leapy , nn_istate , nn_stock , & 118 & nn_write, ln_dimgnnn, 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, & 120 & nn_acc , rn_atfp , rn_rdt , rn_rdtmin , & 121 & rn_rdtmax, rn_rdth , nn_baro , nn_closea , ln_crs, & 122 & jphgr_msh, & 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, & 123 121 & ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, & 124 122 & ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, & … … 154 152 WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock 155 153 WRITE(numout,*) ' frequency of output file nn_write = ', nn_write 156 WRITE(numout,*) ' multi file dimgout ln_dimgnnn = ', ln_dimgnnn157 154 WRITE(numout,*) ' mask land points ln_mskland = ', ln_mskland 158 155 WRITE(numout,*) ' additional CF standard metadata ln_cfmeta = ', ln_cfmeta … … 186 183 ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 187 184 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 188 adatrj = ( REAL( nit000-1, wp ) * rdt tra(1)) / rday185 adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 189 186 190 187 #if defined key_agrif … … 231 228 WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp 232 229 WRITE(numout,*) ' time-splitting: nb of sub time-step nn_baro = ', nn_baro 233 WRITE(numout,*) ' acceleration of converge nn_acc = ', nn_acc234 WRITE(numout,*) ' nn_acc=1: surface tracer rdt rn_rdtmin = ', rn_rdtmin235 WRITE(numout,*) ' bottom tracer rdt rdtmax = ', rn_rdtmax236 WRITE(numout,*) ' depth of transition rn_rdth = ', rn_rdth237 230 WRITE(numout,*) ' suppression of closed seas (=0) nn_closea = ', nn_closea 238 231 WRITE(numout,*) ' type of horizontal mesh jphgr_msh = ', jphgr_msh … … 260 253 e3zps_rat = rn_e3zps_rat 261 254 nmsh = nn_msh 262 nacc = nn_acc263 255 atfp = rn_atfp 264 256 rdt = rn_rdt 265 rdtmin = rn_rdtmin266 rdtmax = rn_rdtmin267 rdth = rn_rdth268 269 257 #if defined key_netcdf4 270 258 ! ! NetCDF 4 case ("key_netcdf4" defined) … … 319 307 INTEGER :: ios 320 308 !! 321 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav 309 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav, ln_linssh 322 310 !!---------------------------------------------------------------------- 323 311 … … 340 328 WRITE(numout,*) ' s- or hybrid z-s-coordinate ln_sco = ', ln_sco 341 329 WRITE(numout,*) ' ice shelf cavity ln_isfcav = ', ln_isfcav 330 WRITE(numout,*) ' Linear free surface ln_linssh = ', ln_linssh 342 331 ENDIF 343 332 … … 554 543 CALL iom_get( inum4, jpdom_unknown, 'esigw', esigw ) 555 544 556 CALL iom_get( inum4, jpdom_data, 'e3t_0', fse3t_n(:,:,:) ) ! scale factors557 CALL iom_get( inum4, jpdom_data, 'e3u_0', fse3u_n(:,:,:) )558 CALL iom_get( inum4, jpdom_data, 'e3v_0', fse3v_n(:,:,:) )559 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(:,:,:) ) 560 549 561 550 CALL iom_get( inum4, jpdom_unknown, 'gdept_1d', gdept_1d ) ! depth … … 571 560 ! 572 561 IF( nmsh <= 6 ) THEN ! 3D vertical scale factors 573 CALL iom_get( inum4, jpdom_data, 'e3t_0', fse3t_n(:,:,:) )574 CALL iom_get( inum4, jpdom_data, 'e3u_0', fse3u_n(:,:,:) )575 CALL iom_get( inum4, jpdom_data, 'e3v_0', fse3v_n(:,:,:) )576 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(:,:,:) ) 577 566 ELSE ! 2D bottom scale factors 578 567 CALL iom_get( inum4, jpdom_data, 'e3t_ps', e3tp ) … … 580 569 ! ! deduces the 3D scale factors 581 570 DO jk = 1, jpk 582 fse3t_n(:,:,jk) = e3t_1d(jk) ! set to the ref. factors583 fse3u_n(:,:,jk) = e3t_1d(jk)584 fse3v_n(:,:,jk) = e3t_1d(jk)585 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) 586 575 END DO 587 576 DO jj = 1,jpj ! adjust the deepest values 588 577 DO ji = 1,jpi 589 578 ik = mbkt(ji,jj) 590 fse3t_n(ji,jj,ik) = e3tp(ji,jj) * tmask(ji,jj,1) + e3t_1d(1) * ( 1._wp - tmask(ji,jj,1) )591 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) ) 592 581 END DO 593 582 END DO … … 595 584 DO jj = 1, jpjm1 596 585 DO ji = 1, jpim1 597 fse3u_n(ji,jj,jk) = MIN( fse3t_n(ji,jj,jk), fse3t_n(ji+1,jj,jk) )598 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) ) 599 588 END DO 600 589 END DO 601 590 END DO 602 CALL lbc_lnk( fse3u_n(:,:,:) , 'U', 1._wp ) ; CALL lbc_lnk( fse3uw_n(:,:,:), 'U', 1._wp ) ! lateral boundary conditions603 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 ) 604 593 ! 605 594 DO jk = 1, jpk ! set to z-scale factor if zero (i.e. along closed boundaries) 606 WHERE( fse3u_n(:,:,jk) == 0._wp ) fse3u_n(:,:,jk) = e3t_1d(jk)607 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) 608 597 END DO 609 598 END IF 610 599 611 600 IF( iom_varid( inum4, 'gdept_0', ldstop = .FALSE. ) > 0 ) THEN ! 3D depth of t- and w-level 612 CALL iom_get( inum4, jpdom_data, 'gdept_0', fsdept_n(:,:,:) )613 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(:,:,:) ) 614 603 ELSE ! 2D bottom depth 615 604 CALL iom_get( inum4, jpdom_data, 'hdept', zprt ) … … 617 606 ! 618 607 DO jk = 1, jpk ! deduces the 3D depth 619 fsdept_n(:,:,jk) = gdept_1d(jk)620 fsdepw_n(:,:,jk) = gdepw_1d(jk)608 gdept_0(:,:,jk) = gdept_1d(jk) 609 gdepw_0(:,:,jk) = gdepw_1d(jk) 621 610 END DO 622 611 DO jj = 1, jpj … … 624 613 ik = mbkt(ji,jj) 625 614 IF( ik > 0 ) THEN 626 fsdepw_n(ji,jj,ik+1) = zprw(ji,jj)627 fsdept_n(ji,jj,ik ) = zprt(ji,jj)628 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) 629 618 ENDIF 630 619 END DO … … 640 629 CALL iom_get( inum4, jpdom_unknown, 'e3w_1d' , e3w_1d ) 641 630 DO jk = 1, jpk 642 fse3t_n(:,:,jk) = e3t_1d(jk) ! set to the ref. factors643 fse3u_n(:,:,jk) = e3t_1d(jk)644 fse3v_n(:,:,jk) = e3t_1d(jk)645 fse3w_n(:,:,jk) = e3w_1d(jk)646 fsdept_n(:,:,jk) = gdept_1d(jk)647 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) 648 637 END DO 649 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 ! 650 656 651 657 !!gm BUG in s-coordinate this does not work! … … 677 683 & e2t (1,jj), e2u (1,jj), & 678 684 & e2v (1,jj), jj = 1, jpj, 10 ) 679 ENDIF680 681 682 IF( nprint == 1 .AND. lwp ) THEN683 WRITE(numout,*) ' e1u e2u '684 CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )685 CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )686 WRITE(numout,*) ' e1v e2v '687 CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )688 CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )689 685 ENDIF 690 686 … … 813 809 DO jj = 1, jpjm1 814 810 DO ji = 1, fs_jpim1 ! vector loop 815 umask_i(ji,jj) = ssmask(ji,jj) * ssmask(ji+1,jj ) * MIN(1._wp,SUM(umask(ji,jj,:)))816 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,:))) 817 813 END DO 818 814 DO ji = 1, jpim1 ! NO vector opt. 819 fmask_i(ji,jj) = ssmask(ji,jj ) * ssmask(ji+1,jj ) &815 ssfmask(ji,jj) = ssmask(ji,jj ) * ssmask(ji+1,jj ) & 820 816 & * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 821 817 END DO 822 818 END DO 823 CALL lbc_lnk( umask_i, 'U', 1._wp ) ! Lateral boundary conditions824 CALL lbc_lnk( vmask_i, 'V', 1._wp )825 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 ) 826 822 827 823 ! 3. Ocean/land mask at wu-, wv- and w points … … 836 832 END DO 837 833 ! 838 IF( nprint == 1 .AND. lwp ) THEN ! Control print839 imsk(:,:) = INT( tmask_i(:,:) )840 WRITE(numout,*) ' tmask_i : '841 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)842 WRITE (numout,*)843 WRITE (numout,*) ' dommsk: tmask for each level'844 WRITE (numout,*) ' ----------------------------'845 DO jk = 1, jpk846 imsk(:,:) = INT( tmask(:,:,jk) )847 WRITE(numout,*)848 WRITE(numout,*) ' level = ',jk849 CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)850 END DO851 ENDIF852 !853 834 CALL wrk_dealloc( jpi, jpj, imsk ) 854 835 !
Note: See TracChangeset
for help on using the changeset viewer.
