- Timestamp:
- 2019-06-18T17:48:39+02:00 (5 years ago)
- Location:
- branches/UKMO/r6232_collate_bgc_diagnostics/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/r6232_collate_bgc_diagnostics/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r11132 r11134 121 121 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sprecip !: solid precipitation [Kg/m2/s] 122 122 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_i !: ice fraction = 1 - lead fraction (between 0 to 1) 123 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pressnow !: UKMO SHELF pressure 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: apgu !: UKMO SHELF pressure forcing 125 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: apgv !: UKMO SHELF pressure forcing 123 126 #if defined key_cpl_carbon_cycle 124 127 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: atm_co2 !: atmospheric pCO2 [ppm] … … 171 174 #endif 172 175 & ssu_m (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) , & 176 & pressnow(jpi,jpj), apgu(jpi,jpj) , apgv(jpi,jpj) , & 173 177 & ssv_m (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) 174 178 ! -
branches/UKMO/r6232_collate_bgc_diagnostics/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
r11132 r11134 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 arrays 24 25 25 26 IMPLICIT NONE … … 28 29 PUBLIC sbc_flx ! routine called by step.F90 29 30 30 INTEGER , PARAMETER :: jpfld = 5! maximum number of files to read31 INTEGER , PARAMETER :: jpfld = 6 ! maximum number of files to read 31 32 INTEGER , PARAMETER :: jp_utau = 1 ! index of wind stress (i-component) file 32 33 INTEGER , PARAMETER :: jp_vtau = 2 ! index of wind stress (j-component) file … … 34 35 INTEGER , PARAMETER :: jp_qsr = 4 ! index of solar heat file 35 36 INTEGER , PARAMETER :: jp_emp = 5 ! index of evaporation-precipation file 37 INTEGER , PARAMETER :: jp_press = 6 ! index of pressure for UKMO shelf fluxes 36 38 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) 39 LOGICAL , PUBLIC :: ln_shelf_flx = .FALSE. ! UKMO SHELF specific flux flag 40 LOGICAL , PUBLIC :: ln_rel_wind = .FALSE. ! UKMO SHELF specific flux flag - relative winds 41 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) 37 43 38 44 !! * Substitutions … … 82 88 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 83 89 REAL(wp) :: ztx, zty, zmod, zcoef ! temporary variables 90 REAL :: cs ! UKMO SHELF: Friction co-efficient at surface 91 REAL :: totwindspd ! UKMO SHELF: Magnitude of wind speed vector 92 REAL(wp), DIMENSION(:,:), POINTER :: zwnd_i, zwnd_j ! wind speed components at T-point 93 94 REAL(wp) :: rhoa = 1.22 ! Air density kg/m3 95 REAL(wp) :: cdrag = 1.5e-3 ! drag coefficient 84 96 !! 85 97 CHARACTER(len=100) :: cn_dir ! Root directory for location of flx files 86 98 TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist information structures 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 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 89 104 !!--------------------------------------------------------------------- 90 105 ! … … 109 124 slf_i(jp_emp ) = sn_emp 110 125 ! 111 ALLOCATE( sf(jpfld), STAT=ierror ) ! set sf structure 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 ! 112 136 IF( ierror > 0 ) THEN 113 137 CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' ) ; RETURN 114 138 ENDIF 115 DO ji= 1, jpfld 139 DO ji= 1, jpfld_local 116 140 ALLOCATE( sf(ji)%fnow(jpi,jpj,1) ) 117 141 IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) ) … … 128 152 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! update ocean fluxes at each SBC frequency 129 153 154 !!UKMO SHELF wind speed relative to surface currents - put here to allow merging with coupling branch 155 IF( ln_shelf_flx ) THEN 156 CALL wrk_alloc( jpi,jpj, zwnd_i, zwnd_j ) 157 158 IF( ln_rel_wind ) THEN 159 DO jj = 1, jpj 160 DO ji = 1, jpi 161 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 DO 164 END DO 165 ELSE 166 zwnd_i(:,:) = sf(jp_utau)%fnow(:,:,1) 167 zwnd_j(:,:) = sf(jp_vtau)%fnow(:,:,1) 168 ENDIF 169 ENDIF 170 130 171 IF( ln_dm2dc ) THEN ; qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) ! modify now Qsr to include the diurnal cycle 131 172 ELSE ; qsr(:,:) = sf(jp_qsr)%fnow(:,:,1) 132 173 ENDIF 133 174 !CDIR COLLAPSE 175 !!UKMO SHELF effect of atmospheric pressure on SSH 176 ! If using ln_apr_dyn, this is done there so don't repeat here. 177 IF( ln_shelf_flx .AND. .NOT. ln_apr_dyn) THEN 178 DO jj = 1, jpjm1 179 DO ji = 1, jpim1 180 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 DO 183 END DO 184 ENDIF ! ln_shelf_flx 185 134 186 DO jj = 1, jpj ! set the ocean fluxes from read fields 135 187 DO ji = 1, jpi 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) 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 140 210 END DO 141 211 END DO … … 143 213 qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! mass flux is at SST 144 214 ! 215 216 !! UKMO FOAM wind fluxes need lbc_lnk calls owing to a bug in interp.exe 217 IF( ln_foam_flx ) THEN 218 CALL lbc_lnk( utau(:,:), 'U', -1. ) 219 CALL lbc_lnk( vtau(:,:), 'V', -1. ) 220 ENDIF 221 145 222 ! ! module of wind stress and wind speed at T-point 146 223 zcoef = 1. / ( zrhoa * zcdrag ) … … 162 239 WRITE(numout,*) 163 240 WRITE(numout,*) ' read daily momentum, heat and freshwater fluxes OK' 164 DO jf = 1, jpfld 241 DO jf = 1, jpfld_local 165 242 IF( jf == jp_utau .OR. jf == jp_vtau ) zfact = 1. 166 243 IF( jf == jp_qtot .OR. jf == jp_qsr ) zfact = 0.1 … … 173 250 ENDIF 174 251 ! 252 IF( ln_shelf_flx ) THEN 253 CALL wrk_dealloc( jpi,jpj, zwnd_i, zwnd_j ) 254 ENDIF 255 ! 175 256 ENDIF 176 257 ! -
branches/UKMO/r6232_collate_bgc_diagnostics/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
r11132 r11134 42 42 LOGICAL :: ln_sssr_bnd ! flag to bound erp term 43 43 REAL(wp) :: rn_sssr_bnd ! ABS(Max./Min.) value of erp term [mm/day] 44 LOGICAL :: ln_UKMO_haney ! UKMO specific flag to calculate Haney forcing 44 45 45 46 REAL(wp) , ALLOCATABLE, DIMENSION(:) :: buffer ! Temporary buffer for exchange … … 79 80 INTEGER :: ierror ! return error code 80 81 !! 82 REAL(wp) :: sst1,sst2 ! sea surface temperature 83 REAL(wp) :: e_sst1, e_sst2 ! saturation vapour pressure 84 REAL(wp) :: qs1,qs2 ! specific humidity 85 REAL(wp) :: pr_tmp ! temporary variable for pressure 86 87 REAL(wp), DIMENSION(jpi,jpj) :: hny_frc1 ! Haney forcing for sensible heat, correction for latent heat 88 REAL(wp), DIMENSION(jpi,jpj) :: hny_frc2 ! Haney forcing for sensible heat, correction for latent heat 89 !! 81 90 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 82 91 TYPE(FLD_N) :: sn_sst, sn_sss ! informations about the fields to be read … … 95 104 ! 96 105 IF( nn_sstr == 1 ) THEN !* Temperature restoring term 97 DO jj = 1, jpj 98 DO ji = 1, jpi 99 zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) 100 qns(ji,jj) = qns(ji,jj) + zqrp 101 qrp(ji,jj) = zqrp 102 END DO 103 END DO 106 IF( ln_UKMO_haney ) THEN 107 DO jj = 1, jpj 108 DO ji = 1, jpi 109 sst1 = sst_m(ji,jj) 110 sst2 = sf_sst(1)%fnow(ji,jj,1) 111 e_sst1 = 10**((0.7859+0.03477*sst1)/(1.+0.00412*sst1)) 112 e_sst2 = 10**((0.7859+0.03477*sst2)/(1.+0.00412*sst2)) 113 pr_tmp = 0.01*pressnow(ji,jj) !pr_tmp = 1012.0 114 qs1 = (0.62197*e_sst1)/(pr_tmp-0.378*e_sst1) 115 qs2 = (0.62197*e_sst2)/(pr_tmp-0.378*e_sst2) 116 hny_frc1(ji,jj) = sst1-sst2 117 hny_frc2(ji,jj) = qs1-qs2 118 !Might need to mask off land points. 119 hny_frc1(ji,jj)=-hny_frc1(ji,jj)*wndm(ji,jj)*1.42 120 hny_frc2(ji,jj)=-hny_frc2(ji,jj)*wndm(ji,jj)*4688.0 121 qns(ji,jj)=qns(ji,jj)+hny_frc1(ji,jj)+hny_frc2(ji,jj) 122 qrp(ji,jj) = 0.e0 123 END DO 124 END DO 125 ELSE 126 DO jj = 1, jpj 127 DO ji = 1, jpi 128 zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) 129 qns(ji,jj) = qns(ji,jj) + zqrp 130 qrp(ji,jj) = zqrp 131 END DO 132 END DO 133 ENDIF 104 134 CALL iom_put( "qrp", qrp ) ! heat flux damping 105 135 ENDIF … … 163 193 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 164 194 TYPE(FLD_N) :: sn_sst, sn_sss ! informations about the fields to be read 165 NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd 195 NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd, ln_UKMO_haney 166 196 INTEGER :: ios 167 197 !!---------------------------------------------------------------------- … … 189 219 WRITE(numout,*) ' flag to bound erp term ln_sssr_bnd = ', ln_sssr_bnd 190 220 WRITE(numout,*) ' ABS(Max./Min.) erp threshold rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' 221 WRITE(numout,*) ' Haney forcing ln_UKMO_haney = ', ln_UKMO_haney 191 222 ENDIF 192 223 ! -
branches/UKMO/r6232_collate_bgc_diagnostics/NEMOGCM/NEMO/OPA_SRC/SBC/tide.h90
r4292 r11134 28 28 Wave(18) = tide( 'L2' , 0.006694 , 2 , 2 , -1 , 2 , -1 , 0 , +180 , 2 , -2 , 0 , 0 , 0 , 215 ) 29 29 Wave(19) = tide( 'T2' , 0.006614 , 2 , 2 , 0 , -1 , 0 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 ) 30 ! 31 ! !! name_tide , equitide , nutide , nt , ns , nh , np , np1 , shift , nksi , nnu0 , nnu1 , nnu2 , R , formula !! 32 Wave(20) = tide( 'MNS2' , 0.000000 , 2 , 2 , -5 , 4 , 1 , 0 , 0 , 4 , -4 , 0 , 0 , 0 , 6 ) 33 Wave(21) = tide( 'Lam2' , 0.001760 , 2 , 2 , -1 , 0 , 1 , 0 , +180 , 2 , -2 , 0 , 0 , 0 , 78 ) 34 Wave(22) = tide( 'MSN2' , 0.000000 , 2 , 2 , 1 , 0 , 1 , 0 , 0 , 2 , -2 , 0 , 2 , 0 , 6 ) 35 Wave(23) = tide( '2SM2' , 0.000000 , 2 , 2 , 2 , -2 , 0 , 0 , 0 , -2 , 2 , 0 , 0 , 0 , 16 ) 36 Wave(24) = tide( 'MO3' , 0.000000 , 3 , 3 , -4 , 1 , 0 , 0 , +90 , 2 , -2 , 0 , 0 , 0 , 13 ) 37 Wave(25) = tide( 'MK3' , 0.000000 , 3 , 3 , -2 , 3 , 0 , 0 , -90 , 2 , -2 , -1 , 0 , 0 , 10 ) 38 Wave(26) = tide( 'MN4' , 0.000000 , 4 , 4 , -5 , 4 , 1 , 0 , 0 , 4 , -4 , 0 , 0 , 0 , 1 ) 39 Wave(27) = tide( 'MS4' , 0.000000 , 4 , 4 , -2 , 2 , 0 , 0 , 0 , 2 , -2 , 0 , 0 , 0 , 2 ) 40 Wave(28) = tide( 'M6' , 0.000000 , 6 , 6 , -6 , 6 , 0 , 0 , 0 , 6 , -6 , 0 , 0 , 0 , 4 ) 41 Wave(29) = tide( '2MS6' , 0.000000 , 6 , 6 , -4 , 4 , 0 , 0 , 0 , 4 , -4 , 0 , 0 , 0 , 6 ) 42 Wave(30) = tide( '2MK6' , 0.000000 , 6 , 6 , -4 , 6 , 0 , 0 , 0 , 4 , -4 , 0 , -2 , 0 , 5 ) 43 Wave(31) = tide( '3M2S2' , 0.000000 , 2 , 2 , -6 , 6 , 0 , 0 , 0 , 6 , -6 , 0 , 0 , 0 , 12 ) -
branches/UKMO/r6232_collate_bgc_diagnostics/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90
r11132 r11134 16 16 PUBLIC tide_init_Wave ! called by tideini and diaharm modules 17 17 18 INTEGER, PUBLIC, PARAMETER :: jpmax_harmo = 19!: maximum number of harmonic18 INTEGER, PUBLIC, PARAMETER :: jpmax_harmo = 31 !: maximum number of harmonic 19 19 20 20 TYPE, PUBLIC :: tide 21 CHARACTER(LEN= 4) :: cname_tide21 CHARACTER(LEN=5) :: cname_tide 22 22 REAL(wp) :: equitide 23 23 INTEGER :: nutide
Note: See TracChangeset
for help on using the changeset viewer.