Changeset 15455 for NEMO/branches/UKMO/r14075_ukmo_shelf
- Timestamp:
- 2021-10-28T11:23:37+02:00 (3 years ago)
- Location:
- NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE
- Files:
-
- 1 added
- 10 edited
-
SBC/inv_bar_vel_mod.F90 (added)
-
SBC/sbc_oce.F90 (modified) (2 diffs)
-
SBC/sbcapr.F90 (modified) (5 diffs)
-
SBC/sbccpl.F90 (modified) (4 diffs)
-
SBC/sbcflx.F90 (modified) (8 diffs)
-
SBC/sbcmod.F90 (modified) (4 diffs)
-
SBC/sbcssm.F90 (modified) (8 diffs)
-
SBC/sbcssr.F90 (modified) (5 diffs)
-
step.F90 (modified) (1 diff)
-
step_oce.F90 (modified) (1 diff)
-
trc_oce.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/SBC/sbc_oce.F90
r14075 r15455 134 134 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sprecip !: solid precipitation [Kg/m2/s] 135 135 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_i !: ice fraction = 1 - lead fraction (between 0 to 1) 136 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pressnow !: UKMO SHELF pressure 137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: apgu !: UKMO SHELF pressure forcing 138 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: apgv !: UKMO SHELF pressure forcing 136 139 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: atm_co2 !: atmospheric pCO2 [ppm] 137 140 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask !: coupling mask for ln_mixcpl (warning: allocated in sbccpl) … … 180 183 ! 181 184 ALLOCATE( tprecip(jpi,jpj) , sprecip (jpi,jpj) , fr_i(jpi,jpj) , & 185 & pressnow(jpi,jpj), apgu(jpi,jpj) , apgv(jpi,jpj) , & 182 186 & atm_co2(jpi,jpj) , cloud_fra(jpi,jpj) , & 183 187 & ssu_m (jpi,jpj) , sst_m (jpi,jpj) , frq_m(jpi,jpj) , & -
NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/SBC/sbcapr.F90
r14075 r15455 16 16 USE fldread ! read input fields 17 17 USE in_out_manager ! I/O manager 18 USE lib_fortran ! distribu ed memory computing library18 USE lib_fortran ! distributed memory computing library 19 19 USE iom ! IOM library 20 20 USE lib_mpp ! MPP library … … 29 29 LOGICAL, PUBLIC :: ln_apr_obc = .false. !: inverse barometer added to OBC ssh data 30 30 LOGICAL, PUBLIC :: ln_ref_apr !: ref. pressure: global mean Patm (F) or a constant (F) 31 REAL(wp) 31 REAL(wp),PUBLIC :: rn_pref ! reference atmospheric pressure [N/m2] 32 32 33 33 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: ssh_ib ! Inverse barometer now sea surface height [m] … … 35 35 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: apr ! atmospheric pressure at kt [N/m2] 36 36 37 REAL(wp) :: tarea ! whole domain mean masked ocean surface 38 REAL(wp) :: r1_grau ! = 1.e0 / (grav * rau0) 37 REAL(wp), PUBLIC :: tarea ! whole domain mean masked ocean surface 38 REAL(wp), PUBLIC :: r1_grau ! = 1.e0 / (grav * rau0) 39 40 LOGICAL, PUBLIC :: cpl_mslp = .FALSE. ! Presure is passed via coupling 39 41 40 42 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_apr ! structure of input fields (file informations, fields read) … … 78 80 IF(lwm) WRITE ( numond, namsbc_apr ) 79 81 ! 80 ALLOCATE( sf_apr(1), STAT=ierror ) !* allocate and fill sf_sst (forcing structure) with sn_sst 81 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' ) 82 ! 83 CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' ) 82 IF( .NOT. cpl_mslp ) THEN 83 ALLOCATE( sf_apr(1), STAT=ierror ) !* allocate and fill sf_sst (forcing structure) with sn_sst 84 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' ) 85 ! 86 CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' ) 84 87 ALLOCATE( sf_apr(1)%fnow(jpi,jpj,1) ) 85 IF( sn_apr%ln_tint ) ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) ) 86 ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) ) 87 ALLOCATE( apr (jpi,jpj) ) 88 IF( sn_apr%ln_tint ) ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) ) 89 ENDIF 90 ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) ) 91 ALLOCATE( apr (jpi,jpj) ) 88 92 ! 89 93 IF( lwp )THEN !* control print 90 94 WRITE(numout,*) 91 WRITE(numout,*) ' Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing' 95 IF( cpl_mslp ) THEN 96 WRITE(numout,*) ' Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing' 97 ELSE 98 WRITE(numout,*) ' Namelist namsbc_apr : Atmospheric Pressure as extrenal forcing' 99 ENDIF 92 100 WRITE(numout,*) ' ref. pressure: global mean Patm (T) or a constant (F) ln_ref_apr = ', ln_ref_apr 93 101 ENDIF … … 132 140 !!---------------------------------------------------------------------- 133 141 134 ! ! ========================== !135 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! At each sbc time-step !136 ! ! ===========+++============ !137 !138 IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields139 !140 CALL fld_read( kt, nn_fsbc, sf_apr ) !* input Patm provided at kt + nn_fsbc/2141 !142 ! !* update the reference atmospheric pressure (if necessary)143 IF( ln_ref_apr ) rn_pref = glob_sum( 'sbcapr', sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea144 !145 ! !* Patm related forcing at kt146 ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_grau ! equivalent ssh (inverse barometer)147 apr (:,:) = sf_apr(1)%fnow(:,:,1) ! atmospheric pressure148 !149 CALL iom_put( "ssh_ib", ssh_ib ) !* output the inverse barometer ssh150 ENDIF142 IF( .NOT. cpl_mslp ) THEN 143 ! ========================== ! 144 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! At each sbc time-step ! 145 ! ! ===========+++============ ! 146 IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields 147 ! 148 CALL fld_read( kt, nn_fsbc, sf_apr ) !* input Patm provided at kt + nn_fsbc/2 149 ! 150 ! !* update the reference atmospheric pressure (if necessary) 151 IF( ln_ref_apr ) rn_pref = glob_sum( 'sbcapr', sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea 152 ! 153 ! !* Patm related forcing at kt 154 ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_grau ! equivalent ssh (inverse barometer) 155 apr (:,:) = sf_apr(1)%fnow(:,:,1) ! atmospheric pressure 156 ! 157 CALL iom_put( "ssh_ib", ssh_ib ) !* output the inverse barometer ssh 158 ENDIF 151 159 152 ! ! ---------------------------------------- ! 153 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! 154 ! ! ---------------------------------------- ! 155 ! !* Restart: read in restart file 156 IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN 157 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb read in the restart file' 158 CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb, ldxios = lrxios ) ! before inv. barometer ssh 159 ! 160 ELSE !* no restart: set from nit000 values 161 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb set to nit000 values' 162 ssh_ibb(:,:) = ssh_ib(:,:) 160 ! ! ---------------------------------------- ! 161 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! 162 ! ! ---------------------------------------- ! 163 ! !* Restart: read in restart file 164 IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN 165 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb read in the restart file' 166 CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb ) ! before inv. barometer ssh 167 ! 168 ELSE !* no restart: set from nit000 values 169 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb set to nit000 values' 170 ssh_ibb(:,:) = ssh_ib(:,:) 171 ENDIF 172 ENDIF 173 ! ! ---------------------------------------- ! 174 IF( lrst_oce ) THEN ! Write in the ocean restart file ! 175 ! ! ---------------------------------------- ! 176 IF(lwp) WRITE(numout,*) 177 IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp 178 IF(lwp) WRITE(numout,*) '~~~~' 179 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib ) 163 180 ENDIF 164 ENDIF165 ! ! ---------------------------------------- !166 IF( lrst_oce ) THEN ! Write in the ocean restart file !167 ! ! ---------------------------------------- !168 IF(lwp) WRITE(numout,*)169 IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp170 IF(lwp) WRITE(numout,*) '~~~~'171 IF( lwxios ) CALL iom_swap( cwxios_context )172 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib, ldxios = lwxios )173 181 IF( lwxios ) CALL iom_swap( cxios_context ) 174 182 ENDIF -
NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/SBC/sbccpl.F90
r14075 r15455 209 209 #endif 210 210 211 REAL(wp) :: rpref = 101000._wp ! reference atmospheric pressure[N/m2]212 REAL(wp) :: r1_grau ! = 1.e0 / (grav * rau0)213 214 211 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) :: nrcvinfo ! OASIS info argument 215 212 … … 573 570 ! ! Mean Sea Level Pressure ! 574 571 ! ! ------------------------- ! 575 srcv(jpr_mslp)%clname = 'O_MSLP' ; IF( TRIM(sn_rcv_mslp%cldes ) == 'coupled' ) srcv(jpr_mslp)%laction = .TRUE. 572 srcv(jpr_mslp)%clname = 'O_MSLP' 573 IF( TRIM(sn_rcv_mslp%cldes ) == 'coupled' ) THEN 574 srcv(jpr_mslp)%laction = .TRUE. 575 cpl_mslp = .TRUE. 576 ENDIF 576 577 ! 577 578 ! ! ------------------------- ! … … 1122 1123 !!---------------------------------------------------------------------- 1123 1124 USE zdf_oce, ONLY : ln_zdfswm 1125 USE sbcssm , ONLY : sbc_ssm_cpl 1126 USE lib_fortran ! distributed memory computing library 1124 1127 ! 1125 1128 INTEGER, INTENT(in) :: kt ! ocean model time step index … … 1294 1297 ! ! ========================= ! 1295 1298 IF( srcv(jpr_mslp)%laction ) THEN ! UKMO SHELF effect of atmospheric pressure on SSH 1296 IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields 1297 1298 r1_grau = 1.e0 / (grav * rau0) !* constant for optimization 1299 ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau ! equivalent ssh (inverse barometer) 1300 apr (:,:) = frcv(jpr_mslp)%z3(:,:,1) !atmospheric pressure 1299 IF( ln_apr_dyn ) THEN 1300 IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields 1301 1301 1302 IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) ! correct this later (read from restart if possible) 1302 ! !* update the reference atmospheric pressure (if necessary) 1303 IF( ln_ref_apr ) rn_pref = glob_sum( 'sbccpl', frcv(jpr_mslp)%z3(:,:,1) * e1e2t(:,:) ) / tarea 1304 1305 ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rn_pref ) * r1_grau ! equivalent ssh (inverse barometer) 1306 apr (:,:) = frcv(jpr_mslp)%z3(:,:,1) !atmospheric pressure 1307 ! 1308 CALL iom_put( "ssh_ib", ssh_ib ) !* output the inverse barometer ssh 1309 ! ! ---------------------------------------- ! 1310 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! 1311 ! ! ---------------------------------------- ! 1312 !* Restart: read in restart file 1313 IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN 1314 IF(lwp) WRITE(numout,*) 'sbc_cpl: ssh_ibb read in the restart file' 1315 CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb ) ! before inv. barometer ssh 1316 ELSE !* no restart: set from nit000 values 1317 IF(lwp) WRITE(numout,*) 'sbc_cpl: ssh_ibb set to nit000 values' 1318 ssh_ibb(:,:) = ssh_ib(:,:) 1319 ENDIF 1320 ENDIF 1321 ! ! ---------------------------------------- ! 1322 IF( lrst_oce ) THEN ! Write in the ocean restart file ! 1323 ! ! ---------------------------------------- ! 1324 IF(lwp) WRITE(numout,*) 1325 IF(lwp) WRITE(numout,*) 'sbc_cpl : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp 1326 IF(lwp) WRITE(numout,*) '~~~~' 1327 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib ) 1328 ENDIF 1329 ENDIF 1330 1331 ! Update mean ssh 1332 IF( nn_components /= jp_iam_sas ) CALL sbc_ssm_cpl( kt ) 1303 1333 END IF 1304 1334 ! -
NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/SBC/sbcflx.F90
r14075 r15455 35 35 INTEGER , PARAMETER :: jp_emp = 5 ! index of evaporation-precipation file 36 36 !!INTEGER , PARAMETER :: jp_sfx = 6 ! index of salt flux flux 37 INTEGER , PARAMETER :: jpfld = 5 !! 6 ! maximum number of files to read 37 INTEGER , PARAMETER :: jp_press = 6 ! index of pressure for UKMO shelf fluxes 38 INTEGER , PARAMETER :: jpfld = 6 ! maximum number of files to read 38 39 39 40 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) 41 LOGICAL , PUBLIC :: ln_shelf_flx = .FALSE. ! UKMO SHELF specific flux flag 42 LOGICAL , PUBLIC :: ln_rel_wind = .FALSE. ! UKMO SHELF specific flux flag - relative winds 43 REAL(wp) :: rn_wfac ! multiplication factor for ice/ocean velocity in the calculation of wind stress (clem) 44 INTEGER :: jpfld_local ! maximum number of files to read (locally modified depending on ln_shelf_flx) 40 45 41 46 !! * Substitutions … … 85 90 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 86 91 REAL(wp) :: ztx, zty, zmod, zcoef ! temporary variables 92 REAL :: cs ! UKMO SHELF: Friction co-efficient at surface 93 REAL :: totwindspd ! UKMO SHELF: Magnitude of wind speed vector 94 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zwnd_i, zwnd_j ! wind speed components at T-point 95 96 REAL(wp) :: rhoa = 1.22 ! Air density kg/m3 97 REAL(wp) :: cdrag = 1.5e-3 ! drag coefficient 87 98 !! 88 99 CHARACTER(len=100) :: cn_dir ! Root directory for location of flx files 89 100 TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist information structures 90 TYPE(FLD_N) :: sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp !!, sn_sfx ! informations about the fields to be read 91 NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp !!, sn_sfx 101 TYPE(FLD_N) :: sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp, sn_press ! informations about the fields to be read 102 LOGICAL :: ln_foam_flx = .FALSE. ! UKMO FOAM specific flux flag 103 NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp, & 104 & ln_foam_flx, sn_press, ln_shelf_flx, ln_rel_wind, & 105 & rn_wfac 92 106 !!--------------------------------------------------------------------- 93 107 ! … … 112 126 slf_i(jp_emp ) = sn_emp !! ; slf_i(jp_sfx ) = sn_sfx 113 127 ! 114 ALLOCATE( sf(jpfld), STAT=ierror ) ! set sf structure 128 IF( ln_shelf_flx ) slf_i(jp_press) = sn_press 129 130 ! define local jpfld depending on shelf_flx logical 131 IF( ln_shelf_flx ) THEN 132 jpfld_local = jpfld 133 ELSE 134 jpfld_local = jpfld-1 135 ENDIF 136 ! 137 ALLOCATE( sf(jpfld_local), STAT=ierror ) ! set sf structure 115 138 IF( ierror > 0 ) THEN 116 139 CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' ) ; RETURN 117 140 ENDIF 118 DO ji= 1, jpfld 141 DO ji= 1, jpfld_local 119 142 ALLOCATE( sf(ji)%fnow(jpi,jpj,1) ) 120 143 IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) ) … … 129 152 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! update ocean fluxes at each SBC frequency 130 153 154 !!UKMO SHELF wind speed relative to surface currents 155 IF( ln_shelf_flx ) THEN 156 ALLOCATE( zwnd_i(jpi,jpj), zwnd_j(jpi,jpj) ) 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 131 171 IF( ln_dm2dc ) THEN ; qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) ! modify now Qsr to include the diurnal cycle 132 172 ELSE ; qsr(:,:) = sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1) 133 173 ENDIF 174 !!UKMO SHELF effect of atmospheric pressure on SSH 175 ! If using ln_apr_dyn, this is done there so don't repeat here. 176 IF( ln_shelf_flx .AND. .NOT. ln_apr_dyn) THEN 177 DO jj = 1, jpjm1 178 DO ji = 1, jpim1 179 apgu(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji+1,jj,1)-sf(jp_press)%fnow(ji,jj,1))/e1u(ji,jj) 180 apgv(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji,jj+1,1)-sf(jp_press)%fnow(ji,jj,1))/e2v(ji,jj) 181 END DO 182 END DO 183 ENDIF ! ln_shelf_flx 134 184 DO jj = 1, jpj ! set the ocean fluxes from read fields 135 185 DO ji = 1, jpi 136 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) * umask(ji,jj,1) 137 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) * vmask(ji,jj,1) 138 qns (ji,jj) = ( sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 139 emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) * tmask(ji,jj,1) 186 IF( ln_shelf_flx ) THEN 187 !! UKMO SHELF - need atmospheric pressure to calculate Haney forcing 188 pressnow(ji,jj) = sf(jp_press)%fnow(ji,jj,1) 189 !! UKMO SHELF flux files contain wind speed not wind stress 190 totwindspd = sqrt(zwnd_i(ji,jj)*zwnd_i(ji,jj) + zwnd_j(ji,jj)*zwnd_j(ji,jj)) 191 cs = 0.63 + (0.066 * totwindspd) 192 utau(ji,jj) = cs * (rhoa/rau0) * zwnd_i(ji,jj) * totwindspd 193 vtau(ji,jj) = cs * (rhoa/rau0) * zwnd_j(ji,jj) * totwindspd 194 ELSE 195 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 196 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 197 ENDIF 198 qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1) 199 IF( ln_foam_flx .OR. ln_shelf_flx ) THEN 200 !! UKMO FOAM flux files contain non-solar heat flux (qns) rather than total heat flux (qtot) 201 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) 202 !! UKMO FOAM flux files contain the net DOWNWARD freshwater flux P-E rather then E-P 203 emp (ji,jj) = -1. * sf(jp_emp )%fnow(ji,jj,1) 204 ELSE 205 qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 206 emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 207 ENDIF 140 208 !!sfx (ji,jj) = sf(jp_sfx )%fnow(ji,jj,1) * tmask(ji,jj,1) 141 209 END DO 142 210 END DO 211 ! 212 IF( ln_shelf_flx ) THEN 213 ! calculate first the wind module, as it will be used later 214 DO jj = 2, jpjm1 215 DO ji = fs_2, fs_jpim1 ! vect. opt. 216 ztx = zwnd_i(ji-1,jj ) + zwnd_i(ji,jj) 217 zty = zwnd_j(ji ,jj-1) + zwnd_j(ji,jj) 218 wndm(ji,jj) = 0.5 * SQRT( ztx * ztx + zty * zty ) 219 END DO 220 END DO 221 CALL lbc_lnk_multi( 'sbcflx', wndm, 'T', 1. ) 222 ENDIF 143 223 ! ! add to qns the heat due to e-p 144 !clem: I do not think it is needed 145 !!qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! mass flux is at SST 224 qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! mass flux is at SST 146 225 ! 147 226 ! clem: without these lbc calls, it seems that the northfold is not ok (true in 3.6, not sure in 4.x) … … 152 231 WRITE(numout,*) 153 232 WRITE(numout,*) ' read daily momentum, heat and freshwater fluxes OK' 154 DO jf = 1, jpfld 233 DO jf = 1, jpfld_local 155 234 IF( jf == jp_utau .OR. jf == jp_vtau ) zfact = 1. 156 235 IF( jf == jp_qtot .OR. jf == jp_qsr ) zfact = 0.1 … … 164 243 ! ! module of wind stress and wind speed at T-point 165 244 ! Note the use of 0.5*(2-umask) in order to unmask the stress along coastlines 245 !! UKMO FOAM wind fluxes need lbc_lnk calls owing to a bug in interp.exe 246 IF( ln_foam_flx ) THEN 247 CALL lbc_lnk_multi( 'sbcflx', utau, 'U', -1._wp, vtau, 'V', -1._wp ) 248 ENDIF 166 249 zcoef = 1. / ( zrhoa * zcdrag ) 167 250 DO jj = 2, jpjm1 … … 171 254 zmod = 0.5_wp * SQRT( ztx * ztx + zty * zty ) * tmask(ji,jj,1) 172 255 taum(ji,jj) = zmod 173 wndm(ji,jj) = SQRT( zmod * zcoef ) !!clem: not used? 256 IF( .NOT. ln_shelf_flx ) THEN 257 wndm(ji,jj) = SQRT( zmod * zcoef ) !!clem: not used? 258 ENDIF 174 259 END DO 175 260 END DO … … 177 262 CALL lbc_lnk_multi( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp ) 178 263 ! 264 IF( ln_shelf_flx ) THEN 265 DEALLOCATE( zwnd_i, zwnd_j ) 266 ENDIF 179 267 ! 180 268 END SUBROUTINE sbc_flx -
NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/SBC/sbcmod.F90
r14075 r15455 39 39 USE sbcisf ! surface boundary condition: ice-shelf 40 40 USE sbccpl ! surface boundary condition: coupled formulation 41 USE inv_bar_vel_mod! Atmos press effect on vel 41 42 USE cpl_oasis3 ! OASIS routines for coupling 42 43 USE sbcssr ! surface boundary condition: sea surface restoring … … 391 392 !! - updte the ice fraction : fr_i 392 393 !!---------------------------------------------------------------------- 394 USE sbcapr, ONLY: sbc_apr 395 USE bdydta, ONLY: bdy_dta 396 ! 393 397 INTEGER, INTENT(in) :: kt ! ocean time step 394 398 ! … … 423 427 ! ! forcing field computation ! 424 428 ! ! ---------------------------------------- ! 429 IF( ln_apr_dyn ) CALL sbc_apr( kt ) ! atmospheric pressure provided at kt+0.5*nn_fsbc 430 ! (caution called before sbc_ssm) 425 431 ! 426 432 ll_sas = nn_components == jp_iam_sas ! component flags … … 443 449 CASE( jp_purecpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! pure coupled formulation 444 450 CASE( jp_none ) 445 IF( ll_opa )CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: OPA receiving fields from SAS451 IF( .NOT. ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: OPA receiving fields from SAS 446 452 END SELECT 447 453 ! 448 IF( ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! forced-coupled mixed formulation after forcing 454 IF( ln_mixcpl .OR. ( ln_wave .AND. nsbc .NE. jp_purecpl .AND. nsbc .NE. jp_none ) ) & 455 CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! forced-coupled mixed formulation after forcing 456 IF ( ln_shelf_flx .AND. .NOT. ln_apr_dyn) & 457 CALL inv( kt ) ! modification to vel from atmos pres 458 IF( ln_bdy ) CALL bdy_dta ( kt, kt_offset=+1 ) ! update dynamic & tracer data at open boundaries 459 460 ! (caution called after sbc_ssm[_cpl] and before ice) 449 461 ! 450 462 IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( ) ! Wind stress provided by waves -
NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/SBC/sbcssm.F90
r14075 r15455 28 28 29 29 PUBLIC sbc_ssm ! routine called by step.F90 30 PUBLIC sbc_ssm_cpl ! routine called by sbccpl.F90 30 31 PUBLIC sbc_ssm_init ! routine called by sbcmod.F90 31 32 … … 76 77 sss_m(:,:) = zts(:,:,jp_sal) 77 78 ! ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 78 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 79 ELSE ; ssh_m(:,:) = sshn(:,:) 79 IF( .NOT. cpl_mslp ) THEN 80 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 81 ELSE ; ssh_m(:,:) = sshn(:,:) 82 ENDIF 80 83 ENDIF 81 84 ! … … 99 102 sss_m(:,:) = zcoef * zts(:,:,jp_sal) 100 103 ! ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 101 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 102 ELSE ; ssh_m(:,:) = zcoef * sshn(:,:) 104 IF( .NOT. cpl_mslp ) THEN 105 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 106 ELSE ; ssh_m(:,:) = zcoef * sshn(:,:) 107 ENDIF 103 108 ENDIF 104 109 ! … … 113 118 sst_m(:,:) = 0._wp 114 119 sss_m(:,:) = 0._wp 115 ssh_m(:,:) = 0._wp120 IF( .NOT. cpl_mslp ) ssh_m(:,:) = 0._wp 116 121 e3t_m(:,:) = 0._wp 117 122 frq_m(:,:) = 0._wp … … 127 132 sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal) 128 133 ! ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 129 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 130 ELSE ; ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) 134 IF( .NOT. cpl_mslp ) THEN 135 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 136 ELSE ; ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) 137 ENDIF 131 138 ENDIF 132 139 ! … … 143 150 ssu_m(:,:) = ssu_m(:,:) * zcoef ! mean suface current [m/s] 144 151 ssv_m(:,:) = ssv_m(:,:) * zcoef ! 145 ssh_m(:,:) = ssh_m(:,:) * zcoef ! mean SSH [m]152 IF( .NOT. cpl_mslp ) ssh_m(:,:) = ssh_m(:,:) * zcoef ! mean SSH [m] 146 153 e3t_m(:,:) = e3t_m(:,:) * zcoef ! mean vertical scale factor [m] 147 154 frq_m(:,:) = frq_m(:,:) * zcoef ! mean fraction of solar net radiation absorbed in the 1st T level [-] … … 162 169 CALL iom_rstput( kt, nitrst, numrow, 'sst_m' , sst_m, ldxios = lwxios ) 163 170 CALL iom_rstput( kt, nitrst, numrow, 'sss_m' , sss_m, ldxios = lwxios ) 164 CALL iom_rstput( kt, nitrst, numrow, 'ssh_m' , ssh_m, ldxios = lwxios )171 IF( .NOT. cpl_mslp ) CALL iom_rstput( kt, nitrst, numrow, 'ssh_m' , ssh_m, ldxios = lwxios ) 165 172 CALL iom_rstput( kt, nitrst, numrow, 'e3t_m' , e3t_m, ldxios = lwxios ) 166 173 CALL iom_rstput( kt, nitrst, numrow, 'frq_m' , frq_m, ldxios = lwxios ) … … 183 190 END SUBROUTINE sbc_ssm 184 191 192 SUBROUTINE sbc_ssm_cpl( kt ) 193 !!--------------------------------------------------------------------- 194 !! *** ROUTINE sbc_ssm_cpl *** 195 !! 196 !! ** Purpose : provide ocean surface variable to sea-surface boundary 197 !! condition computation when pressure is read from coupling 198 !! 199 !! ** Method : The inverse barometer ssh (i.e. ssh associated with Patm) 200 !! is added to ssh_m when ln_apr_dyn = T. Required for sea-ice dynamics. 201 !!--------------------------------------------------------------------- 202 INTEGER, INTENT(in) :: kt ! ocean time step 203 ! 204 REAL(wp) :: zcoef ! local scalar 205 !!--------------------------------------------------------------------- 206 ! 207 IF( nn_fsbc == 1 ) THEN ! Instantaneous surface fields ! 208 ! ! ---------------------------------------- ! 209 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 210 ELSE ; ssh_m(:,:) = sshn(:,:) 211 ENDIF 212 ELSE 213 ! ! ----------------------------------------------- ! 214 IF( kt == nit000 .AND. .NOT. l_ssm_mean ) THEN ! Initialisation: 1st time-step, no input means ! 215 ! ! ----------------------------------------------- ! 216 IF(lwp) WRITE(numout,*) 217 IF(lwp) WRITE(numout,*) '~~~~~~~ mean ssh field initialised to instantaneous values' 218 zcoef = REAL( nn_fsbc - 1, wp ) 219 zcoef = REAL( nn_fsbc - 1, wp ) 220 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 221 ELSE ; ssh_m(:,:) = zcoef * sshn(:,:) 222 ENDIF 223 ! ! ---------------------------------------- ! 224 ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN ! Initialisation: New mean computation ! 225 ! ! ---------------------------------------- ! 226 ssh_m(:,:) = 0.e0 227 ENDIF 228 229 IF( ln_apr_dyn ) THEN ; ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 230 ELSE ; ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) 231 ENDIF 232 ! ! ---------------------------------------- ! 233 IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN ! Mean value at each nn_fsbc time-step ! 234 ! ! ---------------------------------------- ! 235 zcoef = 1. / REAL( nn_fsbc, wp ) 236 ssh_m(:,:) = ssh_m(:,:) * zcoef ! mean SSH [m] 237 ENDIF 238 ! ! ---------------------------------------- ! 239 IF( lrst_oce ) THEN ! Write in the ocean restart file ! 240 ! ! ---------------------------------------- ! 241 IF(lwp) WRITE(numout,*) 242 IF(lwp) WRITE(numout,*) 'sbc_ssm_cpl : ssh mean field written in ocean restart file ', & 243 & 'at it= ', kt,' date= ', ndastp 244 IF(lwp) WRITE(numout,*) '~~~~~~~' 245 CALL iom_rstput( kt, nitrst, numrow, 'ssh_m' , ssh_m ) 246 ENDIF 247 ENDIF 248 ! 249 IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN ! Mean value at each nn_fsbc time-step ! 250 CALL iom_put( 'ssh_m', ssh_m ) 251 ENDIF 252 ! 253 END SUBROUTINE sbc_ssm_cpl 185 254 186 255 SUBROUTINE sbc_ssm_init -
NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/SBC/sbcssr.F90
r14075 r15455 44 44 REAL(wp) :: rn_sssr_bnd ! ABS(Max./Min.) value of erp term [mm/day] 45 45 INTEGER :: nn_sssr_ice ! Control of restoring under ice 46 LOGICAL :: ln_UKMO_haney ! UKMO specific flag to calculate Haney forcing 46 47 47 48 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 … … 93 102 ! 94 103 IF( nn_sstr == 1 ) THEN !* Temperature restoring term 95 DO jj = 1, jpj 96 DO ji = 1, jpi 97 zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 98 qns(ji,jj) = qns(ji,jj) + zqrp 99 qrp(ji,jj) = zqrp 100 END DO 101 END DO 104 IF( ln_UKMO_haney ) THEN 105 DO jj = 1, jpj 106 DO ji = 1, jpi 107 sst1 = sst_m(ji,jj) 108 sst2 = sf_sst(1)%fnow(ji,jj,1) 109 e_sst1 = 10**((0.7859+0.03477*sst1)/(1.+0.00412*sst1)) 110 e_sst2 = 10**((0.7859+0.03477*sst2)/(1.+0.00412*sst2)) 111 pr_tmp = 0.01*pressnow(ji,jj) !pr_tmp = 1012.0 112 qs1 = (0.62197*e_sst1)/(pr_tmp-0.378*e_sst1) 113 qs2 = (0.62197*e_sst2)/(pr_tmp-0.378*e_sst2) 114 hny_frc1(ji,jj) = sst1-sst2 115 hny_frc2(ji,jj) = qs1-qs2 116 !Might need to mask off land points. 117 hny_frc1(ji,jj)=-hny_frc1(ji,jj)*wndm(ji,jj)*1.42 118 hny_frc2(ji,jj)=-hny_frc2(ji,jj)*wndm(ji,jj)*4688.0 119 qns(ji,jj)=qns(ji,jj)+hny_frc1(ji,jj)+hny_frc2(ji,jj) 120 qrp(ji,jj) = 0.e0 121 END DO 122 END DO 123 ELSE 124 DO jj = 1, jpj 125 DO ji = 1, jpi 126 zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) 127 qns(ji,jj) = qns(ji,jj) + zqrp 128 qrp(ji,jj) = zqrp 129 END DO 130 END DO 131 ENDIF 102 132 ENDIF 103 133 ! … … 170 200 TYPE(FLD_N) :: sn_sst, sn_sss ! informations about the fields to be read 171 201 NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, & 172 & sn_sss, ln_sssr_bnd, rn_sssr_bnd, nn_sssr_ice 202 & sn_sss, ln_sssr_bnd, rn_sssr_bnd, nn_sssr_ice, ln_UKMO_haney 173 203 INTEGER :: ios 174 204 !!---------------------------------------------------------------------- … … 202 232 WRITE(numout,*) ' ( 1 = restoration everywhere )' 203 233 WRITE(numout,*) ' (>1 = enhanced restoration under ice )' 234 WRITE(numout,*) ' Haney forcing ln_UKMO_haney = ', ln_UKMO_haney 204 235 ENDIF 205 236 ! -
NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/step.F90
r14075 r15455 109 109 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 110 110 IF( ln_tide ) CALL sbc_tide( kstp ) ! update tide potential 111 IF( ln_apr_dyn ) CALL sbc_apr ( kstp ) ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib)112 IF( ln_bdy ) CALL bdy_dta ( kstp, kt_offset = +1 ) ! update dynamic & tracer data at open boundaries113 111 CALL sbc ( kstp ) ! Sea Boundary Condition (including sea-ice) 114 112 -
NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/step_oce.F90
r14075 r15455 18 18 USE sbcrnf ! surface boundary condition: runoff variables 19 19 USE sbccpl ! surface boundary condition: coupled formulation (call send at end of step) 20 USE sbcflx ! surface boundary condition: Fluxes 20 21 USE sbcapr ! surface boundary condition: atmospheric pressure 21 22 USE sbctide ! Tide initialisation -
NEMO/branches/UKMO/r14075_ukmo_shelf/src/OCE/trc_oce.F90
r14075 r15455 30 30 ! 31 31 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: etot3 !: light absortion coefficient 32 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: rlambda2 !: Lambda2 for downwell version of Short wave Radiation 33 REAL(wp), PUBLIC :: rlambda !: Lambda for downwell version of Short wave Radiation 32 34 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:) :: oce_co2 !: ocean carbon flux 33 35 … … 54 56 !! *** trc_oce_alloc *** 55 57 !!---------------------------------------------------------------------- 56 ALLOCATE( etot3(jpi,jpj,jpk), oce_co2(jpi,jpj), STAT=trc_oce_alloc )57 IF( trc_oce_alloc /= 0 ) CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array')58 ALLOCATE( etot3(jpi,jpj,jpk), oce_co2(jpi,jpj), rlambda2(jpi,jpj), STAT=trc_oce_alloc ) 59 IF( trc_oce_alloc /= 0 ) CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 or rlambda2 array') 58 60 ! 59 61 END FUNCTION trc_oce_alloc
Note: See TracChangeset
for help on using the changeset viewer.
