Changeset 12731
- Timestamp:
- 2020-04-09T19:30:08+02:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src
- Files:
-
- 19 edited
-
ICE/icedyn_rhg_evp.F90 (modified) (1 diff)
-
OCE/ASM/asminc.F90 (modified) (3 diffs)
-
OCE/DIA/diaar5.F90 (modified) (3 diffs)
-
OCE/DIA/diawri.F90 (modified) (8 diffs)
-
OCE/DOM/dom_oce.F90 (modified) (2 diffs)
-
OCE/DOM/domain.F90 (modified) (5 diffs)
-
OCE/DOM/domqe.F90 (modified) (4 diffs)
-
OCE/DOM/domzgr_substitute.h90 (modified) (1 diff)
-
OCE/DOM/istate.F90 (modified) (3 diffs)
-
OCE/DYN/dynatf.F90 (modified) (1 diff)
-
OCE/DYN/dynatfQCO.F90 (modified) (1 diff)
-
OCE/DYN/dynhpg.F90 (modified) (1 diff)
-
OCE/DYN/dynspg_ts.F90 (modified) (6 diffs)
-
OCE/ISF/isfcpl.F90 (modified) (2 diffs)
-
OCE/ISF/isfdynatf.F90 (modified) (1 diff)
-
OCE/ISF/isfstp.F90 (modified) (4 diffs)
-
OCE/LDF/ldfslp.F90 (modified) (1 diff)
-
OCE/ZDF/zdfosm.F90 (modified) (1 diff)
-
OCE/stepLF.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/ICE/icedyn_rhg_evp.F90
r12724 r12731 49 49 !! * Substitutions 50 50 # include "do_loop_substitute.h90" 51 # include "domzgr_substitute.h90" 51 52 !!---------------------------------------------------------------------- 52 53 !! NEMO/ICE 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ASM/asminc.F90
r12724 r12731 803 803 ELSE 804 804 ALLOCATE( ztim(jpi,jpj) ) 805 ztim(:,:) = ssh_iau(:,:) / ( ht(:,:) + 1.0 - ssmask(:,:) ) 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 806 809 DO jk = 1, jpkm1 807 810 phdivn(:,:,jk) = phdivn(:,:,jk) - ztim(:,:) * tmask(:,:,jk) … … 900 903 IF ( kt == nitdin_r ) THEN 901 904 ! 902 l_1st_euler = 0! Force Euler forward step905 l_1st_euler = .TRUE. ! Force Euler forward step 903 906 ! 904 907 ! Sea-ice : SI3 case … … 974 977 ! ! set to bottom of a level 975 978 ! DO jk = jpk-1, 2, -1 976 ! IF ((mld > gdepw(ji,jj,jk )) .and. (mld < gdepw(ji,jj,jk+1))) THEN977 ! mld=gdepw(ji,jj,jk+1 )979 ! IF ((mld > gdepw(ji,jj,jk,Kmm)) .and. (mld < gdepw(ji,jj,jk+1,Kmm))) THEN 980 ! mld=gdepw(ji,jj,jk+1,Kmm) 978 981 ! jkmax=jk 979 982 ! ENDIF -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diaar5.F90
r12724 r12731 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 ! 3D workspace80 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d, zrhd , zrhop, ztpot, zgdept ! 3D workspace 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 CALL eos( ztsn, zrhd, gdept(:,:,:,Kmm) ) ! now in situ density using initial salinity 134 !!st to be improved 135 DO jk = 1, jpkm1 136 zgdept(:,:,jk) = gdept(:,:,jk,Kmm) 137 END DO 138 CALL eos( ztsn, zrhd, zgdept) ! now in situ density using initial salinity 135 139 ! 136 140 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice … … 159 163 160 164 ! ! steric sea surface height 161 CALL eos( ts(:,:,:,:,Kmm), zrhd, zrhop, gdept(:,:,:,Kmm)) ! now in situ and potential density165 CALL eos( ts(:,:,:,:,Kmm), zrhd, zrhop, zgdept ) ! now in situ and potential density 162 166 zrhop(:,:,jpk) = 0._wp 163 167 CALL iom_put( 'rhop', zrhop ) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diawri.F90
r12724 r12731 435 435 ! 436 436 REAL(wp), DIMENSION(jpi,jpj) :: zw2d ! 2D workspace 437 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d, ze3t ! 3D workspace437 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d, ze3t, zgdept ! 3D workspace 438 438 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl ! ABL 3D workspace 439 439 !!---------------------------------------------------------------------- … … 479 479 DO jk = 1, jpk 480 480 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 481 zgdept(:,:,jk) = gdept(:,:,jk,Kmm) 481 482 END DO 482 483 … … 805 806 zw3d(:,:,:) = ( ( ze3t(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 806 807 CALL histwrite( nid_T, "vovvle3t", it, ze3t (:,:,:) , ndim_T , ndex_T ) ! level thickness 807 CALL histwrite( nid_T, "vovvldep", it, gdept(:,:,:,Kmm) , ndim_T , ndex_T ) ! t-point depth808 CALL histwrite( nid_T, "vovvldep", it, zgdept , ndim_T , ndex_T ) ! t-point depth !!st patch 808 809 CALL histwrite( nid_T, "vovvldef", it, zw3d , ndim_T , ndex_T ) ! level thickness deformation 809 810 ENDIF … … 944 945 !! 945 946 INTEGER :: inum, jk 946 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t 947 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, zgdept ! 3D workspace 947 948 !!---------------------------------------------------------------------- 948 949 ! … … 954 955 ENDIF 955 956 ! 957 !!st patch 956 958 DO jk = 1, jpk 957 959 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 960 zgdept(:,:,jk) = gdept(:,:,jk,Kmm) 958 961 END DO 959 962 ! … … 962 965 CALL iom_rstput( 0, 0, inum, 'votemper', ts(:,:,:,jp_tem,Kmm) ) ! now temperature 963 966 CALL iom_rstput( 0, 0, inum, 'vosaline', ts(:,:,:,jp_sal,Kmm) ) ! now salinity 964 CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,: ,Kmm)) ! sea surface height965 CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,: ,Kmm)) ! now i-velocity966 CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,: ,Kmm)) ! now j-velocity967 CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,: ,Kmm) ) ! sea surface height 968 CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu(:,:,: ,Kmm) ) ! now i-velocity 969 CALL iom_rstput( 0, 0, inum, 'vomecrty', vv(:,:,: ,Kmm) ) ! now j-velocity 967 970 IF( ln_zad_Aimp ) THEN 968 971 CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww + wi ) ! now k-velocity … … 971 974 ENDIF 972 975 CALL iom_rstput( 0, 0, inum, 'risfdep', risfdep ) ! now k-velocity 973 CALL iom_rstput( 0, 0, inum, 'ht' , ht 976 CALL iom_rstput( 0, 0, inum, 'ht' , ht(:,:) ) ! now water column height 974 977 ! 975 978 IF ( ln_isf ) THEN … … 1007 1010 CALL iom_rstput( 0, 0, inum, 'sozotaux', utau ) ! i-wind stress 1008 1011 CALL iom_rstput( 0, 0, inum, 'sometauy', vtau ) ! j-wind stress 1009 IF( .NOT.ln_linssh ) THEN 1010 CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept(:,:,:,Kmm) ) ! T-cell depth 1011 CALL iom_rstput( 0, 0, inum, 'vovvle3t', ze3t(:,:,:) ) ! T-cell thickness 1012 IF( .NOT.ln_linssh ) THEN 1013 !!st patch 1014 CALL iom_rstput( 0, 0, inum, 'vovvldep', zgdept ) ! T-cell depth 1015 CALL iom_rstput( 0, 0, inum, 'vovvle3t', ze3t ) ! T-cell thickness 1012 1016 END IF 1013 1017 IF( ln_wave .AND. ln_sdw ) THEN -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/dom_oce.F90
r12724 r12731 159 159 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hf_0, r1_hf_0 !: f-depth [m] and [1/m] 160 160 ! ! time-dependent heights of ocean water column 161 #if ! defined key_qco 161 162 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht !: t-points [m] 163 #endif 162 164 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hu, r1_hu !: u-depth [m] and [1/m] 163 165 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hv, r1_hv !: v-depth [m] and [1/m] … … 293 295 ii = ii+1 294 296 ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj) , hv_0(jpi,jpj) , hf_0(jpi,jpj) , & 295 & ht (jpi,jpj) , hu (jpi,jpj,jpt), hv (jpi,jpj,jpt) , &296 & r1_hu (jpi,jpj,jpt), r1_hv (jpi,jpj,jpt) , &297 297 & r1_ht_0(jpi,jpj) , r1_hu_0(jpi,jpj) , r1_hv_0(jpi,jpj), r1_hf_0(jpi,jpj) , STAT=ierr(ii) ) 298 ! 299 #if ! defined key_qco 300 ii = ii+1 301 ALLOCATE( ht (jpi,jpj) , hu (jpi,jpj,jpt), hv (jpi,jpj,jpt) , & 302 & r1_hu (jpi,jpj,jpt), r1_hv (jpi,jpj,jpt) , STAT=ierr(ii) ) 303 #else 304 ii = ii+1 305 ALLOCATE( hu (jpi,jpj,jpt), hv (jpi,jpj,jpt) , & 306 & r1_hu (jpi,jpj,jpt), r1_hv (jpi,jpj,jpt) , STAT=ierr(ii) ) 307 #endif 298 308 ! 299 309 ii = ii+1 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domain.F90
r12724 r12731 149 149 CALL dom_msk( ik_top, ik_bot ) ! Masks 150 150 ! 151 ht_0(:,:) = 0._wp ! Reference ocean thickness151 !!st ht_0(:,:) = 0._wp ! Reference ocean thickness 152 152 hu_0(:,:) = 0._wp 153 153 hv_0(:,:) = 0._wp … … 166 166 167 167 ! 168 #if defined key_qco 169 ! !== initialisation of time varying coordinate ==! Quasi-Euerian coordinate case 170 ! 171 IF( .NOT.l_offline ) CALL dom_qe_init( Kbb, Kmm, Kaa ) 172 ! 173 IF( ln_linssh ) CALL ctl_stop('STOP','domain: key_qco and ln_linssh = T are incompatible') 174 ! 175 #else 168 176 ! !== time varying part of coordinate system ==! 169 177 ! … … 176 184 gde3w(:,:,:) = gde3w_0(:,:,:) ! = gdept as the sum of e3t 177 185 ! 178 #if defined key_qco179 ! Quasi-Euerian coordinate : no initialisation of e3. scale factors180 #else181 186 DO jt = 1, jpt ! vertical scale factors 182 187 e3t(:,:,:,jt) = e3t_0(:,:,:) … … 189 194 e3f(:,:,:) = e3f_0(:,:,:) 190 195 ! 191 #endif192 !193 196 DO jt = 1, jpt ! water column thickness and its inverse 194 197 hu(:,:,jt) = hu_0(:,:) … … 201 204 ELSE != time varying : initialize before/now/after variables 202 205 ! 203 #if defined key_qco204 IF( .NOT.l_offline ) CALL dom_qe_init( Kbb, Kmm, Kaa )205 #else206 206 IF( .NOT.l_offline ) CALL dom_vvl_init( Kbb, Kmm, Kaa ) 207 ! 208 ENDIF 207 209 #endif 208 ! 209 ENDIF 210 210 211 ! 211 212 IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domqe.F90
r12724 r12731 44 44 !!st PUBLIC dom_qe_sf_nxt ! called by steplf.F90 45 45 !!st PUBLIC dom_qe_sf_update ! called by steplf.F90 46 PUBLIC dom_h_nxt ! called by steplf.F9047 PUBLIC dom_h_update ! called by steplf.F9046 !!st PUBLIC dom_h_nxt ! called by steplf.F90 47 !!st PUBLIC dom_h_update ! called by steplf.F90 48 48 PUBLIC dom_qe_r3c ! called by steplf.F90 49 49 … … 175 175 !!st end 176 176 ! 177 !!st ATTENTION CAS ISF A GERER !!! 177 178 ! !== depth of t and w-point ==! (set the isf depth as it is in the initial timestep) 178 IF( ln_isf ) THEN !** IceShelF cavities179 ! ! to be created depending of the new names in isf180 ! ! it should be something like that : (with h_isf = thickness of iceshelf)181 ! ! in fact currently, h_isf(:,:) is called : risfdep(:,:)182 !! gm - depth idea 0 : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask !183 gdept(:,:,1,Kmm) = gdept_0(:,:,1) * ( 1._wp + r3t(:,:,Kmm) )184 gdepw(:,:,1,Kmm) = 0._wp ! Initialized to zero one for all185 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) ! reference to a common level z=0 for hpg186 DO jk = 2, jpk187 gdept(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdept_0(:,:,jk) ) &188 + MAX( 0._wp , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) )189 gdepw(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) ) &190 + MAX( 0._wp , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) )191 gde3w(:,:,jk) = gdept(:,:,jk,Kmm) - ssh(:,:,Kmm)192 gdept(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdept_0(:,:,jk) ) &193 + MAX( 0._wp , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) )194 gdepw(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) ) &195 + MAX( 0._wp , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) )196 END DO197 !198 ELSE !** No cavities (all depth rescaled, even inside topography: no mask)199 !200 !! gm idea 0 : just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask !201 DO jk = 1, jpk202 gdept(:,:,jk,Kmm) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) )203 gdepw(:,:,jk,Kmm) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) )204 gde3w(:,:,jk) = gdept (:,:,jk,Kmm) - ssh(:,:,Kmm)205 gdept(:,:,jk,Kbb) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) )206 gdepw(:,:,jk,Kbb) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) )207 END DO208 !209 ENDIF179 !!$ 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 210 211 ! 211 212 ! !== thickness of the water column !! (ocean portion only) 212 ht(:,:) = ht_0(:,:) + ssh(:,:,Kmm) 213 hu(:,:,Kbb) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kbb) ) 214 hu(:,:,Kmm) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kmm) ) 215 hv(:,:,Kbb) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kbb) ) 216 hv(:,:,Kmm) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kmm) ) 217 ! 218 ! !== inverse of water column thickness ==! (u- and v- points) 219 r1_hu(:,:,Kbb) = ssumask(:,:) / ( hu(:,:,Kbb) + 1._wp - ssumask(:,:) ) ! _i mask due to ISF 220 r1_hu(:,:,Kmm) = ssumask(:,:) / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) ) 221 r1_hv(:,:,Kbb) = ssvmask(:,:) / ( hv(:,:,Kbb) + 1._wp - ssvmask(:,:) ) 222 r1_hv(:,:,Kmm) = ssvmask(:,:) / ( hv(:,:,Kmm) + 1._wp - ssvmask(:,:) ) 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 223 225 ! 224 226 END SUBROUTINE dom_qe_zgr … … 294 296 ! END SUBROUTINE dom_qe_sf_nxt 295 297 !!st end 296 297 SUBROUTINE dom_h_nxt( kt, Kbb, Kmm, Kaa, kcall )298 !!----------------------------------------------------------------------299 !! *** ROUTINE dom_qe_sf_nxt ***300 !!301 !! ** Purpose : - compute the after water heigh used in tra_zdf, dynnxt,302 !! tranxt and dynspg routines303 !!304 !! ** Method : - z_star case: Proportionnaly to the water column thickness.305 !!306 !! ** Action : - h(u/v) update wrt ssh/h(u/v)_0307 !!308 !!----------------------------------------------------------------------309 INTEGER, INTENT( in ) :: kt ! time step310 INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time step311 INTEGER, INTENT( in ), OPTIONAL :: kcall ! optional argument indicating call sequence312 !313 !!----------------------------------------------------------------------314 !315 IF( ln_linssh ) RETURN ! No calculation in linear free surface316 !317 IF( ln_timing ) CALL timing_start('dom_h_nxt')318 !319 IF( kt == nit000 ) THEN320 IF(lwp) WRITE(numout,*)321 IF(lwp) WRITE(numout,*) 'dom_h_nxt : compute after scale factors'322 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'323 ENDIF324 !325 ! *********************************** !326 ! After depths at u- v points !327 ! *********************************** !328 hu(:,:,Kaa) = hu_0(:,:) * ( 1._wp + r3u(:,:,Kaa) )329 hv(:,:,Kaa) = hv_0(:,:) * ( 1._wp + r3v(:,:,Kaa) )330 ! ! Inverse of the local depth331 r1_hu(:,:,Kaa) = ssumask(:,:) / ( hu(:,:,Kaa) + 1._wp - ssumask(:,:) )332 r1_hv(:,:,Kaa) = ssvmask(:,:) / ( hv(:,:,Kaa) + 1._wp - ssvmask(:,:) )333 !334 IF( ln_timing ) CALL timing_stop('dom_h_nxt')335 !336 END SUBROUTINE dom_h_nxt337 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 338 340 ! !!st 339 341 ! SUBROUTINE dom_qe_sf_update( kt, Kbb, Kmm, Kaa ) … … 445 447 !!st end 446 448 447 SUBROUTINE dom_h_update( kt, Kbb, Kmm, Kaa )448 !!----------------------------------------------------------------------449 !! *** ROUTINE dom_qe_sf_update ***450 !!451 !! ** Purpose : for z tilde case: compute time filter and swap of scale factors452 !! compute all depths and related variables for next time step453 !! write outputs and restart file454 !!455 !! ** Method : - reconstruct scale factor at other grid points (interpolate)456 !! - recompute depths and water height fields457 !!458 !! ** Action : - Recompute:459 !! gdept(:,:,:,Kmm), gdepw(:,:,:,Kmm) and gde3w460 !! h(u/v) and h(u/v)r461 !!462 !! Reference : Leclair, M., and G. Madec, 2009, Ocean Modelling.463 !! Leclair, M., and G. Madec, 2011, Ocean Modelling.464 !!----------------------------------------------------------------------465 INTEGER, INTENT( in ) :: kt ! time step466 INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time level indices467 !468 INTEGER :: ji, jj, jk ! dummy loop indices469 REAL(wp) :: zcoef ! local scalar470 !!----------------------------------------------------------------------471 !472 IF( ln_linssh ) RETURN ! No calculation in linear free surface473 !474 IF( ln_timing ) CALL timing_start('dom_qe_sf_update')475 !476 IF( kt == nit000 ) THEN477 IF(lwp) WRITE(numout,*)478 IF(lwp) WRITE(numout,*) 'dom_qe_sf_update : - interpolate scale factors and compute depths for next time step'479 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'480 ENDIF481 !482 ! Compute all missing vertical scale factor and depths483 ! ====================================================484 ! Horizontal scale factor interpolations485 ! --------------------------------------486 ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also487 488 IF( ln_isf ) THEN !** IceShelF cavities489 ! ! to be created depending of the new names in isf490 ! ! it should be something like that : (with h_isf = thickness of iceshelf)491 ! ! in fact currently, h_isf(:,:) is called : risfdep(:,:)492 !!gm - depth idea 0 : just realize that mask is not needed ===>>>> with ISF, rescale all grid point position below ISF : no mask !493 gdept(:,:,1,Kmm) = gdept_0(:,:,1) * ( 1._wp + r3t(:,:,Kmm) )494 gdepw(:,:,1,Kmm) = 0._wp ! Initialized to zero one for all495 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) ! reference to a common level z=0 for hpg496 DO jk = 2, jpk497 gdept(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdept_0(:,:,jk) ) &498 + MAX( 0._wp , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) )499 gdepw(:,:,jk,Kmm) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) ) &500 + MAX( 0._wp , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kmm) )501 gde3w(:,:,jk) = gdept(:,:,jk,Kmm) - ssh(:,:,Kmm)502 gdept(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdept_0(:,:,jk) ) &503 + MAX( 0._wp , gdept_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) )504 gdepw(:,:,jk,Kbb) = MIN( risfdep(:,:) , gdepw_0(:,:,jk) ) &505 + MAX( 0._wp , gdepw_0(:,:,jk)-risfdep(:,:) ) * ( 1._wp + r3t(:,:,Kbb) )506 END DO507 !508 ELSE !** No cavities (all depth rescaled, even inside topography: no mask)509 !510 !!gm idea 0 : just realize that mask is not needed ===>>>> without ISF, rescale all grid point position : no mask !511 DO jk = 1, jpk512 gdept(:,:,jk,Kmm) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) )513 gdepw(:,:,jk,Kmm) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kmm) )514 gde3w(:,:,jk) = gdept (:,:,jk,Kmm) - ssh(:,:,Kmm)515 gdept(:,:,jk,Kbb) = gdept_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) )516 gdepw(:,:,jk,Kbb) = gdepw_0(:,:,jk) * ( 1._wp + r3t(:,:,Kbb) )517 END DO518 !519 ENDIF520 521 ! Local depth and Inverse of the local depth of the water522 ! -------------------------------------------------------523 !524 ht(:,:) = ht_0(:,:) + ssh(:,:,Kmm)525 526 ! write restart file527 ! ==================528 IF( ln_timing ) CALL timing_stop('dom_qe_sf_update')529 !530 END SUBROUTINE dom_h_update531 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 532 534 533 535 SUBROUTINE dom_qe_r3c( pssh, pr3t, pr3u, pr3v, pr3f ) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domzgr_substitute.h90
r12680 r12731 19 19 # define e3uw(i,j,k,t) (e3uw_0(i,j,k)*(1._wp+r3u(i,j,t))) 20 20 # define e3vw(i,j,k,t) (e3vw_0(i,j,k)*(1._wp+r3v(i,j,t))) 21 # define ht(i,j) (ht_0(i,j)+ssh(i,j,Kmm)) 22 # define hu(i,j,t) (hu_0(i,j)*(1._wp+r3u(i,j,t))) 23 # define hv(i,j,t) (hv_0(i,j)*(1._wp+r3v(i,j,t))) 24 # define r1_hu(i,j,t) (r1_hu_0(i,j)/(1._wp+r3u(i,j,t))) 25 # define r1_hv(i,j,t) (r1_hv_0(i,j)/(1._wp+r3v(i,j,t))) 26 # define gdept(i,j,k,t) (gdept_0(i,j,k)*(1._wp+r3t(i,j,t))) 27 # define gdepw(i,j,k,t) (gdepw_0(i,j,k)*(1._wp+r3t(i,j,t))) 28 # define gde3w(i,j,k) (gdept_0(i,j,k)*(1._wp+r3t(i,j,Kmm))-ssh(i,j,Kmm)) 21 29 #endif 22 30 !!---------------------------------------------------------------------- -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/istate.F90
r12724 r12731 60 60 ! 61 61 INTEGER :: ji, jj, jk ! dummy loop indices 62 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgdept !!st temporary modif to be able to use gdept subtitute 62 63 !!gm see comment further down 63 64 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zuvd ! U & V data workspace … … 116 117 ! 117 118 ELSE ! user defined initial T and S 118 CALL usr_def_istate( gdept(:,:,:,Kbb), tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 119 !!st zgdept 120 DO jk = 1, jpkm1 121 zgdept(:,:,jk) = gdept(:,:,jk,Kbb) 122 END DO 123 CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 119 124 ENDIF 120 125 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones … … 128 133 !!gm POTENTIAL BUG : 129 134 !!gm ISSUE : if ssh(:,:,Kbb) /= 0 then, in non linear free surface, the e3._n, e3._b should be recomputed 130 !! as well as gdept and gdepw.... !!!!!135 !! as well as gdept_ and gdepw_.... !!!!! 131 136 !! ===>>>> probably a call to domvvl initialisation here.... 132 137 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynatf.F90
r12724 r12731 215 215 zwfld(:,:) = emp_b(:,:) - emp(:,:) 216 216 IF ( ln_rnf ) zwfld(:,:) = zwfld(:,:) - ( rnf_b(:,:) - rnf(:,:) ) 217 DO jk = 1, jpkm1 218 ze3t_f(:,:,jk) = ze3t_f(:,:,jk) - zcoef * zwfld(:,:) * tmask(:,:,jk) & 219 & * pe3t(:,:,jk,Kmm) / ( ht(:,:) + 1._wp - ssmask(:,:) ) 220 END DO 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 221 227 ! 222 228 ! ice shelf melting (deal separately as it can be in depth) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynatfQCO.F90
r12724 r12731 221 221 ! integration 222 222 ! 223 IF(.NOT.ln_linssh ) THEN 224 hu(:,:,Kmm) = e3u(:,:,1,Kmm ) * umask(:,:,1) 225 hv(:,:,Kmm) = e3v(:,:,1,Kmm ) * vmask(:,:,1) 226 DO jk = 2, jpkm1 227 hu(:,:,Kmm) = hu(:,:,Kmm) + e3u(:,:,jk,Kmm ) * umask(:,:,jk) 228 hv(:,:,Kmm) = hv(:,:,Kmm) + e3v(:,:,jk,Kmm ) * vmask(:,:,jk) 229 END DO 230 r1_hu(:,:,Kmm) = ssumask(:,:) / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) ) 231 r1_hv(:,:,Kmm) = ssvmask(:,:) / ( hv(:,:,Kmm) + 1._wp - ssvmask(:,:) ) 232 ENDIF 223 !!st 224 !!$ IF(.NOT.ln_linssh ) THEN 225 !!$ hu(:,:,Kmm) = e3u(:,:,1,Kmm ) * umask(:,:,1) 226 !!$ hv(:,:,Kmm) = e3v(:,:,1,Kmm ) * vmask(:,:,1) 227 !!$ DO jk = 2, jpkm1 228 !!$ hu(:,:,Kmm) = hu(:,:,Kmm) + e3u(:,:,jk,Kmm ) * umask(:,:,jk) 229 !!$ hv(:,:,Kmm) = hv(:,:,Kmm) + e3v(:,:,jk,Kmm ) * vmask(:,:,jk) 230 !!$ END DO 231 !!$ r1_hu(:,:,Kmm) = ssumask(:,:) / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) ) 232 !!$ r1_hv(:,:,Kmm) = ssvmask(:,:) / ( hv(:,:,Kmm) + 1._wp - ssvmask(:,:) ) 233 !!$ ENDIF 233 234 ! 234 235 uu_b(:,:,Kaa) = e3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynhpg.F90
r12616 r12731 781 781 !------------------------------------------------------------- 782 782 783 !!bug gm : e3w-gde3w = 0.5*e3w .... and gde3w(2)-gde3w(1)=e3w(:,:,2,:) .... to be verified784 ! true if gde3w is really defined as the sum of the e3w scale factors as, it seems to me, it should be783 !!bug gm : e3w-gde3w(:,:,:) = 0.5*e3w .... and gde3w(:,:,2)-gde3w(:,:,1)=e3w(:,:,2,Kmm) .... to be verified 784 ! true if gde3w(:,:,:) is really defined as the sum of the e3w scale factors as, it seems to me, it should be 785 785 786 786 DO_2D_00_00 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynspg_ts.F90
r12724 r12731 257 257 zhV(:,:) = pvv_b(:,:,Kmm) * hv(:,:,Kmm) * e1v(:,:) ! NB: FULL domain : put a value in last row and column 258 258 ! 259 CALL dyn_cor_2d( h u(:,:,Kmm), hv(:,:,Kmm), puu_b(:,:,Kmm), pvv_b(:,:,Kmm), zhU, zhV, & ! <<== in259 CALL dyn_cor_2d( ht(:,:), hu(:,:,Kmm), hv(:,:,Kmm), puu_b(:,:,Kmm), pvv_b(:,:,Kmm), zhU, zhV, & ! <<== in 260 260 & zu_trd, zv_trd ) ! ==>> out 261 261 ! … … 388 388 zhup2_e(:,:) = hu(:,:,Kmm) 389 389 zhvp2_e(:,:) = hv(:,:,Kmm) 390 zhtp2_e(:,:) = ht(:,:)390 !!st not used ? zhtp2_e(:,:) = ht_(:,:) 391 391 ENDIF 392 392 ! … … 574 574 ! at each time step. We however keep them constant here for optimization. 575 575 ! Recall that zhU and zhV hold fluxes at jn+0.5 (extrapolated not backward interpolated) 576 CALL dyn_cor_2d( zh up2_e, zhvp2_e, ua_e, va_e, zhU, zhV, zu_trd, zv_trd )576 CALL dyn_cor_2d( zhtp2_e, zhup2_e, zhvp2_e, ua_e, va_e, zhU, zhV, zu_trd, zv_trd ) 577 577 ! 578 578 ! Add tidal astronomical forcing if defined … … 1186 1186 1187 1187 1188 SUBROUTINE dyn_cor_2d( ph u, phv, punb, pvnb, zhU, zhV, zu_trd, zv_trd )1188 SUBROUTINE dyn_cor_2d( pht, phu, phv, punb, pvnb, zhU, zhV, zu_trd, zv_trd ) 1189 1189 !!--------------------------------------------------------------------- 1190 1190 !! *** ROUTINE dyn_cor_2d *** … … 1194 1194 INTEGER :: ji ,jj ! dummy loop indices 1195 1195 REAL(wp) :: zx1, zx2, zy1, zy2, z1_hu, z1_hv ! - - 1196 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: ph u, phv, punb, pvnb, zhU, zhV1196 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pht, phu, phv, punb, pvnb, zhU, zhV 1197 1197 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: zu_trd, zv_trd 1198 1198 !!---------------------------------------------------------------------- … … 1203 1203 z1_hv = ssvmask(ji,jj) / ( phv(ji,jj) + 1._wp - ssvmask(ji,jj) ) 1204 1204 zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * z1_hu & 1205 & * ( e1e2t(ji+1,jj)* ht(ji+1,jj)*ff_t(ji+1,jj) * ( pvnb(ji+1,jj) + pvnb(ji+1,jj-1) ) &1206 & + e1e2t(ji ,jj)* ht(ji ,jj)*ff_t(ji ,jj) * ( pvnb(ji ,jj) + pvnb(ji ,jj-1) ) )1205 & * ( e1e2t(ji+1,jj)*pht(ji+1,jj)*ff_t(ji+1,jj) * ( pvnb(ji+1,jj) + pvnb(ji+1,jj-1) ) & 1206 & + e1e2t(ji ,jj)*pht(ji ,jj)*ff_t(ji ,jj) * ( pvnb(ji ,jj) + pvnb(ji ,jj-1) ) ) 1207 1207 ! 1208 1208 zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * z1_hv & 1209 & * ( e1e2t(ji,jj+1)* ht(ji,jj+1)*ff_t(ji,jj+1) * ( punb(ji,jj+1) + punb(ji-1,jj+1) ) &1210 & + e1e2t(ji,jj )* ht(ji,jj )*ff_t(ji,jj ) * ( punb(ji,jj ) + punb(ji-1,jj ) ) )1209 & * ( e1e2t(ji,jj+1)*pht(ji,jj+1)*ff_t(ji,jj+1) * ( punb(ji,jj+1) + punb(ji-1,jj+1) ) & 1210 & + e1e2t(ji,jj )*pht(ji,jj )*ff_t(ji,jj ) * ( punb(ji,jj ) + punb(ji-1,jj ) ) ) 1211 1211 END_2D 1212 1212 ! -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ISF/isfcpl.F90
r12724 r12731 142 142 !!---------------------------------------------------------------------- 143 143 INTEGER :: jk ! loop index 144 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v ! e3t , e3u, e3v 145 !!---------------------------------------------------------------------- 146 ! 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 147 148 DO jk = 1, jpk 148 149 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 149 150 ze3u(:,:,jk) = e3u(:,:,jk,Kmm) 150 151 ze3v(:,:,jk) = e3v(:,:,jk,Kmm) 152 zgdepw(:,:,jk) = gdepw(:,:,jk,Kmm) 151 153 END DO 152 154 ! … … 157 159 CALL iom_rstput( kt, nitrst, numrow, 'e3u_n' , ze3u , ldxios = lwxios ) 158 160 CALL iom_rstput( kt, nitrst, numrow, 'e3v_n' , ze3v , ldxios = lwxios ) 159 CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw(:,:,:,Kmm), ldxios = lwxios )161 CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', zgdepw , ldxios = lwxios ) 160 162 IF( lwxios ) CALL iom_swap( cxios_context ) 161 163 ! -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ISF/isfdynatf.F90
r12724 r12731 15 15 USE phycst , ONLY: r1_rho0 ! physical constant 16 16 USE dom_oce ! time and space domain 17 17 USE oce, ONLY : ssh ! sea-surface height 18 !!st 18 19 USE in_out_manager 19 20 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ISF/isfstp.F90
r12625 r12731 11 11 12 12 !!---------------------------------------------------------------------- 13 !! isfstp : compute iceshelf melt and heat flux14 !!---------------------------------------------------------------------- 15 !16 USE isf _oce ! isf variables17 USE isf load, ONLY: isf_load ! ice shelf load18 USE isf tbl , ONLY: isf_tbl_lvl ! ice shelf boundary layer19 USE isf par , ONLY: isf_par, isf_par_init ! ice shelf parametrisation20 USE isfc av , ONLY: isf_cav, isf_cav_init ! ice shelf cavity21 USE isfcpl , ONLY: isfcpl_rst_write, isfcpl_init ! isf variables 22 23 USE dom_oce ! ocean space and time domain24 USE domvvl , ONLY: ln_vvl_zstar! zstar logical25 USE zdfdrg , ONLY: r_Cdmin_top, r_ke0_top! vertical physics: top/bottom drag coef.13 !! isfstp : compute iceshelf melt and heat flux 14 !!---------------------------------------------------------------------- 15 USE isf_oce ! isf variables 16 USE isfload , ONLY: isf_load ! ice shelf load 17 USE isftbl , ONLY: isf_tbl_lvl ! ice shelf boundary layer 18 USE isfpar , ONLY: isf_par, isf_par_init ! ice shelf parametrisation 19 USE isfcav , ONLY: isf_cav, isf_cav_init ! ice shelf cavity 20 USE isfcpl , ONLY: isfcpl_rst_write, isfcpl_init ! isf variables 21 22 USE dom_oce ! ocean space and time domain 23 USE oce , ONLY: ssh ! sea surface height 24 USE domvvl , ONLY: ln_vvl_zstar ! zstar logical 25 USE zdfdrg , ONLY: r_Cdmin_top, r_ke0_top ! vertical physics: top/bottom drag coef. 26 26 ! 27 27 USE lib_mpp, ONLY: ctl_stop, ctl_nam … … 31 31 32 32 IMPLICIT NONE 33 34 33 PRIVATE 35 34 … … 87 86 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 88 87 END DO 89 CALL isf_tbl_lvl(ht , ze3t, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav)88 CALL isf_tbl_lvl(ht(:,:), ze3t, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav) 90 89 ! 91 90 ! 1.3: compute ice shelf melt … … 112 111 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 113 112 END DO 114 CALL isf_tbl_lvl(ht , ze3t, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par)113 CALL isf_tbl_lvl(ht(:,:), ze3t, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par) 115 114 ! 116 115 ! 2.3: compute ice shelf melt -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/LDF/ldfslp.F90
r12622 r12731 298 298 ! ! ! jk must be >= ML level for zfk=1. otherwise zfk=0. 299 299 ! zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp ) 300 ! zck = gdepw(ji,jj,jk ) / MAX( hmlp(ji,jj), 10. )300 ! zck = gdepw(ji,jj,jk,Kmm) / MAX( hmlp(ji,jj), 10. ) 301 301 ! zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk) 302 302 ! zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ZDF/zdfosm.F90
r12724 r12731 475 475 476 476 zhbl_t(:,:) = hbl(:,:) + (zdhdt(:,:) - ww(ji,jj,ibld(ji,jj)))* rn_Dt ! certainly need wb here, so subtract it 477 zhbl_t(:,:) = MIN(zhbl_t(:,:), ht(:,:)) 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 478 481 zdhdt(:,:) = MIN(zdhdt(:,:), (zhbl_t(:,:) - hbl(:,:))/rn_Dt + ww(ji,jj,ibld(ji,jj))) ! adjustment to represent limiting by ocean bottom 479 482 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/stepLF.F90
r12724 r12731 90 90 !!gm kcall can be removed, I guess 91 91 INTEGER :: kcall ! optional integer argument (dom_vvl_sf_nxt) 92 !!st patch 93 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgdept ! st patch 92 94 !! --------------------------------------------------------------------- 93 95 #if defined key_agrif … … 194 196 ! Ocean dynamics : hdiv, ssh, e3, u, v, w 195 197 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 196 198 !!st patch 199 !!st patch to be able to use substitution 200 DO jk = 1, jpk 201 zgdept(:,:,jk) = gdept(:,:,jk,Nnn) 202 END DO 203 !!st end 197 204 CALL ssh_nxt ( kstp, Nbb, Nnn, ssh, Naa ) ! after ssh (includes call to div_hor) 198 205 IF( .NOT.ln_linssh ) CALL dom_qe_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa) ) 199 IF( .NOT.ln_linssh ) CALL dom_h_nxt ( kstp, Nbb, Nnn, Naa ) ! after vertical scale factors206 !!st IF( .NOT.ln_linssh ) CALL dom_h_nxt ( kstp, Nbb, Nnn, Naa ) ! after vertical scale factors 200 207 !IF( .NOT.ln_linssh ) CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn, Naa ) ! after vertical scale factors 201 208 CALL wzv ( kstp, Nbb, Nnn, Naa, ww ) ! Nnn cross-level velocity 202 209 IF( ln_zad_Aimp ) CALL wAimp ( kstp, Nnn ) ! Adaptive-implicit vertical advection partitioning 203 CALL eos ( ts(:,:,:,:,Nnn), rhd, rhop, gdept(:,:,:,Nnn)) ! now in situ density for hpg computation210 CALL eos ( ts(:,:,:,:,Nnn), rhd, rhop, zgdept ) ! now in situ density for hpg computation 204 211 205 212 … … 226 233 IF(.NOT.ln_linssh) CALL dom_qe_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) ) 227 234 !IF(.NOT.ln_linssh) CALL dom_qe_sf_nxt ( kstp, Nbb, Nnn, Naa, kcall=2 ) ! after vertical scale factors (update depth average component) 228 IF(.NOT.ln_linssh) CALL dom_h_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) 229 236 ENDIF 230 237 CALL dyn_zdf ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa ) ! vertical diffusion … … 322 329 ! 323 330 !IF(.NOT.ln_linssh) CALL dom_qe_sf_update( kstp, Nbb, Nnn, Naa ) ! recompute vertical scale factors 324 IF(.NOT.ln_linssh) CALL dom_h_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 factors 325 332 ! 326 333 IF( ln_diahsb ) CALL dia_hsb ( kstp, Nbb, Nnn ) ! - ML - global conservation diagnostics
Note: See TracChangeset
for help on using the changeset viewer.
