Changeset 6195 for branches/UKMO/dev_r5518_pkg/NEMOGCM/NEMO
- Timestamp:
- 2015-12-31T16:59:59+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6194 r6195 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 … … 138 143 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 139 144 INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level 140 INTEGER, PARAMETER :: jpsnd = 28 ! total number of fields sended 145 INTEGER, PARAMETER :: jps_bio_co2 = 29 ! MEDUSA air-sea CO2 flux in 146 INTEGER, PARAMETER :: jps_bio_dms = 30 ! MEDUSA DMS surface concentration in 147 INTEGER, PARAMETER :: jpsnd = 30 ! total number of fields sent 148 149 REAL(wp), PARAMETER :: dms_unit_conv = 1.0e+6 ! Coversion factor to get outgong DMS in standard units for coupling 150 ! i.e. specifically nmol/L (= umol/m3) 141 151 142 152 ! !!** namelist namsbc_cpl ** … … 149 159 END TYPE FLD_C 150 160 ! Send to the atmosphere ! 151 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 161 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 162 TYPE(FLD_C) :: sn_snd_bio_co2, sn_snd_bio_dms 152 163 ! Received from the atmosphere ! 153 164 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 154 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 165 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 166 TYPE(FLD_C) :: sn_rcv_atm_pco2, sn_rcv_atm_dust 155 167 ! Other namelist parameters ! 156 168 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data … … 220 232 !! 221 233 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick , sn_snd_crt , sn_snd_co2, & 234 & sn_snd_bio_co2, sn_snd_bio_dms, & 222 235 & sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1, & 223 236 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 224 237 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, & 238 & sn_rcv_atm_pco2, sn_rcv_atm_dust, & 225 239 & sn_rcv_co2 , sn_rcv_grnm , sn_rcv_antm , sn_rcv_ts_ice, nn_cplmodel , & 226 240 & ln_usecplmask, ln_coupled_iceshelf_fluxes, rn_greenland_calving_fraction, & 227 241 & rn_antarctica_calving_fraction, rn_iceshelf_fluxes_tolerance 242 228 243 !!--------------------------------------------------------------------- 229 244 ! … … 251 266 ENDIF 252 267 IF( lwp .AND. ln_cpl ) THEN ! control print 253 WRITE(numout,*)' received fields (mutiple ice catego gies)'268 WRITE(numout,*)' received fields (mutiple ice categories)' 254 269 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' 255 270 WRITE(numout,*)' stress module = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')' … … 266 281 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 267 282 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' 283 WRITE(numout,*)' atm pco2 = ', TRIM(sn_rcv_atm_pco2%cldes), ' (', TRIM(sn_rcv_atm_pco2%clcat), ')' 284 WRITE(numout,*)' atm dust = ', TRIM(sn_rcv_atm_dust%cldes), ' (', TRIM(sn_rcv_atm_dust%clcat), ')' 268 285 WRITE(numout,*)' sent fields (multiple ice categories)' 269 286 WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')' … … 275 292 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 276 293 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 294 WRITE(numout,*)' bio co2 flux = ', TRIM(sn_snd_bio_co2%cldes), ' (', TRIM(sn_snd_bio_co2%clcat), ')' 295 WRITE(numout,*)' bio dms flux = ', TRIM(sn_snd_bio_dms%cldes), ' (', TRIM(sn_snd_bio_dms%clcat), ')' 277 296 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 278 297 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask … … 484 503 ! ! ------------------------- ! 485 504 srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE. 505 506 507 ! ! --------------------------------------- ! 508 ! ! Incoming CO2 and DUST fluxes for MEDUSA ! 509 ! ! --------------------------------------- ! 510 srcv(jpr_atm_pco2)%clname = 'OATMPCO2' 511 512 IF (TRIM(sn_rcv_atm_pco2%cldes) == 'coupled') THEN 513 srcv(jpr_atm_pco2)%laction = .TRUE. 514 END IF 515 516 srcv(jpr_atm_dust)%clname = 'OATMDUST' 517 IF (TRIM(sn_rcv_atm_dust%cldes) == 'coupled') THEN 518 srcv(jpr_atm_dust)%laction = .TRUE. 519 END IF 520 486 521 ! ! ------------------------- ! 487 522 ! ! topmelt and botmelt ! … … 893 928 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 894 929 !!---------------------------------------------------------------------- 930 931 ! RSRH temporary arrays for testing, just to recieve incoming MEDUSA related fields 932 ! until we know where they need to go. 933 REAL(wp), ALLOCATABLE :: atm_pco2(:,:) 934 REAL(wp), ALLOCATABLE :: atm_dust(:,:) 935 895 936 ! 896 937 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') … … 1059 1100 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 1060 1101 #endif 1102 1103 #if defined key_medusa 1104 ! RSRH Allocate temporary arrays to receive incoming fields during testing 1105 ALLOCATE(atm_pco2(jpi,jpj)) 1106 ALLOCATE(atm_dust(jpi,jpj)) 1107 1108 IF( srcv(jpr_atm_pco2)%laction) atm_pco2(:,:) = frcv(jpr_atm_pco2)%z3(:,:,1) 1109 IF( srcv(jpr_atm_dust)%laction) atm_dust(:,:) = frcv(jpr_atm_dust)%z3(:,:,1) 1110 1111 ! RSRH Deallocate temporary arrays. 1112 DEALLOCATE(atm_pco2) 1113 DEALLOCATE(atm_dust) 1114 #endif 1115 1116 1117 1061 1118 1062 1119 ! Fields received by SAS when OASIS coupling … … 1975 2032 ! 1976 2033 #endif 2034 2035 2036 !! JPALM : 03-feb-2015 coupling MEDUSA-UKCA 2037 !! add soing exactely the same that CO2 fluxes 2038 !! of PISCES 2039 !! add CO2-MEDUSA 2040 !! add DMS-MEDUSA 2041 !! May add also a coupling MED-UKCA key 2042 2043 ! RSRH. We don't want to use magic numbers in the code (i.e. 98 and 221). 2044 ! These need moving to a parameter statement (as part of MEDUSA code) or even specifying in a namelist 2045 ! so the following code MUST NOT be viewed as anything more than temporary. 2046 IF( ssnd(jps_bio_co2)%laction ) CALL cpl_prism_snd( jps_bio_co2, isec, trc2d(:,:,98:98), info ) 2047 2048 IF( ssnd(jps_bio_dms)%laction ) THEN 2049 ! We need to multiply DMS by a conversion factor to get values in the standard units expected in 2050 ! the coupling space. 2051 ztmp1(:,: ) = trc2d(:,:,221) * dms_unit_conv 2052 CALL cpl_prism_snd( jps_bio_dms, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2053 ENDIF 2054 1977 2055 ! ! ------------------------- ! 1978 2056 IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current !
Note: See TracChangeset
for help on using the changeset viewer.