Changeset 11408 for NEMO/branches/UKMO/NEMO_4.0_fix_cpl_oce_only
- Timestamp:
- 2019-08-06T16:20:43+02:00 (5 years ago)
- Location:
- NEMO/branches/UKMO/NEMO_4.0_fix_cpl_oce_only/src
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0_fix_cpl_oce_only/src/ICE/ice.F90
r10888 r11408 296 296 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_i !: Ice thickness (m) 297 297 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i !: Ice fractional areas (concentration) 298 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_last_couple !: Ice fractional area at last coupling time 298 299 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_i !: Ice volume per unit area (m) 299 300 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s !: Snow volume per unit area (m) -
NEMO/branches/UKMO/NEMO_4.0_fix_cpl_oce_only/src/OCE/SBC/sbc_ice.F90
r10888 r11408 93 93 94 94 ! already defined in ice.F90 for SI3 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i ! Sea ice fraction on categories 96 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_last_couple ! Sea ice fraction on categories at the last coupling point 96 97 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_i, h_s 97 98 -
NEMO/branches/UKMO/NEMO_4.0_fix_cpl_oce_only/src/OCE/SBC/sbccpl.F90
r11370 r11408 48 48 USE lib_mpp ! distribued memory computing library 49 49 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 50 51 #if defined key_oasis3 52 USE mod_oasis, ONLY : OASIS_Sent, OASIS_ToRest, OASIS_SentOut, OASIS_ToRestOut 53 #endif 50 54 51 55 IMPLICIT NONE … … 160 164 INTEGER, PARAMETER :: jpsnd = 38 ! total number of fields sent 161 165 166 #if ! defined key_oasis3 167 ! Dummy variables to enable compilation when oasis3 is not being used 168 INTEGER :: OASIS_Sent = -1 169 INTEGER :: OASIS_SentOut = -1 170 INTEGER :: OASIS_ToRest = -1 171 INTEGER :: OASIS_ToRestOut = -1 172 #endif 173 162 174 ! !!** namelist namsbc_cpl ** 163 175 TYPE :: FLD_C ! … … 184 196 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 185 197 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 198 LOGICAL :: ln_scale_ice_fluxes ! Scale sea ice fluxes by the sea ice fractions at the previous coupling point 186 199 TYPE :: DYNARR 187 200 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 … … 210 223 !! *** FUNCTION sbc_cpl_alloc *** 211 224 !!---------------------------------------------------------------------- 212 INTEGER :: ierr( 4)225 INTEGER :: ierr(5) 213 226 !!---------------------------------------------------------------------- 214 227 ierr(:) = 0 … … 222 235 ! 223 236 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) ) 237 238 ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(5) ) 224 239 225 240 sbc_cpl_alloc = MAXVAL( ierr ) … … 256 271 & sn_rcv_iceflx, sn_rcv_co2 , nn_cplmodel , ln_usecplmask, sn_rcv_mslp , & 257 272 & sn_rcv_icb , sn_rcv_isf , sn_rcv_wfreq , sn_rcv_tauw, nn_cats_cpl , & 258 & sn_rcv_ts_ice 273 & sn_rcv_ts_ice, ln_scale_ice_fluxes 259 274 260 275 !!--------------------------------------------------------------------- … … 330 345 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask 331 346 WRITE(numout,*)' nn_cats_cpl = ', nn_cats_cpl 347 WRITE(numout,*)' ln_scale_ice_fluxes = ', ln_scale_ice_fluxes 332 348 ENDIF 333 349 … … 815 831 END SELECT 816 832 833 ! Initialise ice fractions from last coupling time to zero 834 a_i_last_couple(:,:,:) = 0._wp 835 836 817 837 ! ! ------------------------- ! 818 838 ! ! Ice Meltponds ! … … 1643 1663 REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice 1644 1664 REAL(wp), DIMENSION(jpi,jpj) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1665 REAL(wp), DIMENSION(jpi,jpj) :: zevap_ice_total 1645 1666 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice !!gm , zfrqsr_tr_i 1646 1667 !!---------------------------------------------------------------------- … … 1663 1684 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1664 1685 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1665 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:)1666 1686 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1667 1687 zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1668 1688 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * picefr(:,:) 1669 1689 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1670 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 1690 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) 1671 1691 CASE( 'none' ) ! Not available as for now: needs additional coding below when computing zevap_oce 1672 1692 ! ! since fields received are not defined with none option … … 1675 1695 1676 1696 #if defined key_si3 1697 1698 ! --- evaporation over ice (kg/m2/s) --- ! 1699 zevap_ice_total(:,:) = 0._wp 1700 IF (sn_rcv_emp%clcat == 'yes') THEN 1701 DO jl=1,jpl 1702 IF (ln_scale_ice_fluxes) THEN 1703 zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) * a_i_last_couple(:,:,jl) 1704 ELSE 1705 zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 1706 ENDIF 1707 zevap_ice_total(:,:) = zevap_ice_total(:,:) + zevap_ice(:,:,jl) 1708 ENDDO 1709 ELSE 1710 zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1 ) 1711 zevap_ice_total(:,:) = zevap_ice(:,:,1) 1712 ENDIF 1713 1714 IF ( TRIM( sn_rcv_emp%cldes == 'conservative' ) THEN 1715 ! For conservative case zemp_ice has not been defined yet. Do it now. 1716 zemp_ice(:,:) = zevap_ice_total(:,:) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:) 1717 END IF 1718 1677 1719 ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 1678 1720 zsnw(:,:) = 0._wp ; CALL ice_thd_snwblow( ziceld, zsnw ) … … 1683 1725 1684 1726 ! --- evaporation over ocean (used later for qemp) --- ! 1685 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) 1686 1687 ! --- evaporation over ice (kg/m2/s) --- ! 1688 DO jl=1,jpl 1689 IF (sn_rcv_emp%clcat == 'yes') THEN ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 1690 ELSE ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 ) ; ENDIF 1691 ENDDO 1727 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) 1728 1729 1730 1692 1731 1693 1732 ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 … … 1774 1813 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1775 1814 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1776 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average)1815 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , zevap_ice_total(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average) 1777 1816 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & 1778 & - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average)1817 & - zevap_ice_total(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1779 1818 ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 1780 1819 ! … … 1850 1889 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - rLfus ) ! solid precip over ocean + snow melting 1851 1890 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptsnw (:,:) - rLfus ) ! solid precip over ice (qevap_ice=0 since atm. does not take it into account) 1852 !! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * zcptsnw (:,:) & ! ice evap1853 !! & + zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhos ! solid precip over ice1854 1891 1855 1892 ! --- total non solar flux (including evap/precip) --- ! … … 1903 1940 IF ( srcv(jpr_icb)%laction ) CALL iom_put('hflx_icb_cea' , - frcv(jpr_icb)%z3(:,:,1) * rLfus ) ! latent heat from icebergs melting 1904 1941 IF ( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea' , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average) 1905 IF ( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1)&1906 & * picefr(:,:) )* zcptn(:,:) * tmask(:,:,1) ) ! heat flux from evap (cell average)1942 IF ( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) ) & 1943 * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from evap (cell average) 1907 1944 IF ( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) ) ! heat flux from snow (cell average) 1908 1945 IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & … … 2015 2052 ! ! ========================= ! 2016 2053 CASE ('coupled') 2017 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 2018 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 2054 IF (ln_scale_ice_fluxes) THEN 2055 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) 2056 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) 2057 ELSE 2058 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 2059 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 2060 ENDIF 2019 2061 END SELECT 2020 2062 ! … … 2200 2242 IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info ) 2201 2243 ENDIF 2244 2245 ! If this coupling was successful then save ice fraction for use between coupling points. 2246 ! This is needed for some calculations where the ice fraction at the last coupling point 2247 ! is needed. 2248 IF( info == OASIS_Sent .OR. info == OASIS_ToRest .OR. & 2249 & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN 2250 IF ( sn_snd_thick%clcat == 'yes' ) THEN 2251 a_i_last_couple(:,:,:) = a_i(:,:,:) 2252 ENDIF 2253 ENDIF 2202 2254 2203 2255 IF( ssnd(jps_fice1)%laction ) THEN
Note: See TracChangeset
for help on using the changeset viewer.