Changeset 6194 for branches/UKMO/dev_r5518_pkg/NEMOGCM/NEMO/OPA_SRC
- Timestamp:
- 2015-12-31T16:44:39+01:00 (9 years ago)
- Location:
- branches/UKMO/dev_r5518_pkg/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_pkg/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90
r5473 r6194 25 25 USE icbutl ! iceberg utility routines 26 26 27 USE sbc_oce ! for icesheet freshwater input variables 28 USE in_out_manager 29 USE iom 30 27 31 IMPLICIT NONE 28 32 PRIVATE … … 48 52 ! 49 53 REAL(wp) :: zcalving_used, zdist, zfact 54 REAL(wp) :: zgreenland_calving_sum, zantarctica_calving_sum 50 55 INTEGER :: jn, ji, jj ! loop counters 51 56 INTEGER :: imx ! temporary integer for max berg class … … 59 64 zfact = ( (1000._wp)**3 / ( NINT(rday) * nyear_len(1) ) ) * 850._wp 60 65 berg_grid%calving(:,:) = src_calving(:,:) * tmask_i(:,:) * zfact 66 67 IF( lk_oasis) THEN 68 ! ln_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 69 IF( ln_coupled_iceshelf_fluxes ) THEN 70 71 ! Adjust total calving rates so that sum of iceberg calving and iceshelf melting in the northern 72 ! and southern hemispheres equals rate of increase of mass of greenland and antarctic ice sheets 73 ! to preserve total freshwater conservation in coupled models without an active ice sheet model. 74 75 zgreenland_calving_sum = SUM( berg_grid%calving(:,:) * greenland_icesheet_mask(:,:) ) 76 IF( lk_mpp ) CALL mpp_sum( zgreenland_calving_sum ) 77 WHERE( greenland_icesheet_mask(:,:) == 1.0 ) & 78 & berg_grid%calving(:,:) = berg_grid%calving(:,:) * greenland_icesheet_mass_rate_of_change * rn_greenland_calving_fraction & 79 & / ( zgreenland_calving_sum + 1.0e-10_wp ) 80 81 ! check 82 IF(lwp) WRITE(numout, *) 'Greenland iceberg calving climatology (kg/s) : ',zgreenland_calving_sum 83 zgreenland_calving_sum = SUM( berg_grid%calving(:,:) * greenland_icesheet_mask(:,:) ) 84 IF( lk_mpp ) CALL mpp_sum( zgreenland_calving_sum ) 85 IF(lwp) WRITE(numout, *) 'Greenland iceberg calving adjusted value (kg/s) : ',zgreenland_calving_sum 86 87 zantarctica_calving_sum = SUM( berg_grid%calving(:,:) * antarctica_icesheet_mask(:,:) ) 88 IF( lk_mpp ) CALL mpp_sum( zantarctica_calving_sum ) 89 WHERE( antarctica_icesheet_mask(:,:) == 1.0 ) & 90 berg_grid%calving(:,:) = berg_grid%calving(:,:) * antarctica_icesheet_mass_rate_of_change * rn_antarctica_calving_fraction & 91 & / ( zantarctica_calving_sum + 1.0e-10_wp ) 92 93 ! check 94 IF(lwp) WRITE(numout, *) 'Antarctica iceberg calving climatology (kg/s) : ',zantarctica_calving_sum 95 zantarctica_calving_sum = SUM( berg_grid%calving(:,:) * antarctica_icesheet_mask(:,:) ) 96 IF( lk_mpp ) CALL mpp_sum( zantarctica_calving_sum ) 97 IF(lwp) WRITE(numout, *) 'Antarctica iceberg calving adjusted value (kg/s) : ',zantarctica_calving_sum 98 99 ENDIF 100 ENDIF 101 102 CALL iom_put( 'berg_calve', berg_grid%calving(:,:) ) 61 103 62 104 ! Heat in units of W/m2, and mask (just in case) -
branches/UKMO/dev_r5518_pkg/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r5575 r6194 24 24 USE trdmxl_oce ! ocean active mixed layer tracers trends variables 25 25 USE divcur ! hor. divergence and curl (div & cur routines) 26 USE sbc_oce ! for icesheet freshwater input variables 26 27 27 28 IMPLICIT NONE … … 145 146 CALL iom_rstput( kt, nitrst, numrow, 'rhd' , rhd ) 146 147 #endif 148 IF( lk_oasis) THEN 149 ! ln_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 150 IF( ln_coupled_iceshelf_fluxes ) THEN 151 CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_mass', greenland_icesheet_mass ) 152 CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_timelapsed', greenland_icesheet_timelapsed ) 153 CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_mass_roc', greenland_icesheet_mass_rate_of_change ) 154 CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_mass', antarctica_icesheet_mass ) 155 CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_timelapsed', antarctica_icesheet_timelapsed ) 156 CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_mass_roc', antarctica_icesheet_mass_rate_of_change ) 157 ENDIF 158 ENDIF 159 147 160 IF( kt == nitrst ) THEN 148 161 CALL iom_close( numrow ) ! close the restart file (only at last time step) … … 258 271 #endif 259 272 ! 273 IF( iom_varid( numror, 'greenland_icesheet_mass', ldstop = .FALSE. ) > 0 ) THEN 274 CALL iom_get( numror, 'greenland_icesheet_mass', greenland_icesheet_mass ) 275 CALL iom_get( numror, 'greenland_icesheet_timelapsed', greenland_icesheet_timelapsed ) 276 CALL iom_get( numror, 'greenland_icesheet_mass_roc', greenland_icesheet_mass_rate_of_change ) 277 ELSE 278 greenland_icesheet_mass = 0.0 279 greenland_icesheet_mass_rate_of_change = 0.0 280 greenland_icesheet_timelapsed = 0.0 281 ENDIF 282 IF( iom_varid( numror, 'antarctica_icesheet_mass', ldstop = .FALSE. ) > 0 ) THEN 283 CALL iom_get( numror, 'antarctica_icesheet_mass', antarctica_icesheet_mass ) 284 CALL iom_get( numror, 'antarctica_icesheet_timelapsed', antarctica_icesheet_timelapsed ) 285 CALL iom_get( numror, 'antarctica_icesheet_mass_roc', antarctica_icesheet_mass_rate_of_change ) 286 ELSE 287 antarctica_icesheet_mass = 0.0 288 antarctica_icesheet_mass_rate_of_change = 0.0 289 antarctica_icesheet_timelapsed = 0.0 290 ENDIF 291 260 292 IF( neuler == 0 ) THEN ! Euler restart (neuler=0) 261 293 tsb (:,:,:,:) = tsn (:,:,:,:) ! all before fields set to now values -
branches/UKMO/dev_r5518_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r5575 r6194 125 125 #endif 126 126 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask !: coupling mask for ln_mixcpl (warning: allocated in sbccpl) 127 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: greenland_icesheet_mass_array, greenland_icesheet_mask 128 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: antarctica_icesheet_mass_array, antarctica_icesheet_mask 127 129 128 130 !!---------------------------------------------------------------------- … … 137 139 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e3t_m !: mean (nn_fsbc time-step) sea surface layer thickness [m] 138 140 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_m !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-] 141 142 !!---------------------------------------------------------------------- 143 !! Surface scalars of total ice sheet mass for Greenland and Antarctica, 144 !! passed from atmosphere to be converted to dvol and hence a freshwater 145 !! flux by using old values. New values are saved in the dump, to become 146 !! old values next coupling timestep. Freshwater fluxes split between 147 !! sub iceshelf melting and iceberg calving, scalled to flux per second 148 !!---------------------------------------------------------------------- 149 150 REAL(wp), PUBLIC :: greenland_icesheet_mass, greenland_icesheet_mass_rate_of_change, greenland_icesheet_timelapsed 151 REAL(wp), PUBLIC :: antarctica_icesheet_mass, antarctica_icesheet_mass_rate_of_change, antarctica_icesheet_timelapsed 152 153 ! sbccpl namelist parameters associated with icesheet freshwater input code. Included here rather than in sbccpl.F90 to 154 ! avoid circular dependencies. 155 LOGICAL, PUBLIC :: ln_coupled_iceshelf_fluxes ! If true use rate of change of mass of Greenland and Antarctic icesheets to set the 156 ! combined magnitude of the iceberg calving and iceshelf melting freshwater fluxes. 157 REAL(wp), PUBLIC :: rn_greenland_calving_fraction ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting. 158 REAL(wp), PUBLIC :: rn_antarctica_calving_fraction ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting. 159 REAL(wp), PUBLIC :: rn_iceshelf_fluxes_tolerance ! Absolute tolerance for detecting differences in icesheet masses. 139 160 140 161 !! * Substitutions … … 172 193 & ssu_m (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) , & 173 194 & ssv_m (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) ) 195 ALLOCATE( greenland_icesheet_mass_array(jpi,jpj) , antarctica_icesheet_mass_array(jpi,jpj) ) 196 ALLOCATE( greenland_icesheet_mask(jpi,jpj) , antarctica_icesheet_mask(jpi,jpj) ) 174 197 ! 175 198 #if defined key_vvl -
branches/UKMO/dev_r5518_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5575 r6194 105 105 INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness 106 106 INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level 107 INTEGER, PARAMETER :: jprcv = 42 ! total number of fields received 107 INTEGER, PARAMETER :: jpr_ts_ice = 43 ! skin temperature of sea-ice (used for melt-ponds) 108 INTEGER, PARAMETER :: jpr_grnm = 44 ! Greenland ice mass 109 INTEGER, PARAMETER :: jpr_antm = 45 ! Antarctic ice mass 110 INTEGER, PARAMETER :: jprcv = 45 ! total number of fields received 108 111 109 112 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere … … 216 219 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos 217 220 !! 218 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 219 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 220 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, & 221 & sn_rcv_co2 , nn_cplmodel , ln_usecplmask 221 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick , sn_snd_crt , sn_snd_co2, & 222 & sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1, & 223 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 224 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, & 225 & sn_rcv_co2 , sn_rcv_grnm , sn_rcv_antm , sn_rcv_ts_ice, nn_cplmodel , & 226 & ln_usecplmask, ln_coupled_iceshelf_fluxes, rn_greenland_calving_fraction, & 227 & rn_antarctica_calving_fraction, rn_iceshelf_fluxes_tolerance 222 228 !!--------------------------------------------------------------------- 223 229 ! … … 271 277 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 272 278 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask 279 WRITE(numout,*)' ln_coupled_iceshelf_fluxes = ', ln_coupled_iceshelf_fluxes 280 WRITE(numout,*)' rn_greenland_calving_fraction = ', rn_greenland_calving_fraction 281 WRITE(numout,*)' rn_antarctica_calving_fraction = ', rn_antarctica_calving_fraction 282 WRITE(numout,*)' rn_iceshelf_fluxes_tolerance = ', rn_iceshelf_fluxes_tolerance 273 283 ENDIF 274 284 … … 789 799 ncpl_qsr_freq = 86400 / ncpl_qsr_freq 790 800 801 IF( ln_coupled_iceshelf_fluxes ) THEN 802 ! Crude masks to separate the Antarctic and Greenland icesheets. Obviously something 803 ! more complicated could be done if required. 804 greenland_icesheet_mask = 0.0 805 WHERE( gphit >= 0.0 ) greenland_icesheet_mask = 1.0 806 antarctica_icesheet_mask = 0.0 807 WHERE( gphit < 0.0 ) antarctica_icesheet_mask = 1.0 808 809 ! initialise other variables 810 greenland_icesheet_mass_array(:,:) = 0.0 811 antarctica_icesheet_mass_array(:,:) = 0.0 812 813 IF( .not. ln_rstart ) THEN 814 greenland_icesheet_mass = 0.0 815 greenland_icesheet_mass_rate_of_change = 0.0 816 greenland_icesheet_timelapsed = 0.0 817 antarctica_icesheet_mass = 0.0 818 antarctica_icesheet_mass_rate_of_change = 0.0 819 antarctica_icesheet_timelapsed = 0.0 820 ENDIF 821 822 ENDIF 823 791 824 CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 792 825 ! … … 851 884 INTEGER :: ikchoix 852 885 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 886 REAL(wp) :: zgreenland_icesheet_mass_in, zantarctica_icesheet_mass_in 887 REAL(wp) :: zgreenland_icesheet_mass_b, zantarctica_icesheet_mass_b 888 REAL(wp) :: zmask_sum, zepsilon 853 889 REAL(wp) :: zcoef ! temporary scalar 854 890 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 … … 1137 1173 1138 1174 ENDIF 1175 1176 ! ! land ice masses : Greenland 1177 zepsilon = rn_iceshelf_fluxes_tolerance 1178 1179 IF( srcv(jpr_grnm)%laction ) THEN 1180 greenland_icesheet_mass_array(:,:) = frcv(jpr_grnm)%z3(:,:,1) 1181 ! take average over ocean points of input array to avoid cumulative error over time 1182 zgreenland_icesheet_mass_in = SUM( greenland_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1183 IF(lk_mpp) CALL mpp_sum( zgreenland_icesheet_mass_in ) 1184 zmask_sum = SUM( tmask(:,:,1) ) 1185 IF(lk_mpp) CALL mpp_sum( zmask_sum ) 1186 zgreenland_icesheet_mass_in = zgreenland_icesheet_mass_in / zmask_sum 1187 greenland_icesheet_timelapsed = greenland_icesheet_timelapsed + rdt 1188 IF( ABS( zgreenland_icesheet_mass_in - greenland_icesheet_mass ) > zepsilon ) THEN 1189 zgreenland_icesheet_mass_b = greenland_icesheet_mass 1190 1191 ! Only update the mass if it has increased 1192 IF ( (zgreenland_icesheet_mass_in - greenland_icesheet_mass) > 0.0 ) THEN 1193 greenland_icesheet_mass = zgreenland_icesheet_mass_in 1194 ENDIF 1195 1196 IF( zgreenland_icesheet_mass_b /= 0.0 ) & 1197 & greenland_icesheet_mass_rate_of_change = ( greenland_icesheet_mass - zgreenland_icesheet_mass_b ) / greenland_icesheet_timelapsed 1198 greenland_icesheet_timelapsed = 0.0_wp 1199 ENDIF 1200 IF(lwp) WRITE(numout,*) 'Greenland icesheet mass (kg) read in is ', zgreenland_icesheet_mass_in 1201 IF(lwp) WRITE(numout,*) 'Greenland icesheet mass (kg) used is ', greenland_icesheet_mass 1202 IF(lwp) WRITE(numout,*) 'Greenland icesheet mass rate of change (kg/s) is ', greenland_icesheet_mass_rate_of_change 1203 IF(lwp) WRITE(numout,*) 'Greenland icesheet seconds lapsed since last change is ', greenland_icesheet_timelapsed 1204 ENDIF 1205 1206 ! ! land ice masses : Antarctica 1207 IF( srcv(jpr_antm)%laction ) THEN 1208 antarctica_icesheet_mass_array(:,:) = frcv(jpr_antm)%z3(:,:,1) 1209 ! take average over ocean points of input array to avoid cumulative error from rounding errors over time 1210 zantarctica_icesheet_mass_in = SUM( antarctica_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1211 IF(lk_mpp) CALL mpp_sum( zantarctica_icesheet_mass_in ) 1212 zmask_sum = SUM( tmask(:,:,1) ) 1213 IF(lk_mpp) CALL mpp_sum( zmask_sum ) 1214 zantarctica_icesheet_mass_in = zantarctica_icesheet_mass_in / zmask_sum 1215 antarctica_icesheet_timelapsed = antarctica_icesheet_timelapsed + rdt 1216 IF( ABS( zantarctica_icesheet_mass_in - antarctica_icesheet_mass ) > zepsilon ) THEN 1217 zantarctica_icesheet_mass_b = antarctica_icesheet_mass 1218 1219 ! Only update the mass if it has increased 1220 IF ( (zantarctica_icesheet_mass_in - antarctica_icesheet_mass) > 0.0 ) THEN 1221 antarctica_icesheet_mass = zantarctica_icesheet_mass_in 1222 END IF 1223 1224 IF( zantarctica_icesheet_mass_b /= 0.0 ) & 1225 & antarctica_icesheet_mass_rate_of_change = ( antarctica_icesheet_mass - zantarctica_icesheet_mass_b ) / antarctica_icesheet_timelapsed 1226 antarctica_icesheet_timelapsed = 0.0_wp 1227 ENDIF 1228 IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass (kg) read in is ', zantarctica_icesheet_mass_in 1229 IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass (kg) used is ', antarctica_icesheet_mass 1230 IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass rate of change (kg/s) is ', antarctica_icesheet_mass_rate_of_change 1231 IF(lwp) WRITE(numout,*) 'Antarctica icesheet seconds lapsed since last change is ', antarctica_icesheet_timelapsed 1232 ENDIF 1233 1139 1234 ! 1140 1235 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) -
branches/UKMO/dev_r5518_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r5575 r6194 161 161 INTEGER, INTENT( in ) :: ksbc ! surface forcing type 162 162 REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 163 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar163 REAL(wp), DIMENSION(:,:,:), POINTER :: ztfrz3d 164 164 INTEGER :: ji, jj, jl, jk ! dummy loop indices 165 165 !!--------------------------------------------------------------------- … … 174 174 jj_off = INT ( (jpjglo - ny_global) / 2 ) 175 175 176 #if defined key_nemocice_decomp 177 ! Pass initial SST from NEMO to CICE so ice is initialised correctly if 178 ! there is no restart file. 179 ! Values from a CICE restart file would overwrite this 180 IF ( .NOT. ln_rstart ) THEN 181 CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.) 182 ENDIF 183 #endif 184 185 ! Initialize CICE 176 ! Initialize CICE 186 177 CALL CICE_Initialize 187 178 188 ! Do some CICE consistency checks179 ! Do some CICE consistency checks 189 180 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 190 181 IF ( calc_strair .OR. calc_Tsfc ) THEN … … 198 189 199 190 200 ! allocate sbc_ice and sbc_cice arrays201 IF( sbc_ice_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_ice_ cice_alloc : unable to allocate arrays' )191 ! allocate sbc_ice and sbc_cice arrays 192 IF( sbc_ice_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_ice_alloc : unable to allocate arrays' ) 202 193 IF( sbc_ice_cice_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_ice_cice_alloc : unable to allocate cice arrays' ) 203 194 204 ! Ensure ocean temperatures are nowhere below freezing if not a NEMO restart195 ! Ensure that no temperature points are below freezing if not a NEMO restart 205 196 IF( .NOT. ln_rstart ) THEN 206 tsn(:,:,:,jp_tem) = MAX (tsn(:,:,:,jp_tem),Tocnfrz) 197 198 CALL wrk_alloc( jpi,jpj,jpk, ztfrz3d ) 199 DO jk=1,jpk 200 ztfrz3d(:,:,jk) = eos_fzp( tsn(:,:,jk,jp_sal), fsdept_n(:,:,jk) ) 201 ENDDO 202 tsn(:,:,:,jp_tem) = MAX( tsn(:,:,:,jp_tem), ztfrz3d ) 207 203 tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) 208 ENDIF 209 210 fr_iu(:,:)=0.0 211 fr_iv(:,:)=0.0 204 CALL wrk_dealloc( jpi,jpj,jpk, ztfrz3d ) 205 206 #if defined key_nemocice_decomp 207 ! Pass initial SST from NEMO to CICE so ice is initialised correctly if 208 ! there is no restart file. 209 ! Values from a CICE restart file would overwrite this 210 CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.) 211 #endif 212 213 ENDIF 214 215 ! calculate surface freezing temperature and send to CICE 216 sstfrz(:,:) = eos_fzp(sss_m(:,:), fsdept_n(:,:,1)) 217 CALL nemo2cice(sstfrz,Tf, 'T', 1. ) 212 218 213 219 CALL cice2nemo(aice,fr_i, 'T', 1. ) … … 220 226 ! T point to U point 221 227 ! T point to V point 228 fr_iu(:,:)=0.0 229 fr_iv(:,:)=0.0 222 230 DO jj=1,jpjm1 223 231 DO ji=1,jpim1 … … 348 356 ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) 349 357 ENDDO 350 ELSE 351 ! emp_ice is set in sbc_cpl_ice_flx as sublimation-snow 352 qla_ice(:,:,1)= - ( emp_ice(:,:)+sprecip(:,:) ) * Lsub 353 ! End of temporary code 354 DO jj=1,jpj 355 DO ji=1,jpi 356 IF (fr_i(ji,jj).eq.0.0) THEN 357 DO jl=1,ncat 358 ztmpn(ji,jj,jl)=0.0 359 ENDDO 360 ! This will then be conserved in CICE 361 ztmpn(ji,jj,1)=qla_ice(ji,jj,1) 362 ELSE 363 DO jl=1,ncat 364 ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj) 365 ENDDO 366 ENDIF 367 ENDDO 358 ELSE IF (ksbc == jp_purecpl) THEN 359 DO jl=1,ncat 360 ztmpn(:,:,jl)=qla_ice(:,:,jl)*a_i(:,:,jl) 368 361 ENDDO 362 ELSE 363 !In coupled mode - qla_ice calculated in sbc_cpl for each category 364 ztmpn(:,:,1:ncat)=qla_ice(:,:,1:ncat) 369 365 ENDIF 370 366 DO jl=1,ncat … … 454 450 CALL nemo2cice(sss_m,sss,'T', 1. ) 455 451 452 IF( ksbc == jp_purecpl ) THEN 453 ! Sea ice surface skin temperature 454 DO jl=1,ncat 455 CALL nemo2cice(tsfc_ice(:,:,jl), trcrn(:,:,nt_tsfc,jl,:),'T',1.) 456 ENDDO 457 ENDIF 458 456 459 ! x comp and y comp of surface ocean current 457 460 ! U point to F point -
branches/UKMO/dev_r5518_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r5575 r6194 27 27 USE fldread ! read input field at current time step 28 28 29 30 31 29 IMPLICIT NONE 32 30 PRIVATE … … 90 88 INTEGER :: ji, jj, jk, ijkmin, inum, ierror 91 89 INTEGER :: ikt, ikb ! top and bottom level of the isf boundary layer 90 REAL(wp) :: zgreenland_fwfisf_sum, zantarctica_fwfisf_sum 92 91 REAL(wp) :: rmin 93 92 REAL(wp) :: zhk … … 256 255 CALL fld_read ( kt, nn_fsbc, sf_rnfisf ) 257 256 fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1) ! fresh water flux from the isf (fwfisf <0 mean melting) 257 258 IF( lk_oasis) THEN 259 ! ln_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 260 IF( ln_coupled_iceshelf_fluxes ) THEN 261 262 ! Adjust total iceshelf melt rates so that sum of iceberg calving and iceshelf melting in the northern 263 ! and southern hemispheres equals rate of increase of mass of greenland and antarctic ice sheets 264 ! to preserve total freshwater conservation in coupled models without an active ice sheet model. 265 266 zgreenland_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 267 IF( lk_mpp ) CALL mpp_sum( zgreenland_fwfisf_sum ) 268 ! use ABS function because we need to preserve the sign of fwfisf 269 WHERE( greenland_icesheet_mask(:,:) == 1.0 ) & 270 & fwfisf(:,:) = fwfisf(:,:) * ABS( greenland_icesheet_mass_rate_of_change * (1.0-rn_greenland_calving_fraction) & 271 & / ( zgreenland_fwfisf_sum + 1.0e-10_wp ) ) 272 273 ! check 274 IF(lwp) WRITE(numout, *) 'Greenland iceshelf melting climatology (kg/s) : ',zgreenland_fwfisf_sum 275 zgreenland_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 276 IF( lk_mpp ) CALL mpp_sum( zgreenland_fwfisf_sum ) 277 IF(lwp) WRITE(numout, *) 'Greenland iceshelf melting adjusted value (kg/s) : ',zgreenland_fwfisf_sum 278 279 zantarctica_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) ) 280 IF( lk_mpp ) CALL mpp_sum( zantarctica_fwfisf_sum ) 281 ! use ABS function because we need to preserve the sign of fwfisf 282 WHERE( antarctica_icesheet_mask(:,:) == 1.0 ) & 283 & fwfisf(:,:) = fwfisf(:,:) * ABS( antarctica_icesheet_mass_rate_of_change * (1.0-rn_antarctica_calving_fraction) & 284 & / ( zantarctica_fwfisf_sum + 1.0e-10_wp ) ) 285 286 ! check 287 IF(lwp) WRITE(numout, *) 'Antarctica iceshelf melting climatology (kg/s) : ',zantarctica_fwfisf_sum 288 zantarctica_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) ) 289 IF( lk_mpp ) CALL mpp_sum( zantarctica_fwfisf_sum ) 290 IF(lwp) WRITE(numout, *) 'Antarctica iceshelf melting adjusted value (kg/s) : ',zantarctica_fwfisf_sum 291 292 ENDIF 293 ENDIF 294 258 295 qisf(:,:) = fwfisf(:,:) * lfusisf ! heat flux 259 296 stbl(:,:) = soce … … 264 301 !CALL fld_read ( kt, nn_fsbc, sf_qisf ) 265 302 fwfisf(:,:) = sf_fwfisf(1)%fnow(:,:,1) ! fwf 303 304 IF( lk_oasis) THEN 305 ! ln_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 306 IF( ln_coupled_iceshelf_fluxes ) THEN 307 308 ! Adjust total iceshelf melt rates so that sum of iceberg calving and iceshelf melting in the northern 309 ! and southern hemispheres equals rate of increase of mass of greenland and antarctic ice sheets 310 ! to preserve total freshwater conservation in coupled models without an active ice sheet model. 311 312 zgreenland_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 313 IF( lk_mpp ) CALL mpp_sum( zgreenland_fwfisf_sum ) 314 ! use ABS function because we need to preserve the sign of fwfisf 315 WHERE( greenland_icesheet_mask(:,:) == 1.0 ) & 316 & fwfisf(:,:) = fwfisf(:,:) * ABS( greenland_icesheet_mass_rate_of_change * (1.0-rn_greenland_calving_fraction) & 317 & / ( zgreenland_fwfisf_sum + 1.0e-10_wp ) ) 318 319 ! check 320 IF(lwp) WRITE(numout, *) 'Greenland iceshelf melting climatology (kg/s) : ',zgreenland_fwfisf_sum 321 zgreenland_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 322 IF( lk_mpp ) CALL mpp_sum( zgreenland_fwfisf_sum ) 323 IF(lwp) WRITE(numout, *) 'Greenland iceshelf melting adjusted value (kg/s) : ',zgreenland_fwfisf_sum 324 325 zantarctica_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) ) 326 IF( lk_mpp ) CALL mpp_sum( zantarctica_fwfisf_sum ) 327 ! use ABS function because we need to preserve the sign of fwfisf 328 WHERE( antarctica_icesheet_mask(:,:) == 1.0 ) & 329 & fwfisf(:,:) = fwfisf(:,:) * ABS( antarctica_icesheet_mass_rate_of_change * (1.0-rn_antarctica_calving_fraction) & 330 & / ( zantarctica_fwfisf_sum + 1.0e-10_wp ) ) 331 332 ! check 333 IF(lwp) WRITE(numout, *) 'Antarctica iceshelf melting climatology (kg/s) : ',zantarctica_fwfisf_sum 334 zantarctica_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) ) 335 IF( lk_mpp ) CALL mpp_sum( zantarctica_fwfisf_sum ) 336 IF(lwp) WRITE(numout, *) 'Antarctica iceshelf melting adjusted value (kg/s) : ',zantarctica_fwfisf_sum 337 338 ENDIF 339 ENDIF 340 266 341 qisf(:,:) = fwfisf(:,:) * lfusisf ! heat flux 267 342 !qisf(:,:) = sf_qisf(1)%fnow(:,:,1) ! heat flux
Note: See TracChangeset
for help on using the changeset viewer.