Changeset 6255
- Timestamp:
- 2016-01-15T10:51:06+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/nemo_v3_6_STABLE_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6254 r6255 52 52 USE limthd_dh ! for CALL lim_thd_snwblow 53 53 #endif 54 #if defined key_medusa 55 USE trc 56 #endif 54 57 55 58 IMPLICIT NONE … … 108 111 INTEGER, PARAMETER :: jpr_grnm = 44 ! Greenland ice mass 109 112 INTEGER, PARAMETER :: jpr_antm = 45 ! Antarctic ice mass 110 INTEGER, PARAMETER :: jprcv = 45 ! total number of fields received 113 INTEGER, PARAMETER :: jpr_atm_pco2 = 46 ! Incoming atm CO2 flux 114 INTEGER, PARAMETER :: jpr_atm_dust = 47 ! Incoming atm aggregate dust 115 INTEGER, PARAMETER :: jprcv = 47 ! total number of fields received 111 116 112 117 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere … … 143 148 INTEGER, PARAMETER :: jps_sstfrz = 32 ! sea-surface freezing temperature 144 149 INTEGER, PARAMETER :: jps_fice1 = 33 ! first-order ice concentration (for time-travelling ice coupling) 145 INTEGER, PARAMETER :: jpsnd = 33 ! total number of fields sended 150 INTEGER, PARAMETER :: jps_bio_co2 = 34 ! MEDUSA air-sea CO2 flux in 151 INTEGER, PARAMETER :: jps_bio_dms = 35 ! MEDUSA DMS surface concentration in 152 INTEGER, PARAMETER :: jpsnd = 35 ! total number of fields sent 153 154 REAL(wp), PARAMETER :: dms_unit_conv = 1.0e+6 ! Coversion factor to get outgong DMS in standard units for coupling 155 ! i.e. specifically nmol/L (= umol/m3) 146 156 147 157 ! !!** namelist namsbc_cpl ** … … 155 165 ! Send to the atmosphere ! 156 166 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 167 TYPE(FLD_C) :: sn_snd_bio_co2, sn_snd_bio_dms 157 168 158 169 ! Received from the atmosphere ! 159 170 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 160 171 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_ts_ice, sn_rcv_grnm, sn_rcv_antm 172 TYPE(FLD_C) :: sn_rcv_atm_pco2, sn_rcv_atm_dust 173 161 174 ! Other namelist parameters ! 162 175 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data … … 234 247 & sn_rcv_co2 , sn_rcv_grnm , sn_rcv_antm , sn_rcv_ts_ice, nn_cplmodel , & 235 248 & ln_usecplmask, ln_coupled_iceshelf_fluxes, rn_greenland_calving_fraction, & 236 & rn_antarctica_calving_fraction, rn_iceshelf_fluxes_tolerance 249 & rn_antarctica_calving_fraction, rn_iceshelf_fluxes_tolerance, & 250 & sn_snd_bio_co2, sn_snd_bio_dms, & 251 & sn_rcv_atm_pco2, sn_rcv_atm_dust 237 252 !!--------------------------------------------------------------------- 238 253 ! … … 260 275 ENDIF 261 276 IF( lwp .AND. ln_cpl ) THEN ! control print 262 WRITE(numout,*)' received fields (mutiple ice catego gies)'277 WRITE(numout,*)' received fields (mutiple ice categories)' 263 278 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' 264 279 WRITE(numout,*)' stress module = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')' … … 277 292 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 278 293 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' 294 WRITE(numout,*)' atm pco2 = ', TRIM(sn_rcv_atm_pco2%cldes), ' (', TRIM(sn_rcv_atm_pco2%clcat), ')' 295 WRITE(numout,*)' atm dust = ', TRIM(sn_rcv_atm_dust%cldes), ' (', TRIM(sn_rcv_atm_dust%clcat), ')' 279 296 WRITE(numout,*)' sent fields (multiple ice categories)' 280 297 WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')' … … 290 307 WRITE(numout,*)' sea surface freezing temp = ', TRIM(sn_snd_sstfrz%cldes ), ' (', TRIM(sn_snd_sstfrz%clcat ), ')' 291 308 309 WRITE(numout,*)' bio co2 flux = ', TRIM(sn_snd_bio_co2%cldes), ' (', TRIM(sn_snd_bio_co2%clcat), ')' 310 WRITE(numout,*)' bio dms flux = ', TRIM(sn_snd_bio_dms%cldes), ' (', TRIM(sn_snd_bio_dms%clcat), ')' 292 311 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 293 312 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask … … 504 523 ! ! ------------------------- ! 505 524 srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE. 525 526 527 ! ! --------------------------------------- ! 528 ! ! Incoming CO2 and DUST fluxes for MEDUSA ! 529 ! ! --------------------------------------- ! 530 srcv(jpr_atm_pco2)%clname = 'OATMPCO2' 531 532 IF (TRIM(sn_rcv_atm_pco2%cldes) == 'coupled') THEN 533 srcv(jpr_atm_pco2)%laction = .TRUE. 534 END IF 535 536 srcv(jpr_atm_dust)%clname = 'OATMDUST' 537 IF (TRIM(sn_rcv_atm_dust%cldes) == 'coupled') THEN 538 srcv(jpr_atm_dust)%laction = .TRUE. 539 END IF 540 506 541 ! ! ------------------------- ! 507 542 ! ! topmelt and botmelt ! … … 780 815 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 781 816 ! 817 818 ! MEDUSA 819 ssnd(jps_bio_co2)%clname = 'OMED_CO2' 820 IF( TRIM(sn_snd_bio_co2%cldes) == 'coupled' ) ssnd(jps_bio_co2)%laction = .TRUE. 821 822 ! ! ------------------------- ! 823 ! ! DMS field ! 824 ! ! ------------------------- ! 825 ! MEDUSA 826 ssnd(jps_bio_dms)%clname = 'OMED_DMS' 827 IF( TRIM(sn_snd_bio_dms%cldes) == 'coupled' ) ssnd(jps_bio_dms)%laction = .TRUE. 828 782 829 783 830 ! ! ------------------------- ! … … 1001 1048 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 1002 1049 !!---------------------------------------------------------------------- 1050 1051 ! RSRH temporary arrays for testing, just to recieve incoming MEDUSA related fields 1052 ! until we know where they need to go. 1053 REAL(wp), ALLOCATABLE :: atm_pco2(:,:) 1054 REAL(wp), ALLOCATABLE :: atm_dust(:,:) 1055 1003 1056 ! 1004 1057 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') … … 1186 1239 ENDIF 1187 1240 #endif 1241 1242 #if defined key_medusa 1243 ! RSRH Allocate temporary arrays to receive incoming fields during testing 1244 ALLOCATE(atm_pco2(jpi,jpj)) 1245 ALLOCATE(atm_dust(jpi,jpj)) 1246 1247 IF( srcv(jpr_atm_pco2)%laction) atm_pco2(:,:) = frcv(jpr_atm_pco2)%z3(:,:,1) 1248 IF( srcv(jpr_atm_dust)%laction) atm_dust(:,:) = frcv(jpr_atm_dust)%z3(:,:,1) 1249 1250 ! RSRH Deallocate temporary arrays. 1251 DEALLOCATE(atm_pco2) 1252 DEALLOCATE(atm_dust) 1253 #endif 1254 1255 1256 1188 1257 1189 1258 ! Fields received by SAS when OASIS coupling … … 2194 2263 ! 2195 2264 #endif 2265 2266 2267 !! JPALM : 03-feb-2015 coupling MEDUSA-UKCA 2268 !! add soing exactly the same that CO2 fluxes 2269 !! of PISCES 2270 !! add CO2-MEDUSA 2271 !! add DMS-MEDUSA 2272 !! May add also a coupling MED-UKCA key 2273 2274 ! RSRH. We don't want to use magic numbers in the final code (i.e. 98 and 221). 2275 ! These need moving to a parameter statement (as part of MEDUSA code) or specifying in a namelist 2276 ! so the following code MUST NOT be viewed as anything more than temporary. 2277 IF ( ssnd(jps_bio_co2)%laction ) THEN 2278 CALL cpl_prism_snd( jps_bio_co2, isec, trc2d(:,:,98:98), info ) 2279 END IF 2280 2281 IF ( ssnd(jps_bio_dms)%laction ) THEN 2282 ! We need to multiply DMS by a conversion factor to get values in the standard units expected in 2283 ! the coupling space. 2284 ztmp1(:,: ) = trc2d(:,:,221) * dms_unit_conv 2285 CALL cpl_prism_snd( jps_bio_dms, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2286 ENDIF 2287 2196 2288 ! ! ------------------------- ! 2197 2289 IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current !
Note: See TracChangeset
for help on using the changeset viewer.
