Changeset 6200
- Timestamp:
- 2016-01-04T11:49:32+01:00 (8 years ago)
- Location:
- branches/UKMO/dev_r5518_med_test/NEMOGCM
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_med_test/NEMOGCM/CONFIG/SHARED/field_def.xml
r5575 r6200 193 193 194 194 <!-- * variable related to ice shelf forcing * --> 195 <field id="berg_calve" long_name="Iceberg calving" unit="kg/m2/s" /> 195 196 <field id="fwfisf" long_name="Ice shelf melting" unit="kg/m2/s" /> 196 197 <field id="qisf" long_name="Ice Shelf Heat Flux" unit="W/m2" /> -
branches/UKMO/dev_r5518_med_test/NEMOGCM/CONFIG/SHARED/namelist_ref
r5575 r6200 378 378 ln_usecplmask = .false. ! use a coupling mask file to merge data received from several models 379 379 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 380 ln_coupled_iceshelf_fluxes = .false. ! If true use rate of change of mass of Greenland and Antarctic icesheets to set the 381 ! combined magnitude of the iceberg calving and iceshelf melting freshwater fluxes. 382 rn_greenland_calving_fraction = 0.5 ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting. 383 rn_antarctica_calving_fraction = 0.5 ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting. 384 rn_iceshelf_fluxes_tolerance = 1e-6 ! Fractional threshold for detecting differences in icesheet masses (must be positive definite). 380 385 / 381 386 !----------------------------------------------------------------------- -
branches/UKMO/dev_r5518_med_test/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90
r5473 r6200 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_med_test/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r5575 r6200 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_med_test/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r5575 r6200 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_med_test/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6199 r6200 52 52 USE limthd_dh ! for CALL lim_thd_snwblow 53 53 #endif 54 #if defined key_medusa 55 ! RSRH Temporarily commented out until we get MEDUSA code USE trc 56 #endif 57 58 59 54 60 55 61 IMPLICIT NONE … … 105 111 INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness 106 112 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 113 INTEGER, PARAMETER :: jpr_ts_ice = 43 ! skin temperature of sea-ice (used for melt-ponds) 114 INTEGER, PARAMETER :: jpr_grnm = 44 ! Greenland ice mass 115 INTEGER, PARAMETER :: jpr_antm = 45 ! Antarctic ice mass 116 INTEGER, PARAMETER :: jpr_atm_pco2 = 46 ! Incoming atm CO2 flux 117 INTEGER, PARAMETER :: jpr_atm_dust = 47 ! Incoming atm aggregate dust 118 INTEGER, PARAMETER :: jprcv = 47 ! total number of fields received 108 119 109 120 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere … … 135 146 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 136 147 INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level 137 INTEGER, PARAMETER :: jpsnd = 28 ! total number of fields sended 148 INTEGER, PARAMETER :: jps_bio_co2 = 29 ! MEDUSA air-sea CO2 flux in 149 INTEGER, PARAMETER :: jps_bio_dms = 30 ! MEDUSA DMS surface concentration in 150 INTEGER, PARAMETER :: jpsnd = 30 ! total number of fields sent 151 152 REAL(wp), PARAMETER :: dms_unit_conv = 1.0e+6 ! Coversion factor to get outgong DMS in standard units for coupling 153 ! i.e. specifically nmol/L (= umol/m3) 138 154 139 155 ! !!** namelist namsbc_cpl ** … … 146 162 END TYPE FLD_C 147 163 ! Send to the atmosphere ! 148 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 164 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2, sn_snd_cond, sn_snd_mpnd, sn_snd_sstfrz, sn_snd_thick1 165 TYPE(FLD_C) :: sn_snd_bio_co2, sn_snd_bio_dms 149 166 ! Received from the atmosphere ! 150 167 TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 151 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 168 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_ts_ice, sn_rcv_grnm, sn_rcv_antm 169 TYPE(FLD_C) :: sn_rcv_atm_pco2, sn_rcv_atm_dust 152 170 ! Other namelist parameters ! 153 171 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data … … 163 181 164 182 INTEGER , ALLOCATABLE, SAVE, DIMENSION( :) :: nrcvinfo ! OASIS info argument 183 165 184 166 185 !! Substitution … … 216 235 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos 217 236 !! 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 237 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick , sn_snd_crt , sn_snd_co2, & 238 & sn_snd_bio_co2, sn_snd_bio_dms, & 239 & sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1, & 240 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 241 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, & 242 & sn_rcv_atm_pco2, sn_rcv_atm_dust, & 243 & sn_rcv_co2 , sn_rcv_grnm , sn_rcv_antm , sn_rcv_ts_ice, nn_cplmodel , & 244 & ln_usecplmask, ln_coupled_iceshelf_fluxes, rn_greenland_calving_fraction, & 245 & rn_antarctica_calving_fraction, rn_iceshelf_fluxes_tolerance 246 222 247 !!--------------------------------------------------------------------- 223 248 ! … … 245 270 ENDIF 246 271 IF( lwp .AND. ln_cpl ) THEN ! control print 247 WRITE(numout,*)' received fields (mutiple ice catego gies)'272 WRITE(numout,*)' received fields (mutiple ice categories)' 248 273 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' 249 274 WRITE(numout,*)' stress module = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')' … … 260 285 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 261 286 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' 287 WRITE(numout,*)' atm pco2 = ', TRIM(sn_rcv_atm_pco2%cldes), ' (', TRIM(sn_rcv_atm_pco2%clcat), ')' 288 WRITE(numout,*)' atm dust = ', TRIM(sn_rcv_atm_dust%cldes), ' (', TRIM(sn_rcv_atm_dust%clcat), ')' 262 289 WRITE(numout,*)' sent fields (multiple ice categories)' 263 290 WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')' … … 269 296 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 270 297 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 298 WRITE(numout,*)' bio co2 flux = ', TRIM(sn_snd_bio_co2%cldes), ' (', TRIM(sn_snd_bio_co2%clcat), ')' 299 WRITE(numout,*)' bio dms flux = ', TRIM(sn_snd_bio_dms%cldes), ' (', TRIM(sn_snd_bio_dms%clcat), ')' 271 300 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 272 301 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask 302 WRITE(numout,*)' ln_coupled_iceshelf_fluxes = ', ln_coupled_iceshelf_fluxes 303 WRITE(numout,*)' rn_greenland_calving_fraction = ', rn_greenland_calving_fraction 304 WRITE(numout,*)' rn_antarctica_calving_fraction = ', rn_antarctica_calving_fraction 305 WRITE(numout,*)' rn_iceshelf_fluxes_tolerance = ', rn_iceshelf_fluxes_tolerance 273 306 ENDIF 274 307 … … 474 507 ! ! ------------------------- ! 475 508 srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE. 509 510 511 ! ! --------------------------------------- ! 512 ! ! Incoming CO2 and DUST fluxes for MEDUSA ! 513 ! ! --------------------------------------- ! 514 srcv(jpr_atm_pco2)%clname = 'OATMPCO2' 515 516 IF (TRIM(sn_rcv_atm_pco2%cldes) == 'coupled') THEN 517 srcv(jpr_atm_pco2)%laction = .TRUE. 518 END IF 519 520 srcv(jpr_atm_dust)%clname = 'OATMDUST' 521 IF (TRIM(sn_rcv_atm_dust%cldes) == 'coupled') THEN 522 srcv(jpr_atm_dust)%laction = .TRUE. 523 END IF 524 476 525 ! ! ------------------------- ! 477 526 ! ! topmelt and botmelt ! … … 789 838 ncpl_qsr_freq = 86400 / ncpl_qsr_freq 790 839 840 IF( ln_coupled_iceshelf_fluxes ) THEN 841 ! Crude masks to separate the Antarctic and Greenland icesheets. Obviously something 842 ! more complicated could be done if required. 843 greenland_icesheet_mask = 0.0 844 WHERE( gphit >= 0.0 ) greenland_icesheet_mask = 1.0 845 antarctica_icesheet_mask = 0.0 846 WHERE( gphit < 0.0 ) antarctica_icesheet_mask = 1.0 847 848 ! initialise other variables 849 greenland_icesheet_mass_array(:,:) = 0.0 850 antarctica_icesheet_mass_array(:,:) = 0.0 851 852 IF( .not. ln_rstart ) THEN 853 greenland_icesheet_mass = 0.0 854 greenland_icesheet_mass_rate_of_change = 0.0 855 greenland_icesheet_timelapsed = 0.0 856 antarctica_icesheet_mass = 0.0 857 antarctica_icesheet_mass_rate_of_change = 0.0 858 antarctica_icesheet_timelapsed = 0.0 859 ENDIF 860 861 ENDIF 862 791 863 CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 792 864 ! … … 851 923 INTEGER :: ikchoix 852 924 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 925 REAL(wp) :: zgreenland_icesheet_mass_in, zantarctica_icesheet_mass_in 926 REAL(wp) :: zgreenland_icesheet_mass_b, zantarctica_icesheet_mass_b 927 REAL(wp) :: zmask_sum, zepsilon 853 928 REAL(wp) :: zcoef ! temporary scalar 854 929 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 … … 857 932 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 858 933 !!---------------------------------------------------------------------- 934 935 ! RSRH temporary arrays for testing, just to recieve incoming MEDUSA related fields 936 ! until we know where they need to go. 937 REAL(wp), ALLOCATABLE :: atm_pco2(:,:) 938 REAL(wp), ALLOCATABLE :: atm_dust(:,:) 939 859 940 ! 860 941 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') … … 1024 1105 #endif 1025 1106 1107 #if defined key_medusa 1108 ! RSRH Allocate temporary arrays to receive incoming fields during testing 1109 ALLOCATE(atm_pco2(jpi,jpj)) 1110 ALLOCATE(atm_dust(jpi,jpj)) 1111 1112 IF( srcv(jpr_atm_pco2)%laction) atm_pco2(:,:) = frcv(jpr_atm_pco2)%z3(:,:,1) 1113 IF( srcv(jpr_atm_dust)%laction) atm_dust(:,:) = frcv(jpr_atm_dust)%z3(:,:,1) 1114 1115 ! RSRH Deallocate temporary arrays. 1116 DEALLOCATE(atm_pco2) 1117 DEALLOCATE(atm_dust) 1118 #endif 1119 1120 1121 1122 1026 1123 ! Fields received by SAS when OASIS coupling 1027 1124 ! (arrays no more filled at sbcssm stage) … … 1137 1234 1138 1235 ENDIF 1236 1237 ! ! land ice masses : Greenland 1238 zepsilon = rn_iceshelf_fluxes_tolerance 1239 1240 IF( srcv(jpr_grnm)%laction ) THEN 1241 greenland_icesheet_mass_array(:,:) = frcv(jpr_grnm)%z3(:,:,1) 1242 ! take average over ocean points of input array to avoid cumulative error over time 1243 zgreenland_icesheet_mass_in = SUM( greenland_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1244 IF(lk_mpp) CALL mpp_sum( zgreenland_icesheet_mass_in ) 1245 zmask_sum = SUM( tmask(:,:,1) ) 1246 IF(lk_mpp) CALL mpp_sum( zmask_sum ) 1247 zgreenland_icesheet_mass_in = zgreenland_icesheet_mass_in / zmask_sum 1248 greenland_icesheet_timelapsed = greenland_icesheet_timelapsed + rdt 1249 IF( ABS( zgreenland_icesheet_mass_in - greenland_icesheet_mass ) > zepsilon ) THEN 1250 zgreenland_icesheet_mass_b = greenland_icesheet_mass 1251 1252 ! Only update the mass if it has increased 1253 IF ( (zgreenland_icesheet_mass_in - greenland_icesheet_mass) > 0.0 ) THEN 1254 greenland_icesheet_mass = zgreenland_icesheet_mass_in 1255 ENDIF 1256 1257 IF( zgreenland_icesheet_mass_b /= 0.0 ) & 1258 & greenland_icesheet_mass_rate_of_change = ( greenland_icesheet_mass - zgreenland_icesheet_mass_b ) / greenland_icesheet_timelapsed 1259 greenland_icesheet_timelapsed = 0.0_wp 1260 ENDIF 1261 IF(lwp) WRITE(numout,*) 'Greenland icesheet mass (kg) read in is ', zgreenland_icesheet_mass_in 1262 IF(lwp) WRITE(numout,*) 'Greenland icesheet mass (kg) used is ', greenland_icesheet_mass 1263 IF(lwp) WRITE(numout,*) 'Greenland icesheet mass rate of change (kg/s) is ', greenland_icesheet_mass_rate_of_change 1264 IF(lwp) WRITE(numout,*) 'Greenland icesheet seconds lapsed since last change is ', greenland_icesheet_timelapsed 1265 ENDIF 1266 1267 ! ! land ice masses : Antarctica 1268 IF( srcv(jpr_antm)%laction ) THEN 1269 antarctica_icesheet_mass_array(:,:) = frcv(jpr_antm)%z3(:,:,1) 1270 ! take average over ocean points of input array to avoid cumulative error from rounding errors over time 1271 zantarctica_icesheet_mass_in = SUM( antarctica_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1272 IF(lk_mpp) CALL mpp_sum( zantarctica_icesheet_mass_in ) 1273 zmask_sum = SUM( tmask(:,:,1) ) 1274 IF(lk_mpp) CALL mpp_sum( zmask_sum ) 1275 zantarctica_icesheet_mass_in = zantarctica_icesheet_mass_in / zmask_sum 1276 antarctica_icesheet_timelapsed = antarctica_icesheet_timelapsed + rdt 1277 IF( ABS( zantarctica_icesheet_mass_in - antarctica_icesheet_mass ) > zepsilon ) THEN 1278 zantarctica_icesheet_mass_b = antarctica_icesheet_mass 1279 1280 ! Only update the mass if it has increased 1281 IF ( (zantarctica_icesheet_mass_in - antarctica_icesheet_mass) > 0.0 ) THEN 1282 antarctica_icesheet_mass = zantarctica_icesheet_mass_in 1283 END IF 1284 1285 IF( zantarctica_icesheet_mass_b /= 0.0 ) & 1286 & antarctica_icesheet_mass_rate_of_change = ( antarctica_icesheet_mass - zantarctica_icesheet_mass_b ) / antarctica_icesheet_timelapsed 1287 antarctica_icesheet_timelapsed = 0.0_wp 1288 ENDIF 1289 IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass (kg) read in is ', zantarctica_icesheet_mass_in 1290 IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass (kg) used is ', antarctica_icesheet_mass 1291 IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass rate of change (kg/s) is ', antarctica_icesheet_mass_rate_of_change 1292 IF(lwp) WRITE(numout,*) 'Antarctica icesheet seconds lapsed since last change is ', antarctica_icesheet_timelapsed 1293 ENDIF 1294 1139 1295 ! 1140 1296 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) … … 1738 1894 REAL(wp), POINTER, DIMENSION(:,:) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 1739 1895 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp3, ztmp4 1896 1897 #if defined key_medusa 1898 ! RSRH Temporarily definitition of array used in medusa coupling until we actually have the medusa code included in the build 1899 REAL(wp) :: TRC2D_TEST(jpi,jpj) 1900 #endif 1901 1740 1902 !!---------------------------------------------------------------------- 1741 1903 ! … … 1879 2041 IF( ssnd(jps_co2)%laction ) CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 1880 2042 ! 2043 #endif 2044 2045 2046 !! JPALM : 03-feb-2015 coupling MEDUSA-UKCA 2047 !! add soing exactely the same that CO2 fluxes 2048 !! of PISCES 2049 !! add CO2-MEDUSA 2050 !! add DMS-MEDUSA 2051 !! May add also a coupling MED-UKCA key 2052 2053 2054 #if defined key_medusa 2055 ! RSRH. We don't want to use magic numbers in the code (i.e. 98 and 221). 2056 ! These need moving to a parameter statement (as part of MEDUSA code) or even specifying in a namelist 2057 ! so the following code MUST NOT be viewed as anything more than temporary. 2058 ! IF( ssnd(jps_bio_co2)%laction ) CALL cpl_prism_snd( jps_bio_co2, isec, trc2d(:,:,98:98), info ) 2059 TRC2D_TEST(:,:) = 0.0 2060 IF( ssnd(jps_bio_co2)%laction ) CALL cpl_prism_snd( jps_bio_co2, isec, trc2d_TEST(:,:), info ) 2061 2062 IF( ssnd(jps_bio_dms)%laction ) THEN 2063 ! We need to multiply DMS by a conversion factor to get values in the standard units expected in 2064 ! the coupling space. 2065 ! ztmp1(:,: ) = trc2d(:,:,221) * dms_unit_conv 2066 ztmp1(:,: ) = trc2d_TEST(:,:) * dms_unit_conv 2067 CALL cpl_prism_snd( jps_bio_dms, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2068 ENDIF 1881 2069 #endif 1882 2070 ! ! ------------------------- ! … … 1981 2169 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 1982 2170 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 1983 2171 END DO 1984 2172 END DO 1985 2173 #if defined key_cice -
branches/UKMO/dev_r5518_med_test/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r5575 r6200 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 -
branches/UKMO/dev_r5518_med_test/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r5575 r6200 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.