Changeset 4370 for branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC
- Timestamp:
- 2014-01-23T18:13:16+01:00 (10 years ago)
- Location:
- branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90
r4354 r4370 61 61 !! 62 62 REAL(wp), POINTER, DIMENSION(:,:) :: pua2d, pva2d ! after barotropic velocities 63 REAL(wp), POINTER, DIMENSION(:,:) :: phura, phvra ! after inverse depth at u and v points64 63 65 64 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn') … … 82 81 !------------------------------------------------------- 83 82 84 CALL wrk_alloc(jpi,jpj,pua2d,pva2d ,phura,phvra)83 CALL wrk_alloc(jpi,jpj,pua2d,pva2d) 85 84 86 85 !------------------------------------------------------- … … 91 90 92 91 pua2d(:,:) = 0.e0 93 pva2d(:,:) = 0.e0 94 95 IF (lk_vvl) THEN 96 phura(:,:) = 0. 97 phvra(:,:) = 0. 98 DO jk = 1, jpkm1 99 phura(:,:) = phura(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) 100 phvra(:,:) = phvra(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) 101 pua2d(:,:) = pua2d(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 102 pva2d(:,:) = pva2d(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 103 END DO 104 phura(:,:) = umask(:,:,1) / ( phura(:,:) + 1. - umask(:,:,1) ) 105 phvra(:,:) = vmask(:,:,1) / ( phvra(:,:) + 1. - vmask(:,:,1) ) 106 ELSE 107 phura(:,:) = hur(:,:) 108 phvra(:,:) = hvr(:,:) 109 DO jk = 1, jpkm1 110 pua2d(:,:) = pua2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 111 pva2d(:,:) = pva2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 112 END DO 113 ENDIF 114 pua2d(:,:) = pua2d(:,:) * phura(:,:) 115 pva2d(:,:) = pva2d(:,:) * phvra(:,:) 92 pva2d(:,:) = 0.e0 93 DO jk = 1, jpkm1 94 pua2d(:,:) = pua2d(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 95 pva2d(:,:) = pva2d(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 96 END DO 97 98 pua2d(:,:) = pua2d(:,:) * hur_a(:,:) 99 pva2d(:,:) = pva2d(:,:) * hvr_a(:,:) 116 100 117 101 DO jk = 1 , jpkm1 … … 134 118 !------------------------------------------------------- 135 119 136 IF( ll_dyn2d ) CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, phura, phvra, ssha )120 IF( ll_dyn2d ) CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, hur_a(:,:), hvr_a(:,:), ssha ) 137 121 138 122 IF( ll_dyn3d ) CALL bdy_dyn3d( kt ) … … 154 138 END IF 155 139 156 CALL wrk_dealloc(jpi,jpj,pua2d,pva2d ,phura,phvra)140 CALL wrk_dealloc(jpi,jpj,pua2d,pva2d) 157 141 158 142 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn') -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r4292 r4370 41 41 REAL(wp), PUBLIC :: rn_rdtmax !: maximum time step on tracers 42 42 REAL(wp), PUBLIC :: rn_rdth !: depth variation of tracer step 43 INTEGER , PUBLIC :: nn_baro !: number of barotropic time steps (key_dynspg_ts)44 43 INTEGER , PUBLIC :: nn_closea !: =0 suppress closed sea/lake from the ORCA domain or not (=1) 44 INTEGER , PUBLIC :: nn_euler !: =0 start with forward time step or not (=1) 45 45 LOGICAL , PUBLIC :: ln_crs !: Apply grid coarsening to dynamical model output or online passive tracers 46 47 !! Time splitting parameters 48 !! ========================= 49 LOGICAL, PUBLIC :: ln_bt_fw !: Forward integration of barotropic sub-stepping 50 LOGICAL, PUBLIC :: ln_bt_av !: Time averaging of barotropic variables 51 LOGICAL, PUBLIC :: ln_bt_nn_auto !: Set number of barotropic iterations automatically 52 INTEGER, PUBLIC :: nn_bt_flt !: Filter choice 53 INTEGER, PUBLIC :: nn_baro !: Number of barotropic iterations during one baroclinic step (rdt) 54 REAL(wp), PUBLIC :: rn_bt_cmax !: Maximum allowed courant number (used if ln_bt_nn_auto=T) 46 55 47 56 !! Horizontal grid parameters for domhgr … … 93 102 94 103 ! !!! associated variables 95 INTEGER , PUBLIC :: neuler = 0!: restart euler forward option (0=Euler)104 INTEGER , PUBLIC :: neuler !: restart euler forward option (0=Euler) 96 105 REAL(wp), PUBLIC :: atfp1 !: asselin time filter coeff. (atfp1= 1-2*atfp) 97 106 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdttra !: vertical profile of tracer time step … … 194 203 LOGICAL, PUBLIC, PARAMETER :: lk_vvl = .FALSE. !: fixed grid flag 195 204 #endif 196 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: hur , hvr !: inverse of u and v-points ocean depth (1/m) 197 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu , hv !: depth at u- and v-points (meters) 198 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_0 !: reference depth at t- points (meters) 199 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0 , hv_0 !: reference depth at u- and v-points (meters) 200 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: re2u_e1u !: scale factor coeffs at u points (e2u/e1u) 201 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: re1v_e2v !: scale factor coeffs at v points (e1v/e2v) 202 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e12t , r1_e12t !: horizontal cell surface and inverse at t points 203 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e12u , r1_e12u !: horizontal cell surface and inverse at u points 204 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e12v , r1_e12v !: horizontal cell surface and inverse at v points 205 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e12f , r1_e12f !: horizontal cell surface and inverse at f points 205 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hur , hvr !: Now inverse of u and v-points ocean depth (1/m) 206 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu , hv !: depth at u- and v-points (meters) 207 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht !: depth at t-points (meters) 208 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ehur_a, ehvr_a !: After inverse of u and v-points ocean depth (1/m) 209 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ehu_a , ehv_a !: depth at u- and v-points (meters) 210 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ehur_b, ehvr_b !: Before inverse of u and v-points ocean depth (1/m) 211 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ehu_b , ehv_b !: depth at u- and v-points (meters) 212 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_0 !: reference depth at t- points (meters) 213 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0 , hv_0 !: reference depth at u- and v-points (meters) 214 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: re2u_e1u !: scale factor coeffs at u points (e2u/e1u) 215 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: re1v_e2v !: scale factor coeffs at v points (e1v/e2v) 216 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e12t , r1_e12t !: horizontal cell surface and inverse at t points 217 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e12u , r1_e12u !: horizontal cell surface and inverse at u points 218 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e12v , r1_e12v !: horizontal cell surface and inverse at v points 219 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e12f , r1_e12f !: horizontal cell surface and inverse at f points 206 220 207 221 INTEGER, PUBLIC :: nla10 !: deepest W level Above ~10m (nlb10 - 1) … … 336 350 & e3t_b (jpi,jpj,jpk) , e3u_b (jpi,jpj,jpk) , e3v_b (jpi,jpj,jpk) , & 337 351 & e3uw_b (jpi,jpj,jpk) , e3vw_b(jpi,jpj,jpk) , & 338 & e3t_a (jpi,jpj,jpk) , e3u_a (jpi,jpj,jpk) , e3v_a (jpi,jpj,jpk) , STAT=ierr(5) ) 352 & e3t_a (jpi,jpj,jpk) , e3u_a (jpi,jpj,jpk) , e3v_a (jpi,jpj,jpk), & 353 & ehu_a (jpi,jpj) , ehv_a (jpi,jpj), & 354 & ehur_a (jpi,jpj) , ehvr_a (jpi,jpj), & 355 & ehu_b (jpi,jpj) , ehv_b (jpi,jpj), & 356 & ehur_b (jpi,jpj) , ehvr_b (jpi,jpj), STAT=ierr(5) ) 339 357 #endif 340 358 ! 341 359 ALLOCATE( hu (jpi,jpj) , hur (jpi,jpj) , hu_0(jpi,jpj) , ht_0 (jpi,jpj) , & 342 & hv (jpi,jpj) , hvr (jpi,jpj) , hv_0(jpi,jpj) , 360 & hv (jpi,jpj) , hvr (jpi,jpj) , hv_0(jpi,jpj) , ht (jpi,jpj) , & 343 361 & re2u_e1u(jpi,jpj) , re1v_e2v(jpi,jpj) , & 344 362 & e12t (jpi,jpj) , r1_e12t (jpi,jpj) , & … … 375 393 !!====================================================================== 376 394 END MODULE dom_oce 395 -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r4366 r4370 91 91 IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point 92 92 ! 93 hu(:,:) = 0._wp ! Ocean depth at U- and V-points 94 hv(:,:) = 0._wp 95 DO jk = 1, jpk 93 ! 94 hu(:,:) = 0._wp ! Ocean depth at U-points 95 hv(:,:) = 0._wp ! Ocean depth at V-points 96 ht(:,:) = 0._wp ! Ocean depth at T-points 97 DO jk = 1, jpkm1 96 98 hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 97 99 hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 100 ht(:,:) = ht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 98 101 END DO 99 102 ! ! Inverse of the local depth … … 124 127 NAMELIST/namrun/ nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl, & 125 128 & nn_it000, nn_itend , nn_date0 , nn_leapy , nn_istate , nn_stock , & 126 & nn_write, ln_dimgnnn, ln_mskland , ln_clobber , nn_chunksz 129 & nn_write, ln_dimgnnn, ln_mskland , ln_clobber , nn_chunksz, nn_euler 127 130 NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin, & 128 131 & nn_acc , rn_atfp , rn_rdt , rn_rdtmin , & 129 & rn_rdtmax, rn_rdth , nn_ baro , nn_closea , ln_crs, &132 & rn_rdtmax, rn_rdth , nn_closea , ln_crs, & 130 133 & jphgr_msh, & 131 134 & ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, & … … 158 161 WRITE(numout,*) ' file prefix restart output cn_ocerst_out= ', cn_ocerst_out 159 162 WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart 163 WRITE(numout,*) ' start with forward time step nn_euler = ', nn_euler 160 164 WRITE(numout,*) ' control of time step nn_rstctl = ', nn_rstctl 161 165 WRITE(numout,*) ' number of the first time step nn_it000 = ', nn_it000 … … 182 186 nstock = nn_stock 183 187 nwrite = nn_write 184 188 neuler = nn_euler 189 IF ( neuler == 1 .AND. .NOT.ln_rstart ) THEN 190 WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 ' 191 CALL ctl_warn( ctmp1 ) 192 neuler = 0 193 ENDIF 185 194 186 195 ! ! control of output frequency … … 240 249 WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt 241 250 WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp 242 WRITE(numout,*) ' time-splitting: nb of sub time-step nn_baro = ', nn_baro243 251 WRITE(numout,*) ' acceleration of converge nn_acc = ', nn_acc 244 252 WRITE(numout,*) ' nn_acc=1: surface tracer rdt rn_rdtmin = ', rn_rdtmin … … 447 455 !!====================================================================== 448 456 END MODULE domain 449 -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r4366 r4370 182 182 END DO 183 183 184 ! Before depth and Inverse of the local depth of the water column at u- and v- points 185 ! ----------------------------------------------------------------------------------- 186 hu_b(:,:) = 0. 187 hv_b(:,:) = 0. 188 DO jk = 1, jpkm1 189 hu_b(:,:) = hu_b(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) 190 hv_b(:,:) = hv_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) 191 END DO 192 hur_b(:,:) = umask(:,:,1) / ( hu_b(:,:) + 1. - umask(:,:,1) ) 193 hvr_b(:,:) = vmask(:,:,1) / ( hv_b(:,:) + 1. - vmask(:,:,1) ) 194 184 195 ! Restoring frequencies for z_tilde coordinate 185 196 ! ============================================ … … 514 525 CALL dom_vvl_interpol( fse3t_a(:,:,:), fse3v_a(:,:,:), 'V' ) 515 526 527 ! *********************************** ! 528 ! After depths at u- v points ! 529 ! *********************************** ! 530 531 hu_a(:,:) = 0._wp ! Ocean depth at U-points 532 hv_a(:,:) = 0._wp ! Ocean depth at V-points 533 DO jk = 1, jpkm1 534 hu_a(:,:) = hu_a(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) 535 hv_a(:,:) = hv_a(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) 536 END DO 537 ! ! Inverse of the local depth 538 hur_a(:,:) = 1._wp / ( hu_a(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1) 539 hvr_a(:,:) = 1._wp / ( hv_a(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1) 540 516 541 CALL wrk_dealloc( jpi, jpj, zht, z_scale, zwu, zwv, zhdiv ) 517 542 CALL wrk_dealloc( jpi, jpj, jpk, ze3t ) … … 584 609 ! -------------------------------------- 585 610 ! - ML - fse3u_b and fse3v_b are allready computed in dynnxt 611 ! - JC - hu_b, hv_b, hur_b, hvr_b also 586 612 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n (:,:,:), 'F' ) 587 613 ! Vertical scale factor interpolations … … 604 630 ! Local depth and Inverse of the local depth of the water column at u- and v- points 605 631 ! ---------------------------------------------------------------------------------- 606 hu(:,:) = 0. 607 hv(:,:) = 0. 608 DO jk = 1, jpk 609 hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 610 hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 632 hu (:,:) = hu_a (:,:) 633 hv (:,:) = hv_a (:,:) 634 635 ! Inverse of the local depth 636 hur(:,:) = hur_a(:,:) 637 hvr(:,:) = hvr_a(:,:) 638 639 ! Local depth of the water column at t- points 640 ! -------------------------------------------- 641 ht(:,:) = 0. 642 DO jk = 1, jpkm1 643 ht(:,:) = ht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 611 644 END DO 612 ! Inverse of the local depth613 hur(:,:) = umask(:,:,1) / ( hu(:,:) + 1. - umask(:,:,1) )614 hvr(:,:) = vmask(:,:,1) / ( hv(:,:) + 1. - vmask(:,:,1) )615 645 616 646 ! Write outputs … … 1322 1352 !!====================================================================== 1323 1353 END MODULE domvvl 1354 1355 1356 -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr_substitute.h90
r4292 r4370 34 34 35 35 # define fse3t_m(i,j) e3t_m(i,j) 36 37 # define hu_a(i,j) ehu_a(i,j) 38 # define hur_a(i,j) ehur_a(i,j) 39 # define hv_a(i,j) ehv_a(i,j) 40 # define hvr_a(i,j) ehvr_a(i,j) 41 # define hu_b(i,j) ehu_b(i,j) 42 # define hur_b(i,j) ehur_b(i,j) 43 # define hv_b(i,j) ehv_b(i,j) 44 # define hvr_b(i,j) ehvr_b(i,j) 36 45 37 46 ! This part should be removed one day ... … … 75 84 # define fse3t_m(i,j) e3t_0(i,j,1) 76 85 86 # define hu_a(i,j) hu(i,j) 87 # define hur_a(i,j) hur(i,j) 88 # define hv_a(i,j) hv(i,j) 89 # define hvr_a(i,j) hvr(i,j) 90 # define hu_b(i,j) hu(i,j) 91 # define hur_b(i,j) hur(i,j) 92 # define hv_b(i,j) hv(i,j) 93 # define hvr_b(i,j) hvr(i,j) 94 77 95 ! This part should be removed one day ... 78 96 ! ... In that case all occurence of the above statement functions -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r4354 r4370 40 40 USE domvvl ! varying vertical mesh 41 41 USE dynspg_oce ! pressure gradient schemes 42 USE dynspg_flt ! pressure gradient schemes 43 USE dynspg_exp ! pressure gradient schemes 44 USE dynspg_ts ! pressure gradient schemes 42 USE dynspg_flt ! filtered free surface 45 43 USE sol_oce ! ocean solver variables 46 44 USE lib_mpp ! MPP library … … 72 70 ! - ML - needed for initialization of e3t_b 73 71 INTEGER :: ji,jj,jk ! dummy loop indices 74 REAL(wp), POINTER, DIMENSION(:,:) :: zhur_b, zhvr_b ! U & Inverse of before depths75 72 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zuvd ! U & V data workspace 76 73 !!---------------------------------------------------------------------- … … 93 90 IF( ln_rstart ) THEN ! Restart from a file 94 91 ! ! ------------------- 95 neuler = 1 ! Set time-step indicator at nit000 (leap-frog)96 92 CALL rst_read ! Read the restart file 97 93 CALL day_init ! model calendar (using both namelist and restart infos) … … 161 157 ! being eventually used 162 158 ! 163 IF (lk_vvl) THEN164 CALL wrk_alloc( jpi, jpj, zhur_b, zhvr_b )165 zhur_b(:,:) = 0._wp166 zhvr_b(:,:) = 0._wp167 DO jk = 1, jpk168 zhur_b(:,:) = zhur_b(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk)169 zhvr_b(:,:) = zhvr_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk)170 END DO171 zhur_b(:,:) = umask(:,:,1) / ( zhur_b(:,:) + 1._wp - umask(:,:,1) )172 zhvr_b(:,:) = vmask(:,:,1) / ( zhvr_b(:,:) + 1._wp - vmask(:,:,1) )173 ENDIF174 159 ! 175 160 un_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp … … 187 172 vn_b(ji,jj) = vn_b(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 188 173 ! 189 ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) 190 vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) 174 ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 175 vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 191 176 END DO 192 177 END DO 193 178 END DO 194 179 ! 195 un_b(:,:) = un_b(:,:) * hur(:,:) 196 vn_b(:,:) = vn_b(:,:) * hvr(:,:) 197 ! 198 IF( lk_vvl ) THEN 199 ub_b(:,:) = ub_b(:,:) * zhur_b(:,:) 200 vb_b(:,:) = vb_b(:,:) * zhvr_b(:,:) 201 ELSE 202 ub_b(:,:) = ub_b(:,:) * hur(:,:) 203 vb_b(:,:) = vb_b(:,:) * hvr(:,:) 204 ENDIF 205 ! 206 IF (lk_vvl) CALL wrk_dealloc( jpi, jpj, zhur_b, zhvr_b ) 180 un_b(:,:) = un_b(:,:) * hur (:,:) 181 vn_b(:,:) = vn_b(:,:) * hvr (:,:) 182 ! 183 ub_b(:,:) = ub_b(:,:) * hur_b(:,:) 184 vb_b(:,:) = vb_b(:,:) * hvr_b(:,:) 185 ! 207 186 ! 208 187 IF( nn_timing == 1 ) CALL timing_stop('istate_init') -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r4354 r4370 39 39 USE wrk_nemo ! Memory Allocation 40 40 USE prtctl ! Print control 41 USE dynspg_ts ! Barotropic velocities42 41 43 42 #if defined key_agrif … … 102 101 REAL(wp) :: zue3a, zue3n, zue3b, zuf, zec ! local scalars 103 102 REAL(wp) :: zve3a, zve3n, zve3b, zvf ! - - 104 REAL(wp), POINTER, DIMENSION(:,:) :: zua, zva , zhura, zhvra, zhurb, zhvrb103 REAL(wp), POINTER, DIMENSION(:,:) :: zua, zva 105 104 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3u_f, ze3v_f 106 105 !!---------------------------------------------------------------------- … … 109 108 ! 110 109 CALL wrk_alloc( jpi,jpj,jpk, ze3u_f, ze3v_f ) 111 IF ( lk_dynspg_ts ) CALL wrk_alloc( jpi,jpj, zua, zva , zhura, zhvra)110 IF ( lk_dynspg_ts ) CALL wrk_alloc( jpi,jpj, zua, zva ) 112 111 ! 113 112 IF( kt == nit000 ) THEN … … 157 156 zua(:,:) = 0._wp 158 157 zva(:,:) = 0._wp 159 IF (lk_vvl) THEN 160 zhura(:,:) = 0._wp 161 zhvra(:,:) = 0._wp 162 DO jk = 1, jpkm1 163 zua(:,:) = zua(:,:) + fse3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 164 zva(:,:) = zva(:,:) + fse3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 165 zhura(:,:) = zhura(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) 166 zhvra(:,:) = zhvra(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) 167 END DO 168 zhura(:,:) = umask(:,:,1) / ( zhura(:,:) + 1._wp - umask(:,:,1) ) 169 zhvra(:,:) = vmask(:,:,1) / ( zhvra(:,:) + 1._wp - vmask(:,:,1) ) 170 DO jk = 1, jpkm1 171 ua(:,:,jk) = ( ua(:,:,jk) - zua(:,:) * zhura(:,:) + ua_b(:,:) ) * umask(:,:,jk) 172 va(:,:,jk) = ( va(:,:,jk) - zva(:,:) * zhvra(:,:) + va_b(:,:) ) * vmask(:,:,jk) 173 END DO 174 ELSE 175 DO jk = 1, jpkm1 176 zua(:,:) = zua(:,:) + fse3u(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 177 zva(:,:) = zva(:,:) + fse3v(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 178 END DO 179 DO jk = 1, jpkm1 180 ua(:,:,jk) = ( ua(:,:,jk) - zua(:,:) * hur(:,:) + ua_b(:,:) ) *umask(:,:,jk) 181 va(:,:,jk) = ( va(:,:,jk) - zva(:,:) * hvr(:,:) + va_b(:,:) ) *vmask(:,:,jk) 182 END DO 183 ENDIF 158 DO jk = 1, jpkm1 159 zua(:,:) = zua(:,:) + fse3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 160 zva(:,:) = zva(:,:) + fse3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 161 END DO 162 DO jk = 1, jpkm1 163 ua(:,:,jk) = ( ua(:,:,jk) - zua(:,:) * hur_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 164 va(:,:,jk) = ( va(:,:,jk) - zva(:,:) * hvr_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 165 END DO 184 166 185 167 IF (lk_dynspg_ts.AND.(.NOT.ln_bt_fw)) THEN … … 321 303 zua(:,:) = 0._wp 322 304 zva(:,:) = 0._wp 323 IF (lk_vvl) THEN 324 DO jk = 1, jpkm1 325 zua(:,:) = zua(:,:) + fse3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 326 zva(:,:) = zva(:,:) + fse3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 327 END DO 328 ELSE 329 DO jk = 1, jpkm1 330 zua(:,:) = zua(:,:) + fse3u(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 331 zva(:,:) = zva(:,:) + fse3v(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 332 END DO 333 ENDIF 305 DO jk = 1, jpkm1 306 zua(:,:) = zua(:,:) + fse3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 307 zva(:,:) = zva(:,:) + fse3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 308 END DO 334 309 DO jk = 1, jpkm1 335 310 ub(:,:,jk) = ub(:,:,jk) - (zua(:,:) * hur(:,:) - un_b(:,:)) * umask(:,:,jk) … … 344 319 ! integration 345 320 ! 346 IF (lk_vvl) THEN347 CALL wrk_alloc( jpi, jpj, zhurb, zhvrb )348 zhurb(:,:) = 0._wp349 zhvrb(:,:) = 0._wp350 DO jk = 1, jpk 351 zhurb(:,:) = zhurb(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk)352 zhvrb(:,:) = zhvrb(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk)353 END DO 354 zhurb(:,:) = umask(:,:,1) / ( zhurb(:,:) + 1._wp- umask(:,:,1) )355 zhvrb(:,:) = vmask(:,:,1) / ( zhvrb(:,:) + 1._wp- vmask(:,:,1) )321 ! 322 IF (lk_vvl) THEN 323 hu_b(:,:) = 0. 324 hv_b(:,:) = 0. 325 DO jk = 1, jpkm1 326 hu_b(:,:) = hu_b(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) 327 hv_b(:,:) = hv_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) 328 END DO 329 hur_b(:,:) = umask(:,:,1) / ( hu_b(:,:) + 1. - umask(:,:,1) ) 330 hvr_b(:,:) = vmask(:,:,1) / ( hv_b(:,:) + 1. - vmask(:,:,1) ) 356 331 ENDIF 357 332 ! … … 367 342 DO ji = 1, jpi 368 343 #endif 369 un_b(ji,jj) = un_b(ji,jj) + fse3u_ n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)370 vn_b(ji,jj) = vn_b(ji,jj) + fse3v_ n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)344 un_b(ji,jj) = un_b(ji,jj) + fse3u_a(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 345 vn_b(ji,jj) = vn_b(ji,jj) + fse3v_a(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 371 346 ! 372 ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) 373 vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) 347 ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 348 vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 374 349 END DO 375 350 END DO 376 351 END DO 377 352 ! 378 un_b(:,:) = un_b(:,:) * hur(:,:) 379 vn_b(:,:) = vn_b(:,:) * hvr(:,:) 380 ! 381 IF( lk_vvl ) THEN 382 ub_b(:,:) = ub_b(:,:) * zhurb(:,:) 383 vb_b(:,:) = vb_b(:,:) * zhvrb(:,:) 384 ELSE 385 ub_b(:,:) = ub_b(:,:) * hur(:,:) 386 vb_b(:,:) = vb_b(:,:) * hvr(:,:) 387 ENDIF 388 ! 389 IF (lk_vvl) CALL wrk_dealloc( jpi, jpj, zhurb, zhvrb ) 353 ! 354 un_b(:,:) = un_b(:,:) * hur_a(:,:) 355 vn_b(:,:) = vn_b(:,:) * hvr_a(:,:) 356 ub_b(:,:) = ub_b(:,:) * hur_b(:,:) 357 vb_b(:,:) = vb_b(:,:) * hvr_b(:,:) 358 ! 390 359 ! 391 360 IF(ln_ctl) CALL prt_ctl( tab3d_1=un, clinfo1=' nxt - Un: ', mask1=umask, & … … 393 362 ! 394 363 CALL wrk_dealloc( jpi,jpj,jpk, ze3u_f, ze3v_f ) 395 IF ( lk_dynspg_ts ) CALL wrk_dealloc( jpi,jpj, zua, zva , zhura, zhvra)364 IF ( lk_dynspg_ts ) CALL wrk_dealloc( jpi,jpj, zua, zva ) 396 365 ! 397 366 IF( nn_timing == 1 ) CALL timing_stop('dyn_nxt') -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90
r4354 r4370 34 34 35 35 ! !!! Time splitting scheme (key_dynspg_ts) 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: sshn_e, ssha_e ! sea surface heigth (now, after, average) 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: ua_e , va_e ! barotropic velocities (after) 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_e , hv_e ! now ocean depth ( = Ho+sshn_e ) 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: hur_e , hvr_e ! inverse of hu_e and hv_e 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: sshn_b ! before field without time-filter 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_adv, vn_adv ! Advection vel. at "now" barocl. step 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub2_b, vb2_b ! Advection vel. at "now-0.5" barocl. step 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_e, ssha_e ! sea surface heigth (now, after) 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ua_e , va_e ! barotropic velocities (after) 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_e , hv_e ! now ocean depth ( = Ho+sshn_e ) 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hur_e , hvr_e ! inverse of hu_e and hv_e 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_adv, vn_adv ! Advection vel. at "now" barocl. step 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub2_b, vb2_b ! Advection vel. at "now-0.5" barocl. step 43 42 44 43 !!---------------------------------------------------------------------- … … 56 55 & ssha_e(jpi,jpj) , va_e(jpi,jpj) , hv_e(jpi,jpj) , hvr_e(jpi,jpj) , & 57 56 & ub2_b(jpi,jpj) , vb2_b(jpi,jpj) , & 58 & un_adv(jpi,jpj) , vn_adv(jpi,jpj) , & 59 & sshn_b(jpi,jpj) , STAT = dynspg_oce_alloc ) 57 & un_adv(jpi,jpj) , vn_adv(jpi,jpj) , STAT = dynspg_oce_alloc ) 60 58 ! 61 59 IF( lk_mpp ) CALL mpp_sum ( dynspg_oce_alloc ) -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r4354 r4370 14 14 #if defined key_dynspg_ts || defined key_esopa 15 15 !!---------------------------------------------------------------------- 16 !! 'key_dynspg_ts' free surface cst volume with time splitting16 !! 'key_dynspg_ts' split explicit free surface 17 17 !!---------------------------------------------------------------------- 18 18 !! dyn_spg_ts : compute surface pressure gradient trend using a time- … … 55 55 PUBLIC dyn_spg_ts_init ! " " " " 56 56 57 ! Potential namelist parameters below to be read in dyn_spg_ts_init58 LOGICAL, PUBLIC, PARAMETER :: ln_bt_fw=.TRUE. !: Forward integration of barotropic sub-stepping59 LOGICAL, PRIVATE, PARAMETER :: ln_bt_av=.TRUE. !: Time averaging of barotropic variables60 LOGICAL, PRIVATE, PARAMETER :: ln_bt_nn_auto=.FALSE. !: Set number of iterations automatically61 INTEGER, PRIVATE, PARAMETER :: nn_bt_flt=1 !: Filter choice62 REAL(wp), PRIVATE, PARAMETER :: rn_bt_cmax=0.8_wp !: Max. courant number (used if ln_bt_nn_auto=T)63 ! End namelist parameters64 65 57 INTEGER, SAVE :: icycle ! Number of barotropic sub-steps for each internal step nn_baro <= 2.5 nn_baro 66 58 REAL(wp),SAVE :: rdtbt ! Barotropic time step … … 160 152 REAL(wp), POINTER, DIMENSION(:,:) :: zu_sum, zv_sum, zwx, zwy, zhdiv 161 153 REAL(wp), POINTER, DIMENSION(:,:) :: zhup2_e, zhvp2_e, zhust_e, zhvst_e 162 REAL(wp), POINTER, DIMENSION(:,:) :: zhur_b, zhvr_b163 154 REAL(wp), POINTER, DIMENSION(:,:) :: zsshu_a, zsshv_a 164 REAL(wp), POINTER, DIMENSION(:,:) :: zh t, zhf155 REAL(wp), POINTER, DIMENSION(:,:) :: zhf 165 156 !!---------------------------------------------------------------------- 166 157 ! … … 172 163 CALL wrk_alloc( jpi, jpj, zwx, zwy, zu_sum, zv_sum, zssh_frc, zu_frc, zv_frc) 173 164 CALL wrk_alloc( jpi, jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e) 174 CALL wrk_alloc( jpi, jpj, zhur_b, zhvr_b )175 165 CALL wrk_alloc( jpi, jpj, zsshu_a, zsshv_a ) 176 CALL wrk_alloc( jpi, jpj, zh t, zhf )166 CALL wrk_alloc( jpi, jpj, zhf ) 177 167 ! 178 168 ! !* Local constant initialization … … 228 218 IF ( kt == nit000 .OR. lk_vvl ) THEN 229 219 IF ( ln_dynvor_een ) THEN 230 ! JC: Simplification needed below: define ht_0 even when volume is fixed231 IF (lk_vvl) THEN232 zht(:,:) = (ht_0(:,:) + sshn(:,:)) * tmask(:,:,1)233 ELSE234 zht(:,:) = 0.235 DO jk = 1, jpkm1236 zht(:,:) = zht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk)237 END DO238 ENDIF239 240 220 DO jj = 1, jpjm1 241 221 DO ji = 1, jpim1 242 zwz(ji,jj) = ( zht(ji ,jj+1) + zht(ji+1,jj+1) + &243 & zht(ji ,jj ) + zht(ji+1,jj ) ) &222 zwz(ji,jj) = ( ht(ji ,jj+1) + ht(ji+1,jj+1) + & 223 & ht(ji ,jj ) + ht(ji+1,jj ) ) & 244 224 & / ( MAX( 1.0_wp, tmask(ji ,jj+1, 1) + tmask(ji+1,jj+1, 1) + & 245 225 & tmask(ji ,jj , 1) + tmask(ji+1,jj , 1) ) ) … … 261 241 ELSE 262 242 zwz(:,:) = 0._wp 263 zh t(:,:) = 0.243 zhf(:,:) = 0. 264 244 IF ( .not. ln_sco ) THEN 265 245 ! IF( rn_hmin < 0._wp ) THEN ; jk = - INT( rn_hmin ) ! from a nb of level 266 246 ! ELSE ; jk = MINLOC( gdepw_0, mask = gdepw_0 > rn_hmin, dim = 1 ) ! from a depth 267 247 ! ENDIF 268 ! zh t(:,:) = gdepw_0(:,:,jk+1)248 ! zhf(:,:) = gdepw_0(:,:,jk+1) 269 249 ELSE 270 zh t(:,:) = hbatf(:,:)250 zhf(:,:) = hbatf(:,:) 271 251 END IF 272 252 273 253 DO jj = 1, jpjm1 274 zh t(:,jj) = zht(:,jj)*(1._wp- umask(:,jj,1) * umask(:,jj+1,1))254 zhf(:,jj) = zhf(:,jj)*(1._wp- umask(:,jj,1) * umask(:,jj+1,1)) 275 255 END DO 276 256 277 257 DO jk = 1, jpkm1 278 258 DO jj = 1, jpjm1 279 zh t(:,jj) = zht(:,jj) + fse3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk)280 END DO 281 END DO 282 CALL lbc_lnk( zh t, 'F', 1._wp )259 zhf(:,jj) = zhf(:,jj) + fse3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 260 END DO 261 END DO 262 CALL lbc_lnk( zhf, 'F', 1._wp ) 283 263 ! JC: TBC. hf should be greater than 0 284 264 DO jj = 1, jpj 285 265 DO ji = 1, jpi 286 IF( zh t(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zht(ji,jj) ! zhtis actually hf here but it saves an array266 IF( zhf(ji,jj) /= 0._wp ) zwz(ji,jj) = 1._wp / zhf(ji,jj) ! zhf is actually hf here but it saves an array 287 267 END DO 288 268 END DO … … 296 276 ll_fw_start=.FALSE. 297 277 CALL ts_wgt(ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2) 298 ENDIF299 300 ! before inverse water column height at u- and v- points301 IF( lk_vvl ) THEN302 zhur_b(:,:) = 0.303 zhvr_b(:,:) = 0.304 DO jk = 1, jpk305 zhur_b(:,:) = zhur_b(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk)306 zhvr_b(:,:) = zhvr_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk)307 END DO308 zhur_b(:,:) = umask(:,:,1) / ( zhur_b(:,:) + 1. - umask(:,:,1) )309 zhvr_b(:,:) = vmask(:,:,1) / ( zhvr_b(:,:) + 1. - vmask(:,:,1) )310 ELSE311 zhur_b(:,:) = hur(:,:)312 zhvr_b(:,:) = hvr(:,:)313 278 ENDIF 314 279 … … 331 296 DO ji = 1, jpi 332 297 #endif 333 zu_frc(ji,jj) = zu_frc(ji,jj) + fse3u (ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk)334 zv_frc(ji,jj) = zv_frc(ji,jj) + fse3v (ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk)298 zu_frc(ji,jj) = zu_frc(ji,jj) + fse3u_n(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 299 zv_frc(ji,jj) = zv_frc(ji,jj) + fse3v_n(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 335 300 END DO 336 301 END DO … … 492 457 ! ! Initialisations ! 493 458 ! ! ==================== ! 494 ! Initialize barotropic variables: 495 IF (ln_bt_fw) THEN ! FORWARD integration: start from NOW fields 496 sshn_e (:,:) = sshn (:,:) 497 zun_e (:,:) = un_b (:,:) 498 zvn_e (:,:) = vn_b (:,:) 499 ELSE ! CENTRED integration: start from BEFORE fields 500 sshn_e (:,:) = sshb (:,:) 501 zun_e (:,:) = ub_b (:,:) 502 zvn_e (:,:) = vb_b (:,:) 503 ENDIF 504 ! 505 ! Initialize depths: 506 IF ( lk_vvl.AND.(.NOT.ln_bt_fw) ) THEN 507 hu_e (:,:) = umask(:,:,1) / ( zhur_b(:,:) + 1._wp - umask(:,:,1) ) 508 hv_e (:,:) = vmask(:,:,1) / ( zhvr_b(:,:) + 1._wp - vmask(:,:,1) ) 509 hur_e (:,:) = zhur_b(:,:) 510 hvr_e (:,:) = zhvr_b(:,:) 511 ELSE 459 ! Initialize barotropic variables: 460 IF (ln_bt_fw) THEN ! FORWARD integration: start from NOW fields 461 sshn_e(:,:) = sshn (:,:) 462 zun_e (:,:) = un_b (:,:) 463 zvn_e (:,:) = vn_b (:,:) 464 ! 512 465 hu_e (:,:) = hu (:,:) 513 466 hv_e (:,:) = hv (:,:) 514 467 hur_e (:,:) = hur (:,:) 515 468 hvr_e (:,:) = hvr (:,:) 516 ENDIF 517 ! 518 IF (.NOT.lk_vvl) THEN ! Depths at jn+0.5: 519 zhup2_e (:,:) = hu(:,:) 520 zhvp2_e (:,:) = hv(:,:) 521 ENDIF 469 ELSE ! CENTRED integration: start from BEFORE fields 470 sshn_e(:,:) = sshb (:,:) 471 zun_e (:,:) = ub_b (:,:) 472 zvn_e (:,:) = vb_b (:,:) 473 ! 474 hu_e (:,:) = hu_b (:,:) 475 hv_e (:,:) = hv_b (:,:) 476 hur_e (:,:) = hur_b(:,:) 477 hvr_e (:,:) = hvr_b(:,:) 478 ENDIF 479 ! 480 ! 522 481 ! 523 482 ! Initialize sums: … … 560 519 DO jj = 2, jpjm1 ! Sea Surface Height at u- & v-points 561 520 DO ji = 2, fs_jpim1 ! Vector opt. 562 zwx(ji,jj) = z1_2 * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) )&563 & * ( e1 t(ji ,jj) * e2t(ji ,jj) * zsshp2_e(ji ,jj) &564 & + e1 t(ji+1,jj) * e2t(ji+1,jj) * zsshp2_e(ji+1,jj) )565 zwy(ji,jj) = z1_2 * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) )&566 & * ( e1 t(ji,jj ) * e2t(ji,jj ) * zsshp2_e(ji,jj ) &567 & + e1 t(ji,jj+1) * e2t(ji,jj+1) * zsshp2_e(ji,jj+1) )521 zwx(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e12u(ji,jj) & 522 & * ( e12t(ji ,jj) * zsshp2_e(ji ,jj) & 523 & + e12t(ji+1,jj) * zsshp2_e(ji+1,jj) ) 524 zwy(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e12v(ji,jj) & 525 & * ( e12t(ji,jj ) * zsshp2_e(ji,jj ) & 526 & + e12t(ji,jj+1) * zsshp2_e(ji,jj+1) ) 568 527 END DO 569 528 END DO … … 572 531 zhup2_e (:,:) = hu_0(:,:) + zwx(:,:) ! Ocean depth at U- and V-points 573 532 zhvp2_e (:,:) = hv_0(:,:) + zwy(:,:) 533 ELSE 534 zhup2_e (:,:) = hu(:,:) 535 zhvp2_e (:,:) = hv(:,:) 574 536 ENDIF 575 537 ! !* after ssh … … 583 545 DO ji = fs_2, fs_jpim1 ! vector opt. 584 546 zhdiv(ji,jj) = ( zwx(ji,jj) - zwx(ji-1,jj) & 585 & + zwy(ji,jj) - zwy(ji,jj-1) & 586 & ) / ( e1t(ji,jj) * e2t(ji,jj) ) 547 & + zwy(ji,jj) - zwy(ji,jj-1) ) * r1_e12t(ji,jj) 587 548 END DO 588 549 END DO … … 609 570 DO jj = 2, jpjm1 610 571 DO ji = 2, jpim1 ! NO Vector Opt. 611 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) / ( e1u(ji ,jj) * e2u(ji ,jj) )&612 & * ( e1t(ji ,jj) * e2t(ji ,jj) * ssha_e(ji ,jj) &613 & + e1t(ji+1,jj) * e2t(ji+1,jj) * ssha_e(ji+1,jj) )614 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) / ( e1v(ji,jj ) * e2v(ji,jj ) )&615 & * ( e1t(ji,jj ) * e2t(ji,jj ) * ssha_e(ji,jj ) &616 & + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha_e(ji,jj+1) )572 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e12u(ji,jj) & 573 & * ( e12t(ji ,jj ) * ssha_e(ji ,jj ) & 574 & + e12t(ji+1,jj ) * ssha_e(ji+1,jj ) ) 575 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e12v(ji,jj) & 576 & * ( e12t(ji ,jj ) * ssha_e(ji ,jj ) & 577 & + e12t(ji ,jj+1) * ssha_e(ji ,jj+1) ) 617 578 END DO 618 579 END DO … … 648 609 DO jj = 2, jpjm1 649 610 DO ji = 2, jpim1 650 zx1 = z1_2 * umask(ji ,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) )&651 & * ( e1t(ji ,jj) * e2t(ji ,jj) * zsshp2_e(ji ,jj)&652 & + e1t(ji+1,jj) * e2t(ji+1,jj) * zsshp2_e(ji+1,jj) )653 zy1 = z1_2 * vmask(ji ,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) )&654 & * ( e1 t(ji,jj ) * e2t(ji,jj ) * zsshp2_e(ji,jj ) &655 & + e1 t(ji,jj+1) * e2t(ji,jj+1) * zsshp2_e(ji,jj+1) )611 zx1 = z1_2 * umask(ji ,jj,1) * r1_e12u(ji ,jj) & 612 & * ( e12t(ji ,jj ) * zsshp2_e(ji ,jj) & 613 & + e12t(ji+1,jj ) * zsshp2_e(ji+1,jj ) ) 614 zy1 = z1_2 * vmask(ji ,jj,1) * r1_e12v(ji ,jj ) & 615 & * ( e12t(ji ,jj ) * zsshp2_e(ji ,jj ) & 616 & + e12t(ji ,jj+1) * zsshp2_e(ji ,jj+1) ) 656 617 zhust_e(ji,jj) = hu_0(ji,jj) + zx1 657 618 zhvst_e(ji,jj) = hv_0(ji,jj) + zy1 … … 833 794 DO jj = 1, jpjm1 834 795 DO ji = 1, jpim1 ! NO Vector Opt. 835 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) / ( e1u(ji ,jj) * e2u(ji ,jj) )&836 & * ( e1t(ji ,jj) * e2t(ji ,jj) * ssha(ji ,jj)&837 & + e1t(ji+1,jj) * e2t(ji+1,jj) * ssha(ji+1,jj) )838 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) / ( e1v(ji,jj ) * e2v(ji,jj ) )&839 & * ( e1t(ji,jj ) * e2t(ji,jj ) * ssha(ji,jj )&840 & + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha(ji,jj+1) )796 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e12u(ji,jj) & 797 & * ( e12t(ji ,jj) * ssha_e(ji ,jj) & 798 & + e12t(ji+1,jj) * ssha_e(ji+1,jj) ) 799 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e12v(ji,jj) & 800 & * ( e12t(ji,jj ) * ssha_e(ji,jj ) & 801 & + e12t(ji,jj+1) * ssha_e(ji,jj+1) ) 841 802 END DO 842 803 END DO … … 865 826 END DO 866 827 ELSE 867 hu_e (:,:) = umask(:,:,1) / ( zhur_b(:,:) + 1._wp - umask(:,:,1) )868 hv_e (:,:) = vmask(:,:,1) / ( zhvr_b(:,:) + 1._wp - vmask(:,:,1) )869 828 DO jk=1,jpkm1 870 ua(:,:,jk) = ua(:,:,jk) + hur(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_ e(:,:) ) * z1_2dt_b871 va(:,:,jk) = va(:,:,jk) + hvr(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_ e(:,:) ) * z1_2dt_b829 ua(:,:,jk) = ua(:,:,jk) + hur(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b 830 va(:,:,jk) = va(:,:,jk) + hvr(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * z1_2dt_b 872 831 END DO 873 832 ! Save barotropic velocities not transport: … … 890 849 CALL wrk_dealloc( jpi, jpj, zwx, zwy, zu_sum, zv_sum, zssh_frc, zu_frc, zv_frc ) 891 850 CALL wrk_dealloc( jpi, jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e ) 892 CALL wrk_dealloc( jpi, jpj, zhur_b, zhvr_b )893 851 CALL wrk_dealloc( jpi, jpj, zsshu_a, zsshv_a ) 894 CALL wrk_dealloc( jpi, jpj, zh t, zhf )852 CALL wrk_dealloc( jpi, jpj, zhf ) 895 853 ! 896 854 IF( nn_timing == 1 ) CALL timing_stop('dyn_spg_ts') … … 989 947 CALL iom_get( numror, jpdom_autoglo, 'ub2_b' , ub2_b (:,:) ) 990 948 CALL iom_get( numror, jpdom_autoglo, 'vb2_b' , vb2_b (:,:) ) 991 IF( .NOT.ln_bt_av .AND. iom_varid( numror, 'sshbb_e', ldstop = .FALSE. ) > 0) THEN949 IF( .NOT.ln_bt_av ) THEN 992 950 CALL iom_get( numror, jpdom_autoglo, 'sshbb_e' , sshbb_e(:,:) ) 993 951 CALL iom_get( numror, jpdom_autoglo, 'ubb_e' , ubb_e(:,:) ) … … 996 954 CALL iom_get( numror, jpdom_autoglo, 'ub_e' , ub_e(:,:) ) 997 955 CALL iom_get( numror, jpdom_autoglo, 'vb_e' , vb_e(:,:) ) 998 ELSE999 sshbb_e = sshn_b ! ACC GUESS WORK1000 ubb_e = ub_b1001 vbb_e = vb_b1002 sshb_e = sshn_b1003 ub_e = ub_b1004 vb_e = vb_b1005 956 ENDIF 1006 957 ! … … 1029 980 INTEGER , INTENT(in) :: kt ! ocean time-step 1030 981 ! 1031 INTEGER :: ji ,jj, jk 982 INTEGER :: ji ,jj 983 INTEGER :: ios ! Local integer output status for namelist read 1032 984 REAL(wp) :: zxr2, zyr2, zcmax 1033 REAL(wp), POINTER, DIMENSION(:,:) :: zcu , zht985 REAL(wp), POINTER, DIMENSION(:,:) :: zcu 1034 986 !! 1035 !NAMELIST/namsplit/ ln_bt_fw, ln_bt_av, ln_bt_nn_auto, &1036 !& nn_baro, rn_bt_cmax, nn_bt_flt987 NAMELIST/namsplit/ ln_bt_fw, ln_bt_av, ln_bt_nn_auto, & 988 & nn_baro, rn_bt_cmax, nn_bt_flt 1037 989 !!---------------------------------------------------------------------- 1038 ! REWIND( numnam ) !* Namelist namsplit: split-explicit free surface 1039 ! READ ( numnam, namsplit ) 990 ! 991 REWIND( numnam_ref ) ! Namelist namsplit in reference namelist : time splitting parameters 992 READ ( numnam_ref, namsplit, IOSTAT = ios, ERR = 901) 993 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsplit in reference namelist', lwp ) 994 995 REWIND( numnam_cfg ) ! Namelist namsplit in configuration namelist : time splitting parameters 996 READ ( numnam_cfg, namsplit, IOSTAT = ios, ERR = 902 ) 997 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsplit in configuration namelist', lwp ) 998 WRITE ( numond, namsplit ) 999 ! 1040 1000 ! ! Max courant number for ext. grav. waves 1041 1001 ! 1042 CALL wrk_alloc( jpi, jpj, zcu, zht ) 1043 ! 1044 ! JC: Simplification needed below: define ht_0 even when volume is fixed 1002 CALL wrk_alloc( jpi, jpj, zcu ) 1003 ! 1045 1004 IF (lk_vvl) THEN 1046 zht(:,:) = ht_0(:,:) * tmask(:,:,1) 1005 DO jj = 1, jpj 1006 DO ji =1, jpi 1007 zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj)) 1008 zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj)) 1009 zcu(ji,jj) = sqrt(grav*ht_0(ji,jj)*(zxr2 + zyr2) ) 1010 END DO 1011 END DO 1047 1012 ELSE 1048 zht(:,:) = 0. 1049 DO jk = 1, jpkm1 1050 zht(:,:) = zht(:,:) + fse3t_n(:,:,jk) * tmask(:,:,jk) 1051 END DO 1052 ENDIF 1053 1054 DO jj = 1, jpj 1055 DO ji =1, jpi 1056 zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj)) 1057 zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj)) 1058 zcu(ji,jj) = sqrt(grav*zht(ji,jj)*(zxr2 + zyr2) ) 1059 END DO 1060 END DO 1013 DO jj = 1, jpj 1014 DO ji =1, jpi 1015 zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj)) 1016 zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj)) 1017 zcu(ji,jj) = sqrt(grav*ht(ji,jj)*(zxr2 + zyr2) ) 1018 END DO 1019 END DO 1020 ENDIF 1061 1021 1062 1022 zcmax = MAXVAL(zcu(:,:)) 1063 1023 IF( lk_mpp ) CALL mpp_max( zcmax ) 1064 1024 1065 ! Estimate number of iterations to satisfy a max courant number= 0.81025 ! Estimate number of iterations to satisfy a max courant number= rn_bt_cmax 1066 1026 IF (ln_bt_nn_auto) nn_baro = CEILING( rdt / rn_bt_cmax * zcmax) 1067 1027 … … 1073 1033 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 1074 1034 IF( ln_bt_nn_auto ) THEN 1075 IF(lwp) WRITE(numout,*) ' ln_ts_nn_auto=.true. Automatically set nn_baro '1076 IF(lwp) WRITE(numout,*) ' Max. courant number allowed: ', rn_bt_cmax1035 IF(lwp) WRITE(numout,*) ' ln_ts_nn_auto=.true. Automatically set nn_baro ' 1036 IF(lwp) WRITE(numout,*) ' Max. courant number allowed: ', rn_bt_cmax 1077 1037 ELSE 1078 IF(lwp) WRITE(numout,*) ' ln_ts_nn_auto=.false.: Use nn_baro in namelist ' 1079 ENDIF 1080 IF(lwp) WRITE(numout,*) ' nn_baro = ', nn_baro 1081 IF(lwp) WRITE(numout,*) ' Barotropic time step [s] is :', rdtbt 1082 IF(lwp) WRITE(numout,*) ' Maximum Courant number is :', zcmax 1038 IF(lwp) WRITE(numout,*) ' ln_ts_nn_auto=.false.: Use nn_baro in namelist ' 1039 ENDIF 1083 1040 1084 1041 IF(ln_bt_av) THEN 1085 IF(lwp) WRITE(numout,*) ' ln_bt_av=.true. => Time averaging over nn_baro time steps is on '1042 IF(lwp) WRITE(numout,*) ' ln_bt_av=.true. => Time averaging over nn_baro time steps is on ' 1086 1043 ELSE 1087 IF(lwp) WRITE(numout,*) ' ln_bt_av=.false. => No time averaging of barotropic variables '1044 IF(lwp) WRITE(numout,*) ' ln_bt_av=.false. => No time averaging of barotropic variables ' 1088 1045 ENDIF 1089 1046 ! 1090 1047 ! 1091 1048 IF(ln_bt_fw) THEN 1092 IF(lwp) WRITE(numout,*) ' ln_bt_fw=.true. => Forward integration of barotropic variables '1049 IF(lwp) WRITE(numout,*) ' ln_bt_fw=.true. => Forward integration of barotropic variables ' 1093 1050 ELSE 1094 IF(lwp) WRITE(numout,*) ' ln_bt_fw =.false.=> Centred integration of barotropic variables '1095 ENDIF 1096 ! 1097 IF(lwp) WRITE(numout,*) 'Time filter choice, nn_bt_flt: ', nn_bt_flt1051 IF(lwp) WRITE(numout,*) ' ln_bt_fw =.false.=> Centred integration of barotropic variables ' 1052 ENDIF 1053 ! 1054 IF(lwp) WRITE(numout,*) ' Time filter choice, nn_bt_flt: ', nn_bt_flt 1098 1055 SELECT CASE ( nn_bt_flt ) 1099 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' Dirac'1100 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = nn_baro'1101 CASE( 2 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = 2*nn_baro'1056 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' Dirac' 1057 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = nn_baro' 1058 CASE( 2 ) ; IF(lwp) WRITE(numout,*) ' Boxcar: width = 2*nn_baro' 1102 1059 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_bt_flt: should 0,1,2' ) 1103 1060 END SELECT 1104 1061 ! 1062 IF(lwp) WRITE(numout,*) ' ' 1063 IF(lwp) WRITE(numout,*) ' nn_baro = ', nn_baro 1064 IF(lwp) WRITE(numout,*) ' Barotropic time step [s] is :', rdtbt 1065 IF(lwp) WRITE(numout,*) ' Maximum Courant number is :', zcmax 1066 ! 1105 1067 IF ((.NOT.ln_bt_av).AND.(.NOT.ln_bt_fw)) THEN 1106 1068 CALL ctl_stop( 'dynspg_ts ERROR: No time averaging => only forward integration is possible' ) … … 1110 1072 ENDIF 1111 1073 ! 1112 CALL wrk_dealloc( jpi, jpj, zcu , zht)1074 CALL wrk_dealloc( jpi, jpj, zcu ) 1113 1075 ! 1114 1076 END SUBROUTINE dyn_spg_ts_init … … 1116 1078 #else 1117 1079 !!--------------------------------------------------------------------------- 1118 !! Default case : Empty module No s tandard free surface constant volume1080 !! Default case : Empty module No split explicit free surface 1119 1081 !!--------------------------------------------------------------------------- 1120 1121 USE par_kind1122 LOGICAL, PUBLIC, PARAMETER :: ln_bt_fw=.FALSE. ! Forward integration of barotropic sub-stepping1123 1082 CONTAINS 1124 1083 INTEGER FUNCTION dyn_spg_ts_alloc() ! Dummy function -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r4354 r4370 27 27 USE dynadv ! dynamics: vector invariant versus flux form 28 28 USE dynspg_oce, ONLY: lk_dynspg_ts 29 USE dynspg_ts30 29 31 30 IMPLICIT NONE -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r4338 r4370 33 33 USE diaar5, ONLY: lk_diaar5 34 34 USE iom 35 USE sbcrnf, ONLY: h_rnf, nk_rnf, sbc_rnf_div ! River runoff36 USE dynspg_ts, ONLY: ln_bt_fw37 USE dynspg_oce, ONLY: lk_dynspg_ts38 35 #if defined key_agrif 39 36 USE agrif_opa_update
Note: See TracChangeset
for help on using the changeset viewer.