Changeset 6253 for branches/2015/dev_r5936_INGV1_WAVE/NEMOGCM/NEMO
- Timestamp:
- 2016-01-14T19:22:56+01:00 (8 years ago)
- Location:
- branches/2015/dev_r5936_INGV1_WAVE/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5936_INGV1_WAVE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r5983 r6253 423 423 ENDIF 424 424 ! 425 ! Add Stokes Coriolis if defined426 IF ( ln_stcor ) THEN427 DO jj = 1, jpjm1428 DO ji = 1, fs_jpim1 ! vector opt.429 430 zy1 = ff(ji ,jj-1) * ( vsd2d(ji ,jj-1) + vsd2d(ji+1,jj-1) )431 zy2 = ff(ji ,jj ) * ( vsd2d(ji ,jj ) + vsd2d(ji+1,jj ) )432 zx1 = ff(ji-1,jj ) * ( usd2d(ji-1,jj ) + usd2d(ji-1,jj+1) )433 zx2 = ff(ji ,jj ) * ( usd2d(ji ,jj ) + usd2d(ji ,jj+1) )434 435 zu_frc(ji,jj) = zu_frc(ji,jj) + 0.25 * ( zy1 + zy2 ) * hur(ji,jj)436 zv_frc(ji,jj) = zv_frc(ji,jj) - 0.25 * ( zx1 + zx2 ) * hvr(ji,jj)437 END DO438 END DO439 ENDIF440 !441 425 IF ( ln_apr_dyn ) THEN ! Add atm pressure forcing 442 426 IF (ln_bt_fw) THEN -
branches/2015/dev_r5936_INGV1_WAVE/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r5983 r6253 39 39 USE wrk_nemo ! Memory Allocation 40 40 USE timing ! Timing 41 USE sbcwave, ONLY: usd2dt,vsd2dt,wsd3d41 USE sbcwave, ONLY: zusd2dt, zvsd2dt,wsd3d 42 42 43 43 IMPLICIT NONE … … 240 240 ! Compute the surface vertical velocity accounting for the Stokes Drift 241 241 !--------------------------------------------------------------------- 242 wn(:,:,1) = wn(:,:,1) + usd2dt(:,:) * dsshnu(:,:) &243 & + vsd2dt(:,:) * dsshnv(:,:) &242 wn(:,:,1) = wn(:,:,1) + zusd2dt(:,:) * dsshnu(:,:) & 243 & + zvsd2dt(:,:) * dsshnv(:,:) & 244 244 & - ( wsd3d (:,:,1) ) * tmask(:,:,1) 245 245 ENDIF -
branches/2015/dev_r5936_INGV1_WAVE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
r5983 r6253 6 6 !! History : 3.3 ! 2011-09 (Adani M) Original code: Drag Coefficient 7 7 !! : 3.4 ! 2012-10 (Adani M) Stokes Drift 8 !! History : 3.6 !2014-09 (Clementi E, Oddo P)New Stokes Drift Computation9 !!---------------------------------------------------------------------- 10 11 !!---------------------------------------------------------------------- 12 !! sbc_wave : read drag coefficientfrom wave model in netcdf files8 !! 3.6 ! 2014-09 (Clementi E, Oddo P)New Stokes Drift Computation 9 !!---------------------------------------------------------------------- 10 11 !!---------------------------------------------------------------------- 12 !! sbc_wave : wave data from wave model in netcdf files 13 13 !!---------------------------------------------------------------------- 14 14 USE oce ! … … 27 27 PRIVATE 28 28 29 PUBLIC sbc_wave ! routine called in sbc _blk_core or sbc_blk_mfs29 PUBLIC sbc_wave ! routine called in sbcmod 30 30 31 31 INTEGER , PARAMETER :: jpfld = 4 ! number of files to read for stokes drift … … 34 34 INTEGER , PARAMETER :: jp_swh = 3 ! index of significant wave hight (m) at T-point 35 35 INTEGER , PARAMETER :: jp_wmp = 4 ! index of mean wave period (s) at T-point 36 ! 36 37 37 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_cd ! structure of input fields (file informations, fields read) Drag Coefficient 38 38 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sd ! structure of input fields (file informations, fields read) Stokes Drift 39 39 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_wn ! structure of input fields (file informations, fields read) wave number for Qiao 40 40 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_tauoc ! structure of input fields (file informations, fields read) normalized wave stress into the ocean 41 REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:) :: cdn_wave 42 REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:) :: usd2d,vsd2d 43 REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:) :: swh,wmp,wnum 44 REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:) :: usd2dt,vsd2dt,tsd2d 45 REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:,:) :: usd3d,vsd3d,wsd3d 46 REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:) :: tauoc_wave 41 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: cdn_wave 42 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: swh,wmp, wnum 43 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tauoc_wave 44 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: tsd2d 45 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: usd2d, vsd2d 46 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: usd3d, vsd3d, wsd3d 47 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: zusd2dt, zvsd2dt 47 48 48 49 !! * Substitutions … … 58 59 SUBROUTINE sbc_wave( kt ) 59 60 !!--------------------------------------------------------------------- 60 !! *** ROUTINE sbc_ apr***61 !! *** ROUTINE sbc_wave *** 61 62 !! 62 !! ** Purpose : read drag coefficientfrom wave model in netcdf files.63 !! ** Purpose : read wave parameters from wave model in netcdf files. 63 64 !! 64 65 !! ** Method : - Read namelist namsbc_wave … … 68 69 !! - Compute 3d stokes drift using Breivik et al.,2014 69 70 !! formulation 70 !! ** action :71 !! ** action 71 72 !!--------------------------------------------------------------------- 72 73 USE zdf_oce, ONLY : ln_zdfqiao … … 77 78 INTEGER :: ifpr, jj,ji,jk 78 79 INTEGER :: ios ! Local integer output status for namelist read 79 80 REAL(wp) :: ztransp,zsp0, zk, zus,zvs 80 ! 81 CHARACTER(len=100) :: cn_dir ! Root directory for location of drag coefficient files 82 REAL(wp) :: ztransp, zsp0, zk, zus, zvs 81 83 REAL(wp), DIMENSION(jpi,jpj) :: zfac 82 84 REAL(wp), DIMENSION(:,:,:), POINTER :: ze3hdiv ! 3D workspace 83 85 TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist informations on the fields to read 84 CHARACTER(len=100) :: cn_dir ! Root directory for location of drag coefficient files85 86 TYPE(FLD_N) :: sn_cdg, sn_usd, sn_vsd, & 86 87 & sn_swh, sn_wmp, sn_wnum, sn_tauoc ! informations about the fields to be read 87 REAL(wp), DIMENSION(:,:,:), POINTER :: zusd_t, zvsd_t, ze3hdiv ! 3D workspace88 88 !! 89 89 NAMELIST/namsbc_wave/ sn_cdg, cn_dir, sn_usd, sn_vsd, sn_swh, sn_wmp, sn_wnum, sn_tauoc … … 112 112 cdn_wave(:,:) = 0.0 113 113 ENDIF 114 ! 114 115 115 IF ( ln_tauoc ) THEN 116 116 ALLOCATE( sf_tauoc(1), STAT=ierror ) !* allocate and fill sf_wave with sn_tauoc … … 123 123 tauoc_wave(:,:) = 0.0 124 124 ENDIF 125 ! 125 126 126 IF ( ln_sdw ) THEN 127 127 slf_i(jp_usd) = sn_usd ; slf_i(jp_vsd) = sn_vsd; … … 134 134 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf_sd(ifpr)%fdta(jpi,jpj,1,2) ) 135 135 END DO 136 ! 136 137 137 CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave', 'Wave module ', 'namsbc_wave' ) 138 ALLOCATE( usd2d(jpi,jpj),vsd2d(jpi,jpj) ,usd2dt(jpi,jpj),vsd2dt(jpi,jpj))138 ALLOCATE( usd2d(jpi,jpj),vsd2d(jpi,jpj) ) 139 139 ALLOCATE( usd3d(jpi,jpj,jpk),vsd3d(jpi,jpj,jpk),wsd3d(jpi,jpj,jpk) ) 140 140 ALLOCATE( swh(jpi,jpj), wmp(jpi,jpj) ) 141 usd3d(:,:,:) = 0._wp ; usd2d(:,:) = 0._wp ; usd2dt(:,:) = 0._wp ;142 vsd3d(:,:,:) = 0._wp ; vsd2d(:,:) = 0._wp ; vsd2dt(:,:) = 0._wp ;141 usd3d(:,:,:) = 0._wp ; usd2d(:,:) = 0._wp ; 142 vsd3d(:,:,:) = 0._wp ; vsd2d(:,:) = 0._wp ; 143 143 wsd3d(:,:,:) = 0._wp ; 144 144 swh (:,:) = 0._wp ; wmp (:,:) = 0._wp ; … … 159 159 cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1) 160 160 ENDIF 161 ! 161 162 162 IF ( ln_tauoc ) THEN !== Wave induced stress ==! 163 163 CALL fld_read( kt, nn_fsbc, sf_tauoc ) !* read wave norm stress from external forcing 164 164 tauoc_wave(:,:) = sf_tauoc(1)%fnow(:,:,1) 165 165 ENDIF 166 ! 166 167 167 IF ( ln_sdw ) THEN !== Computation of the 3d Stokes Drift ==! 168 168 ! 169 169 CALL fld_read( kt, nn_fsbc, sf_sd ) !* read wave parameters from external forcing 170 swh(:,:) = sf_sd(jp_swh)%fnow(:,:,1)! significant wave height171 wmp(:,:) = sf_sd(jp_wmp)%fnow(:,:,1)! wave mean period172 usd2dt(:,:) = sf_sd(jp_usd)%fnow(:,:,1) ! 2D zonal Stokes Drift173 vsd2dt(:,:) = sf_sd(jp_vsd)%fnow(:,:,1) ! 2D meridional Stokes Drift170 swh(:,:) = sf_sd(jp_swh)%fnow(:,:,1) ! significant wave height 171 wmp(:,:) = sf_sd(jp_wmp)%fnow(:,:,1) ! wave mean period 172 zusd2dt(:,:) = sf_sd(jp_usd)%fnow(:,:,1) ! 2D zonal Stokes Drift at T point 173 zvsd2dt(:,:) = sf_sd(jp_vsd)%fnow(:,:,1) ! 2D meridional Stokes Drift at T point 174 174 ! 175 175 !== Computation of the 3d Stokes Drift according to Breivik et al.,2014 … … 177 177 ! 178 178 CALL wrk_alloc( jpi,jpj,jpk, ze3hdiv ) 179 180 181 179 DO jk = 1, jpk 180 DO jj = 1, jpj 181 DO ji = 1, jpi 182 182 ! On T grid 183 183 ! Stokes transport speed estimated from Hs and Tmean … … 189 189 ! Depth attenuation 190 190 zfac(ji,jj) = EXP(-2.0_wp*zk*fsdept(ji,jj,jk))/(1.0_wp+8.0_wp*zk*fsdept(ji,jj,jk)) 191 192 193 ! 194 195 196 ! Into the U and V Grid197 zus = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zfac(ji,jj) * tmask(ji,jj,1) &191 END DO 192 END DO 193 194 DO jj = 1, jpjm1 195 DO ji = 1, jpim1 196 ! Into the U and V Grid 197 zus = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zfac(ji,jj) * tmask(ji,jj,1) & 198 198 & + zfac(ji+1,jj) * tmask(ji+1,jj,1) ) 199 ! 200 zvs = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zfac(ji,jj) * tmask(ji,jj,1) &199 200 zvs = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zfac(ji,jj) * tmask(ji,jj,1) & 201 201 & + zfac(ji,jj+1) * tmask(ji,jj+1,1) ) 202 ! 203 usd2d(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * (usd2dt(ji,jj) * tmask(ji,jj,1) &204 & + usd2dt(ji+1,jj) * tmask(ji+1,jj,1) )205 ! 206 vsd2d(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * (vsd2dt(ji,jj) * tmask(ji,jj,1) &207 & + vsd2dt(ji,jj+1) * tmask(ji,jj+1,1) )208 ! 209 usd3d(ji,jj,jk) = usd2d(ji,jj)*zus210 vsd3d(ji,jj,jk) = vsd2d(ji,jj)*zvs211 212 213 202 203 usd2d(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( zusd2dt(ji,jj) * tmask(ji,jj,1) & 204 & + zusd2dt(ji+1,jj) * tmask(ji+1,jj,1) ) 205 206 vsd2d(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zvsd2dt(ji,jj) * tmask(ji,jj,1) & 207 & + zvsd2dt(ji,jj+1) * tmask(ji,jj+1,1) ) 208 209 usd3d(ji,jj,jk) = usd2d(ji,jj) * zus 210 vsd3d(ji,jj,jk) = vsd2d(ji,jj) * zvs 211 END DO 212 END DO 213 END DO 214 214 ! 215 215 CALL lbc_lnk( usd3d(:,:,:), 'U', -1. ) 216 216 CALL lbc_lnk( vsd3d(:,:,:), 'V', -1. ) 217 217 ! 218 DO jk = 1, jpkm1 ! * e3t * Horizontal divergence ==!218 DO jk = 1, jpkm1 ! e3t * Horizontal divergence 219 219 DO jj = 2, jpjm1 220 220 DO ji = fs_2, fs_jpim1 ! vector opt. … … 244 244 ENDIF 245 245 #endif 246 ! CALL wrk_dealloc( jpi,jpj,jpk, zusd_t, zvsd_t, ze3hdiv )247 246 CALL wrk_dealloc( jpi,jpj,jpk, ze3hdiv ) 248 ! 249 IF ( ln_zdfqiao ) THEN 250 wnum(:,:) = sf_wn(1)%fnow(:,:,1) 251 ! Calculate the module of the stokes drift on T grid 252 !------------------------------------------------- 253 DO jj = 1, jpj 254 DO ji = 1, jpi 255 tsd2d(ji,jj) = ((sf_sd(jp_usd)%fnow(ji,jj,1) * tmask(ji,jj,1))**2.0 + & 247 248 IF ( ln_zdfqiao ) THEN 249 wnum(:,:) = sf_wn(1)%fnow(:,:,1) 250 251 ! Calculate the module of the stokes drift on T grid 252 !------------------------------------------------- 253 DO jj = 1, jpj 254 DO ji = 1, jpi 255 tsd2d(ji,jj) = ((sf_sd(jp_usd)%fnow(ji,jj,1) * tmask(ji,jj,1))**2.0 + & 256 256 & (sf_sd(jp_vsd)%fnow(ji,jj,1) * tmask(ji,jj,1))**2.0)**0.5 257 END DO258 END DO259 ENDIF260 !257 END DO 258 END DO 259 ENDIF 260 ! 261 261 ENDIF 262 262 ! -
branches/2015/dev_r5936_INGV1_WAVE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfqiao.F90
r5983 r6253 53 53 !!--------------------------------------------------------------------- 54 54 INTEGER, INTENT( in ) :: kt ! ocean time step 55 INTEGER :: ierror ! return error code56 INTEGER :: jj, ji,jk55 ! 56 INTEGER :: jj, ji, jk 57 57 !!--------------------------------------------------------------------- 58 !!----------------------------------------------------------------------59 58 ! 60 59 ! 61 60 ! ! -------------------- ! 62 61 IF( kt == nit000 ) THEN ! First call kt=nit000 ! 63 ! ! -------------------- ! 64 ALLOCATE(QBv(jpi,jpj,jpk)) 62 ALLOCATE(QBv(jpi,jpj,jpk)) ! -------------------- ! 65 63 ALLOCATE(QBvu(jpi,jpj,jpk)) 66 64 ALLOCATE(QBvv(jpi,jpj,jpk)) 67 68 65 ENDIF 69 66 70 QBv (:,:,:) = 0.0 71 QBvu(:,:,:) = 0.0 72 QBvv(:,:,:) = 0.0 67 QBv (:,:,:) = 0.0 68 QBvu(:,:,:) = 0.0 69 QBvv(:,:,:) = 0.0 70 73 71 ! 74 72 ! Compute the Qiao term Bv (QBv) to be added to … … 80 78 IF ( ln_wave ) THEN 81 79 DO jk = 1, jpk 82 DO jj = 1, jpjm1 83 DO ji = 1, jpim1 84 85 QBv(ji,jj,jk) = 1.0 * 0.353553 * swh(ji,jj) * tsd2d(ji,jj) * & 86 & exp(3.0 * wnum(ji,jj) * & 87 & (-MIN( gdept_0(ji ,jj ,jk) , gdept_0(ji+1,jj ,jk), & 80 DO jj = 1, jpjm1 81 DO ji = 1, jpim1 82 QBv(ji,jj,jk) = 1.0 * 0.353553 * swh(ji,jj) * tsd2d(ji,jj) * & 83 & exp(3.0 * wnum(ji,jj) * & 84 & (-MIN( gdept_0(ji ,jj ,jk) , gdept_0(ji+1,jj ,jk), & 88 85 & gdept_0(ji ,jj+1,jk),gdept_0(ji+1,jj+1,jk)))) 89 90 ENDDO 91 ENDDO 92 ENDDO 86 END DO 87 END DO 88 END DO 93 89 94 90 QBv(jpi,:,:)=QBv(jpim1,:,:) … … 98 94 ! Interpolate Qiao parameter QBv into the grid_U and grid_V 99 95 !------------------------------------------------- 100 96 ! 101 97 DO jk = 1, jpk 102 DO jj = 1, jpjm1 103 DO ji = 1, jpim1 104 105 QBvu(ji,jj,jk)=0.5 * ( 2. - umask(ji,jj,jk) ) * & 106 & ( QBv(ji,jj,jk) * tmask(ji,jj,jk) & 98 DO jj = 1, jpjm1 99 DO ji = 1, jpim1 100 QBvu(ji,jj,jk)=0.5 * ( 2. - umask(ji,jj,jk) ) * & 101 & ( QBv(ji,jj,jk) * tmask(ji,jj,jk) & 107 102 & + QBv(ji+1,jj,jk) * tmask(ji+1,jj,jk) ) 108 QBvv(ji,jj,jk)=0.5 * ( 2. - vmask(ji,jj,jk) ) * &109 & ( QBv(ji,jj,jk) * tmask(ji,jj,jk) &103 QBvv(ji,jj,jk)=0.5 * ( 2. - vmask(ji,jj,jk) ) * & 104 & ( QBv(ji,jj,jk) * tmask(ji,jj,jk) & 110 105 & + QBv(ji,jj+1,jk) * tmask(ji,jj+1,jk) ) 111 106 112 ENDDO113 END DO114 ENDDO115 ! 107 END DO 108 END DO 109 END DO 110 ! 116 111 QBvu(jpi,:,:)=QBvu(jpim1,:,:) 117 112 QBvu(:,jpj,:)=QBvu(:,jpjm1,:) 118 113 QBvv(jpi,:,:)=QBvv(jpim1,:,:) 119 114 QBvv(:,jpj,:)=QBvv(:,jpjm1,:) 120 ! 115 121 116 ELSE 117 CALL ctl_stop( 'STOP', 'To use Qiao formulation you have to set: ln_wave=.true.') 118 ENDIF 122 119 ! 123 CALL ctl_stop( 'STOP', 'To use Qiao formulation you have to set: ln_wave=.true.')124 !125 ENDIF126 !127 120 END SUBROUTINE zdf_qiao 128 121
Note: See TracChangeset
for help on using the changeset viewer.