Changeset 12599
- Timestamp:
- 2020-03-25T10:46:53+01:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
r11277 r12599 135 135 slf_i(jp_emp ) = sn_emp 136 136 ! 137 ALLOCATE( sf(jpfld), STAT=ierror ) ! set sf structure138 IF( ln_shelf_flx ) slf_i(jp_press) = sn_press139 140 ! define local jpfld depending on shelf_flx logical141 IF( ln_shelf_flx ) THEN142 jpfld_local = jpfld143 ELSE144 jpfld_local = jpfld-1145 ENDIF146 137 ! define local jpfld depending on shelf_flx logical 138 IF( ln_shelf_flx ) THEN 139 slf_i(jp_press) = sn_press 140 jpfld_local = jpfld 141 ELSE 142 jpfld_local = jpfld-1 143 ENDIF 144 ! 145 ALLOCATE( sf(jpfld), STAT=ierror ) ! set sf structure 146 ! 147 147 IF( ierror > 0 ) THEN 148 148 CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' ) ; RETURN … … 163 163 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! update ocean fluxes at each SBC frequency 164 164 165 IF( ln_dm2dc ) THEN ; qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) ! modify now Qsr to include the diurnal cycle 166 ELSE ; qsr(:,:) = sf(jp_qsr)%fnow(:,:,1) 167 ENDIF 168 165 169 !!UKMO SHELF wind speed relative to surface currents - put here to allow merging with coupling branch 166 170 IF( ln_shelf_flx ) THEN 167 171 CALL wrk_alloc( jpi,jpj, zwnd_i, zwnd_j ) 168 172 169 IF( ln_rel_wind ) THEN 170 DO jj = 1, jpj 171 DO ji = 1, jpi 173 ! set the ocean fluxes from read fields 174 DO jj = 1, jpj 175 DO ji = 1, jpi 176 !! UKMO SHELF - need atmospheric pressure to calculate Haney forcing 177 pressnow(ji,jj) = sf(jp_press)%fnow(ji,jj,1) 178 !! UKMO SHELF flux files contain wind speed not wind stress 179 IF( ln_rel_wind ) THEN 172 180 zwnd_i(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) - rn_wfac * ssu_m(ji,jj) 173 181 zwnd_j(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) - rn_wfac * ssv_m(ji,jj) 174 END DO 175 END DO 176 ELSE 177 zwnd_i(:,:) = sf(jp_utau)%fnow(:,:,1) 178 zwnd_j(:,:) = sf(jp_vtau)%fnow(:,:,1) 179 ENDIF 180 ENDIF 181 182 IF( ln_dm2dc ) THEN ; qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) ! modify now Qsr to include the diurnal cycle 183 ELSE ; qsr(:,:) = sf(jp_qsr)%fnow(:,:,1) 184 ENDIF 185 !CDIR COLLAPSE 186 !!UKMO SHELF effect of atmospheric pressure on SSH 187 ! If using ln_apr_dyn, this is done there so don't repeat here. 188 IF( ln_shelf_flx .AND. .NOT. ln_apr_dyn) THEN 189 DO jj = 1, jpjm1 190 DO ji = 1, jpim1 182 ELSE 183 zwnd_i(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 184 zwnd_j(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 185 ENDIF 186 wndm(ji,jj) = sqrt(zwnd_i(ji,jj)*zwnd_i(ji,jj) + zwnd_j(ji,jj)*zwnd_j(ji,jj)) 187 188 ! add modification due to drag coefficient read from wave forcing 189 IF( ln_cdgw .AND. nn_drag == jp_std ) THEN 190 IF( cpl_wdrag ) THEN 191 ! reset utau and vtau to the wind components: the momentum will 192 ! be calculated from the coupled value of the drag coefficient 193 utau(ji,jj) = zwnd_i(ji,jj) 194 vtau(ji,jj) = zwnd_j(ji,jj) 195 ELSE 196 utau(ji,jj) = zrhoa * cdn_wave(ji,jj) * zwnd_i(ji,jj) * wndm(ji,jj) 197 vtau(ji,jj) = zrhoa * cdn_wave(ji,jj) * zwnd_j(ji,jj) * wndm(ji,jj) 198 ENDIF 199 ELSE IF( nn_drag == jp_const ) THEN 200 utau(ji,jj) = zrhoa * zcdrag * zwnd_i(ji,jj) * wndm(ji,jj) 201 vtau(ji,jj) = zrhoa * zcdrag * zwnd_j(ji,jj) * wndm(ji,jj) 202 ELSE IF( nn_drag == jp_ukmo ) THEN 203 cs = 0.63 + (0.066 * wndm(ji,jj)) 204 utau(ji,jj) = cs * (rhoa/rau0) * zwnd_i(ji,jj) * wndm(ji,jj) 205 vtau(ji,jj) = cs * (rhoa/rau0) * zwnd_j(ji,jj) * wndm(ji,jj) 206 ENDIF 207 taum(ji,jj) = sqrt(utau(ji,jj)*utau(ji,jj) + vtau(ji,jj)*vtau(ji,jj)) 208 209 qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1) 210 !! UKMO FOAM flux files contain non-solar heat flux (qns) rather than total heat flux (qtot) 211 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) 212 !! UKMO FOAM flux files contain the net DOWNWARD freshwater flux P-E rather then E-P 213 emp (ji,jj) = -1. * sf(jp_emp )%fnow(ji,jj,1) 214 END DO 215 END DO 216 ! Move tau components to the right grid 217 DO jj = 1, jpjm1 218 DO ji = 1, jpim1 219 utau(ji,jj) = 0.5 * ( utau(ji,jj) + utau(ji+1,jj) ) 220 vtau(ji,jj) = 0.5 * ( vtau(ji,jj) + vtau(ji,jj+1) ) 221 222 !!UKMO SHELF effect of atmospheric pressure on SSH 223 ! If using ln_apr_dyn, this is done there so don't repeat here. 224 IF( .NOT. ln_apr_dyn) THEN 191 225 apgu(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji+1,jj,1)-sf(jp_press)%fnow(ji,jj,1))/e1u(ji,jj) 192 226 apgv(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji,jj+1,1)-sf(jp_press)%fnow(ji,jj,1))/e2v(ji,jj) 193 END DO 194 END DO 195 ENDIF ! ln_shelf_flx 196 197 DO jj = 1, jpj ! set the ocean fluxes from read fields 198 DO ji = 1, jpi 199 IF( ln_shelf_flx ) THEN 200 !! UKMO SHELF - need atmospheric pressure to calculate Haney forcing 201 pressnow(ji,jj) = sf(jp_press)%fnow(ji,jj,1) 202 !! UKMO SHELF flux files contain wind speed not wind stress 203 totwindspd = sqrt(zwnd_i(ji,jj)*zwnd_i(ji,jj) + zwnd_j(ji,jj)*zwnd_j(ji,jj)) 204 cs = 0.63 + (0.066 * totwindspd) 205 utau(ji,jj) = cs * (rhoa/rau0) * zwnd_i(ji,jj) * totwindspd 206 vtau(ji,jj) = cs * (rhoa/rau0) * zwnd_j(ji,jj) * totwindspd 207 ELSE 208 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 209 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 210 ENDIF 211 qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1) 212 IF( ln_foam_flx .OR. ln_shelf_flx ) THEN 213 !! UKMO FOAM flux files contain non-solar heat flux (qns) rather than total heat flux (qtot) 214 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) 215 !! UKMO FOAM flux files contain the net DOWNWARD freshwater flux P-E rather then E-P 216 emp (ji,jj) = -1. * sf(jp_emp )%fnow(ji,jj,1) 217 ELSE 218 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 219 emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 220 ENDIF 221 END DO 222 END DO 223 ! ! add modification due to drag coefficient read from wave forcing 224 ! ! this code is inefficient but put here to allow merging with another UKMO branch 225 IF( ln_shelf_flx ) THEN 226 ! calculate first the wind module, as it will be used later 227 DO jj = 2, jpjm1 228 DO ji = fs_2, fs_jpim1 ! vect. opt. 229 ztx = zwnd_i(ji-1,jj ) + zwnd_i(ji,jj) 230 zty = zwnd_j(ji ,jj-1) + zwnd_j(ji,jj) 231 wndm(ji,jj) = 0.5 * SQRT( ztx * ztx + zty * zty ) 232 END DO 233 END DO 234 CALL lbc_lnk( wndm(:,:), 'T', 1. ) 235 236 IF( ln_cdgw .AND. nn_drag == jp_std ) THEN 237 IF( cpl_wdrag ) THEN 238 ! reset utau and vtau to the wind components: the momentum will 239 ! be calculated from the coupled value of the drag coefficient 240 DO jj = 1, jpj 241 DO ji = 1, jpi 242 utau(ji,jj) = zwnd_i(ji,jj) 243 vtau(ji,jj) = zwnd_j(ji,jj) 244 END DO 245 END DO 246 ELSE 247 DO jj = 1, jpjm1 248 DO ji = 1, jpim1 249 utau(ji,jj) = zrhoa * 0.5 * ( cdn_wave(ji,jj) + cdn_wave(ji+1,jj) ) * zwnd_i(ji,jj) * & 250 0.5 * ( wndm(ji,jj) + wndm(ji+1,jj) ) 251 vtau(ji,jj) = zrhoa * 0.5 * ( cdn_wave(ji,jj) + cdn_wave(ji,jj+1) ) * zwnd_j(ji,jj) * & 252 0.5 * ( wndm(ji,jj) + wndm(ji,jj+1) ) 253 END DO 254 END DO 255 CALL lbc_lnk_multi( utau(:,:), 'U', -1., vtau(:,:), 'V', -1. ) 256 ENDIF 257 ELSE IF( nn_drag == jp_const ) THEN 258 DO jj = 1, jpjm1 259 DO ji = 1, jpim1 260 utau(ji,jj) = zrhoa * zcdrag * zwnd_i(ji,jj) * 0.5 * ( wndm(ji,jj) + wndm(ji+1,jj) ) 261 vtau(ji,jj) = zrhoa * zcdrag * zwnd_j(ji,jj) * 0.5 * ( wndm(ji,jj) + wndm(ji,jj+1) ) 262 END DO 263 END DO 264 CALL lbc_lnk_multi( utau(:,:), 'U', -1., vtau(:,:), 'V', -1. ) 265 ENDIF 227 ENDIF 228 END DO 229 END DO 230 ELSE 231 DO jj = 1, jpj ! set the ocean fluxes from read fields 232 DO ji = 1, jpi 233 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 234 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 235 qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1) 236 IF( ln_foam_flx ) THEN 237 !! UKMO FOAM flux files contain non-solar heat flux (qns) rather than total heat flux (qtot) 238 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) 239 !! UKMO FOAM flux files contain the net DOWNWARD freshwater flux P-E rather then E-P 240 emp (ji,jj) = -1. * sf(jp_emp )%fnow(ji,jj,1) 241 ELSE 242 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 243 emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 244 ENDIF 245 END DO 246 END DO 247 ! ! module of wind stress and wind speed at T-point 248 zcoef = 1. / ( zrhoa * zcdrag ) 249 !CDIR NOVERRCHK 250 DO jj = 2, jpjm1 251 !CDIR NOVERRCHK 252 DO ji = fs_2, fs_jpim1 ! vect. opt. 253 ztx = utau(ji-1,jj ) + utau(ji,jj) 254 zty = vtau(ji ,jj-1) + vtau(ji,jj) 255 zmod = 0.5 * SQRT( ztx * ztx + zty * zty ) 256 taum(ji,jj) = zmod 257 wndm(ji,jj) = SQRT( zmod * zcoef ) 258 END DO 259 END DO 266 260 ENDIF 267 261 ! ! add to qns the heat due to e-p 268 262 qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! mass flux is at SST 269 263 ! 270 271 !! UKMO FOAM wind fluxes need lbc_lnk calls owing to a bug in interp.exe 272 IF( ln_foam_flx ) THEN 273 CALL lbc_lnk( utau(:,:), 'U', -1. ) 274 CALL lbc_lnk( vtau(:,:), 'V', -1. ) 275 ENDIF 264 !! UKMO FOAM wind fluxes need lbc_lnk calls owing to a bug in interp.exe 265 IF( ln_foam_flx .OR. ln_shelf_flx ) THEN 266 CALL lbc_lnk_multi( utau(:,:), 'U', -1., vtau(:,:), 'V', -1. ) 267 ENDIF 276 268 277 ! ! module of wind stress and wind speed at T-point278 zcoef = 1. / ( zrhoa * zcdrag )279 !CDIR NOVERRCHK280 DO jj = 2, jpjm1281 !CDIR NOVERRCHK282 DO ji = fs_2, fs_jpim1 ! vect. opt.283 ztx = utau(ji-1,jj ) + utau(ji,jj)284 zty = vtau(ji ,jj-1) + vtau(ji,jj)285 zmod = 0.5 * SQRT( ztx * ztx + zty * zty )286 taum(ji,jj) = zmod287 IF ( .NOT. (ln_shelf_flx .AND. ln_cpl)) THEN288 wndm(ji,jj) = SQRT( zmod * zcoef )289 ENDIF290 END DO291 END DO292 269 taum(:,:) = taum(:,:) * tmask(:,:,1) ; wndm(:,:) = wndm(:,:) * tmask(:,:,1) 293 CALL lbc_lnk ( taum(:,:), 'T', 1. ) ; CALL lbc_lnk(wndm(:,:), 'T', 1. )270 CALL lbc_lnk_multi( taum(:,:), 'T', 1., wndm(:,:), 'T', 1. ) 294 271 295 272 IF( nitend-nit000 <= 100 .AND. lwp ) THEN ! control print (if less than 100 time-step asked)
Note: See TracChangeset
for help on using the changeset viewer.
