- Timestamp:
- 2015-12-24T17:28:53+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_medusa_cpl_rh/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6168 r6171 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 … … 105 108 INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness 106 109 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 110 INTEGER, PARAMETER :: jpr_atm_pco2 = 43 ! Incoming atm CO2 flux 111 INTEGER, PARAMETER :: jpr_atm_dust = 44 ! Incoming atm aggregate dust 112 INTEGER, PARAMETER :: jprcv = 44 ! total number of fields received 108 113 109 114 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere … … 135 140 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 136 141 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 142 INTEGER, PARAMETER :: jps_bio_co2 = 29 ! MEDUSA air-sea CO2 flux in 143 INTEGER, PARAMETER :: jps_bio_dms = 30 ! MEDUSA DMS surface concentration in 144 INTEGER, PARAMETER :: jpsnd = 30 ! total number of fields sent 145 146 REAL(wp), PARAMETER :: dms_unit_conv = 1.0e+6 ! Coversion factor to get outgong DMS in standard units for coupling 147 ! i.e. specifically nmol/L (= umol/m3) 138 148 139 149 ! !!** namelist namsbc_cpl ** … … 146 156 END TYPE FLD_C 147 157 ! Send to the atmosphere ! 148 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 158 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 159 TYPE(FLD_C) :: sn_snd_bio_co2, sn_snd_bio_dms 149 160 ! Received from the atmosphere ! 150 161 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 162 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 163 TYPE(FLD_C) :: sn_rcv_atm_pco2, sn_rcv_atm_dust 152 164 ! Other namelist parameters ! 153 165 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data … … 217 229 !! 218 230 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 231 & sn_snd_bio_co2, sn_snd_bio_dms, & 232 & sn_rcv_atm_pco2, sn_rcv_atm_dust, & 219 233 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 220 234 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, & … … 245 259 ENDIF 246 260 IF( lwp .AND. ln_cpl ) THEN ! control print 247 WRITE(numout,*)' received fields (mutiple ice catego gies)'261 WRITE(numout,*)' received fields (mutiple ice categories)' 248 262 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' 249 263 WRITE(numout,*)' stress module = ', TRIM(sn_rcv_taumod%cldes), ' (', TRIM(sn_rcv_taumod%clcat), ')' … … 260 274 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 261 275 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' 276 WRITE(numout,*)' atm pco2 = ', TRIM(sn_rcv_atm_pco2%cldes), ' (', TRIM(sn_rcv_atm_pco2%clcat), ')' 277 WRITE(numout,*)' atm dust = ', TRIM(sn_rcv_atm_dust%cldes), ' (', TRIM(sn_rcv_atm_dust%clcat), ')' 262 278 WRITE(numout,*)' sent fields (multiple ice categories)' 263 279 WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')' … … 269 285 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 270 286 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 287 WRITE(numout,*)' bio co2 flux = ', TRIM(sn_snd_bio_co2%cldes), ' (', TRIM(sn_snd_bio_co2%clcat), ')' 288 WRITE(numout,*)' bio dms flux = ', TRIM(sn_snd_bio_dms%cldes), ' (', TRIM(sn_snd_bio_dms%clcat), ')' 271 289 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 272 290 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask … … 470 488 ! ! ------------------------- ! 471 489 srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE. 490 491 492 ! ! --------------------------------------- ! 493 ! ! Incoming CO2 and DUST fluxes for MEDUSA ! 494 ! ! --------------------------------------- ! 495 srcv(jpr_atm_pco2)%clname = 'OATMPCO2' 496 497 IF (TRIM(sn_rcv_atm_pco2%cldes) == 'coupled') THEN 498 srcv(jpr_atm_pco2)%laction = .TRUE. 499 END IF 500 501 srcv(jpr_atm_dust)%clname = 'OATMDUST' 502 IF (TRIM(sn_rcv_atm_dust%cldes) == 'coupled') THEN 503 srcv(jpr_atm_dust)%laction = .TRUE. 504 END IF 505 472 506 ! ! ------------------------- ! 473 507 ! ! topmelt and botmelt ! … … 852 886 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr 853 887 !!---------------------------------------------------------------------- 888 889 ! RSRH temporary arrays for testing, just to recieve incoming MEDUSA related fields 890 ! until we know where they need to go. 891 REAL(wp), ALLOCATABLE :: atm_pco2(:,:) 892 REAL(wp), ALLOCATABLE :: atm_dust(:,:) 893 854 894 ! 855 895 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') … … 996 1036 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 997 1037 #endif 1038 1039 #if defined key_medusa 1040 ! RSRH Allocate temporary arrays to receive incoming fields during testing 1041 ALLOCATE(atm_pco2(jpi,jpj)) 1042 ALLOCATE(atm_dust(jpi,jpj)) 1043 1044 IF( srcv(jpr_atm_pco2)%laction) atm_pco2(:,:) = frcv(jpr_atm_pco2)%z3(:,:,1) 1045 IF( srcv(jpr_atm_dust)%laction) atm_dust(:,:) = frcv(jpr_atm_dust)%z3(:,:,1) 1046 1047 ! RSRH Deallocate temporary arrays. 1048 DEALLOCATE(atm_pco2) 1049 DEALLOCATE(atm_dust) 1050 #endif 1051 1052 1053 998 1054 999 1055 ! Fields received by SAS when OASIS coupling … … 1852 1908 ! 1853 1909 #endif 1910 1911 1912 !! JPALM : 03-feb-2015 coupling MEDUSA-UKCA 1913 !! add soing exactely the same that CO2 fluxes 1914 !! of PISCES 1915 !! add CO2-MEDUSA 1916 !! add DMS-MEDUSA 1917 !! May add also a coupling MED-UKCA key 1918 1919 ! RSRH. We don't want to use magic numbers in the code (i.e. 98 and 221). 1920 ! These need moving to a parameter statement (as part of MEDUSA code) or even specifying in a namelist 1921 ! so the following code MUST NOT be viewed as anything more than temporary. 1922 IF( ssnd(jps_bio_co2)%laction ) CALL cpl_prism_snd( jps_bio_co2, isec, trc2d(:,:,98:98), info ) 1923 1924 IF( ssnd(jps_bio_dms)%laction ) THEN 1925 ! We need to multiply DMS by a conversion factor to get values in the standard units expected in 1926 ! the coupling space. 1927 ztmp1(:,: ) = trc2d(:,:,221) * dms_unit_conv 1928 CALL cpl_prism_snd( jps_bio_dms, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1929 ENDIF 1930 1854 1931 ! ! ------------------------- ! 1855 1932 IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current !
Note: See TracChangeset
for help on using the changeset viewer.