Changeset 6181
- Timestamp:
- 2015-12-31T12:38:52+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5107_PKG_MEDUSA_RH/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6180 r6181 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 … … 474 492 ! ! ------------------------- ! 475 493 srcv(jpr_co2 )%clname = 'O_AtmCO2' ; IF( TRIM(sn_rcv_co2%cldes ) == 'coupled' ) srcv(jpr_co2 )%laction = .TRUE. 494 495 496 ! ! --------------------------------------- ! 497 ! ! Incoming CO2 and DUST fluxes for MEDUSA ! 498 ! ! --------------------------------------- ! 499 srcv(jpr_atm_pco2)%clname = 'OATMPCO2' 500 501 IF (TRIM(sn_rcv_atm_pco2%cldes) == 'coupled') THEN 502 srcv(jpr_atm_pco2)%laction = .TRUE. 503 END IF 504 505 srcv(jpr_atm_dust)%clname = 'OATMDUST' 506 IF (TRIM(sn_rcv_atm_dust%cldes) == 'coupled') THEN 507 srcv(jpr_atm_dust)%laction = .TRUE. 508 END IF 509 476 510 ! ! ------------------------- ! 477 511 ! ! topmelt and botmelt ! … … 857 891 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 858 892 !!---------------------------------------------------------------------- 893 894 ! RSRH temporary arrays for testing, just to recieve incoming MEDUSA related fields 895 ! until we know where they need to go. 896 REAL(wp), ALLOCATABLE :: atm_pco2(:,:) 897 REAL(wp), ALLOCATABLE :: atm_dust(:,:) 898 859 899 ! 860 900 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') … … 1023 1063 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 1024 1064 #endif 1065 1066 #if defined key_medusa 1067 ! RSRH Allocate temporary arrays to receive incoming fields during testing 1068 ALLOCATE(atm_pco2(jpi,jpj)) 1069 ALLOCATE(atm_dust(jpi,jpj)) 1070 1071 IF( srcv(jpr_atm_pco2)%laction) atm_pco2(:,:) = frcv(jpr_atm_pco2)%z3(:,:,1) 1072 IF( srcv(jpr_atm_dust)%laction) atm_dust(:,:) = frcv(jpr_atm_dust)%z3(:,:,1) 1073 1074 ! RSRH Deallocate temporary arrays. 1075 DEALLOCATE(atm_pco2) 1076 DEALLOCATE(atm_dust) 1077 #endif 1078 1079 1080 1025 1081 1026 1082 ! Fields received by SAS when OASIS coupling … … 1880 1936 ! 1881 1937 #endif 1938 1939 1940 !! JPALM : 03-feb-2015 coupling MEDUSA-UKCA 1941 !! add soing exactely the same that CO2 fluxes 1942 !! of PISCES 1943 !! add CO2-MEDUSA 1944 !! add DMS-MEDUSA 1945 !! May add also a coupling MED-UKCA key 1946 1947 ! RSRH. We don't want to use magic numbers in the code (i.e. 98 and 221). 1948 ! These need moving to a parameter statement (as part of MEDUSA code) or even specifying in a namelist 1949 ! so the following code MUST NOT be viewed as anything more than temporary. 1950 IF( ssnd(jps_bio_co2)%laction ) CALL cpl_prism_snd( jps_bio_co2, isec, trc2d(:,:,98:98), info ) 1951 1952 IF( ssnd(jps_bio_dms)%laction ) THEN 1953 ! We need to multiply DMS by a conversion factor to get values in the standard units expected in 1954 ! the coupling space. 1955 ztmp1(:,: ) = trc2d(:,:,221) * dms_unit_conv 1956 CALL cpl_prism_snd( jps_bio_dms, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1957 ENDIF 1958 1882 1959 ! ! ------------------------- ! 1883 1960 IF( ssnd(jps_ocx1)%laction ) THEN ! Surface current !
Note: See TracChangeset
for help on using the changeset viewer.