- Timestamp:
- 2015-12-04T17:05:58+01:00 (9 years ago)
- Location:
- branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
r5563 r6004 26 26 !! 27 27 !!---------------------------------------------------------------------- 28 USE dom_oce 29 USE phycst 30 USE in_out_manager 31 USE iom 32 USE ioipsl , ONLY : ymds2ju ! for calendar33 USE prtctl 34 USE trc_oce , ONLY : lk_offline ! offline flag35 USE timing 36 USE restart 28 USE dom_oce ! ocean space and time domain 29 USE phycst ! physical constants 30 USE in_out_manager ! I/O manager 31 USE iom ! 32 USE ioipsl , ONLY : ymds2ju ! for calendar 33 USE prtctl ! Print control 34 USE trc_oce , ONLY : lk_offline ! offline flag 35 USE timing ! Timing 36 USE restart ! restart 37 37 38 38 IMPLICIT NONE … … 43 43 PUBLIC day_mth ! Needed by TAM 44 44 45 INTEGER, PUBLIC :: nsecd, nsecd05, ndt, ndt05 !(PUBLIC for TAM)45 INTEGER, PUBLIC :: nsecd, nsecd05, ndt, ndt05 !: (PUBLIC for TAM) 46 46 47 47 !!---------------------------------------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r5866 r6004 46 46 LOGICAL , PUBLIC :: ln_crs !: Apply grid coarsening to dynamical model output or online passive tracers 47 47 48 !! Free surface parameters 49 !! ======================= 50 LOGICAL , PUBLIC :: ln_dynspg_exp !: Explicit free surface flag 51 LOGICAL , PUBLIC :: ln_dynspg_ts !: Split-Explicit free surface flag 52 48 53 !! Time splitting parameters 49 54 !! ========================= 50 55 LOGICAL, PUBLIC :: ln_bt_fw !: Forward integration of barotropic sub-stepping 51 56 LOGICAL, PUBLIC :: ln_bt_av !: Time averaging of barotropic variables 52 LOGICAL, PUBLIC :: ln_bt_ nn_auto!: Set number of barotropic iterations automatically57 LOGICAL, PUBLIC :: ln_bt_auto !: Set number of barotropic iterations automatically 53 58 INTEGER, PUBLIC :: nn_bt_flt !: Filter choice 54 59 INTEGER, PUBLIC :: nn_baro !: Number of barotropic iterations during one baroclinic step (rdt) 55 REAL(wp), PUBLIC :: rn_bt_cmax !: Maximum allowed courant number (used if ln_bt_ nn_auto=T)60 REAL(wp), PUBLIC :: rn_bt_cmax !: Maximum allowed courant number (used if ln_bt_auto=T) 56 61 57 62 !! Horizontal grid parameters for domhgr 58 63 !! ===================================== 59 INTEGER :: jphgr_msh !: type of horizontal mesh64 INTEGER :: jphgr_msh !: type of horizontal mesh 60 65 ! ! = 0 curvilinear coordinate on the sphere read in coordinate.nc 61 66 ! ! = 1 geographical mesh on the sphere with regular grid-spacing … … 64 69 ! ! = 4 Mercator grid with T/U point at the equator 65 70 66 REAL(wp) :: ppglam0 67 REAL(wp) :: ppgphi0 71 REAL(wp) :: ppglam0 !: longitude of first raw and column T-point (jphgr_msh = 1) 72 REAL(wp) :: ppgphi0 !: latitude of first raw and column T-point (jphgr_msh = 1) 68 73 ! ! used for Coriolis & Beta parameters (jphgr_msh = 2 or 3) 69 REAL(wp) :: ppe1_deg 70 REAL(wp) :: ppe2_deg 71 REAL(wp) :: ppe1_m 72 REAL(wp) :: ppe2_m 74 REAL(wp) :: ppe1_deg !: zonal grid-spacing (degrees) 75 REAL(wp) :: ppe2_deg !: meridional grid-spacing (degrees) 76 REAL(wp) :: ppe1_m !: zonal grid-spacing (degrees) 77 REAL(wp) :: ppe2_m !: meridional grid-spacing (degrees) 73 78 74 79 !! Vertical grid parameter for domzgr 75 80 !! ================================== 76 REAL(wp) :: ppsur 77 REAL(wp) :: ppa0 78 REAL(wp) :: ppa1 79 REAL(wp) :: ppkth 80 REAL(wp) :: ppacr 81 REAL(wp) :: ppsur !: ORCA r4, r2 and r05 coefficients 82 REAL(wp) :: ppa0 !: (default coefficients) 83 REAL(wp) :: ppa1 !: 84 REAL(wp) :: ppkth !: 85 REAL(wp) :: ppacr !: 81 86 ! 82 87 ! If both ppa0 ppa1 and ppsur are specified to 0, then 83 88 ! they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr 84 REAL(wp) :: ppdzmin 85 REAL(wp) :: pphmax 89 REAL(wp) :: ppdzmin !: Minimum vertical spacing 90 REAL(wp) :: pphmax !: Maximum depth 86 91 ! 87 LOGICAL :: ldbletanh 88 REAL(wp) :: ppa2 89 REAL(wp) :: ppkth2 90 REAL(wp) :: ppacr2 92 LOGICAL :: ldbletanh !: Use/do not use double tanf function for vertical coordinates 93 REAL(wp) :: ppa2 !: Double tanh function parameters 94 REAL(wp) :: ppkth2 !: 95 REAL(wp) :: ppacr2 !: 91 96 92 97 ! !! old non-DOCTOR names still used in the model … … 102 107 REAL(wp), PUBLIC :: rdth !: depth variation of tracer step 103 108 104 ! !!! associated variables 105 INTEGER , PUBLIC :: neuler !: restart euler forward option (0=Euler) 106 REAL(wp), PUBLIC :: atfp1 !: asselin time filter coeff. (atfp1= 1-2*atfp) 109 ! !!! associated variables 110 INTEGER , PUBLIC :: neuler !: restart euler forward option (0=Euler) 111 REAL(wp), PUBLIC :: atfp1 !: asselin time filter coeff. (atfp1= 1-2*atfp) 112 107 113 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdttra !: vertical profile of tracer time step 108 114 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: r2dtra !: = 2*rdttra except at nit000 (=rdttra) if neuler=0 … … 211 217 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e3tp , e3wp !: ocean bottom level thickness at T and W points 212 218 219 !!gm This should be removed from here.... ==>>> only used in domzgr at initialization phase 213 220 !! s-coordinate and hybrid z-s-coordinate 214 221 !! =----------------======--------------- … … 224 231 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hift , hifu !: and quasi-uniform spacing t--u points (m) 225 232 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rx1 !: Maximum grid stiffness ratio 233 !!gm end 226 234 227 235 !!---------------------------------------------------------------------- … … 229 237 !! --------------------------------------------------------------------- 230 238 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbathy !: number of ocean level (=0, 1, ... , jpk-1) 231 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt !: vertical index of the bottom last T- ocean level 232 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbku, mbkv !: vertical index of the bottom last U- and W- ocean level 233 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bathy !: ocean depth (meters) 239 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt, mbku, mbkv !: vertical index of the bottom last T-, U- & V ocean level 240 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bathy !: ocean depth (meters) 234 241 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_i, umask_i, vmask_i, fmask_i !: interior domain T-point mask 235 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bmask !: land/ocean mask of barotropic stream function236 242 237 243 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: misfdep !: top first ocean level (ISF) … … 364 370 ALLOCATE( mbathy(jpi,jpj) , bathy(jpi,jpj) , & 365 371 & tmask_i(jpi,jpj) , umask_i(jpi,jpj), vmask_i(jpi,jpj), fmask_i(jpi,jpj), & 366 & bmask (jpi,jpj) , &367 372 & mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , STAT=ierr(9) ) 368 373 -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r5883 r6004 13 13 !! 3.3 ! 2010-11 (G. Madec) initialisation in C1D configuration 14 14 !! 3.6 ! 2013 ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs 15 !! - !2015-11 (G. Madec, A. Coward) time varying zgr by default15 !! 3.7 ! 2015-11 (G. Madec, A. Coward) time varying zgr by default 16 16 !!---------------------------------------------------------------------- 17 17 … … 70 70 !! - 1D configuration, move Coriolis, u and v at T-point 71 71 !!---------------------------------------------------------------------- 72 INTEGER :: jk ! dummy loop argument72 INTEGER :: jk ! dummy loop indices 73 73 INTEGER :: iconf = 0 ! local integers 74 REAL(wp), POINTER, DIMENSION(:,:) ::z1_hu_0, z1_hv_074 REAL(wp), POINTER, DIMENSION(:,:) :: z1_hu_0, z1_hv_0 75 75 !!---------------------------------------------------------------------- 76 76 ! … … 427 427 INTEGER :: ji, jj, jk 428 428 REAL(wp) :: zrxmax 429 REAL(wp), DIMENSION(4) :: zr1429 REAL(wp), DIMENSION(4) :: zr1 430 430 !!---------------------------------------------------------------------- 431 431 rx1(:,:) = 0._wp … … 444 444 & / ( gdepw_0(ji+1,jj,jk )+gdepw_0(ji ,jj,jk ) & 445 445 & -gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji ,jj,jk+1) + rsmall ) ) * umask(ji ,jj,jk) 446 zr1(3) = ABS( (gdepw_0(ji,jj+1,jk )-gdepw_0(ji,jj ,jk ) &446 zr1(3) = ABS( ( gdepw_0(ji,jj+1,jk )-gdepw_0(ji,jj ,jk ) & 447 447 & +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj ,jk+1) ) & 448 448 & / ( gdepw_0(ji,jj+1,jk )+gdepw_0(ji,jj ,jk ) & -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r5845 r6004 391 391 ! 392 392 #if defined key_agrif 393 IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN ! for EEL6 configuration only 394 IF( .NOT. Agrif_Root() ) THEN 395 zphi0 = ppgphi0 - REAL( Agrif_Parent(jpjglo)/2 )*Agrif_Parent(ppe2_m) & 396 & / (ra * rad) ! CAUTIOn : split in 2 lignes for AGRIF 393 IF( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN ! for EEL6 configuration only 394 IF( .NOT.Agrif_Root() ) THEN 395 zphi0 = ppgphi0 - REAL( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 397 396 ENDIF 398 397 ENDIF -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r5845 r6004 7 7 !! 6.0 ! 1993-03 (M. Guyon) symetrical conditions (M. Guyon) 8 8 !! 7.0 ! 1996-01 (G. Madec) suppression of common work arrays 9 !! - ! 1996-05 (G. Madec) mask computed from tmask and sup- 10 !! ! pression of the double computation of bmask 9 !! - ! 1996-05 (G. Madec) mask computed from tmask 11 10 !! 8.0 ! 1997-02 (G. Madec) mesh information put in domhgr.F 12 11 !! 8.1 ! 1997-07 (G. Madec) modification of mbathy and fmask … … 25 24 USE oce ! ocean dynamics and tracers 26 25 USE dom_oce ! ocean space and time domain 26 ! 27 27 USE in_out_manager ! I/O manager 28 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 29 USE lib_mpp 30 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 29 USE lib_mpp ! 31 30 USE wrk_nemo ! Memory allocation 32 31 USE timing ! Timing … … 35 34 PRIVATE 36 35 37 PUBLIC dom_msk 36 PUBLIC dom_msk ! routine called by inidom.F90 38 37 39 38 ! !!* Namelist namlbc : lateral boundary condition * … … 90 89 !! 91 90 !! N.B. If nperio not equal to 0, the land/ocean mask arrays 92 !! are defined with the proper value at lateral domain boundaries, 93 !! but bmask. indeed, bmask defined the domain over which the 94 !! barotropic stream function is computed. this domain cannot 95 !! contain identical columns because the matrix associated with 96 !! the barotropic stream function equation is then no more inverti- 97 !! ble. therefore bmask is set to 0 along lateral domain boundaries 98 !! even IF nperio is not zero. 91 !! are defined with the proper value at lateral domain boundaries. 99 92 !! 100 93 !! In case of open boundaries (lk_bdy=T): 101 94 !! - tmask is set to 1 on the points to be computed bay the open 102 95 !! boundaries routines. 103 !! - bmask is set to 0 on the open boundaries.104 96 !! 105 97 !! ** Action : tmask : land/ocean mask at t-point (=0. or 1.) … … 108 100 !! fmask : land/ocean mask at f-point (=0. or 1.) 109 101 !! =rn_shlat along lateral boundaries 110 !! bmask : land/ocean mask at barotropic stream111 !! function point (=0. or 1.) and set to 0 along lateral boundaries112 102 !! tmask_i : interior ocean mask 113 103 !!---------------------------------------------------------------------- … … 255 245 END DO 256 246 257 ! 4. ocean/land mask for the elliptic equation258 ! --------------------------------------------259 bmask(:,:) = ssmask(:,:) ! elliptic equation is written at t-point260 !261 ! ! Boundary conditions262 ! ! cyclic east-west : bmask must be set to 0. on rows 1 and jpi263 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN264 bmask( 1 ,:) = 0._wp265 bmask(jpi,:) = 0._wp266 ENDIF267 IF( nperio == 2 ) THEN ! south symmetric : bmask must be set to 0. on row 1268 bmask(:, 1 ) = 0._wp269 ENDIF270 ! ! north fold :271 IF( nperio == 3 .OR. nperio == 4 ) THEN ! T-pt pivot : bmask set to 0. on row jpj and on half jpjglo-1 row272 DO ji = 1, jpi273 ii = ji + nimpp - 1274 bmask(ji,jpj-1) = bmask(ji,jpj-1) * tpol(ii)275 bmask(ji,jpj ) = 0._wp276 END DO277 ENDIF278 IF( nperio == 5 .OR. nperio == 6 ) THEN ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj279 bmask(:,jpj) = 0._wp280 ENDIF281 !282 IF( lk_mpp ) THEN ! mpp specificities283 ! ! bmask is set to zero on the overlap region284 IF( nbondi /= -1 .AND. nbondi /= 2 ) bmask( 1 :jpreci,:) = 0._wp285 IF( nbondi /= 1 .AND. nbondi /= 2 ) bmask(nlci:jpi ,:) = 0._wp286 IF( nbondj /= -1 .AND. nbondj /= 2 ) bmask(:, 1 :jprecj) = 0._wp287 IF( nbondj /= 1 .AND. nbondj /= 2 ) bmask(:,nlcj:jpj ) = 0._wp288 !289 IF( npolj == 3 .OR. npolj == 4 ) THEN ! north fold : bmask must be set to 0. on rows jpj-1 and jpj290 DO ji = 1, nlci291 ii = ji + nimpp - 1292 bmask(ji,nlcj-1) = bmask(ji,nlcj-1) * tpol(ii)293 bmask(ji,nlcj ) = 0._wp294 END DO295 ENDIF296 IF( npolj == 5 .OR. npolj == 6 ) THEN ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj297 DO ji = 1, nlci298 bmask(ji,nlcj ) = 0._wp299 END DO300 ENDIF301 ENDIF302 303 247 ! Lateral boundary conditions on velocity (modify fmask) 304 248 ! --------------------------------------- -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r5883 r6004 64 64 # include "vectopt_loop_substitute.h90" 65 65 !!---------------------------------------------------------------------- 66 !! NEMO/OPA 3. 3 , NEMO-Consortium (2010)66 !! NEMO/OPA 3.7 , NEMO-Consortium (2015) 67 67 !! $Id$ 68 68 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 120 120 !!---------------------------------------------------------------------- 121 121 ! 122 IF( nn_timing == 1 ) CALL timing_start('dom_vvl_init')122 IF( nn_timing == 1 ) CALL timing_start('dom_vvl_init') 123 123 ! 124 124 IF(lwp) WRITE(numout,*) … … 270 270 INTEGER, INTENT( in ), OPTIONAL :: kcall ! optional argument indicating call sequence 271 271 ! 272 INTEGER :: ji, jj, jk ! dummy loop indices 273 INTEGER , DIMENSION(3) :: ijk_max, ijk_min ! temporary integers 274 REAL(wp) :: z2dt ! temporary scalars 275 REAL(wp) :: z_tmin, z_tmax ! temporary scalars 276 LOGICAL :: ll_do_bclinic ! temporary logical 277 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3t 278 REAL(wp), POINTER, DIMENSION(:,: ) :: zht, z_scale, zwu, zwv, zhdiv 272 INTEGER :: ji, jj, jk ! dummy loop indices 273 INTEGER , DIMENSION(3) :: ijk_max, ijk_min ! temporary integers 274 REAL(wp) :: z2dt, z_tmin, z_tmax ! local scalars 275 LOGICAL :: ll_do_bclinic ! local logical 276 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3t 277 REAL(wp), POINTER, DIMENSION(:,: ) :: zht, z_scale, zwu, zwv, zhdiv 279 278 !!---------------------------------------------------------------------- 280 279 ! 281 280 IF( ln_linssh ) RETURN ! No calculation in linear free surface 282 281 ! 283 IF( nn_timing == 1 ) CALL timing_start('dom_vvl_sf_nxt')282 IF( nn_timing == 1 ) CALL timing_start('dom_vvl_sf_nxt') 284 283 ! 285 284 CALL wrk_alloc( jpi,jpj,zht, z_scale, zwu, zwv, zhdiv ) 286 285 CALL wrk_alloc( jpi,jpj,jpk, ze3t ) 287 286 288 IF( kt == nit000)THEN287 IF( kt == nit000 ) THEN 289 288 IF(lwp) WRITE(numout,*) 290 289 IF(lwp) WRITE(numout,*) 'dom_vvl_sf_nxt : compute after scale factors' … … 312 311 IF( ln_vvl_ztilde .OR. ln_vvl_layer .AND. ll_do_bclinic ) THEN ! z_tilde or layer coordinate ! 313 312 ! ! ------baroclinic part------ ! 314 315 313 ! I - initialization 316 314 ! ================== … … 638 636 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 639 637 gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 640 gdept_n(ji,jj,jk) = zcoef * ( gdepw_n(ji,jj,jk ) + 0.5 * e3w_n(ji,jj,jk)) &641 & + (1-zcoef) * ( gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk))638 gdept_n(ji,jj,jk) = zcoef * ( gdepw_n(ji,jj,jk ) + 0.5 * e3w_n(ji,jj,jk) ) & 639 & + (1-zcoef) * ( gdept_n(ji,jj,jk-1) + e3w_n(ji,jj,jk) ) 642 640 gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - sshn(ji,jj) 643 641 END DO -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r5866 r6004 158 158 ! 159 159 IF( nprint == 1 .AND. lwp ) THEN 160 WRITE(numout,*) ' MIN val mbathy ', MINVAL(mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) )160 WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) 161 161 WRITE(numout,*) ' MIN val depth t ', MINVAL( gdept_0(:,:,:) ), & 162 & ' w ',MINVAL( gdepw_0(:,:,:) ), '3w ', MINVAL( gde3w_0(:,:,:) )163 WRITE(numout,*) ' MIN val e3 t ', MINVAL( e3t_0(:,:,:) ), ' f ', MINVAL(e3f_0(:,:,:) ), &164 & ' u ', MINVAL( e3u_0(:,:,:) ), ' u ', MINVAL(e3v_0(:,:,:) ), &165 & ' uw', MINVAL( e3uw_0(:,:,:)), ' vw', MINVAL(e3vw_0(:,:,:)), &166 & ' w ', MINVAL(e3w_0(:,:,:) )162 & ' w ', MINVAL( gdepw_0(:,:,:) ), '3w ', MINVAL( gde3w_0(:,:,:) ) 163 WRITE(numout,*) ' MIN val e3 t ', MINVAL( e3t_0(:,:,:) ), ' f ', MINVAL( e3f_0(:,:,:) ), & 164 & ' u ', MINVAL( e3u_0(:,:,:) ), ' u ', MINVAL( e3v_0(:,:,:) ), & 165 & ' uw', MINVAL( e3uw_0(:,:,:) ), ' vw', MINVAL( e3vw_0(:,:,:)), & 166 & ' w ', MINVAL( e3w_0(:,:,:) ) 167 167 168 168 WRITE(numout,*) ' MAX val depth t ', MAXVAL( gdept_0(:,:,:) ), & 169 & ' w ',MAXVAL( gdepw_0(:,:,:) ), '3w ', MAXVAL( gde3w_0(:,:,:) )170 WRITE(numout,*) ' MAX val e3 t ', MAXVAL( e3t_0(:,:,:) ), ' f ', MAXVAL(e3f_0(:,:,:) ), &171 & ' u ', MAXVAL( e3u_0(:,:,:) ), ' u ', MAXVAL(e3v_0(:,:,:) ), &172 & ' uw', MAXVAL( e3uw_0(:,:,:)), ' vw', MAXVAL( e3vw_0(:,:,:)),&173 & ' w ', MAXVAL(e3w_0(:,:,:) )169 & ' w ', MAXVAL( gdepw_0(:,:,:) ), '3w ', MAXVAL( gde3w_0(:,:,:) ) 170 WRITE(numout,*) ' MAX val e3 t ', MAXVAL( e3t_0(:,:,:) ), ' f ', MAXVAL( e3f_0(:,:,:) ), & 171 & ' u ', MAXVAL( e3u_0(:,:,:) ), ' u ', MAXVAL( e3v_0(:,:,:) ), & 172 & ' uw', MAXVAL( e3uw_0(:,:,:) ), ' vw', MAXVAL( e3vw_0(:,:,:) ), & 173 & ' w ', MAXVAL( e3w_0(:,:,:) ) 174 174 ENDIF 175 175 ! … … 910 910 !! 911 911 !! ** Purpose : the depth and vertical scale factor in partial step 912 !! reference z-coordinate case912 !! reference z-coordinate case 913 913 !! 914 914 !! ** Method : Partial steps : computes the 3D vertical scale factors … … 1180 1180 ! Compute gde3w_0 (vertical sum of e3w) 1181 1181 IF ( ln_isfcav ) THEN ! if cavity 1182 WHERE (misfdep == 0)misfdep = 11182 WHERE( misfdep == 0 ) misfdep = 1 1183 1183 DO jj = 1,jpj 1184 1184 DO ji = 1,jpi … … 1187 1187 gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) 1188 1188 END DO 1189 IF (misfdep(ji,jj) .GE. 2)gde3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj))1189 IF( misfdep(ji,jj) >= 2 ) gde3w_0(ji,jj,misfdep(ji,jj)) = risfdep(ji,jj) + 0.5_wp * e3w_0(ji,jj,misfdep(ji,jj)) 1190 1190 DO jk = misfdep(ji,jj) + 1, jpk 1191 1191 gde3w_0(ji,jj,jk) = gde3w_0(ji,jj,jk-1) + e3w_0(ji,jj,jk) … … 1235 1235 !!--------------------------------------------------------------------- 1236 1236 ! 1237 IF( nn_timing == 1 ) CALL timing_start('zgr_isf')1237 IF( nn_timing == 1 ) CALL timing_start('zgr_isf') 1238 1238 ! 1239 1239 CALL wrk_alloc( jpi,jpj, zbathy, zmask, zrisfdep) … … 1707 1707 CALL wrk_dealloc( jpi, jpj, zmisfdep, zmbathy ) 1708 1708 ! 1709 IF( nn_timing == 1 ) CALL timing_stop('zgr_isf')1709 IF( nn_timing == 1 ) CALL timing_stop('zgr_isf') 1710 1710 ! 1711 1711 END SUBROUTINE … … 2029 2029 CALL lbc_lnk( e3uw_0, 'U', 1._wp ) 2030 2030 CALL lbc_lnk( e3vw_0, 'V', 1._wp ) 2031 2032 gdepw_n(:,:,:) = gdepw_0(:,:,:)2033 2031 ! 2034 2032 WHERE( e3t_0 (:,:,:) == 0._wp ) e3t_0 (:,:,:) = 1._wp … … 2562 2560 ! 2563 2561 zn1 = 1._wp / REAL( jpkm1, wp ) 2564 zn2 = 1. - zn12562 zn2 = 1._wp - zn1 2565 2563 ! 2566 2564 za1 = (rn_alpha+2.0_wp)*zn1**(rn_alpha+1.0_wp)-(rn_alpha+1.0_wp)*zn1**(rn_alpha+2.0_wp) -
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r5883 r6004 35 35 USE dtauvd ! data: U & V current (dta_uvd routine) 36 36 USE domvvl ! varying vertical mesh 37 USE dynspg_oce ! pressure gradient schemes38 USE dynspg_flt ! filtered free surface39 USE sol_oce ! ocean solver variables40 37 ! 41 38 USE in_out_manager ! I/O manager … … 133 130 ! 134 131 ENDIF 135 !136 IF( lk_agrif ) THEN ! read free surface arrays in restart file137 IF( ln_rstart ) THEN138 IF( lk_dynspg_flt ) THEN ! read or initialize the following fields139 ! ! gcx, gcxb for agrif_opa_init140 IF( sol_oce_alloc() > 0 ) CALL ctl_stop('agrif sol_oce_alloc: allocation of arrays failed')141 CALL flt_rst( nit000, 'READ' )142 ENDIF143 ENDIF ! explicit case not coded yet with AGRIF144 ENDIF145 !146 132 ! 147 133 ! Initialize "now" and "before" barotropic velocities: 148 ! Do it whatever the free surface method, these arrays 149 ! being eventually used 150 ! 134 ! Do it whatever the free surface method, these arrays being eventually used 151 135 ! 152 136 un_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp 153 137 ub_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp 154 138 ! 139 !!gm the use of umsak & vmask is not necessary belox as un, vn, ub, vb are always masked 155 140 DO jk = 1, jpkm1 156 141 DO jj = 1, jpj … … 165 150 END DO 166 151 ! 167 un_b(:,:) = un_b(:,:) * r1_hu_n 168 vn_b(:,:) = vn_b(:,:) * r1_hv_n 152 un_b(:,:) = un_b(:,:) * r1_hu_n(:,:) 153 vn_b(:,:) = vn_b(:,:) * r1_hv_n(:,:) 169 154 ! 170 155 ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 171 156 vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 172 !173 157 ! 174 158 IF( nn_timing == 1 ) CALL timing_stop('istate_init') … … 438 422 !! p=integral [ rau*g dz ] 439 423 !!---------------------------------------------------------------------- 440 USE dynspg ! surface pressure gradient (dyn_spg routine)441 424 USE divhor ! hor. divergence (div_hor routine) 442 425 USE lbclnk ! ocean lateral boundary condition (or mpp link) 443 426 ! 444 427 INTEGER :: ji, jj, jk ! dummy loop indices 445 INTEGER :: indic ! ???446 428 REAL(wp) :: zmsv, zphv, zmsu, zphu, zalfg ! temporary scalars 447 429 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprn … … 510 492 vb(:,:,:) = vn(:,:,:) 511 493 512 ! WARNING !!!!!513 ! after initializing u and v, we need to calculate the initial streamfunction bsf.514 ! Otherwise, only the trend will be computed and the model will blow up (inconsistency).515 ! to do that, we call dyn_spg with a special trick:516 ! we fill ua and va with the velocities divided by dt, and the streamfunction will be brought to the517 ! right value assuming the velocities have been set up in one time step.518 ! we then set bsfd to zero (first guess for next step is d(psi)/dt = 0.)519 ! sets up s false trend to calculate the barotropic streamfunction.520 521 ua(:,:,:) = ub(:,:,:) / rdt522 va(:,:,:) = vb(:,:,:) / rdt523 524 ! calls dyn_spg. we assume euler time step, starting from rest.525 indic = 0526 CALL dyn_spg( nit000, indic ) ! surface pressure gradient527 !528 ! the new velocity is ua*rdt529 !530 CALL lbc_lnk( ua, 'U', -1. )531 CALL lbc_lnk( va, 'V', -1. )532 533 ub(:,:,:) = ua(:,:,:) * rdt534 vb(:,:,:) = va(:,:,:) * rdt535 ua(:,:,:) = 0.e0536 va(:,:,:) = 0.e0537 un(:,:,:) = ub(:,:,:)538 vn(:,:,:) = vb(:,:,:)539 494 ! 540 495 !!gm Check here call to div_hor should not be necessary
Note: See TracChangeset
for help on using the changeset viewer.