Changeset 14072 for NEMO/trunk/src/OCE/DOM
- Timestamp:
- 2020-12-04T08:48:38+01:00 (4 years ago)
- Location:
- NEMO/trunk/src/OCE/DOM
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/DOM/daymod.F90
r13970 r14072 19 19 !! ----------- WARNING ----------- 20 20 !! ------------------------------- 21 !! sbcmod assume that the time step is dividing the number of second of 22 !! in a day, i.e. ===> MOD( rday, rn_Dt ) == 0 21 !! sbcmod assume that the time step is dividing the number of second of 22 !! in a day, i.e. ===> MOD( rday, rn_Dt ) == 0 23 23 !! except when user defined forcing is used (see sbcmod.F90) 24 24 !!---------------------------------------------------------------------- … … 84 84 lrst_oce = .NOT. l_offline ! force definition of offline 85 85 IF( lrst_oce ) CALL day_rst( nit000, 'READ' ) 86 86 87 87 ! set the calandar from ndastp (read in restart file and namelist) 88 88 nyear = ndastp / 10000 … … 94 94 isecrst = ( nhour * NINT(rhhmm) + nminute ) * NINT(rmmss) 95 95 96 CALL ymds2ju( nyear, nmonth, nday, REAL(isecrst,wp), fjulday ) 96 CALL ymds2ju( nyear, nmonth, nday, REAL(isecrst,wp), fjulday ) 97 97 IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < 0.1 / rday ) fjulday = REAL(NINT(fjulday),wp) ! avoid truncation error 98 98 IF( nhour*NINT(rhhmm*rmmss) + nminute*NINT(rmmss) - ndt05 .LT. 0 ) fjulday = fjulday+1. ! move back to the day at nit000 (and not at nit000 - 1) … … 124 124 IF( isecrst - ndt05 .GT. 0 ) THEN 125 125 ! 1 timestep before current middle of first time step is still the same day 126 nsec_year = (nday_year-1) * nsecd + isecrst - ndt05 127 nsec_month = (nday-1) * nsecd + isecrst - ndt05 126 nsec_year = (nday_year-1) * nsecd + isecrst - ndt05 127 nsec_month = (nday-1) * nsecd + isecrst - ndt05 128 128 ELSE 129 ! 1 time step before the middle of the first time step is the previous day 130 nsec_year = nday_year * nsecd + isecrst - ndt05 131 nsec_month = nday * nsecd + isecrst - ndt05 129 ! 1 time step before the middle of the first time step is the previous day 130 nsec_year = nday_year * nsecd + isecrst - ndt05 131 nsec_month = nday * nsecd + isecrst - ndt05 132 132 ENDIF 133 133 nsec_monday = imonday * nsecd + isecrst - ndt05 134 nsec_day = isecrst - ndt05 134 nsec_day = isecrst - ndt05 135 135 IF( nsec_day .LT. 0 ) nsec_day = nsec_day + nsecd 136 136 IF( nsec_monday .LT. 0 ) nsec_monday = nsec_monday + nsecd*7 … … 144 144 nsec000_1jan000 = nsec1jan000 + nsec_year + ndt05 145 145 nsecend_1jan000 = nsec000_1jan000 + ndt * ( nitend - nit000 + 1 ) 146 146 147 147 ! Up to now, calendar parameters are related to the end of previous run (nit000-1) 148 148 ! call day to set the calendar parameters at the begining of the current simulaton. needed by iom_init … … 344 344 ! calculate start time in hours and minutes 345 345 zdayfrac = adatrj - REAL(INT(adatrj), wp) 346 ksecs = NINT(zdayfrac * rday) ! Nearest second to catch rounding errors in adatrj 346 ksecs = NINT(zdayfrac * rday) ! Nearest second to catch rounding errors in adatrj 347 347 ihour = ksecs / NINT( rhhmm*rmmss ) 348 348 iminute = ksecs / NINT(rmmss) - ihour*NINT(rhhmm) 349 349 350 350 ! Add to nn_time0 351 351 nhour = nn_time0 / 100 352 352 nminute = ( nn_time0 - nhour * 100 ) 353 353 nminute = nminute + iminute 354 354 355 355 IF( nminute >= NINT(rhhmm) ) THEN 356 356 nminute = nminute - NINT(rhhmm) … … 361 361 nhour = nhour - NINT(rjjhh) 362 362 adatrj = adatrj + 1. 363 ENDIF 363 ENDIF 364 364 nn_time0 = nhour * 100 + nminute 365 adatrj = REAL(INT(adatrj), wp) ! adatrj set to integer as nn_time0 updated 365 adatrj = REAL(INT(adatrj), wp) ! adatrj set to integer as nn_time0 updated 366 366 ELSE 367 367 ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day) -
NEMO/trunk/src/OCE/DOM/dom_oce.F90
r14053 r14072 4 4 !! ** Purpose : Define in memory all the ocean space domain variables 5 5 !!====================================================================== 6 !! History : 1.0 ! 2005-10 (A. Beckmann, G. Madec) reactivate s-coordinate 6 !! History : 1.0 ! 2005-10 (A. Beckmann, G. Madec) reactivate s-coordinate 7 7 !! 3.3 ! 2010-11 (G. Madec) add mbk. arrays associated to the deepest ocean level 8 8 !! 3.4 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation … … 72 72 ! ! = 6 cyclic East-West AND North fold F-point pivot 73 73 ! ! = 7 bi-cyclic East-West AND North-South 74 LOGICAL, PUBLIC :: l_Iperio, l_Jperio ! should we explicitely take care I/J periodicity 74 LOGICAL, PUBLIC :: l_Iperio, l_Jperio ! should we explicitely take care I/J periodicity 75 75 76 76 ! Tiling namelist … … 91 91 INTEGER, ALLOCATABLE, PUBLIC :: nbondi_bdy(:) !: mark i-direction local boundaries for BDY open boundaries 92 92 INTEGER, ALLOCATABLE, PUBLIC :: nbondj_bdy(:) !: mark j-direction local boundaries for BDY open boundaries 93 INTEGER, ALLOCATABLE, PUBLIC :: nbondi_bdy_b(:) !: mark i-direction of neighbours local boundaries for BDY open boundaries 94 INTEGER, ALLOCATABLE, PUBLIC :: nbondj_bdy_b(:) !: mark j-direction of neighbours local boundaries for BDY open boundaries 93 INTEGER, ALLOCATABLE, PUBLIC :: nbondi_bdy_b(:) !: mark i-direction of neighbours local boundaries for BDY open boundaries 94 INTEGER, ALLOCATABLE, PUBLIC :: nbondj_bdy_b(:) !: mark j-direction of neighbours local boundaries for BDY open boundaries 95 95 96 96 INTEGER, PUBLIC :: npolj !: north fold mark (0, 3 or 4) 97 97 INTEGER, PUBLIC :: noea, nowe !: index of the local neighboring processors in 98 98 INTEGER, PUBLIC :: noso, nono !: east, west, south and north directions 99 INTEGER, PUBLIC :: nones, nonws !: north-east, north-west directions for sending 99 INTEGER, PUBLIC :: nones, nonws !: north-east, north-west directions for sending 100 100 INTEGER, PUBLIC :: noses, nosws !: south-east, south-west directions for sending 101 101 INTEGER, PUBLIC :: noner, nonwr !: north-east, north-west directions for receiving … … 142 142 LOGICAL, PUBLIC :: ln_zps !: z-coordinate - partial step 143 143 LOGICAL, PUBLIC :: ln_sco !: s-coordinate or hybrid z-s coordinate 144 LOGICAL, PUBLIC :: ln_isfcav !: presence of ISF 144 LOGICAL, PUBLIC :: ln_isfcav !: presence of ISF 145 145 ! ! reference scale factors 146 146 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_0 !: t- vert. scale factor [m] … … 166 166 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w_0 !: w- depth (sum of e3w) [m] 167 167 ! ! time-dependent depths of cells 168 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: gdept, gdepw 169 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w 170 168 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: gdept, gdepw 169 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w 170 171 171 ! ! reference heights of ocean water column and its inverse 172 172 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_0, r1_ht_0 !: t-depth [m] and [1/m] … … 182 182 183 183 INTEGER, PUBLIC :: nla10 !: deepest W level Above ~10m (nlb10 - 1) 184 INTEGER, PUBLIC :: nlb10 !: shallowest W level Bellow ~10m (nla10 + 1) 184 INTEGER, PUBLIC :: nlb10 !: shallowest W level Bellow ~10m (nla10 + 1) 185 185 186 186 !! 1D reference vertical coordinate … … 207 207 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, wmask, fmask !: land/ocean mask at T-, U-, V-, W- and F-pts 208 208 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wumask, wvmask !: land/ocean mask at WU- and WV-pts 209 #if defined key_qco 209 #if defined key_qco 210 210 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: fe3mask !: land/ocean mask at F-pts for qco 211 211 #endif … … 224 224 INTEGER , PUBLIC :: nsec_monday !: seconds between 00h of the last Monday and half of the current time step 225 225 INTEGER , PUBLIC :: nsec_day !: seconds between 00h of the current day and half of the current time step 226 REAL(wp), PUBLIC :: fjulday !: current julian day 226 REAL(wp), PUBLIC :: fjulday !: current julian day 227 227 REAL(wp), PUBLIC :: fjulstartyear !: first day of the current year in julian days 228 228 REAL(wp), PUBLIC :: adatrj !: number of elapsed days since the begining of the whole simulation … … 252 252 !!---------------------------------------------------------------------- 253 253 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 254 !! $Id$ 254 !! $Id$ 255 255 !! Software governed by the CeCILL license (see ./LICENSE) 256 256 !!---------------------------------------------------------------------- … … 270 270 271 271 CHARACTER(len=3) FUNCTION Agrif_CFixed() 272 Agrif_CFixed = '0' 272 Agrif_CFixed = '0' 273 273 END FUNCTION Agrif_CFixed 274 274 #endif … … 311 311 ii = ii+1 312 312 ALLOCATE( r3t (jpi,jpj,jpt) , r3u (jpi,jpj,jpt) , r3v (jpi,jpj,jpt) , r3f (jpi,jpj) , & 313 & r3t_f(jpi,jpj) , r3u_f(jpi,jpj) , r3v_f(jpi,jpj) , STAT=ierr(ii) ) 313 & r3t_f(jpi,jpj) , r3u_f(jpi,jpj) , r3v_f(jpi,jpj) , STAT=ierr(ii) ) 314 314 #else 315 315 ii = ii+1 -
NEMO/trunk/src/OCE/DOM/domain.F90
r14053 r14072 6 6 !! History : OPA ! 1990-10 (C. Levy - G. Madec) Original code 7 7 !! ! 1992-01 (M. Imbard) insert time step initialization 8 !! ! 1996-06 (G. Madec) generalized vertical coordinate 8 !! ! 1996-06 (G. Madec) generalized vertical coordinate 9 9 !! ! 1997-02 (G. Madec) creation of domwri.F 10 10 !! ! 2001-05 (E.Durand - G. Madec) insert closed sea … … 17 17 !! 4.1 ! 2020-02 (G. Madec, S. Techene) introduce ssh to h0 ratio 18 18 !!---------------------------------------------------------------------- 19 19 20 20 !!---------------------------------------------------------------------- 21 21 !! dom_init : initialize the space and time domain … … 33 33 USE domvvl ! variable volume 34 34 #endif 35 USE sshwzv , ONLY : ssh_init_rst ! set initial ssh 35 USE sshwzv , ONLY : ssh_init_rst ! set initial ssh 36 36 USE sbc_oce ! surface boundary condition: ocean 37 37 USE trc_oce ! shared ocean & passive tracers variab … … 72 72 !!---------------------------------------------------------------------- 73 73 !! *** ROUTINE dom_init *** 74 !! 75 !! ** Purpose : Domain initialization. Call the routines that are 76 !! required to create the arrays which define the space 74 !! 75 !! ** Purpose : Domain initialization. Call the routines that are 76 !! required to create the arrays which define the space 77 77 !! and time domain of the ocean model. 78 78 !! … … 89 89 INTEGER :: iconf = 0 ! local integers 90 90 REAL(wp):: zrdt 91 CHARACTER (len=64) :: cform = "(A12, 3(A13, I7))" 91 CHARACTER (len=64) :: cform = "(A12, 3(A13, I7))" 92 92 INTEGER , DIMENSION(jpi,jpj) :: ik_top , ik_bot ! top and bottom ocean level 93 93 REAL(wp), DIMENSION(jpi,jpj) :: z1_hu_0, z1_hv_0 … … 126 126 WRITE(numout,*) ' cn_cfg = ', TRIM( cn_cfg ), ' nn_cfg = ', nn_cfg 127 127 ENDIF 128 128 129 129 ! 130 130 ! !== Reference coordinate system ==! … … 240 240 WRITE(numout,*) 'dom_init : ==>>> END of domain initialization' 241 241 WRITE(numout,*) '~~~~~~~~' 242 WRITE(numout,*) 242 WRITE(numout,*) 243 243 ENDIF 244 244 ! … … 252 252 !! ** Purpose : initialization of global domain <--> local domain indices 253 253 !! 254 !! ** Method : 254 !! ** Method : 255 255 !! 256 256 !! ** Action : - mig , mjg : local domain indices ==> global domain, including halos, indices … … 271 271 ! 272 272 mig0(:) = mig(:) - nn_hls 273 mjg0(:) = mjg(:) - nn_hls 274 ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data, 273 mjg0(:) = mjg(:) - nn_hls 274 ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data, 275 275 ! we must define mig0 and mjg0 as bellow. 276 276 ! Once we decide to forget trunk compatibility, we must simply define mig0 and mjg0 as: … … 279 279 ! 280 280 ! ! global domain, including halos, indices ==> local domain indices 281 ! ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 282 ! ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. 281 ! ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the 282 ! ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain. 283 283 DO ji = 1, jpiglo 284 284 mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) ) … … 387 387 !!---------------------------------------------------------------------- 388 388 !! *** ROUTINE dom_nam *** 389 !! 389 !! 390 390 !! ** Purpose : read domaine namelists and print the variables. 391 391 !! … … 549 549 ! 550 550 IF( .NOT.l_SAS .AND. iom_varid( numror, 'sshb', ldstop = .FALSE. ) <= 0 ) THEN !- Check absence of one of the Kbb field (here sshb) 551 ! ! (any Kbb field is missing ==> all Kbb fields are missing) 551 ! ! (any Kbb field is missing ==> all Kbb fields are missing) 552 552 IF( .NOT.l_1st_euler ) THEN 553 553 CALL ctl_warn('dom_nam : ssh at Kbb not found in restart files ', & … … 558 558 ENDIF 559 559 ELSEIF( .NOT.l_1st_euler ) THEN !* Initialization case 560 IF(lwp) WRITE(numout,*) 560 IF(lwp) WRITE(numout,*) 561 561 IF(lwp) WRITE(numout,*)' ==>>> Start from rest (ln_rstart=F)' 562 IF(lwp) WRITE(numout,*)' an Euler initial time step is used : l_1st_euler is forced to .true. ' 562 IF(lwp) WRITE(numout,*)' an Euler initial time step is used : l_1st_euler is forced to .true. ' 563 563 l_1st_euler = .TRUE. 564 564 ENDIF … … 586 586 IF(lwp) WRITE(numout,*) 587 587 SELECT CASE ( nleapy ) !== Choose calendar for IOIPSL ==! 588 CASE ( 1 ) 588 CASE ( 1 ) 589 589 CALL ioconf_calendar('gregorian') 590 590 IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "gregorian", i.e. leap year' … … 699 699 !!---------------------------------------------------------------------- 700 700 !! *** ROUTINE domain_cfg *** 701 !! 701 !! 702 702 !! ** Purpose : read the domain size in domain configuration file 703 703 !! … … 706 706 CHARACTER(len=*) , INTENT(out) :: cd_cfg ! configuration name 707 707 INTEGER , INTENT(out) :: kk_cfg ! configuration resolution 708 INTEGER , INTENT(out) :: kpi, kpj, kpk ! global domain sizes 709 INTEGER , INTENT(out) :: kperio ! lateral global domain b.c. 708 INTEGER , INTENT(out) :: kpi, kpj, kpk ! global domain sizes 709 INTEGER , INTENT(out) :: kperio ! lateral global domain b.c. 710 710 ! 711 711 INTEGER :: inum ! local integer … … 739 739 cd_cfg = 'UNKNOWN' 740 740 kk_cfg = -9999999 741 !- or they may be present as global attributes 742 !- (netcdf only) 741 !- or they may be present as global attributes 742 !- (netcdf only) 743 743 CALL iom_getatt( inum, 'cn_cfg', cd_cfg ) ! returns ! if not found 744 744 CALL iom_getatt( inum, 'nn_cfg', kk_cfg ) ! returns -999 if not found … … 762 762 WRITE(numout,*) ' type of global domain lateral boundary jperio = ', kperio 763 763 ENDIF 764 ! 764 ! 765 765 END SUBROUTINE domain_cfg 766 767 766 767 768 768 SUBROUTINE cfg_write 769 769 !!---------------------------------------------------------------------- 770 770 !! *** ROUTINE cfg_write *** 771 !! 772 !! ** Purpose : Create the "cn_domcfg_out" file, a NetCDF file which 773 !! contains all the ocean domain informations required to 771 !! 772 !! ** Purpose : Create the "cn_domcfg_out" file, a NetCDF file which 773 !! contains all the ocean domain informations required to 774 774 !! define an ocean configuration. 775 775 !! … … 777 777 !! ocean configuration. 778 778 !! 779 !! ** output file : domcfg_out.nc : domain size, characteristics, horizontal 779 !! ** output file : domcfg_out.nc : domain size, characteristics, horizontal 780 780 !! mesh, Coriolis parameter, and vertical scale factors 781 781 !! NB: also contain ORCA family information … … 794 794 ! ! create 'domcfg_out.nc' file ! 795 795 ! ! ============================= ! 796 ! 796 ! 797 797 clnam = cn_domcfg_out ! filename (configuration information) 798 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 798 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 799 799 ! 800 800 ! !== ORCA family specificities ==! 801 801 IF( TRIM(cn_cfg) == "orca" .OR. TRIM(cn_cfg) == "ORCA" ) THEN 802 802 CALL iom_rstput( 0, 0, inum, 'ORCA' , 1._wp , ktype = jp_i4 ) 803 CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 ) 803 CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 ) 804 804 ENDIF 805 805 ! … … 823 823 CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 ) 824 824 CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 ) 825 ! 825 ! 826 826 CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 ) ! longitude 827 827 CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 ) 828 828 CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 ) 829 829 CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 ) 830 ! 830 ! 831 831 CALL iom_rstput( 0, 0, inum, 'e1t' , e1t , ktype = jp_r8 ) ! i-scale factors (e1.) 832 832 CALL iom_rstput( 0, 0, inum, 'e1u' , e1u , ktype = jp_r8 ) … … 843 843 ! 844 844 ! !== vertical mesh ==! 845 ! 845 ! 846 846 CALL iom_rstput( 0, 0, inum, 'e3t_1d' , e3t_1d , ktype = jp_r8 ) ! reference 1D-coordinate 847 847 CALL iom_rstput( 0, 0, inum, 'e3w_1d' , e3w_1d , ktype = jp_r8 ) … … 854 854 CALL iom_rstput( 0, 0, inum, 'e3uw_0' , e3uw_0 , ktype = jp_r8 ) 855 855 CALL iom_rstput( 0, 0, inum, 'e3vw_0' , e3vw_0 , ktype = jp_r8 ) 856 ! 856 ! 857 857 ! !== wet top and bottom level ==! (caution: multiplied by ssmask) 858 858 ! … … 874 874 ! 875 875 ! ! ============================ 876 ! ! close the files 876 ! ! close the files 877 877 ! ! ============================ 878 878 CALL iom_close( inum ) -
NEMO/trunk/src/OCE/DOM/domutl.F90
r13982 r14072 31 31 !!---------------------------------------------------------------------- 32 32 !! NEMO/OCE 4.2 , NEMO Consortium (2020) 33 !! $Id$ 33 !! $Id$ 34 34 !! Software governed by the CeCILL license (see ./LICENSE) 35 35 !!---------------------------------------------------------------------- … … 42 42 !! ** Purpose : find the closest grid point from a given lon/lat position 43 43 !! 44 !! ** Method : look for minimum distance in cylindrical projection 44 !! ** Method : look for minimum distance in cylindrical projection 45 45 !! -> not good if located at too high latitude... 46 46 !!---------------------------------------------------------------------- … … 86 86 !!---------------------------------------------------------------------- 87 87 !! *** ROUTINE dom_uniq *** 88 !! 88 !! 89 89 !! ** Purpose : identify unique point of a grid (TUVF) 90 90 !! … … 92 92 !! 2) check which elements have been changed 93 93 !!---------------------------------------------------------------------- 94 CHARACTER(len=1) , INTENT(in ) :: cdgrd ! 95 REAL(wp), DIMENSION(:,:), INTENT(inout) :: puniq ! 94 CHARACTER(len=1) , INTENT(in ) :: cdgrd ! 95 REAL(wp), DIMENSION(:,:), INTENT(inout) :: puniq ! 96 96 ! 97 97 REAL(wp) :: zshift ! shift value link to the process number … … 101 101 !!---------------------------------------------------------------------- 102 102 ! 103 ! build an array with different values for each element 103 ! build an array with different values for each element 104 104 ! in mpp: make sure that these values are different even between process 105 105 ! -> apply a shift value according to the process number … … 109 109 puniq(:,:) = ztstref(:,:) ! default definition 110 110 CALL lbc_lnk( 'domwri', puniq, cdgrd, 1. ) ! apply boundary conditions 111 lluniq(:,:,1) = puniq(:,:) == ztstref(:,:) ! check which values have not been changed 111 lluniq(:,:,1) = puniq(:,:) == ztstref(:,:) ! check which values have not been changed 112 112 ! 113 113 puniq(:,:) = REAL( COUNT( lluniq(:,:,:), dim = 3 ), wp ) -
NEMO/trunk/src/OCE/DOM/domvvl.F90
r14053 r14072 2 2 !!====================================================================== 3 3 !! *** MODULE domvvl *** 4 !! Ocean : 4 !! Ocean : 5 5 !!====================================================================== 6 6 !! History : 2.0 ! 2006-06 (B. Levier, L. Marie) original code … … 58 58 !! Default key Old management of time varying vertical coordinate 59 59 !!---------------------------------------------------------------------- 60 60 61 61 !!---------------------------------------------------------------------- 62 62 !! dom_vvl_init : define initial vertical scale factors, depths and column thickness … … 73 73 PUBLIC dom_vvl_sf_update ! called by step.F90 74 74 PUBLIC dom_vvl_interpol ! called by dynnxt.F90 75 75 76 76 !! * Substitutions 77 77 # include "do_loop_substitute.h90" … … 109 109 !!---------------------------------------------------------------------- 110 110 !! *** ROUTINE dom_vvl_init *** 111 !! 111 !! 112 112 !! ** Purpose : Initialization of all scale factors, depths 113 113 !! and water column heights … … 118 118 !! ** Action : - e3t_(n/b) and tilde_e3t_(n/b) 119 119 !! - Regrid: e3[u/v](:,:,:,Kmm) 120 !! e3[u/v](:,:,:,Kmm) 121 !! e3w(:,:,:,Kmm) 120 !! e3[u/v](:,:,:,Kmm) 121 !! e3w(:,:,:,Kmm) 122 122 !! e3[u/v]w_b 123 !! e3[u/v]w_n 123 !! e3[u/v]w_n 124 124 !! gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w 125 125 !! - h(t/u/v)_0 … … 151 151 !!---------------------------------------------------------------------- 152 152 !! *** ROUTINE dom_vvl_init *** 153 !! 154 !! ** Purpose : Interpolation of all scale factors, 153 !! 154 !! ** Purpose : Interpolation of all scale factors, 155 155 !! depths and water column heights 156 156 !! … … 159 159 !! ** Action : - e3t_(n/b) and tilde_e3t_(n/b) 160 160 !! - Regrid: e3(u/v)_n 161 !! e3(u/v)_b 162 !! e3w_n 163 !! e3(u/v)w_b 164 !! e3(u/v)w_n 161 !! e3(u/v)_b 162 !! e3w_n 163 !! e3(u/v)w_b 164 !! e3(u/v)w_n 165 165 !! gdept_n, gdepw_n and gde3w_n 166 166 !! - h(t/u/v)_0 … … 180 180 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) ! from T to U 181 181 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 182 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) ! from T to V 182 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) ! from T to V 183 183 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 184 184 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) ! from U to F 185 ! ! Vertical interpolation of e3t,u,v 185 ! ! Vertical interpolation of e3t,u,v 186 186 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W' ) ! from T to W 187 187 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3w (:,:,:,Kbb), 'W' ) … … 205 205 ! zcoef = tmask - wmask ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 206 206 ! ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 207 ! ! 0.5 where jk = mikt 207 ! ! 0.5 where jk = mikt 208 208 !!gm ??????? BUG ? gdept(:,:,:,Kmm) as well as gde3w does not include the thickness of ISF ?? 209 209 zcoef = ( tmask(ji,jj,jk) - wmask(ji,jj,jk) ) 210 210 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 211 211 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm)) & 212 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm)) 212 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm)) 213 213 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 214 214 gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 215 215 gdept(ji,jj,jk,Kbb) = zcoef * ( gdepw(ji,jj,jk ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb)) & 216 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) + e3w(ji,jj,jk,Kbb)) 216 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) + e3w(ji,jj,jk,Kbb)) 217 217 END_3D 218 218 ! … … 273 273 IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 274 274 IF( nn_cfg == 3 ) THEN ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 275 ii0 = 103 + nn_hls - 1 ; ii1 = 111 + nn_hls - 1 275 ii0 = 103 + nn_hls - 1 ; ii1 = 111 + nn_hls - 1 276 276 ij0 = 128 + nn_hls ; ij1 = 135 + nn_hls 277 277 frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.0_wp … … 285 285 286 286 287 SUBROUTINE dom_vvl_sf_nxt( kt, Kbb, Kmm, Kaa, kcall ) 287 SUBROUTINE dom_vvl_sf_nxt( kt, Kbb, Kmm, Kaa, kcall ) 288 288 !!---------------------------------------------------------------------- 289 289 !! *** ROUTINE dom_vvl_sf_nxt *** 290 !! 290 !! 291 291 !! ** Purpose : - compute the after scale factors used in tra_zdf, dynnxt, 292 292 !! tranxt and dynspg routines 293 293 !! 294 294 !! ** Method : - z_star case: Repartition of ssh INCREMENT proportionnaly to the level thickness. 295 !! - z_tilde_case: after scale factor increment = 295 !! - z_tilde_case: after scale factor increment = 296 296 !! high frequency part of horizontal divergence 297 297 !! + retsoring towards the background grid … … 301 301 !! 302 302 !! ** Action : - hdiv_lf : restoring towards full baroclinic divergence in z_tilde case 303 !! - tilde_e3t_a: after increment of vertical scale factor 303 !! - tilde_e3t_a: after increment of vertical scale factor 304 304 !! in z_tilde case 305 305 !! - e3(t/u/v)_a … … 405 405 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 406 406 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) 407 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj) & 407 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj) & 408 408 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) ) 409 409 zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) … … 450 450 WRITE(numout, *) 'at i, j, k=', ijk_max 451 451 WRITE(numout, *) 'MIN( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin 452 WRITE(numout, *) 'at i, j, k=', ijk_min 452 WRITE(numout, *) 'at i, j, k=', ijk_min 453 453 CALL ctl_stop( 'STOP', 'MAX( ABS( tilde_e3t_a(:,:,: ) ) / e3t_0(:,:,:) ) too high') 454 454 ENDIF … … 566 566 !!---------------------------------------------------------------------- 567 567 !! *** ROUTINE dom_vvl_sf_update *** 568 !! 569 !! ** Purpose : for z tilde case: compute time filter and swap of scale factors 568 !! 569 !! ** Purpose : for z tilde case: compute time filter and swap of scale factors 570 570 !! compute all depths and related variables for next time step 571 571 !! write outputs and restart file … … 577 577 !! ** Action : - tilde_e3t_(b/n) ready for next time step 578 578 !! - Recompute: 579 !! e3(u/v)_b 580 !! e3w(:,:,:,Kmm) 581 !! e3(u/v)w_b 582 !! e3(u/v)w_n 579 !! e3(u/v)_b 580 !! e3w(:,:,:,Kmm) 581 !! e3(u/v)w_b 582 !! e3(u/v)w_n 583 583 !! gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w 584 584 !! h(u/v) and h(u/v)r … … 611 611 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) 612 612 ELSE 613 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) & 613 tilde_e3t_b(:,:,:) = tilde_e3t_n(:,:,:) & 614 614 & + rn_atfp * ( tilde_e3t_b(:,:,:) - 2.0_wp * tilde_e3t_n(:,:,:) + tilde_e3t_a(:,:,:) ) 615 615 ENDIF … … 623 623 ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt 624 624 ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 625 625 626 626 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 627 627 628 628 ! Vertical scale factor interpolations 629 629 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w(:,:,:,Kmm), 'W' ) … … 644 644 gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 645 645 gdept(ji,jj,jk,Kmm) = zcoef * ( gdepw(ji,jj,jk ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm) ) & 646 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm) ) 646 & + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) + e3w(ji,jj,jk,Kmm) ) 647 647 gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - ssh(ji,jj,Kmm) 648 648 END_3D … … 763 763 !!--------------------------------------------------------------------- 764 764 !! *** ROUTINE dom_vvl_rst *** 765 !! 765 !! 766 766 !! ** Purpose : Read or write VVL file in restart file 767 767 !! … … 807 807 IF(lwp) WRITE(numout,*) ' Kmm scale factor read in the restart file' 808 808 CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm) ) 809 WHERE ( tmask(:,:,:) == 0.0_wp ) 809 WHERE ( tmask(:,:,:) == 0.0_wp ) 810 810 e3t(:,:,:,Kmm) = e3t_0(:,:,:) 811 811 END WHERE … … 816 816 IF(lwp) WRITE(numout,*) ' Kbb scale factor read in the restart file' 817 817 CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb) ) 818 WHERE ( tmask(:,:,:) == 0.0_wp ) 818 WHERE ( tmask(:,:,:) == 0.0_wp ) 819 819 e3t(:,:,:,Kbb) = e3t_0(:,:,:) 820 820 END WHERE … … 840 840 CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 841 841 ENDIF 842 ELSE 842 ELSE 843 843 tilde_e3t_b(:,:,:) = 0.0_wp 844 844 tilde_e3t_n(:,:,:) = 0.0_wp … … 850 850 CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:) ) 851 851 ELSE ! array is missing 852 hdiv_lf(:,:,:) = 0.0_wp 852 hdiv_lf(:,:,:) = 0.0_wp 853 853 ENDIF 854 854 ENDIF … … 884 884 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:)) 885 885 END IF 886 ! ! -------------! 886 ! ! -------------! 887 887 IF( ln_vvl_ztilde ) THEN ! z_tilde case ! 888 888 ! ! ------------ ! … … 898 898 !!--------------------------------------------------------------------- 899 899 !! *** ROUTINE dom_vvl_ctl *** 900 !! 900 !! 901 901 !! ** Purpose : Control the consistency between namelist options 902 902 !! for vertical coordinate … … 907 907 & ln_vvl_zstar_at_eqtor , rn_ahe3 , rn_rst_e3t , & 908 908 & rn_lf_cutoff , rn_zdef_max , ln_vvl_dbg ! not yet implemented: ln_vvl_kepe 909 !!---------------------------------------------------------------------- 909 !!---------------------------------------------------------------------- 910 910 ! 911 911 READ ( numnam_ref, nam_vvl, IOSTAT = ios, ERR = 901) -
NEMO/trunk/src/OCE/DOM/dtatsd.F90
r13982 r14072 6 6 !! History : OPA ! 1991-03 () Original code 7 7 !! - ! 1992-07 (M. Imbard) 8 !! 8.0 ! 1999-10 (M.A. Foujols, M. Imbard) NetCDF FORMAT 9 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 8 !! 8.0 ! 1999-10 (M.A. Foujols, M. Imbard) NetCDF FORMAT 9 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 10 10 !! 3.3 ! 2010-10 (C. Bricaud, S. Masson) use of fldread 11 11 !! 3.4 ! 2010-11 (G. Madec, C. Ethe) Merge of dtatem and dtasal + remove CPP keys … … 40 40 !!---------------------------------------------------------------------- 41 41 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 42 !! $Id$ 42 !! $Id$ 43 43 !! Software governed by the CeCILL license (see ./LICENSE) 44 44 !!---------------------------------------------------------------------- … … 48 48 !!---------------------------------------------------------------------- 49 49 !! *** ROUTINE dta_tsd_init *** 50 !! 51 !! ** Purpose : initialisation of T & S input data 52 !! 50 !! 51 !! ** Purpose : initialisation of T & S input data 52 !! 53 53 !! ** Method : - Read namtsd namelist 54 !! - allocates T & S data structure 54 !! - allocates T & S data structure 55 55 !!---------------------------------------------------------------------- 56 56 LOGICAL, INTENT(in), OPTIONAL :: ld_tradmp ! force the initialization when tradp is used … … 75 75 76 76 IF( PRESENT( ld_tradmp ) ) ln_tsd_dmp = .TRUE. ! forces the initialization when tradmp is used 77 77 78 78 IF(lwp) THEN ! control print 79 79 WRITE(numout,*) … … 124 124 !!---------------------------------------------------------------------- 125 125 !! *** ROUTINE dta_tsd *** 126 !! 126 !! 127 127 !! ** Purpose : provides T and S data at kt 128 !! 128 !! 129 129 !! ** Method : - call fldread routine 130 !! - ORCA_R2: add some hand made alteration to read data 130 !! - ORCA_R2: add some hand made alteration to read data 131 131 !! - 'key_orca_lev10' interpolates on 10 times more levels 132 132 !! - s- or mixed z-s coordinate: vertical interpolation on model mesh … … 211 211 IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 212 212 zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 213 ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 213 ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi 214 214 zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi 215 215 ENDIF … … 224 224 ptsd(ji,jj,jpk,jp_sal) = 0._wp 225 225 END_2D 226 ! 226 ! 227 227 ELSE !== z- or zps- coordinate ==! 228 ! 228 ! 229 229 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) 230 230 ptsd(ji,jj,jk,jp_tem) = ptsd(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) ! Mask … … 235 235 ! NOTE: [tiling-comms-merge] This fix was necessary to take out tra_adv lbc_lnk statements in the zps case 236 236 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 237 ik = mbkt(ji,jj) 237 ik = mbkt(ji,jj) 238 238 IF( ik > 1 ) THEN 239 239 zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) … … 243 243 ik = mikt(ji,jj) 244 244 IF( ik > 1 ) THEN 245 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 245 zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 246 246 ptsd(ji,jj,ik,jp_tem) = (1.-zl) * ptsd(ji,jj,ik,jp_tem) + zl * ptsd(ji,jj,ik+1,jp_tem) 247 247 ptsd(ji,jj,ik,jp_sal) = (1.-zl) * ptsd(ji,jj,ik,jp_sal) + zl * ptsd(ji,jj,ik+1,jp_sal) … … 252 252 ENDIF 253 253 ! 254 IF( .NOT.ln_tsd_dmp ) THEN !== deallocate T & S structure ==! 254 IF( .NOT.ln_tsd_dmp ) THEN !== deallocate T & S structure ==! 255 255 ! (data used only for initialisation) 256 256 IF(lwp) WRITE(numout,*) 'dta_tsd: deallocte T & S arrays as they are only use to initialize the run' -
NEMO/trunk/src/OCE/DOM/phycst.F90
r14053 r14072 7 7 !! 8.1 ! 1991-11 (G. Madec, M. Imbard) cosmetic changes 8 8 !! NEMO 1.0 ! 2002-08 (G. Madec, C. Ethe) F90, add ice constants 9 !! - ! 2006-08 (G. Madec) style 10 !! 3.2 ! 2006-08 (S. Masson, G. Madec) suppress useless variables + style 11 !! 3.4 ! 2011-11 (C. Harris) minor changes for CICE constants 9 !! - ! 2006-08 (G. Madec) style 10 !! 3.2 ! 2006-08 (S. Masson, G. Madec) suppress useless variables + style 11 !! 3.4 ! 2011-11 (C. Harris) minor changes for CICE constants 12 12 !!---------------------------------------------------------------------- 13 13 … … 26 26 REAL(wp), PUBLIC :: rad = 3.141592653589793_wp / 180._wp !: conversion from degre into radian 27 27 REAL(wp), PUBLIC :: rsmall = 0.5 * EPSILON( 1.e0 ) !: smallest real computer value 28 28 29 29 REAL(wp), PUBLIC :: rday = 24.*60.*60. !: day [s] 30 30 REAL(wp), PUBLIC :: rsiyea !: sideral year [s] … … 36 36 REAL(wp), PUBLIC :: omega !: earth rotation parameter [s-1] 37 37 REAL(wp), PUBLIC :: ra = 6371229._wp !: earth radius [m] 38 REAL(wp), PUBLIC :: grav = 9.80665_wp !: gravity [m/s2] 38 REAL(wp), PUBLIC :: grav = 9.80665_wp !: gravity [m/s2] 39 39 REAL(wp), PUBLIC :: rt0 = 273.15_wp !: freezing point of fresh water [Kelvin] 40 40 … … 43 43 REAL(wp), PUBLIC :: rcp !: ocean specific heat [J/Kelvin] 44 44 REAL(wp), PUBLIC :: r1_rcp !: = 1. / rcp [Kelvin/J] 45 REAL(wp), PUBLIC :: rho0_rcp !: = rho0 * rcp 45 REAL(wp), PUBLIC :: rho0_rcp !: = rho0 * rcp 46 46 REAL(wp), PUBLIC :: r1_rho0_rcp !: = 1. / ( rho0 * rcp ) 47 47 … … 52 52 REAL(wp), PUBLIC :: rLevap = 2.5e+6_wp !: latent heat of evaporation (water) 53 53 REAL(wp), PUBLIC :: vkarmn = 0.4_wp !: von Karman constant 54 REAL(wp), PUBLIC :: stefan = 5.67e-8_wp !: Stefan-Boltzmann constant 54 REAL(wp), PUBLIC :: vkarmn2 = 0.4_wp*0.4_wp !: square of von Karman constant 55 REAL(wp), PUBLIC :: stefan = 5.67e-8_wp !: Stefan-Boltzmann constant 55 56 56 57 REAL(wp), PUBLIC :: rhos = 330._wp !: volumic mass of snow [kg/m3] … … 66 67 REAL(wp), PUBLIC :: r1_rhos !: 1 / rhos 67 68 REAL(wp), PUBLIC :: r1_rcpi !: 1 / rcpi 68 69 69 70 !!---------------------------------------------------------------------- 70 71 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 71 !! $Id$ 72 !! $Id$ 72 73 !! Software governed by the CeCILL license (see ./LICENSE) 73 74 !!---------------------------------------------------------------------- 74 75 75 76 CONTAINS 76 77 77 78 SUBROUTINE phy_cst 78 79 !!---------------------------------------------------------------------- … … 87 88 omega = 7.292116e-05 88 89 #else 89 omega = 2._wp * rpi / rsiday 90 omega = 2._wp * rpi / rsiday 90 91 #endif 91 92 … … 126 127 WRITE(numout,*) ' salinity of ice (for pisces) = ', sice , ' psu' 127 128 WRITE(numout,*) ' salinity of sea (for pisces and isf) = ', soce , ' psu' 128 WRITE(numout,*) ' latent heat of evaporation (water) = ', rLevap , ' J/m^3' 129 WRITE(numout,*) ' von Karman constant = ', vkarmn 129 WRITE(numout,*) ' latent heat of evaporation (water) = ', rLevap , ' J/m^3' 130 WRITE(numout,*) ' von Karman constant = ', vkarmn 130 131 WRITE(numout,*) ' Stefan-Boltzmann constant = ', stefan , ' J/s/m^2/K^4' 131 132 WRITE(numout,*)
Note: See TracChangeset
for help on using the changeset viewer.