- Timestamp:
- 2018-10-29T15:20:26+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
r10249 r10251 22 22 USE lib_mpp ! distribued memory computing library 23 23 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 24 USE wrk_nemo ! work arrays25 24 26 25 IMPLICIT NONE … … 29 28 PUBLIC sbc_flx ! routine called by step.F90 30 29 31 INTEGER , PARAMETER :: jpfld = 6! maximum number of files to read30 INTEGER , PARAMETER :: jpfld = 5 ! maximum number of files to read 32 31 INTEGER , PARAMETER :: jp_utau = 1 ! index of wind stress (i-component) file 33 32 INTEGER , PARAMETER :: jp_vtau = 2 ! index of wind stress (j-component) file … … 35 34 INTEGER , PARAMETER :: jp_qsr = 4 ! index of solar heat file 36 35 INTEGER , PARAMETER :: jp_emp = 5 ! index of evaporation-precipation file 37 INTEGER , PARAMETER :: jp_press = 6 ! index of pressure for UKMO shelf fluxes38 36 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) 39 LOGICAL , PUBLIC :: ln_shelf_flx = .FALSE. ! UKMO SHELF specific flux flag40 LOGICAL , PUBLIC :: ln_rel_wind = .FALSE. ! UKMO SHELF specific flux flag - relative winds41 REAL(wp) :: rn_wfac ! multiplication factor for ice/ocean velocity in the calculation of wind stress (clem)42 INTEGER :: jpfld_local ! maximum number of files to read (locally modified depending on ln_shelf_flx)43 37 44 38 !! * Substitutions … … 88 82 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 89 83 REAL(wp) :: ztx, zty, zmod, zcoef ! temporary variables 90 REAL :: cs ! UKMO SHELF: Friction co-efficient at surface91 REAL :: totwindspd ! UKMO SHELF: Magnitude of wind speed vector92 REAL(wp), DIMENSION(:,:), POINTER :: zwnd_i, zwnd_j ! wind speed components at T-point93 94 REAL(wp) :: rhoa = 1.22 ! Air density kg/m395 REAL(wp) :: cdrag = 1.5e-3 ! drag coefficient96 84 !! 97 85 CHARACTER(len=100) :: cn_dir ! Root directory for location of flx files 98 86 TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist information structures 99 TYPE(FLD_N) :: sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp, sn_press ! informations about the fields to be read 100 LOGICAL :: ln_foam_flx = .FALSE. ! UKMO FOAM specific flux flag 101 NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp, & 102 & ln_foam_flx, sn_press, ln_shelf_flx, ln_rel_wind, & 103 & rn_wfac 87 TYPE(FLD_N) :: sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp ! informations about the fields to be read 88 NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp 104 89 !!--------------------------------------------------------------------- 105 90 ! … … 124 109 slf_i(jp_emp ) = sn_emp 125 110 ! 126 ALLOCATE( sf(jpfld), STAT=ierror ) ! set sf structure 127 IF( ln_shelf_flx ) slf_i(jp_press) = sn_press 128 129 ! define local jpfld depending on shelf_flx logical 130 IF( ln_shelf_flx ) THEN 131 jpfld_local = jpfld 132 ELSE 133 jpfld_local = jpfld-1 134 ENDIF 135 ! 111 ALLOCATE( sf(jpfld), STAT=ierror ) ! set sf structure 136 112 IF( ierror > 0 ) THEN 137 113 CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' ) ; RETURN 138 114 ENDIF 139 DO ji= 1, jpfld _local115 DO ji= 1, jpfld 140 116 ALLOCATE( sf(ji)%fnow(jpi,jpj,1) ) 141 117 IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) ) … … 152 128 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! update ocean fluxes at each SBC frequency 153 129 154 !!UKMO SHELF wind speed relative to surface currents - put here to allow merging with coupling branch155 IF( ln_shelf_flx ) THEN156 CALL wrk_alloc( jpi,jpj, zwnd_i, zwnd_j )157 158 IF( ln_rel_wind ) THEN159 DO jj = 1, jpj160 DO ji = 1, jpi161 zwnd_i(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) - rn_wfac * ssu_m(ji,jj)162 zwnd_j(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) - rn_wfac * ssv_m(ji,jj)163 END DO164 END DO165 ELSE166 zwnd_i(:,:) = sf(jp_utau)%fnow(:,:,1)167 zwnd_j(:,:) = sf(jp_vtau)%fnow(:,:,1)168 ENDIF169 ENDIF170 171 130 IF( ln_dm2dc ) THEN ; qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) ! modify now Qsr to include the diurnal cycle 172 131 ELSE ; qsr(:,:) = sf(jp_qsr)%fnow(:,:,1) 173 132 ENDIF 174 133 !CDIR COLLAPSE 175 !!UKMO SHELF effect of atmospheric pressure on SSH176 ! If using ln_apr_dyn, this is done there so don't repeat here.177 IF( ln_shelf_flx .AND. .NOT. ln_apr_dyn) THEN178 DO jj = 1, jpjm1179 DO ji = 1, jpim1180 apgu(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji+1,jj,1)-sf(jp_press)%fnow(ji,jj,1))/e1u(ji,jj)181 apgv(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji,jj+1,1)-sf(jp_press)%fnow(ji,jj,1))/e2v(ji,jj)182 END DO183 END DO184 ENDIF ! ln_shelf_flx185 186 134 DO jj = 1, jpj ! set the ocean fluxes from read fields 187 135 DO ji = 1, jpi 188 IF( ln_shelf_flx ) THEN 189 !! UKMO SHELF - need atmospheric pressure to calculate Haney forcing 190 pressnow(ji,jj) = sf(jp_press)%fnow(ji,jj,1) 191 !! UKMO SHELF flux files contain wind speed not wind stress 192 totwindspd = sqrt(zwnd_i(ji,jj)*zwnd_i(ji,jj) + zwnd_j(ji,jj)*zwnd_j(ji,jj)) 193 cs = 0.63 + (0.066 * totwindspd) 194 utau(ji,jj) = cs * (rhoa/rau0) * zwnd_i(ji,jj) * totwindspd 195 vtau(ji,jj) = cs * (rhoa/rau0) * zwnd_j(ji,jj) * totwindspd 196 ELSE 197 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 198 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 199 ENDIF 200 qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1) 201 IF( ln_foam_flx .OR. ln_shelf_flx ) THEN 202 !! UKMO FOAM flux files contain non-solar heat flux (qns) rather than total heat flux (qtot) 203 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) 204 !! UKMO FOAM flux files contain the net DOWNWARD freshwater flux P-E rather then E-P 205 emp (ji,jj) = -1. * sf(jp_emp )%fnow(ji,jj,1) 206 ELSE 207 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 208 emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 209 ENDIF 136 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 137 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 138 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 139 emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 210 140 END DO 211 141 END DO … … 213 143 qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! mass flux is at SST 214 144 ! 215 216 !! UKMO FOAM wind fluxes need lbc_lnk calls owing to a bug in interp.exe217 IF( ln_foam_flx ) THEN218 CALL lbc_lnk( utau(:,:), 'U', -1. )219 CALL lbc_lnk( vtau(:,:), 'V', -1. )220 ENDIF221 222 145 ! ! module of wind stress and wind speed at T-point 223 146 zcoef = 1. / ( zrhoa * zcdrag ) … … 239 162 WRITE(numout,*) 240 163 WRITE(numout,*) ' read daily momentum, heat and freshwater fluxes OK' 241 DO jf = 1, jpfld _local164 DO jf = 1, jpfld 242 165 IF( jf == jp_utau .OR. jf == jp_vtau ) zfact = 1. 243 166 IF( jf == jp_qtot .OR. jf == jp_qsr ) zfact = 0.1 … … 250 173 ENDIF 251 174 ! 252 IF( ln_shelf_flx ) THEN253 CALL wrk_dealloc( jpi,jpj, zwnd_i, zwnd_j )254 ENDIF255 !256 175 ENDIF 257 176 !
Note: See TracChangeset
for help on using the changeset viewer.