- Timestamp:
- 2016-06-29T15:26:06+02:00 (8 years ago)
- Location:
- branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 2 edited
-
sbccpl.F90 (modified) (20 diffs)
-
sbcisf.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6498 r6755 33 33 USE cpl_oasis3 ! OASIS3 coupling 34 34 USE geo2ocean ! 35 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 35 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev, & 36 CO2Flux_out_cpl, DMS_out_cpl, PCO2a_in_cpl, Dust_in_cpl, & 37 ln_medusa 36 38 USE albedo ! 37 39 USE in_out_manager ! I/O manager … … 49 51 USE limthd_dh ! for CALL lim_thd_snwblow 50 52 #endif 53 USE lib_fortran, ONLY: glob_sum 51 54 52 55 IMPLICIT NONE … … 105 108 INTEGER, PARAMETER :: jpr_grnm = 44 ! Greenland ice mass 106 109 INTEGER, PARAMETER :: jpr_antm = 45 ! Antarctic ice mass 107 INTEGER, PARAMETER :: jprcv = 45 ! total number of fields received 110 INTEGER, PARAMETER :: jpr_atm_pco2 = 46 ! Incoming atm CO2 flux 111 INTEGER, PARAMETER :: jpr_atm_dust = 47 ! Incoming atm aggregate dust 112 INTEGER, PARAMETER :: jprcv = 47 ! total number of fields received 108 113 109 114 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere … … 140 145 INTEGER, PARAMETER :: jps_sstfrz = 32 ! sea-surface freezing temperature 141 146 INTEGER, PARAMETER :: jps_fice1 = 33 ! first-order ice concentration (for time-travelling ice coupling) 142 INTEGER, PARAMETER :: jpsnd = 33 ! total number of fields sended 147 INTEGER, PARAMETER :: jps_bio_co2 = 34 ! MEDUSA air-sea CO2 flux in 148 INTEGER, PARAMETER :: jps_bio_dms = 35 ! MEDUSA DMS surface concentration in 149 INTEGER, PARAMETER :: jpsnd = 35 ! total number of fields sent 150 151 REAL(wp), PARAMETER :: dms_unit_conv = 1.0e+6 ! Coversion factor to get outgong DMS in standard units for coupling 152 ! i.e. specifically nmol/L (= umol/m3) 143 153 144 154 ! !!** namelist namsbc_cpl ** … … 152 162 ! Send to the atmosphere ! 153 163 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 164 TYPE(FLD_C) :: sn_snd_bio_co2, sn_snd_bio_dms 154 165 155 166 ! Received from the atmosphere ! 156 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 157 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 170 158 171 ! Other namelist parameters ! 159 172 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data … … 230 243 & rn_antarctica_calving_fraction, rn_iceshelf_fluxes_tolerance 231 244 !!--------------------------------------------------------------------- 245 246 ! Add MEDUSA related fields to namelist 247 NAMELIST/namsbc_cpl/ sn_snd_bio_co2, sn_snd_bio_dms, & 248 & sn_rcv_atm_pco2, sn_rcv_atm_dust 249 250 !!--------------------------------------------------------------------- 251 232 252 ! 233 253 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_init') … … 254 274 ENDIF 255 275 IF( lwp .AND. ln_cpl ) THEN ! control print 256 WRITE(numout,*)' received fields (mutiple ice catego gies)'276 WRITE(numout,*)' received fields (mutiple ice categories)' 257 277 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' 258 278 WRITE(numout,*)' stress module = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')' … … 271 291 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 272 292 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' 293 WRITE(numout,*)' atm pco2 = ', TRIM(sn_rcv_atm_pco2%cldes), ' (', TRIM(sn_rcv_atm_pco2%clcat), ')' 294 WRITE(numout,*)' atm dust = ', TRIM(sn_rcv_atm_dust%cldes), ' (', TRIM(sn_rcv_atm_dust%clcat), ')' 273 295 WRITE(numout,*)' sent fields (multiple ice categories)' 274 296 WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')' … … 279 301 WRITE(numout,*)' - orientation = ', sn_snd_crt%clvor 280 302 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 303 WRITE(numout,*)' bio co2 flux = ', TRIM(sn_snd_bio_co2%cldes), ' (', TRIM(sn_snd_bio_co2%clcat), ')' 304 WRITE(numout,*)' bio dms flux = ', TRIM(sn_snd_bio_dms%cldes), ' (', TRIM(sn_snd_bio_dms%clcat), ')' 281 305 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 282 306 WRITE(numout,*)' ice effective conductivity = ', TRIM(sn_snd_cond%cldes ), ' (', TRIM(sn_snd_cond%clcat ), ')' … … 494 518 ! ! ------------------------- ! 495 519 srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE. 520 521 522 ! ! --------------------------------------- ! 523 ! ! Incoming CO2 and DUST fluxes for MEDUSA ! 524 ! ! --------------------------------------- ! 525 srcv(jpr_atm_pco2)%clname = 'OATMPCO2' 526 527 IF (TRIM(sn_rcv_atm_pco2%cldes) == 'medusa') THEN 528 srcv(jpr_atm_pco2)%laction = .TRUE. 529 END IF 530 531 srcv(jpr_atm_dust)%clname = 'OATMDUST' 532 IF (TRIM(sn_rcv_atm_dust%cldes) == 'medusa') THEN 533 srcv(jpr_atm_dust)%laction = .TRUE. 534 END IF 535 496 536 ! ! ------------------------- ! 497 537 ! ! topmelt and botmelt ! … … 733 773 END SELECT 734 774 #else 735 IF( TRIM( sn_snd_mpnd%cldes /= 'none' ) THEN775 IF( TRIM( sn_snd_mpnd%cldes ) /= 'none' ) THEN 736 776 CALL ctl_stop('Meltponds can only be used with CICEv5') 737 777 ENDIF … … 770 810 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 771 811 ! 812 813 ! ! ------------------------- ! 814 ! ! MEDUSA output fields ! 815 ! ! ------------------------- ! 816 ! Surface dimethyl sulphide from Medusa 817 ssnd(jps_bio_dms)%clname = 'OBioDMS' 818 IF( TRIM(sn_snd_bio_dms%cldes) == 'medusa' ) ssnd(jps_bio_dms )%laction = .TRUE. 819 820 ! Surface CO2 flux from Medusa 821 ssnd(jps_bio_co2)%clname = 'OBioCO2' 822 IF( TRIM(sn_snd_bio_co2%cldes) == 'medusa' ) ssnd(jps_bio_co2 )%laction = .TRUE. 772 823 773 824 ! ! ------------------------- ! … … 990 1041 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr 991 1042 !!---------------------------------------------------------------------- 1043 1044 ! RSRH temporary arrays for testing, just to recieve incoming MEDUSA related fields 1045 ! until we know where they need to go. 1046 REAL(wp), ALLOCATABLE :: atm_pco2(:,:) 1047 REAL(wp), ALLOCATABLE :: atm_dust(:,:) 1048 992 1049 ! 993 1050 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') … … 1128 1185 ENDIF 1129 1186 1187 IF (ln_medusa) THEN 1188 IF( srcv(jpr_atm_pco2)%laction) PCO2a_in_cpl(:,:) = frcv(jpr_atm_pco2)%z3(:,:,1) 1189 IF( srcv(jpr_atm_dust)%laction) Dust_in_cpl(:,:) = frcv(jpr_atm_dust)%z3(:,:,1) 1190 ENDIF 1191 1130 1192 #if defined key_cpl_carbon_cycle 1131 1193 ! ! ================== ! … … 1273 1335 zepsilon = rn_iceshelf_fluxes_tolerance 1274 1336 1337 1338 ! See if we need zmask_sum... 1339 IF ( srcv(jpr_grnm)%laction .OR. srcv(jpr_antm)%laction ) THEN 1340 zmask_sum = glob_sum( tmask(:,:,1) ) 1341 ENDIF 1342 1275 1343 IF( srcv(jpr_grnm)%laction ) THEN 1276 1344 greenland_icesheet_mass_array(:,:) = frcv(jpr_grnm)%z3(:,:,1) 1277 1345 ! take average over ocean points of input array to avoid cumulative error over time 1278 zgreenland_icesheet_mass_in = SUM( greenland_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1279 IF(lk_mpp) CALL mpp_sum( zgreenland_icesheet_mass_in )1280 z mask_sum = SUM(tmask(:,:,1) )1281 IF(lk_mpp) CALL mpp_sum( zmask_sum ) 1346 1347 ! The following must be bit reproducible over different PE decompositions 1348 zgreenland_icesheet_mass_in = glob_sum( greenland_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1349 1282 1350 zgreenland_icesheet_mass_in = zgreenland_icesheet_mass_in / zmask_sum 1283 1351 greenland_icesheet_timelapsed = greenland_icesheet_timelapsed + rdt … … 1304 1372 antarctica_icesheet_mass_array(:,:) = frcv(jpr_antm)%z3(:,:,1) 1305 1373 ! take average over ocean points of input array to avoid cumulative error from rounding errors over time 1306 zantarctica_icesheet_mass_in = SUM( antarctica_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1307 IF(lk_mpp) CALL mpp_sum( zantarctica_icesheet_mass_in ) 1308 zmask_sum = SUM( tmask(:,:,1) ) 1309 IF(lk_mpp) CALL mpp_sum( zmask_sum ) 1374 ! The following must be bit reproducible over different PE decompositions 1375 zantarctica_icesheet_mass_in = glob_sum( antarctica_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1376 1310 1377 zantarctica_icesheet_mass_in = zantarctica_icesheet_mass_in / zmask_sum 1311 1378 antarctica_icesheet_timelapsed = antarctica_icesheet_timelapsed + rdt … … 2184 2251 ENDIF 2185 2252 ! 2253 #if defined key_cice && ! defined key_cice4 2186 2254 ! Send meltpond fields 2187 2255 IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN … … 2226 2294 IF( ssnd(jps_kice)%laction ) CALL cpl_snd( jps_kice, isec, ztmp3, info ) 2227 2295 ENDIF 2296 #endif 2228 2297 ! 2229 2298 ! … … 2235 2304 ! 2236 2305 #endif 2306 2307 2308 2309 IF (ln_medusa) THEN 2310 ! ! --------------------------------- ! 2311 ! ! CO2 flux and DMS from MEDUSA ! 2312 ! ! --------------------------------- ! 2313 IF ( ssnd(jps_bio_co2)%laction ) THEN 2314 CALL cpl_snd( jps_bio_co2, isec, RESHAPE( CO2Flux_out_cpl, (/jpi,jpj,1/) ), info ) 2315 ENDIF 2316 2317 IF ( ssnd(jps_bio_dms)%laction ) THEN 2318 CALL cpl_snd( jps_bio_dms, isec, RESHAPE( DMS_out_cpl, (/jpi,jpj,1/) ), info ) 2319 ENDIF 2320 ENDIF 2321 2237 2322 ! ! ------------------------- ! 2238 2323 IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current ! … … 2407 2492 IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 2408 2493 2494 #if defined key_cice 2409 2495 ztmp1(:,:) = sstfrz(:,:) + rt0 2410 2496 IF( ssnd(jps_sstfrz)%laction ) CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2497 #endif 2411 2498 ! 2412 2499 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r6498 r6755 26 26 USE zdfbfr 27 27 USE fldread ! read input field at current time step 28 USE lib_fortran, ONLY: glob_sum 28 29 29 30 IMPLICIT NONE … … 257 258 ! and southern hemispheres equals rate of increase of mass of greenland and antarctic ice sheets 258 259 ! to preserve total freshwater conservation in coupled models without an active ice sheet model. 259 260 zgreenland_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 261 IF( lk_mpp ) CALL mpp_sum( zgreenland_fwfisf_sum ) 260 261 ! All related global sums must be done bit reproducibly 262 zgreenland_fwfisf_sum = glob_sum( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 263 262 264 ! use ABS function because we need to preserve the sign of fwfisf 263 265 WHERE( greenland_icesheet_mask(:,:) == 1.0 ) & … … 267 269 ! check 268 270 IF(lwp) WRITE(numout, *) 'Greenland iceshelf melting climatology (kg/s) : ',zgreenland_fwfisf_sum 269 zgreenland_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 270 IF( lk_mpp ) CALL mpp_sum( zgreenland_fwfisf_sum ) 271 272 zgreenland_fwfisf_sum = glob_sum( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 273 271 274 IF(lwp) WRITE(numout, *) 'Greenland iceshelf melting adjusted value (kg/s) : ',zgreenland_fwfisf_sum 272 275 273 zantarctica_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) )274 IF( lk_mpp ) CALL mpp_sum( zantarctica_fwfisf_sum ) 276 zantarctica_fwfisf_sum = glob_sum( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) ) 277 275 278 ! use ABS function because we need to preserve the sign of fwfisf 276 279 WHERE( antarctica_icesheet_mask(:,:) == 1.0 ) & … … 280 283 ! check 281 284 IF(lwp) WRITE(numout, *) 'Antarctica iceshelf melting climatology (kg/s) : ',zantarctica_fwfisf_sum 282 zantarctica_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) ) 283 IF( lk_mpp ) CALL mpp_sum( zantarctica_fwfisf_sum ) 285 286 zantarctica_fwfisf_sum = glob_sum( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) ) 287 284 288 IF(lwp) WRITE(numout, *) 'Antarctica iceshelf melting adjusted value (kg/s) : ',zantarctica_fwfisf_sum 285 289 … … 304 308 ! to preserve total freshwater conservation in coupled models without an active ice sheet model. 305 309 306 zgreenland_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 307 IF( lk_mpp ) CALL mpp_sum( zgreenland_fwfisf_sum ) 310 ! All related global sums must be done bit reproducibly 311 zgreenland_fwfisf_sum = glob_sum( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 312 308 313 ! use ABS function because we need to preserve the sign of fwfisf 309 314 WHERE( greenland_icesheet_mask(:,:) == 1.0 ) & … … 313 318 ! check 314 319 IF(lwp) WRITE(numout, *) 'Greenland iceshelf melting climatology (kg/s) : ',zgreenland_fwfisf_sum 315 zgreenland_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 316 IF( lk_mpp ) CALL mpp_sum( zgreenland_fwfisf_sum ) 320 321 zgreenland_fwfisf_sum = glob_sum( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * greenland_icesheet_mask(:,:) ) 322 317 323 IF(lwp) WRITE(numout, *) 'Greenland iceshelf melting adjusted value (kg/s) : ',zgreenland_fwfisf_sum 318 324 319 zantarctica_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) )320 IF( lk_mpp ) CALL mpp_sum( zantarctica_fwfisf_sum ) 325 zantarctica_fwfisf_sum = glob_sum( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) ) 326 321 327 ! use ABS function because we need to preserve the sign of fwfisf 322 328 WHERE( antarctica_icesheet_mask(:,:) == 1.0 ) & … … 326 332 ! check 327 333 IF(lwp) WRITE(numout, *) 'Antarctica iceshelf melting climatology (kg/s) : ',zantarctica_fwfisf_sum 328 zantarctica_fwfisf_sum = SUM( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) ) 329 IF( lk_mpp ) CALL mpp_sum( zantarctica_fwfisf_sum ) 334 335 zantarctica_fwfisf_sum = glob_sum( fwfisf(:,:) * e1t(:,:) * e2t(:,:) * antarctica_icesheet_mask(:,:) ) 336 330 337 IF(lwp) WRITE(numout, *) 'Antarctica iceshelf melting adjusted value (kg/s) : ',zantarctica_fwfisf_sum 331 338
Note: See TracChangeset
for help on using the changeset viewer.
