Changeset 6698
- Timestamp:
- 2016-06-13T17:14:52+02:00 (8 years ago)
- Location:
- branches/UKMO/dev_r5518_GO6_package_MEDUSA_temporary/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package_MEDUSA_temporary/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6697 r6698 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 … … 106 108 INTEGER, PARAMETER :: jpr_grnm = 44 ! Greenland ice mass 107 109 INTEGER, PARAMETER :: jpr_antm = 45 ! Antarctic ice mass 108 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 109 113 110 114 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere … … 141 145 INTEGER, PARAMETER :: jps_sstfrz = 32 ! sea-surface freezing temperature 142 146 INTEGER, PARAMETER :: jps_fice1 = 33 ! first-order ice concentration (for time-travelling ice coupling) 143 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) 144 153 145 154 ! !!** namelist namsbc_cpl ** … … 153 162 ! Send to the atmosphere ! 154 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 155 165 156 166 ! Received from the atmosphere ! 157 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 158 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 159 171 ! Other namelist parameters ! 160 172 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data … … 231 243 & rn_antarctica_calving_fraction, rn_iceshelf_fluxes_tolerance 232 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 233 252 ! 234 253 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_init') … … 255 274 ENDIF 256 275 IF( lwp .AND. ln_cpl ) THEN ! control print 257 WRITE(numout,*)' received fields (mutiple ice catego gies)'276 WRITE(numout,*)' received fields (mutiple ice categories)' 258 277 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' 259 278 WRITE(numout,*)' stress module = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')' … … 272 291 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 273 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), ')' 274 295 WRITE(numout,*)' sent fields (multiple ice categories)' 275 296 WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')' … … 280 301 WRITE(numout,*)' - orientation = ', sn_snd_crt%clvor 281 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), ')' 282 305 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 283 306 WRITE(numout,*)' ice effective conductivity = ', TRIM(sn_snd_cond%cldes ), ' (', TRIM(sn_snd_cond%clcat ), ')' … … 495 518 ! ! ------------------------- ! 496 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 497 536 ! ! ------------------------- ! 498 537 ! ! topmelt and botmelt ! … … 771 810 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 772 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. 773 823 774 824 ! ! ------------------------- ! … … 991 1041 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr 992 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 993 1049 ! 994 1050 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') … … 1127 1183 CALL iom_put( "taum_oce", taum ) ! output wind stress module 1128 1184 ! 1185 ENDIF 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) 1129 1190 ENDIF 1130 1191 … … 2241 2302 ! 2242 2303 #endif 2304 2305 2306 2307 IF (ln_medusa) THEN 2308 ! ! --------------------------------- ! 2309 ! ! CO2 flux and DMS from MEDUSA ! 2310 ! ! --------------------------------- ! 2311 IF ( ssnd(jps_bio_co2)%laction ) THEN 2312 CALL cpl_snd( jps_bio_co2, isec, RESHAPE( CO2Flux_out_cpl, (/jpi,jpj,1/) ), info ) 2313 ENDIF 2314 2315 IF ( ssnd(jps_bio_dms)%laction ) THEN 2316 CALL cpl_snd( jps_bio_dms, isec, RESHAPE( DMS_out_cpl, (/jpi,jpj,1/) ), info ) 2317 ENDIF 2318 ENDIF 2319 2243 2320 ! ! ------------------------- ! 2244 2321 IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current ! -
branches/UKMO/dev_r5518_GO6_package_MEDUSA_temporary/NEMOGCM/NEMO/OPA_SRC/oce.F90
r6486 r6698 71 71 !! Energy budget of the leads (open water embedded in sea ice) 72 72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fraqsr_1lev !: fraction of solar net radiation absorbed in the first ocean level [-] 73 74 !! Arrays used in coupling when MEDUSA is present. These arrays need to be declared 75 !! even if MEDUSA is not active, to allow compilation, in which case they will not be allocated. 76 !! --------------------- 77 REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: CO2Flux_out_cpl(:,:) ! Output coupling CO2 flux 78 REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: DMS_out_cpl(:,:) ! Output coupling DMS 73 79 80 REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: PCO2a_in_cpl(:,:) ! Input coupling CO2 partial pressure 81 REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: Dust_in_cpl(:,:) ! Input coupling dust 82 83 #if defined key_medusa 84 LOGICAL, PUBLIC, PARAMETER :: ln_medusa=.TRUE. ! Medusa switched on or off. 85 #else 86 LOGICAL, PUBLIC, PARAMETER :: ln_medusa=.FALSE. ! Medusa switched on or off. 87 #endif 74 88 !!---------------------------------------------------------------------- 75 89 !! NEMO/OPA 4.0 , NEMO Consortium (2011) … … 119 133 ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(4) ) 120 134 ! 135 #if defined key_oasis3 136 IF (ln_medusa) THEN 137 ! We only actually need these arrays to be allocated if coupling and MEDUSA 138 ! are enabled 139 ALLOCATE( CO2Flux_out_cpl(jpi,jpj), DMS_out_cpl(jpi,jpj), & 140 PCO2a_in_cpl(jpi,jpj), Dust_in_cpl(jpi,jpj), STAT=ierr(5) ) 141 142 ! RSRH Temporarily initialise output coupling fields while we await clarification 143 ! of exactly how these will be initialised at model startup! 144 DMS_out_cpl(:,:) = 0.0 145 CO2Flux_out_cpl(:,:) = 0.0 146 ENDIF 147 #endif 148 121 149 oce_alloc = MAXVAL( ierr ) 122 150 IF( oce_alloc /= 0 ) CALL ctl_warn('oce_alloc: failed to allocate arrays')
Note: See TracChangeset
for help on using the changeset viewer.