- Timestamp:
- 2016-01-04T11:49:32+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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
Note: See TracChangeset
for help on using the changeset viewer.
