- Timestamp:
- 2020-04-09T21:06:01+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE
- Files:
-
- 12 edited
- 4 moved
-
ASM/asminc.F90 (modified) (1 diff)
-
DIA/diaar5.F90 (modified) (2 diffs)
-
DIA/diawri.F90 (modified) (5 diffs)
-
DOM/domain.F90 (modified) (3 diffs)
-
DOM/domqco.F90 (moved) (moved from NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domqe.F90) (11 diffs)
-
DOM/istate.F90 (modified) (2 diffs)
-
DYN/dynatf.F90 (modified) (1 diff)
-
DYN/dynatf_qco.F90 (moved) (moved from NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynatfQCO.F90) (4 diffs)
-
DYN/dynspg_ts.F90 (modified) (1 diff)
-
ISF/isfcpl.F90 (modified) (3 diffs)
-
ISF/isfdynatf.F90 (modified) (1 diff)
-
SBC/sbcice_cice.F90 (modified) (2 diffs)
-
TRA/traatf_qco.F90 (moved) (moved from NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/TRA/traatfQCO.F90) (5 diffs)
-
ZDF/zdfosm.F90 (modified) (1 diff)
-
nemogcm.F90 (modified) (4 diffs)
-
stpMLF.F90 (moved) (moved from NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/stepLF.F90) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ASM/asminc.F90
r12731 r12732 803 803 ELSE 804 804 ALLOCATE( ztim(jpi,jpj) ) 805 !!st ztim(:,:) = ssh_iau(:,:) / ( ht_(:,:) + 1.0 - ssmask(:,:) ) 806 DO_2D_11_11 807 ztim(ji,jj) = ssh_iau(ji,jj) / ( ht(ji,jj) + 1.0 - ssmask(ji,jj) ) 808 END_2D 805 ztim(:,:) = ssh_iau(:,:) / ( ht(:,:) + 1.0 - ssmask(:,:) ) 809 806 DO jk = 1, jpkm1 810 807 phdivn(:,:,jk) = phdivn(:,:,jk) - ztim(:,:) * tmask(:,:,jk) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diaar5.F90
r12731 r12732 78 78 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace 79 79 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2d, zpe ! 2D workspace 80 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d, zrhd , zrhop, ztpot, zgdept ! 3D workspace 80 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d, zrhd , zrhop, ztpot, zgdept ! 3D workspace (zgdept: needed to use the substitute) 81 81 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace 82 82 … … 132 132 ztsn(:,:,:,jp_tem) = ts(:,:,:,jp_tem,Kmm) ! thermosteric ssh 133 133 ztsn(:,:,:,jp_sal) = sn0(:,:,:) 134 !!st to be improved135 134 DO jk = 1, jpkm1 136 135 zgdept(:,:,jk) = gdept(:,:,jk,Kmm) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diawri.F90
r12731 r12732 142 142 END DO 143 143 CALL iom_put( "e3t" , z3d(:,:,:) ) 144 CALL iom_put( "e3tdef" , ( ( z3d(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) !!st r3t144 CALL iom_put( "e3tdef" , ( ( z3d(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 145 145 ENDIF 146 146 IF ( iom_use("e3u") ) THEN ! time-varying e3u … … 806 806 zw3d(:,:,:) = ( ( ze3t(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 807 807 CALL histwrite( nid_T, "vovvle3t", it, ze3t (:,:,:) , ndim_T , ndex_T ) ! level thickness 808 CALL histwrite( nid_T, "vovvldep", it, zgdept , ndim_T , ndex_T ) ! t-point depth !!st patch808 CALL histwrite( nid_T, "vovvldep", it, zgdept , ndim_T , ndex_T ) ! t-point depth 809 809 CALL histwrite( nid_T, "vovvldef", it, zw3d , ndim_T , ndex_T ) ! level thickness deformation 810 810 ENDIF … … 945 945 !! 946 946 INTEGER :: inum, jk 947 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, zgdept ! 3D workspace 947 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, zgdept ! 3D workspace !!st patch to use substitution 948 948 !!---------------------------------------------------------------------- 949 949 ! … … 955 955 ENDIF 956 956 ! 957 !!st patch958 957 DO jk = 1, jpk 959 958 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) … … 1011 1010 CALL iom_rstput( 0, 0, inum, 'sometauy', vtau ) ! j-wind stress 1012 1011 IF( .NOT.ln_linssh ) THEN 1013 !!st patch1014 1012 CALL iom_rstput( 0, 0, inum, 'vovvldep', zgdept ) ! T-cell depth 1015 1013 CALL iom_rstput( 0, 0, inum, 'vovvle3t', ze3t ) ! T-cell thickness -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domain.F90
r12731 r12732 38 38 USE domvvl ! variable volume 39 39 #else 40 USE domq e! variable volume40 USE domqco ! variable volume 41 41 #endif 42 42 USE c1d ! 1D configuration … … 149 149 CALL dom_msk( ik_top, ik_bot ) ! Masks 150 150 ! 151 !!stht_0(:,:) = 0._wp ! Reference ocean thickness151 ht_0(:,:) = 0._wp ! Reference ocean thickness 152 152 hu_0(:,:) = 0._wp 153 153 hv_0(:,:) = 0._wp … … 169 169 ! !== initialisation of time varying coordinate ==! Quasi-Euerian coordinate case 170 170 ! 171 IF( .NOT.l_offline ) CALL dom_q e_init( Kbb, Kmm, Kaa )171 IF( .NOT.l_offline ) CALL dom_qco_init( Kbb, Kmm, Kaa ) 172 172 ! 173 173 IF( ln_linssh ) CALL ctl_stop('STOP','domain: key_qco and ln_linssh = T are incompatible') -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domqco.F90
r12731 r12732 1 MODULE domq e1 MODULE domqco 2 2 !!====================================================================== 3 !! *** MODULE domq e***3 !! *** MODULE domqco *** 4 4 !! Ocean : 5 5 !!====================================================================== … … 14 14 !!---------------------------------------------------------------------- 15 15 !! dom_qe_init : define initial vertical scale factors, depths and column thickness 16 !! dom_qe_sf_nxt : Compute next vertical scale factors17 !! dom_qe_sf_update: Swap vertical scale factors and update the vertical grid18 !! dom_qe_interpol : Interpolate vertical scale factors from one grid point to another19 16 !! dom_qe_r3c : Compute ssh/h_0 ratioat t-, u-, v-, and optionally f-points 20 17 !! qe_rst_read : read/write restart file … … 40 37 PRIVATE 41 38 42 PUBLIC dom_qe_init ! called by domain.F90 43 PUBLIC dom_qe_zgr ! called by isfcpl.F90 44 !!st PUBLIC dom_qe_sf_nxt ! called by steplf.F90 45 !!st PUBLIC dom_qe_sf_update ! called by steplf.F90 46 !!st PUBLIC dom_h_nxt ! called by steplf.F90 47 !!st PUBLIC dom_h_update ! called by steplf.F90 48 PUBLIC dom_qe_r3c ! called by steplf.F90 39 PUBLIC dom_qco_init ! called by domain.F90 40 PUBLIC dom_qco_zgr ! called by isfcpl.F90 41 PUBLIC dom_qco_r3c ! called by steplf.F90 49 42 50 43 ! !!* Namelist nam_vvl … … 73 66 CONTAINS 74 67 75 SUBROUTINE dom_qe_init( Kbb, Kmm, Kaa ) 76 !!---------------------------------------------------------------------- 77 !! *** ROUTINE dom_qe_init *** 78 !! 79 !! ** Purpose : Initialization of all scale factors, depths 80 !! and water column heights 68 SUBROUTINE dom_qco_init( Kbb, Kmm, Kaa ) 69 !!---------------------------------------------------------------------- 70 !! *** ROUTINE dom_qco_init *** 71 !! 72 !! ** Purpose : Initialization of all ssh. to h._0 ratio 81 73 !! 82 74 !! ** Method : - use restart file and/or initialize 83 !! - interpolate scale factors 84 !! 85 !! ** Action : - e3t_(n/b) 86 !! - Regrid: e3[u/v](:,:,:,Kmm) 87 !! e3[u/v](:,:,:,Kmm) 88 !! e3w(:,:,:,Kmm) 89 !! e3[u/v]w_b 90 !! e3[u/v]w_n 91 !! gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w 92 !! - h(t/u/v)_0 93 !! 94 !! Reference : Leclair, M., and G. Madec, 2011, Ocean Modelling. 75 !! - compute ssh. to h._0 ratio 76 !! 77 !! ** Action : - r3(t/u/v)_b 78 !! - r3(t/u/v/f)_n 79 !! 95 80 !!---------------------------------------------------------------------- 96 81 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 97 82 ! 98 83 IF(lwp) WRITE(numout,*) 99 IF(lwp) WRITE(numout,*) 'dom_q e_init : Variable volume activated'84 IF(lwp) WRITE(numout,*) 'dom_qco_init : Variable volume activated' 100 85 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 101 86 ! 102 CALL dom_q e_ctl ! choose vertical coordinate (z_star, z_tilde or layer)87 CALL dom_qco_ctl ! choose vertical coordinate (z_star, z_tilde or layer) 103 88 ! 104 89 ! ! Read or initialize e3t_(b/n), tilde_e3t_(b/n) and hdiv_lf 105 90 CALL qe_rst_read( nit000, Kbb, Kmm ) 106 !!st e3t(:,:,jpk,Kaa) = e3t_0(:,:,jpk) ! last level always inside the sea floor set one for all 107 ! 108 CALL dom_qe_zgr(Kbb, Kmm, Kaa) ! interpolation scale factor, depth and water column 91 ! 92 CALL dom_qco_zgr(Kbb, Kmm, Kaa) ! interpolation scale factor, depth and water column 109 93 ! 110 94 ! IF(lwxios) THEN ! define variables in restart file when writing with XIOS … … 113 97 ! ENDIF 114 98 ! 115 END SUBROUTINE dom_qe_init 116 117 118 SUBROUTINE dom_qe_zgr(Kbb, Kmm, Kaa) 119 !!---------------------------------------------------------------------- 120 !! *** ROUTINE dom_qe_init *** 121 !! 122 !! ** Purpose : Interpolation of all scale factors, 123 !! depths and water column heights 99 END SUBROUTINE dom_qco_init 100 101 102 SUBROUTINE dom_qco_zgr(Kbb, Kmm, Kaa) 103 !!---------------------------------------------------------------------- 104 !! *** ROUTINE dom_qco_init *** 105 !! 106 !! ** Purpose : Initialization of all ssh. to h._0 ratio 124 107 !! 125 108 !! ** Method : - interpolate scale factors 126 109 !! 127 !! ** Action : - e3t_(n/b) 128 !! - Regrid: e3(u/v)_n 129 !! e3(u/v)_b 130 !! e3w_n 131 !! e3(u/v)w_b 132 !! e3(u/v)w_n 133 !! gdept_n, gdepw_n and gde3w_n 134 !! - h(t/u/v)_0 110 !! ** Action : - r3(t/u/v)_b 111 !! - r3(t/u/v/f)_n 135 112 !! 136 113 !! Reference : Leclair, M., and G. Madec, 2011, Ocean Modelling. … … 145 122 ! !== Set of all other vertical scale factors ==! (now and before) 146 123 ! ! Horizontal interpolation of e3t 147 CALL dom_qe_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb) ) 148 CALL dom_qe_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm), r3f(:,:) ) 149 ! 150 ! !!st 151 ! DO jk = 1, jpkm1 ! Horizontal interpolation of e3t 152 ! e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) * tmask(:,:,jk) ) ! Kbb time level 153 ! e3u(:,:,jk,Kbb) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) * umask(:,:,jk) ) 154 ! e3v(:,:,jk,Kbb) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) * vmask(:,:,jk) ) 155 ! e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) * tmask(:,:,jk) ) ! Kmm time level 156 ! e3u(:,:,jk,Kmm) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) * umask(:,:,jk) ) 157 ! e3v(:,:,jk,Kmm) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) * vmask(:,:,jk) ) 158 ! e3f(:,:,jk) = e3f_0(:,:,jk) * ( 1._wp + r3f(:,:) * fmask(:,:,jk) ) 159 ! END DO 160 ! ! 161 ! DO jk = 1, jpk ! Vertical interpolation of e3t,u,v 162 ! ! ! The ratio does not have to be masked at w-level 163 ! e3w (:,:,jk,Kbb) = e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) ! Kbb time level 164 ! e3uw(:,:,jk,Kbb) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) ) 165 ! e3vw(:,:,jk,Kbb) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) ) 166 ! e3w (:,:,jk,Kmm) = e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) ! Kmm time level 167 ! e3uw(:,:,jk,Kmm) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) ) 168 ! e3vw(:,:,jk,Kmm) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) ) 169 ! END DO 170 ! ! 171 ! ! We need to define e3[tuv]_a for AGRIF initialisation (should not be a problem for the restartability...) 172 ! e3t(:,:,:,Kaa) = e3t(:,:,:,Kmm) 173 ! e3u(:,:,:,Kaa) = e3u(:,:,:,Kmm) 174 ! e3v(:,:,:,Kaa) = e3v(:,:,:,Kmm) 175 !!st end 176 ! 177 !!st ATTENTION CAS ISF A GERER !!! 178 ! !== depth of t and w-point ==! (set the isf depth as it is in the initial timestep) 179 !!$ IF( ln_isf ) THEN !** IceShelF cavities 180 !!$ ! ! to be created depending of the new names in isf 181 !!$ ! ! it should be something like that : (with h_isf = thickness of iceshelf) 182 !!$ ! ! in fact currently, h_isf(:,:) is called : risfdep(:,:) 183 !!$!!gm - depth idea 0 : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask ! 184 !!$ gdept(:,:,1,Kmm) = gdept_0(:,:,1) * ( 1._wp + r3t(:,:,Kmm) ) 185 !!$ gdepw(:,:,1,Kmm) = 0._wp ! Initialized to zero one for all 186 !!$ gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) ! reference to a common level z=0 for hpg 187 !!$ DO jk = 2, jpk 188 !!$ gdept(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdept_0(:,:,jk) ) & 189 !!$ + MAX( 0._wp , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 190 !!$ gdepw(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) ) & 191 !!$ + MAX( 0._wp , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 192 !!$ gde3w(:,:,jk) = gdept(:,:,jk,Kmm) - ssh(:,:,Kmm) 193 !!$ gdept(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdept_0(:,:,jk) ) & 194 !!$ + MAX( 0._wp , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 195 !!$ gdepw(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) ) & 196 !!$ + MAX( 0._wp , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 197 !!$ END DO 198 !!$ ! 199 !!$ ELSE !** No cavities (all depth rescaled, even inside topography: no mask) 200 !!$ ! 201 !!$!!gm idea 0 : just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask ! 202 !!$ DO jk = 1, jpk 203 !!$ gdept(:,:,jk,Kmm) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 204 !!$ gdepw(:,:,jk,Kmm) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 205 !!$ gde3w(:,:,jk) = gdept (:,:,jk,Kmm) - ssh(:,:,Kmm) 206 !!$ gdept(:,:,jk,Kbb) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 207 !!$ gdepw(:,:,jk,Kbb) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 208 !!$ END DO 209 !!$ ! 210 !!$ ENDIF 211 ! 212 ! !== thickness of the water column !! (ocean portion only) 213 !!st ht(:,:) = ht_0(:,:) + ssh(:,:,Kmm) 214 !!$ hu(:,:,Kbb) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kbb) ) 215 !!$ hu(:,:,Kmm) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kmm) ) 216 !!$ hv(:,:,Kbb) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kbb) ) 217 !!$ hv(:,:,Kmm) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kmm) ) 218 !!$ ! 219 !!$ ! !== inverse of water column thickness ==! (u- and v- points) 220 !!$ r1_hu(:,:,Kbb) = ssumask(:,:) / ( hu(:,:,Kbb) + 1._wp - ssumask(:,:) ) ! _i mask due to ISF 221 !!$ r1_hu(:,:,Kmm) = ssumask(:,:) / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) ) 222 !!$ r1_hv(:,:,Kbb) = ssvmask(:,:) / ( hv(:,:,Kbb) + 1._wp - ssvmask(:,:) ) 223 !!$ r1_hv(:,:,Kmm) = ssvmask(:,:) / ( hv(:,:,Kmm) + 1._wp - ssvmask(:,:) ) 224 !!st end 225 ! 226 END SUBROUTINE dom_qe_zgr 227 228 ! !!st 229 ! SUBROUTINE dom_qe_sf_nxt( kt, Kbb, Kmm, Kaa, kcall ) 230 ! !!---------------------------------------------------------------------- 231 ! !! *** ROUTINE dom_qe_sf_nxt *** 232 ! !! 233 ! !! ** Purpose : - compute the after scale factors used in tra_zdf, dynnxt, 234 ! !! tranxt and dynspg routines 235 ! !! 236 ! !! ** Method : - z_star case: Repartition of ssh INCREMENT proportionnaly to the level thickness. 237 ! !! 238 ! !! ** Action : - hdiv_lf : restoring towards full baroclinic divergence in z_tilde case 239 ! !! - tilde_e3t_a: after increment of vertical scale factor 240 ! !! in z_tilde case 241 ! !! - e3(t/u/v)_a 242 ! !! 243 ! !! Reference : Leclair, M., and Madec, G. 2011, Ocean Modelling. 244 ! !!---------------------------------------------------------------------- 245 ! INTEGER, INTENT( in ) :: kt ! time step 246 ! INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time step 247 ! INTEGER, INTENT( in ), OPTIONAL :: kcall ! optional argument indicating call sequence 248 ! ! 249 ! INTEGER :: ji, jj, jk ! dummy loop indices 250 ! INTEGER , DIMENSION(3) :: ijk_max, ijk_min ! temporary integers 251 ! REAL(wp) :: z2dt, z_tmin, z_tmax ! local scalars 252 ! LOGICAL :: ll_do_bclinic ! local logical 253 ! REAL(wp), DIMENSION(jpi,jpj) :: zht, z_scale, zwu, zwv, zhdiv 254 ! !!---------------------------------------------------------------------- 255 ! ! 256 ! IF( ln_linssh ) RETURN ! No calculation in linear free surface 257 ! ! 258 ! IF( ln_timing ) CALL timing_start('dom_qe_sf_nxt') 259 ! ! 260 ! IF( kt == nit000 ) THEN 261 ! IF(lwp) WRITE(numout,*) 262 ! IF(lwp) WRITE(numout,*) 'dom_qe_sf_nxt : compute after scale factors' 263 ! IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 264 ! ENDIF 265 ! 266 ! 267 ! ! ******************************* ! 268 ! ! After acale factors at t-points ! 269 ! ! ******************************* ! 270 ! ! ! --------------------------------------------- ! 271 ! ! ! z_star coordinate and barotropic z-tilde part ! 272 ! ! ! --------------------------------------------- ! 273 ! ! 274 ! ! 275 ! ! *********************************** ! 276 ! ! After scale factors at u- v- points ! 277 ! ! *********************************** ! 278 ! ! 279 ! DO jk = 1, jpkm1 280 ! e3t(:,:,jk,Kaa) = e3t_0(:,:,jk) * ( 1._wp + r3t(:,:,Kaa) * tmask(:,:,jk) ) 281 ! e3u(:,:,jk,Kaa) = e3u_0(:,:,jk) * ( 1._wp + r3u(:,:,Kaa) * umask(:,:,jk) ) 282 ! e3v(:,:,jk,Kaa) = e3v_0(:,:,jk) * ( 1._wp + r3v(:,:,Kaa) * vmask(:,:,jk) ) 283 ! END DO 284 ! ! 285 ! ! *********************************** ! 286 ! ! After depths at u- v points ! 287 ! ! *********************************** ! 288 ! hu(:,:,Kaa) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kaa) ) 289 ! hv(:,:,Kaa) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kaa) ) 290 ! ! ! Inverse of the local depth 291 ! r1_hu(:,:,Kaa) = ssumask(:,:) / ( hu(:,:,Kaa) + 1._wp - ssumask(:,:) ) 292 ! r1_hv(:,:,Kaa) = ssvmask(:,:) / ( hv(:,:,Kaa) + 1._wp - ssvmask(:,:) ) 293 ! ! 294 ! IF( ln_timing ) CALL timing_stop('dom_qe_sf_nxt') 295 ! ! 296 ! END SUBROUTINE dom_qe_sf_nxt 297 !!st end 298 !!st 299 !!$ SUBROUTINE dom_h_nxt( kt, Kbb, Kmm, Kaa, kcall ) 300 !!$ !!---------------------------------------------------------------------- 301 !!$ !! *** ROUTINE dom_qe_sf_nxt *** 302 !!$ !! 303 !!$ !! ** Purpose : - compute the after water heigh used in tra_zdf, dynnxt, 304 !!$ !! tranxt and dynspg routines 305 !!$ !! 306 !!$ !! ** Method : - z_star case: Proportionnaly to the water column thickness. 307 !!$ !! 308 !!$ !! ** Action : - h(u/v) update wrt ssh/h(u/v)_0 309 !!$ !! 310 !!$ !!---------------------------------------------------------------------- 311 !!$ INTEGER, INTENT( in ) :: kt ! time step 312 !!$ INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time step 313 !!$ INTEGER, INTENT( in ), OPTIONAL :: kcall ! optional argument indicating call sequence 314 !!$ ! 315 !!$ !!---------------------------------------------------------------------- 316 !!$ ! 317 !!$ IF( ln_linssh ) RETURN ! No calculation in linear free surface 318 !!$ ! 319 !!$ IF( ln_timing ) CALL timing_start('dom_h_nxt') 320 !!$ ! 321 !!$ IF( kt == nit000 ) THEN 322 !!$ IF(lwp) WRITE(numout,*) 323 !!$ IF(lwp) WRITE(numout,*) 'dom_h_nxt : compute after scale factors' 324 !!$ IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 325 !!$ ENDIF 326 !!$ ! 327 !!$ ! *********************************** ! 328 !!$ ! After depths at u- v points ! 329 !!$ ! *********************************** ! 330 !!$ hu(:,:,Kaa) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kaa) ) 331 !!$ hv(:,:,Kaa) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kaa) ) 332 !!$ ! ! Inverse of the local depth 333 !!$ r1_hu(:,:,Kaa) = ssumask(:,:) / ( hu(:,:,Kaa) + 1._wp - ssumask(:,:) ) 334 !!$ r1_hv(:,:,Kaa) = ssvmask(:,:) / ( hv(:,:,Kaa) + 1._wp - ssvmask(:,:) ) 335 !!$ ! 336 !!$ IF( ln_timing ) CALL timing_stop('dom_h_nxt') 337 !!$ ! 338 !!$ END SUBROUTINE dom_h_nxt 339 !!st end 340 ! !!st 341 ! SUBROUTINE dom_qe_sf_update( kt, Kbb, Kmm, Kaa ) 342 ! !!---------------------------------------------------------------------- 343 ! !! *** ROUTINE dom_qe_sf_update *** 344 ! !! 345 ! !! ** Purpose : for z tilde case: compute time filter and swap of scale factors 346 ! !! compute all depths and related variables for next time step 347 ! !! write outputs and restart file 348 ! !! 349 ! !! ** Method : - reconstruct scale factor at other grid points (interpolate) 350 ! !! - recompute depths and water height fields 351 ! !! 352 ! !! ** Action : - Recompute: 353 ! !! e3(u/v)_b 354 ! !! e3w(:,:,:,Kmm) 355 ! !! e3(u/v)w_b 356 ! !! e3(u/v)w_n 357 ! !! gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w 358 ! !! h(u/v) and h(u/v)r 359 ! !! 360 ! !! Reference : Leclair, M., and G. Madec, 2009, Ocean Modelling. 361 ! !! Leclair, M., and G. Madec, 2011, Ocean Modelling. 362 ! !!---------------------------------------------------------------------- 363 ! INTEGER, INTENT( in ) :: kt ! time step 364 ! INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time level indices 365 ! ! 366 ! INTEGER :: ji, jj, jk ! dummy loop indices 367 ! REAL(wp) :: zcoef ! local scalar 368 ! !!---------------------------------------------------------------------- 369 ! ! 370 ! IF( ln_linssh ) RETURN ! No calculation in linear free surface 371 ! ! 372 ! IF( ln_timing ) CALL timing_start('dom_qe_sf_update') 373 ! ! 374 ! IF( kt == nit000 ) THEN 375 ! IF(lwp) WRITE(numout,*) 376 ! IF(lwp) WRITE(numout,*) 'dom_qe_sf_update : - interpolate scale factors and compute depths for next time step' 377 ! IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 378 ! ENDIF 379 ! ! 380 ! ! Compute all missing vertical scale factor and depths 381 ! ! ==================================================== 382 ! ! Horizontal scale factor interpolations 383 ! ! -------------------------------------- 384 ! ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are already computed in dynnxt 385 ! ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 386 ! 387 ! 388 ! ! Scale factor computation 389 ! DO jk = 1, jpk ! Horizontal interpolation 390 ! e3f(:,:,jk) = e3f_0(:,:,jk) * ( 1._wp + r3f(:,:) * fmask(:,:,jk) ) ! Kmm time level 391 ! ! ! Vertical interpolation 392 ! ! ! The ratio does not have to be masked at w-level 393 ! e3w (:,:,jk,Kmm) = e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) ! Kmm time level 394 ! e3uw(:,:,jk,Kmm) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kmm) ) 395 ! e3vw(:,:,jk,Kmm) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kmm) ) 396 ! e3w (:,:,jk,Kbb) = e3w_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) ! Kbb time level 397 ! e3uw(:,:,jk,Kbb) = e3uw_0(:,:,jk) * ( 1._wp + r3u(:,:,Kbb) ) 398 ! e3vw(:,:,jk,Kbb) = e3vw_0(:,:,jk) * ( 1._wp + r3v(:,:,Kbb) ) 399 ! END DO 400 ! 401 ! 402 ! IF( ln_isf ) THEN !** IceShelF cavities 403 ! ! ! to be created depending of the new names in isf 404 ! ! ! it should be something like that : (with h_isf = thickness of iceshelf) 405 ! ! ! in fact currently, h_isf(:,:) is called : risfdep(:,:) 406 ! !!gm - depth idea 0 : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask ! 407 ! gdept(:,:,1,Kmm) = gdept_0(:,:,1) * ( 1._wp + r3t(:,:,Kmm) ) 408 ! gdepw(:,:,1,Kmm) = 0._wp ! Initialized to zero one for all 409 ! gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) ! reference to a common level z=0 for hpg 410 ! DO jk = 2, jpk 411 ! gdept(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdept_0(:,:,jk) ) & 412 ! + MAX( 0._wp , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 413 ! gdepw(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) ) & 414 ! + MAX( 0._wp , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 415 ! gde3w(:,:,jk) = gdept(:,:,jk,Kmm) - ssh(:,:,Kmm) 416 ! gdept(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdept_0(:,:,jk) ) & 417 ! + MAX( 0._wp , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 418 ! gdepw(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) ) & 419 ! + MAX( 0._wp , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 420 ! END DO 421 ! ! 422 ! ELSE !** No cavities (all depth rescaled, even inside topography: no mask) 423 ! ! 424 ! !!gm idea 0 : just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask ! 425 ! DO jk = 1, jpk 426 ! gdept(:,:,jk,Kmm) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 427 ! gdepw(:,:,jk,Kmm) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 428 ! gde3w(:,:,jk) = gdept (:,:,jk,Kmm) - ssh(:,:,Kmm) 429 ! gdept(:,:,jk,Kbb) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 430 ! gdepw(:,:,jk,Kbb) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 431 ! END DO 432 ! ! 433 ! ENDIF 434 ! 435 ! ! Local depth and Inverse of the local depth of the water 436 ! ! ------------------------------------------------------- 437 ! ! 438 ! ht(:,:) = ht_0(:,:) + ssh(:,:,Kmm) 439 ! 440 ! ! write restart file 441 ! ! ================== 442 ! IF( lrst_oce ) CALL dom_qe_rst( kt, Kbb, Kmm, 'WRITE' ) 443 ! ! 444 ! IF( ln_timing ) CALL timing_stop('dom_qe_sf_update') 445 ! ! 446 ! END SUBROUTINE dom_qe_sf_update 447 !!st end 448 449 !!$ SUBROUTINE dom_h_update( kt, Kbb, Kmm, Kaa ) 450 !!$ !!---------------------------------------------------------------------- 451 !!$ !! *** ROUTINE dom_qe_sf_update *** 452 !!$ !! 453 !!$ !! ** Purpose : for z tilde case: compute time filter and swap of scale factors 454 !!$ !! compute all depths and related variables for next time step 455 !!$ !! write outputs and restart file 456 !!$ !! 457 !!$ !! ** Method : - reconstruct scale factor at other grid points (interpolate) 458 !!$ !! - recompute depths and water height fields 459 !!$ !! 460 !!$ !! ** Action : - Recompute: 461 !!$ !! gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w 462 !!$ !! h(u/v) and h(u/v)r 463 !!$ !! 464 !!$ !! Reference : Leclair, M., and G. Madec, 2009, Ocean Modelling. 465 !!$ !! Leclair, M., and G. Madec, 2011, Ocean Modelling. 466 !!$ !!---------------------------------------------------------------------- 467 !!$ INTEGER, INTENT( in ) :: kt ! time step 468 !!$ INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time level indices 469 !!$ ! 470 !!$ INTEGER :: ji, jj, jk ! dummy loop indices 471 !!$ REAL(wp) :: zcoef ! local scalar 472 !!$ !!---------------------------------------------------------------------- 473 !!$ ! 474 !!$ IF( ln_linssh ) RETURN ! No calculation in linear free surface 475 !!$ ! 476 !!$ IF( ln_timing ) CALL timing_start('dom_qe_sf_update') 477 !!$ ! 478 !!$ IF( kt == nit000 ) THEN 479 !!$ IF(lwp) WRITE(numout,*) 480 !!$ IF(lwp) WRITE(numout,*) 'dom_qe_sf_update : - interpolate scale factors and compute depths for next time step' 481 !!$ IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 482 !!$ ENDIF 483 !!$ ! 484 !!$ ! Compute all missing vertical scale factor and depths 485 !!$ ! ==================================================== 486 !!$ ! Horizontal scale factor interpolations 487 !!$ ! -------------------------------------- 488 !!$ ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 489 !!$ 490 !!$ IF( ln_isf ) THEN !** IceShelF cavities 491 !!$ ! ! to be created depending of the new names in isf 492 !!$ ! ! it should be something like that : (with h_isf = thickness of iceshelf) 493 !!$ ! ! in fact currently, h_isf(:,:) is called : risfdep(:,:) 494 !!$ !!gm - depth idea 0 : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask ! 495 !!$ gdept(:,:,1,Kmm) = gdept_0(:,:,1) * ( 1._wp + r3t(:,:,Kmm) ) 496 !!$ gdepw(:,:,1,Kmm) = 0._wp ! Initialized to zero one for all 497 !!$ gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) ! reference to a common level z=0 for hpg 498 !!$ DO jk = 2, jpk 499 !!$ gdept(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdept_0(:,:,jk) ) & 500 !!$ + MAX( 0._wp , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 501 !!$ gdepw(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) ) & 502 !!$ + MAX( 0._wp , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) ) 503 !!$ gde3w(:,:,jk) = gdept(:,:,jk,Kmm) - ssh(:,:,Kmm) 504 !!$ gdept(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdept_0(:,:,jk) ) & 505 !!$ + MAX( 0._wp , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 506 !!$ gdepw(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) ) & 507 !!$ + MAX( 0._wp , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) ) 508 !!$ END DO 509 !!$ ! 510 !!$ ELSE !** No cavities (all depth rescaled, even inside topography: no mask) 511 !!$ ! 512 !!$ !!gm idea 0 : just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask ! 513 !!$ DO jk = 1, jpk 514 !!$ gdept(:,:,jk,Kmm) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 515 !!$ gdepw(:,:,jk,Kmm) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) ) 516 !!$ gde3w(:,:,jk) = gdept (:,:,jk,Kmm) - ssh(:,:,Kmm) 517 !!$ gdept(:,:,jk,Kbb) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 518 !!$ gdepw(:,:,jk,Kbb) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) ) 519 !!$ END DO 520 !!$ ! 521 !!$ ENDIF 522 !!$ 523 !!$ ! Local depth and Inverse of the local depth of the water 524 !!$ ! ------------------------------------------------------- 525 !!$ ! 526 !!$!!st ht(:,:) = ht_0(:,:) + ssh(:,:,Kmm) 527 !!$ 528 !!$ ! write restart file 529 !!$ ! ================== 530 !!$ IF( ln_timing ) CALL timing_stop('dom_qe_sf_update') 531 !!$ ! 532 !!$ END SUBROUTINE dom_h_update 533 !!st end 534 535 SUBROUTINE dom_qe_r3c( pssh, pr3t, pr3u, pr3v, pr3f ) 124 CALL dom_qco_r3c( ssh(:,:,Kbb), r3t(:,:,Kbb), r3u(:,:,Kbb), r3v(:,:,Kbb) ) 125 CALL dom_qco_r3c( ssh(:,:,Kmm), r3t(:,:,Kmm), r3u(:,:,Kmm), r3v(:,:,Kmm), r3f(:,:) ) 126 ! 127 END SUBROUTINE dom_qco_zgr 128 129 130 SUBROUTINE dom_qco_r3c( pssh, pr3t, pr3u, pr3v, pr3f ) 536 131 !!--------------------------------------------------------------------- 537 132 !! *** ROUTINE r3c *** … … 572 167 ! 573 168 IF( .NOT.PRESENT( pr3f ) ) THEN !- lbc on ratio at u-, v-points only 574 CALL lbc_lnk_multi( 'dom_q e_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp )169 CALL lbc_lnk_multi( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp ) 575 170 ! 576 171 ! … … 591 186 ENDIF 592 187 ! ! lbc on ratio at u-,v-,f-points 593 CALL lbc_lnk_multi( 'dom_q e_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp )188 CALL lbc_lnk_multi( 'dom_qco_r3c', pr3u, 'U', 1._wp, pr3v, 'V', 1._wp, pr3f, 'F', 1._wp ) 594 189 ! 595 190 ENDIF 596 191 ! 597 END SUBROUTINE dom_q e_r3c192 END SUBROUTINE dom_qco_r3c 598 193 599 194 … … 704 299 705 300 706 SUBROUTINE dom_q e_ctl301 SUBROUTINE dom_qco_ctl 707 302 !!--------------------------------------------------------------------- 708 !! *** ROUTINE dom_q e_ctl ***303 !! *** ROUTINE dom_qco_ctl *** 709 304 !! 710 305 !! ** Purpose : Control the consistency between namelist options … … 726 321 IF(lwp) THEN ! Namelist print 727 322 WRITE(numout,*) 728 WRITE(numout,*) 'dom_q e_ctl : choice/control of the variable vertical coordinate'323 WRITE(numout,*) 'dom_qco_ctl : choice/control of the variable vertical coordinate' 729 324 WRITE(numout,*) '~~~~~~~~~~~' 730 325 WRITE(numout,*) ' Namelist nam_vvl : chose a vertical coordinate' … … 771 366 #endif 772 367 ! 773 END SUBROUTINE dom_q e_ctl368 END SUBROUTINE dom_qco_ctl 774 369 775 370 !!====================================================================== 776 END MODULE domq e371 END MODULE domqco -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/istate.F90
r12731 r12732 60 60 ! 61 61 INTEGER :: ji, jj, jk ! dummy loop indices 62 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgdept ! !st temporary modif to be ableto use gdept subtitute62 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgdept ! 3D table !!st patch to use gdept subtitute 63 63 !!gm see comment further down 64 64 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zuvd ! U & V data workspace … … 117 117 ! 118 118 ELSE ! user defined initial T and S 119 !!st zgdept120 119 DO jk = 1, jpkm1 121 120 zgdept(:,:,jk) = gdept(:,:,jk,Kbb) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynatf.F90
r12731 r12732 215 215 zwfld(:,:) = emp_b(:,:) - emp(:,:) 216 216 IF ( ln_rnf ) zwfld(:,:) = zwfld(:,:) - ( rnf_b(:,:) - rnf(:,:) ) 217 !!st 218 !!$ DO jk = 1, jpkm1 219 !!$ ze3t_f(:,:,jk) = ze3t_f(:,:,jk) - zcoef * zwfld(:,:) * tmask(:,:,jk) & 220 !!$ & * pe3t(:,:,jk,Kmm) / ( ht_(:,:) + 1._wp - ssmask(:,:) ) 221 !!$ END DO 222 !!st end 223 DO_3D_11_11( 1, jpkm1 ) 224 ze3t_f(ji,jj,jk) = ze3t_f(ji,jj,jk) - zcoef * zwfld(ji,jj) * tmask(ji,jj,jk) & 225 & * pe3t(ji,jj,jk,Kmm) / ( ht(ji,jj) + 1._wp - ssmask(ji,jj) ) 226 END_3D 217 218 DO jk = 1, jpkm1 219 ze3t_f(:,:,jk) = ze3t_f(:,:,jk) - zcoef * zwfld(:,:) * tmask(:,:,jk) & 220 & * pe3t(:,:,jk,Kmm) / ( ht_(:,:) + 1._wp - ssmask(:,:) ) 221 END DO 227 222 ! 228 223 ! ice shelf melting (deal separately as it can be in depth) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynatf_qco.F90
r12731 r12732 147 147 ELSE ! Variable volume ! 148 148 ! ! ================! 149 ! Time-filtered scale factor at t-points150 ! ----------------------------------------------------151 ! DO jk = 1, jpk ! filtered scale factor at T-points152 ! pe3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + r3t_f(:,:) * tmask(:,:,jk) )153 ! END DO154 !155 149 ! 156 150 IF( ln_dynadv_vec ) THEN ! Asselin filter applied on velocity 157 151 ! Before filtered scale factor at (u/v)-points 158 ! DO jk = 1, jpk159 ! pe3u(:,:,jk,Kmm) = e3u_0(:,:,jk) * ( 1._wp + r3u_f(:,:) * umask(:,:,jk) )160 ! pe3v(:,:,jk,Kmm) = e3v_0(:,:,jk) * ( 1._wp + r3v_f(:,:) * vmask(:,:,jk) )161 ! END DO162 !163 152 DO_3D_11_11( 1, jpkm1 ) 164 153 puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) … … 169 158 ! 170 159 DO_3D_11_11( 1, jpkm1 ) 171 ! zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa)172 ! zve3a = pe3v(ji,jj,jk,Kaa) * pvv(ji,jj,jk,Kaa)173 ! zue3n = pe3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Kmm)174 ! zve3n = pe3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Kmm)175 ! zue3b = pe3u(ji,jj,jk,Kbb) * puu(ji,jj,jk,Kbb)176 ! zve3b = pe3v(ji,jj,jk,Kbb) * pvv(ji,jj,jk,Kbb)177 !178 160 zue3a = ( 1._wp + r3u(ji,jj,Kaa) * umask(ji,jj,jk) ) * puu(ji,jj,jk,Kaa) 179 161 zve3a = ( 1._wp + r3v(ji,jj,Kaa) * vmask(ji,jj,jk) ) * pvv(ji,jj,jk,Kaa) … … 183 165 zve3b = ( 1._wp + r3v(ji,jj,Kbb) * vmask(ji,jj,jk) ) * pvv(ji,jj,jk,Kbb) 184 166 ! ! filtered scale factor at U-,V-points 185 ! pe3u(ji,jj,jk,Kmm) = e3u_0(ji,jj,jk) * ( 1._wp + r3u_f(ji,jj) * umask(ji,jj,jk) ) 186 ! pe3v(ji,jj,jk,Kmm) = e3v_0(ji,jj,jk) * ( 1._wp + r3v_f(ji,jj) * vmask(ji,jj,jk) ) 187 ! 188 puu(ji,jj,jk,Kmm) = ( zue3n + rn_atfp * ( zue3b - 2._wp * zue3n + zue3a ) ) / ( 1._wp + r3u_f(ji,jj)*umask(ji,jj,jk) ) !!st ze3u_f(ji,jj,jk) 189 pvv(ji,jj,jk,Kmm) = ( zve3n + rn_atfp * ( zve3b - 2._wp * zve3n + zve3a ) ) / ( 1._wp + r3v_f(ji,jj)*vmask(ji,jj,jk) ) !!st ze3v_f(ji,jj,jk) 167 puu(ji,jj,jk,Kmm) = ( zue3n + rn_atfp * ( zue3b - 2._wp * zue3n + zue3a ) ) / ( 1._wp + r3u_f(ji,jj)*umask(ji,jj,jk) ) 168 pvv(ji,jj,jk,Kmm) = ( zve3n + rn_atfp * ( zve3b - 2._wp * zve3n + zve3a ) ) / ( 1._wp + r3v_f(ji,jj)*vmask(ji,jj,jk) ) 190 169 END_3D 191 170 ! … … 221 200 ! integration 222 201 ! 223 !!st224 !!$ IF(.NOT.ln_linssh ) THEN225 !!$ hu(:,:,Kmm) = e3u(:,:,1,Kmm ) * umask(:,:,1)226 !!$ hv(:,:,Kmm) = e3v(:,:,1,Kmm ) * vmask(:,:,1)227 !!$ DO jk = 2, jpkm1228 !!$ hu(:,:,Kmm) = hu(:,:,Kmm) + e3u(:,:,jk,Kmm ) * umask(:,:,jk)229 !!$ hv(:,:,Kmm) = hv(:,:,Kmm) + e3v(:,:,jk,Kmm ) * vmask(:,:,jk)230 !!$ END DO231 !!$ r1_hu(:,:,Kmm) = ssumask(:,:) / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) )232 !!$ r1_hv(:,:,Kmm) = ssvmask(:,:) / ( hv(:,:,Kmm) + 1._wp - ssvmask(:,:) )233 !!$ ENDIF234 !235 202 uu_b(:,:,Kaa) = e3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) 236 203 uu_b(:,:,Kmm) = e3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynspg_ts.F90
r12731 r12732 388 388 zhup2_e(:,:) = hu(:,:,Kmm) 389 389 zhvp2_e(:,:) = hv(:,:,Kmm) 390 !!st not used ? zhtp2_e(:,:) = ht_(:,:)390 zhtp2_e(:,:) = ht(:,:) 391 391 ENDIF 392 392 ! -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ISF/isfcpl.F90
r12731 r12732 18 18 USE domvvl , ONLY: dom_vvl_zgr ! vertical scale factor interpolation 19 19 #else 20 USE domq e , ONLY: dom_qe_zgr ! vertical scale factor interpolation20 USE domqco , ONLY: dom_qco_zgr ! vertical scale factor interpolation 21 21 #endif 22 22 USE domngb , ONLY: dom_ngb ! find the closest grid point from a given lon/lat position … … 142 142 !!---------------------------------------------------------------------- 143 143 INTEGER :: jk ! loop index 144 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, zgdepw ! e3t , e3u, e3v 145 !!---------------------------------------------------------------------- 146 ! 147 !!st patch to be able to use substitution 144 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, zgdepw ! e3t , e3u, e3v !!st patch to use substitution 145 !!---------------------------------------------------------------------- 146 ! 148 147 DO jk = 1, jpk 149 148 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 150 149 ze3u(:,:,jk) = e3u(:,:,jk,Kmm) 151 150 ze3v(:,:,jk) = e3v(:,:,jk,Kmm) 151 ! 152 152 zgdepw(:,:,jk) = gdepw(:,:,jk,Kmm) 153 153 END DO … … 233 233 CALL dom_vvl_zgr(Kbb, Kmm, Kaa) 234 234 #else 235 CALL dom_q e_zgr(Kbb, Kmm, Kaa)235 CALL dom_qco_zgr(Kbb, Kmm, Kaa) 236 236 #endif 237 237 ! -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ISF/isfdynatf.F90
r12731 r12732 15 15 USE phycst , ONLY: r1_rho0 ! physical constant 16 16 USE dom_oce ! time and space domain 17 USE oce, ONLY : ssh ! sea-surface height 18 !!st 17 USE oce, ONLY : ssh ! sea-surface height !!st needed for substitution 18 19 19 USE in_out_manager 20 20 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/SBC/sbcice_cice.F90
r12724 r12732 12 12 USE oce ! ocean dynamics and tracers 13 13 USE dom_oce ! ocean space and time domain 14 # if ! defined key_qco 14 15 USE domvvl 16 # else 17 USE domqco 18 # endif 15 19 USE phycst, only : rcp, rho0, r1_rho0, rhos, rhoi 16 20 USE in_out_manager ! I/O manager … … 234 238 !!gm especially here it is assumed zstar coordinate, but it can be ztilde.... 235 239 #if defined key_qco 236 IF( .NOT.ln_linssh ) CALL dom_q e_zgr( Kbb, Kmm, Kaa ) ! interpolation scale factor, depth and water column240 IF( .NOT.ln_linssh ) CALL dom_qco_zgr( Kbb, Kmm, Kaa ) ! interpolation scale factor, depth and water column 237 241 #else 238 242 IF( .NOT.ln_linssh ) THEN -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/TRA/traatf_qco.F90
r12731 r12732 53 53 54 54 PUBLIC tra_atf_qco ! routine called by step.F90 55 PUBLIC tra_atf_fix_lf ! to be used in trcnxt !!st WARNING discrepancy here interpol is used56 PUBLIC tra_atf_qco_lf ! to be used in trcnxt !!st WARNING discrepancy here interpol is used 55 PUBLIC tra_atf_fix_lf ! to be used in trcnxt !!st WARNING discrepancy here interpol is used by PISCES 56 PUBLIC tra_atf_qco_lf ! to be used in trcnxt !!st WARNING discrepancy here interpol is used by PISCES 57 57 58 58 !! * Substitutions … … 103 103 IF(lwp) WRITE(numout,*) '~~~~~~~' 104 104 ENDIF 105 106 ! ! Update after tracer on domain lateral boundaries 107 ! ! 108 ! #if defined key_agrif 109 ! CALL Agrif_tra ! AGRIF zoom boundaries 110 ! #endif 111 ! ! ! local domain boundaries (T-point, unchanged sign) 112 ! CALL lbc_lnk_multi( 'traatfLF', pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1. ) 113 ! ! 114 ! IF( ln_bdy ) CALL bdy_tra( kt, Kbb, pts, Kaa ) ! BDY open boundaries 105 !!st Update after tracer on domain lateral boundaries as been removed outside 115 106 116 107 ! trends computation initialisation … … 127 118 ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from pts(Kmm) terms 128 119 DO jk = 1, jpkm1 129 ! ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kaa)*e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_tem,Kmm)) * zfact130 ! ztrds(:,:,jk) = ( pts(:,:,jk,jp_sal,Kaa)*e3t(:,:,jk,Kaa) / e3t(:,:,jk,Kmm) - pts(:,:,jk,jp_sal,Kmm)) * zfact131 120 ztrdt(:,:,jk) = ( pts(:,:,jk,jp_tem,Kaa) * (1._wp + r3t(:,:,Kaa) * tmask(:,:,jk))/(1._wp + r3t(:,:,Kmm) * tmask(:,:,jk)) & 132 121 & - pts(:,:,jk,jp_tem,Kmm) ) * zfact … … 251 240 INTEGER :: ji, jj, jk, jn ! dummy loop indices 252 241 REAL(wp) :: zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar 253 REAL(wp) :: zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f , ze3t_d! - -242 REAL(wp) :: zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f ! - - 254 243 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrd_atf 255 244 !!---------------------------------------------------------------------- … … 288 277 ztc_a = pt(ji,jj,jk,jn,Kaa) * ze3t_a 289 278 ! 290 ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b291 279 ztc_d = ztc_a - 2. * ztc_n + ztc_b 292 280 ! -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ZDF/zdfosm.F90
r12731 r12732 475 475 476 476 zhbl_t(:,:) = hbl(:,:) + (zdhdt(:,:) - ww(ji,jj,ibld(ji,jj)))* rn_Dt ! certainly need wb here, so subtract it 477 !!st zhbl_t(:,:) = MIN(zhbl_t(:,:), ht_(:,:)) 478 DO_2D_11_11 479 zhbl_t(ji,jj) = MIN(zhbl_t(ji,jj), ht(ji,jj)) 480 END_2D 477 zhbl_t(:,:) = MIN(zhbl_t(:,:), ht(:,:)) 481 478 zdhdt(:,:) = MIN(zdhdt(:,:), (zhbl_t(:,:) - hbl(:,:))/rn_Dt + ww(ji,jj,ibld(ji,jj))) ! adjustment to represent limiting by ocean bottom 482 479 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/nemogcm.F90
r12724 r12732 61 61 USE diamlr ! IOM context management for multiple-linear-regression analysis 62 62 #if defined key_qco 63 USE step lf ! NEMO time-stepping (stplfroutine)63 USE stepMLF ! NEMO time-stepping (stp_MLF routine) 64 64 #else 65 65 USE step ! NEMO time-stepping (stp routine) … … 129 129 !! 130 130 !! ** Method : - model general initialization 131 !! - launch the time-stepping (stp lfroutine)131 !! - launch the time-stepping (stp routine) 132 132 !! - finalize the run by closing files and communications 133 133 !! … … 187 187 DO WHILE( istp <= nitend .AND. nstop == 0 ) 188 188 #if defined key_qco 189 CALL stp lf189 CALL stp_MLF 190 190 #else 191 191 CALL stp … … 215 215 216 216 #if defined key_qco 217 CALL stp lf( istp )217 CALL stp_MLF ( istp ) 218 218 #else 219 219 CALL stp ( istp ) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/stpMLF.F90
r12731 r12732 1 MODULE step lf1 MODULE stepMLF 2 2 !!====================================================================== 3 3 !! *** MODULE step *** … … 35 35 36 36 !!---------------------------------------------------------------------- 37 !! stp lf: OPA system time-stepping38 !!---------------------------------------------------------------------- 39 USE step_oce 37 !! stp_MLF : OPA system time-stepping 38 !!---------------------------------------------------------------------- 39 USE step_oce ! time stepping definition modules 40 40 ! 41 USE iom 42 USE domq e43 USE traatfqco 44 USE dynatfqco 45 USE dynspg_ts 46 USE bdydyn 41 USE iom ! xIOs server 42 USE domqco 43 USE traatfqco ! time filtering (tra_atf_qco routine) 44 USE dynatfqco ! time filtering (dyn_atf_qco routine) 45 USE dynspg_ts ! surface pressure gradient: split-explicit scheme (define un_adv) 46 USE bdydyn ! ocean open boundary conditions (define bdy_dyn) 47 47 48 48 IMPLICIT NONE 49 49 PRIVATE 50 50 51 PUBLIC stp lf! called by nemogcm.F9051 PUBLIC stp_MLF ! called by nemogcm.F90 52 52 53 53 !!---------------------------------------------------------------------- … … 64 64 65 65 #if defined key_agrif 66 RECURSIVE SUBROUTINE stp lf( )66 RECURSIVE SUBROUTINE stp_MLF( ) 67 67 INTEGER :: kstp ! ocean time-step index 68 68 #else 69 SUBROUTINE stp lf( kstp )69 SUBROUTINE stp_MLF( kstp ) 70 70 INTEGER, INTENT(in) :: kstp ! ocean time-step index 71 71 #endif 72 72 !!---------------------------------------------------------------------- 73 !! *** ROUTINE stp lf***73 !! *** ROUTINE stp_MLF *** 74 74 !! 75 75 !! ** Purpose : - Time stepping of OPA (momentum and active tracer eqs.) … … 91 91 INTEGER :: kcall ! optional integer argument (dom_vvl_sf_nxt) 92 92 !!st patch 93 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgdept ! st patch93 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgdept 94 94 !! --------------------------------------------------------------------- 95 95 #if defined key_agrif … … 106 106 #endif 107 107 ! 108 IF( ln_timing ) CALL timing_start('stp lf')108 IF( ln_timing ) CALL timing_start('stp_MLF') 109 109 ! 110 110 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 142 142 IF( ln_isf ) CALL isf_stp ( kstp, Nnn ) 143 143 CALL sbc ( kstp, Nbb, Nnn ) ! Sea Boundary Condition (including sea-ice) 144 145 ! !!st !!!!!!!!!!!!!!!!!!!!!!!146 !147 ! emp = 0._wp148 ! emp_b = 0._wp149 ! qns = 0._wp150 ! qsr = 0._wp151 ! qns_b = 0._wp152 !153 ! !!st154 144 155 145 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 196 186 ! Ocean dynamics : hdiv, ssh, e3, u, v, w 197 187 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 198 !!st patch199 !!st patch to be able to use substitution200 188 DO jk = 1, jpk 201 189 zgdept(:,:,jk) = gdept(:,:,jk,Nnn) 202 190 END DO 203 !!st end 204 CALL ssh_nxt ( kstp, Nbb, Nnn, ssh, Naa ) ! after ssh (includes call to div_hor) 205 IF( .NOT.ln_linssh ) CALL dom_qe_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa) ) 206 !!st IF( .NOT.ln_linssh ) CALL dom_h_nxt ( kstp, Nbb, Nnn, Naa ) ! after vertical scale factors 207 !IF( .NOT.ln_linssh ) CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn, Naa ) ! after vertical scale factors 191 CALL ssh_nxt ( kstp, Nbb, Nnn, ssh, Naa ) ! after ssh (includes call to div_hor) 192 IF( .NOT.ln_linssh ) CALL dom_qco_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa) ) ! "after" ssh./h._0 ratio 208 193 CALL wzv ( kstp, Nbb, Nnn, Naa, ww ) ! Nnn cross-level velocity 209 IF( ln_zad_Aimp ) CALL wAimp ( kstp, Nnn ) ! Adaptive-implicit vertical advection partitioning210 CALL eos ( ts(:,:,:,:,Nnn), rhd, rhop, zgdept ) 194 IF( ln_zad_Aimp ) CALL wAimp ( kstp, Nnn ) ! Adaptive-implicit vertical advection partitioning 195 CALL eos ( ts(:,:,:,:,Nnn), rhd, rhop, zgdept ) ! now in situ density for hpg computation 211 196 212 197 … … 231 216 IF( ln_dynspg_ts ) THEN ! vertical scale factors and vertical velocity need to be updated 232 217 CALL div_hor ( kstp, Nbb, Nnn ) ! Horizontal divergence (2nd call in time-split case) 233 IF(.NOT.ln_linssh) CALL dom_qe_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) ) 234 !IF(.NOT.ln_linssh) CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn, Naa, kcall=2 ) ! after vertical scale factors (update depth average component) 235 !!st IF(.NOT.ln_linssh) CALL dom_h_nxt ( kstp, Nbb, Nnn, Naa, kcall=2 ) ! after vertical scale factors (update depth average component) 218 IF(.NOT.ln_linssh) CALL dom_qco_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) ) ! "after" ssh./h._0 ratio 236 219 ENDIF 237 220 CALL dyn_zdf ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa ) ! vertical diffusion … … 311 294 !! place. 312 295 !! 313 CALL zdyn_ts ( Nnn, Naa, uu, vv ) ! barotrope ajustment314 CALL finalize_sbc ( kstp, Nbb, Naa, uu, vv, ts ) 315 CALL ssh_atf ( kstp, Nbb, Nnn, Naa, ssh ) 316 CALL dom_q e_r3c ( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f )! "now" ssh/h_0 ratio from filtrered ssh317 CALL tra_atf_qco ( kstp, Nbb, Nnn, Naa, ts ) 318 CALL dyn_atf_qco ( kstp, Nbb, Nnn, Naa, uu, vv ) ! time filtering of "now" velocities and scale factors296 CALL zdyn_ts ( Nnn, Naa, uu, vv ) ! barotrope ajustment 297 CALL finalize_sbc ( kstp, Nbb, Naa, uu, vv, ts ) ! boundary condifions 298 CALL ssh_atf ( kstp, Nbb, Nnn, Naa, ssh ) ! time filtering of "now" sea surface height 299 CALL dom_qco_r3c ( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f ) ! "now" ssh/h_0 ratio from filtrered ssh 300 CALL tra_atf_qco ( kstp, Nbb, Nnn, Naa, ts ) ! time filtering of "now" tracer arrays 301 CALL dyn_atf_qco ( kstp, Nbb, Nnn, Naa, uu, vv ) ! time filtering of "now" velocities and scale factors 319 302 r3t(:,:,Nnn) = r3t_f(:,:) 320 303 r3u(:,:,Nnn) = r3u_f(:,:) … … 328 311 Naa = Nrhs 329 312 ! 330 !IF(.NOT.ln_linssh) CALL dom_qe_sf_update( kstp, Nbb, Nnn, Naa ) ! recompute vertical scale factors331 !!st IF(.NOT.ln_linssh) CALL dom_h_update ( kstp, Nbb, Nnn, Naa ) ! recompute vertical scale factors332 313 ! 333 314 IF( ln_diahsb ) CALL dia_hsb ( kstp, Nbb, Nnn ) ! - ML - global conservation diagnostics … … 346 327 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 347 328 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices 348 CALL Agrif_Integrate_ChildGrids( stp lf) ! allows to finish all the Child Grids before updating329 CALL Agrif_Integrate_ChildGrids( stp_MLF ) ! allows to finish all the Child Grids before updating 349 330 350 331 IF( Agrif_NbStepint() == 0 ) THEN … … 385 366 ENDIF 386 367 ! 387 IF( ln_timing ) CALL timing_stop('stp lf')388 ! 389 END SUBROUTINE stp lf368 IF( ln_timing ) CALL timing_stop('stp_MLF') 369 ! 370 END SUBROUTINE stp_MLF 390 371 391 372 … … 481 462 ! 482 463 !!====================================================================== 483 END MODULE step lf464 END MODULE stepMLF
Note: See TracChangeset
for help on using the changeset viewer.
