Changeset 13710 for NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OCE/SBC/sbccpl.F90
- Timestamp:
- 2020-11-02T10:56:42+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/SBC/sbccpl.F90 (modified) (46 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@13559 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OCE/SBC/sbccpl.F90
r12991 r13710 42 42 #endif 43 43 #if defined key_si3 44 USE ice thd_dh ! for CALL ice_thd_snwblow44 USE icevar ! for CALL ice_var_snwblow 45 45 #endif 46 46 ! … … 49 49 USE lib_mpp ! distribued memory computing library 50 50 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 51 52 #if defined key_oasis3 53 USE mod_oasis, ONLY : OASIS_Sent, OASIS_ToRest, OASIS_SentOut, OASIS_ToRestOut 54 #endif 51 55 52 56 IMPLICIT NONE … … 159 163 INTEGER, PARAMETER :: jps_wlev = 32 ! water level 160 164 INTEGER, PARAMETER :: jps_fice1 = 33 ! first-order ice concentration (for semi-implicit coupling of atmos-ice fluxes) 161 INTEGER, PARAMETER :: jps_a_p = 34 ! meltpond area 165 INTEGER, PARAMETER :: jps_a_p = 34 ! meltpond area fraction 162 166 INTEGER, PARAMETER :: jps_ht_p = 35 ! meltpond thickness 163 167 INTEGER, PARAMETER :: jps_kice = 36 ! sea ice effective conductivity … … 166 170 167 171 INTEGER, PARAMETER :: jpsnd = 38 ! total number of fields sent 172 173 #if ! defined key_oasis3 174 ! Dummy variables to enable compilation when oasis3 is not being used 175 INTEGER :: OASIS_Sent = -1 176 INTEGER :: OASIS_SentOut = -1 177 INTEGER :: OASIS_ToRest = -1 178 INTEGER :: OASIS_ToRestOut = -1 179 #endif 168 180 169 181 ! !!** namelist namsbc_cpl ** … … 191 203 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models 192 204 ! -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 205 LOGICAL :: ln_scale_ice_flux ! use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 206 193 207 TYPE :: DYNARR 194 208 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 … … 198 212 199 213 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: alb_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 214 #if defined key_si3 || defined key_cice 215 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_last_couple !: Ice fractional area at last coupling time 216 #endif 200 217 201 218 REAL(wp) :: rpref = 101000._wp ! reference atmospheric pressure[N/m2] … … 206 223 !! Substitution 207 224 # include "do_loop_substitute.h90" 225 # include "domzgr_substitute.h90" 208 226 !!---------------------------------------------------------------------- 209 227 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 217 235 !! *** FUNCTION sbc_cpl_alloc *** 218 236 !!---------------------------------------------------------------------- 219 INTEGER :: ierr( 4)237 INTEGER :: ierr(5) 220 238 !!---------------------------------------------------------------------- 221 239 ierr(:) = 0 … … 227 245 #endif 228 246 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 229 ! 230 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) ) 247 #if defined key_si3 || defined key_cice 248 ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(4) ) 249 #endif 250 ! 251 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(5) ) 231 252 232 253 sbc_cpl_alloc = MAXVAL( ierr ) … … 255 276 REAL(wp), DIMENSION(jpi,jpj) :: zacs, zaos 256 277 !! 257 NAMELIST/namsbc_cpl/ sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2 , & 258 & sn_snd_ttilyr, sn_snd_cond , sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1, & 259 & sn_snd_ifrac , sn_snd_crtw , sn_snd_wlev , sn_rcv_hsig , sn_rcv_phioc, & 260 & sn_rcv_w10m , sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr , & 261 & sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum , sn_rcv_wstrf, & 278 NAMELIST/namsbc_cpl/ nn_cplmodel , ln_usecplmask, nn_cats_cpl , ln_scale_ice_flux, & 279 & sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2 , & 280 & sn_snd_ttilyr, sn_snd_cond , sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1, & 281 & sn_snd_ifrac , sn_snd_crtw , sn_snd_wlev , sn_rcv_hsig , sn_rcv_phioc , & 282 & sn_rcv_w10m , sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr , & 283 & sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum , sn_rcv_wstrf , & 262 284 & sn_rcv_charn , sn_rcv_taw , sn_rcv_bhd , sn_rcv_tusd , sn_rcv_tvsd, & 263 285 & sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , & 264 & sn_rcv_iceflx, sn_rcv_co2 , nn_cplmodel , ln_usecplmask, sn_rcv_mslp , & 265 & sn_rcv_icb , sn_rcv_isf , sn_rcv_ts_ice, nn_cats_cpl 266 286 & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_icb , sn_rcv_isf , sn_rcv_ts_ice 267 287 268 288 !!--------------------------------------------------------------------- … … 285 305 ENDIF 286 306 IF( lwp .AND. ln_cpl ) THEN ! control print 307 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 308 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask 309 WRITE(numout,*)' ln_scale_ice_flux = ', ln_scale_ice_flux 310 WRITE(numout,*)' nn_cats_cpl = ', nn_cats_cpl 287 311 WRITE(numout,*)' received fields (mutiple ice categogies)' 288 312 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' … … 333 357 WRITE(numout,*)' - orientation = ', sn_snd_crtw%clvor 334 358 WRITE(numout,*)' - mesh = ', sn_snd_crtw%clvgrd 335 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel336 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask337 WRITE(numout,*)' nn_cats_cpl = ', nn_cats_cpl338 359 ENDIF 339 360 … … 372 393 ! 373 394 ! Vectors: change of sign at north fold ONLY if on the local grid 374 IF( TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM(sn_rcv_tau%cldes ) == 'oce and ice') THEN ! avoid working with the atmospheric fields if they are not coupled 395 IF( TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM( sn_rcv_tau%cldes ) == 'oce and ice' & 396 .OR. TRIM( sn_rcv_tau%cldes ) == 'mixed oce-ice' ) THEN ! avoid working with the atmospheric fields if they are not coupled 397 ! 375 398 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 376 399 … … 720 743 ! Change first letter to couple with atmosphere if already coupled OPA 721 744 ! this is nedeed as each variable name used in the namcouple must be unique: 722 ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere745 ! for example O_Runoff received by OPA from SAS and therefore S_Runoff received by SAS from the Atmosphere 723 746 DO jn = 1, jprcv 724 747 IF( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) … … 844 867 END SELECT 845 868 869 ! Initialise ice fractions from last coupling time to zero (needed by Met-Office) 870 #if defined key_si3 || defined key_cice 871 a_i_last_couple(:,:,:) = 0._wp 872 #endif 846 873 ! ! ------------------------- ! 847 874 ! ! Ice Meltponds ! … … 1061 1088 xcplmask(:,:,:) = 0. 1062 1089 CALL iom_open( 'cplmask', inum ) 1063 CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1: nlci,1:nlcj,1:nn_cplmodel), &1064 & kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) )1090 CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:jpi,1:jpj,1:nn_cplmodel), & 1091 & kstart = (/ mig(1),mjg(1),1 /), kcount = (/ jpi,jpj,nn_cplmodel /) ) 1065 1092 CALL iom_close( inum ) 1066 1093 ELSE … … 1133 1160 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 1134 1161 REAL(wp) :: zzx, zzy ! temporary variables 1135 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr 1162 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr, zcloud_fra 1136 1163 !!---------------------------------------------------------------------- 1137 1164 ! … … 1197 1224 ! 1198 1225 IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN 1199 DO_2D _00_001226 DO_2D( 0, 0, 0, 0 ) ! T ==> (U,V) 1200 1227 frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 1201 1228 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 1202 1229 END_2D 1203 CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U', -1. , frcv(jpr_oty1)%z3(:,:,1), 'V', -1.)1230 CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U', -1.0_wp, frcv(jpr_oty1)%z3(:,:,1), 'V', -1.0_wp ) 1204 1231 ENDIF 1205 1232 llnewtx = .TRUE. … … 1221 1248 ! => need to be done only when otx1 was changed 1222 1249 IF( llnewtx ) THEN 1223 DO_2D _00_001250 DO_2D( 0, 0, 0, 0 ) 1224 1251 zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) 1225 1252 zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) 1226 1253 frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 1227 1254 END_2D 1228 CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1. )1255 CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1.0_wp ) 1229 1256 llnewtau = .TRUE. 1230 1257 ELSE … … 1246 1273 IF( llnewtau ) THEN 1247 1274 zcoef = 1. / ( zrhoa * zcdrag ) 1248 DO_2D _11_111275 DO_2D( 1, 1, 1, 1 ) 1249 1276 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 1250 1277 END_2D 1251 1278 ENDIF 1252 1279 ENDIF 1253 1280 !!$ ! ! ========================= ! 1281 !!$ SELECT CASE( TRIM( sn_rcv_clouds%cldes ) ) ! cloud fraction ! 1282 !!$ ! ! ========================= ! 1283 !!$ cloud_fra(:,:) = frcv(jpr_clfra)*z3(:,:,1) 1284 !!$ END SELECT 1285 !!$ 1286 zcloud_fra(:,:) = pp_cldf ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm. 1287 IF( ln_mixcpl ) THEN 1288 cloud_fra(:,:) = cloud_fra(:,:) * xcplmask(:,:,0) + zcloud_fra(:,:)* zmsk(:,:) 1289 ELSE 1290 cloud_fra(:,:) = zcloud_fra(:,:) 1291 ENDIF 1292 ! ! ========================= ! 1254 1293 ! u(v)tau and taum will be modified by ice model 1255 1294 ! -> need to be reset before each call of the ice/fsbc … … 1529 1568 INTEGER :: ji, jj ! dummy loop indices 1530 1569 INTEGER :: itx ! index of taux over ice 1570 REAL(wp) :: zztmp1, zztmp2 1531 1571 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty 1532 1572 !!---------------------------------------------------------------------- … … 1592 1632 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! (U,V) ==> (U,V) 1593 1633 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 1594 CASE( 'F' ) 1595 DO_2D_00_00 1596 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj-1,1) ) 1597 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) ) 1634 CASE( 'T' ) 1635 DO_2D( 0, 0, 0, 0 ) ! T ==> (U,V) 1636 ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and rheology 1637 zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj ,1) ) 1638 zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji ,jj+1,1) ) 1639 p_taui(ji,jj) = zztmp1 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 1640 p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1598 1641 END_2D 1599 CASE( 'T' ) 1600 DO_2D_00_00 1601 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 1602 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1603 END_2D 1604 CASE( 'I' ) 1605 DO_2D_00_00 1606 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) ) 1607 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji ,jj+1,1) ) 1608 END_2D 1642 CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U', -1., p_tauj, 'V', -1. ) 1609 1643 END SELECT 1610 IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN1611 CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U', -1., p_tauj, 'V', -1. )1612 ENDIF1613 1644 1614 1645 ENDIF … … 1676 1707 ! 1677 1708 INTEGER :: ji, jj, jl ! dummy loop index 1678 REAL(wp) :: ztri ! local scalar1679 1709 REAL(wp), DIMENSION(jpi,jpj) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw 1680 1710 REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice 1681 1711 REAL(wp), DIMENSION(jpi,jpj) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1712 REAL(wp), DIMENSION(jpi,jpj) :: zevap_ice_total 1682 1713 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top, ztsu 1714 REAL(wp), DIMENSION(jpi,jpj) :: ztri 1683 1715 !!---------------------------------------------------------------------- 1684 1716 ! … … 1700 1732 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1701 1733 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1702 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:)1703 1734 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1704 1735 zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) … … 1712 1743 1713 1744 #if defined key_si3 1745 1746 ! --- evaporation over ice (kg/m2/s) --- ! 1747 IF (ln_scale_ice_flux) THEN ! typically met-office requirements 1748 IF (sn_rcv_emp%clcat == 'yes') THEN 1749 WHERE( a_i(:,:,:) > 1.e-10 ) ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 1750 ELSEWHERE ; zevap_ice(:,:,:) = 0._wp 1751 END WHERE 1752 WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:) 1753 ELSEWHERE ; zevap_ice_total(:,:) = 0._wp 1754 END WHERE 1755 ELSE 1756 WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * SUM( a_i_last_couple, dim=3 ) / picefr(:,:) 1757 ELSEWHERE ; zevap_ice(:,:,1) = 0._wp 1758 END WHERE 1759 zevap_ice_total(:,:) = zevap_ice(:,:,1) 1760 DO jl = 2, jpl 1761 zevap_ice(:,:,jl) = zevap_ice(:,:,1) 1762 ENDDO 1763 ENDIF 1764 ELSE 1765 IF (sn_rcv_emp%clcat == 'yes') THEN 1766 zevap_ice(:,:,1:jpl) = frcv(jpr_ievp)%z3(:,:,1:jpl) 1767 WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:) 1768 ELSEWHERE ; zevap_ice_total(:,:) = 0._wp 1769 END WHERE 1770 ELSE 1771 zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) 1772 zevap_ice_total(:,:) = zevap_ice(:,:,1) 1773 DO jl = 2, jpl 1774 zevap_ice(:,:,jl) = zevap_ice(:,:,1) 1775 ENDDO 1776 ENDIF 1777 ENDIF 1778 1779 IF ( TRIM( sn_rcv_emp%cldes ) == 'conservative' ) THEN 1780 ! For conservative case zemp_ice has not been defined yet. Do it now. 1781 zemp_ice(:,:) = zevap_ice_total(:,:) * picefr(:,:) - frcv(jpr_snow)%z3(:,:,1) * picefr(:,:) 1782 ENDIF 1783 1714 1784 ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 1715 zsnw(:,:) = 0._wp ; CALL ice_ thd_snwblow( ziceld, zsnw )1785 zsnw(:,:) = 0._wp ; CALL ice_var_snwblow( ziceld, zsnw ) 1716 1786 1717 1787 ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! … … 1720 1790 1721 1791 ! --- evaporation over ocean (used later for qemp) --- ! 1722 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) 1723 1724 ! --- evaporation over ice (kg/m2/s) --- ! 1725 DO jl=1,jpl 1726 IF(sn_rcv_emp%clcat == 'yes') THEN ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 1727 ELSE ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 ) ; ENDIF 1728 ENDDO 1792 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) * picefr(:,:) 1729 1793 1730 1794 ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 … … 1804 1868 !! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff 1805 1869 !! IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1) ) ! iceshelf 1806 IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving1807 IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs1808 IF( iom_use('snowpre') ) CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow1809 IF( iom_use('precip') ) CALL iom_put( 'precip' , tprecip(:,:) ) ! total precipitation1810 IF( iom_use('rain') ) CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation1811 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average)1812 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average)1813 IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:) ) ! liquid precipitation over ocean (cell average)1814 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('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) &1816 & - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) )! ice-free oce evap (cell average)1870 IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving 1871 IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs 1872 IF( iom_use('snowpre') ) CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow 1873 IF( iom_use('precip') ) CALL iom_put( 'precip' , tprecip(:,:) ) ! total precipitation 1874 IF( iom_use('rain') ) CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation 1875 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1876 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1877 IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:) ) ! liquid precipitation over ocean (cell average) 1878 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) 1879 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & 1880 & - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1817 1881 ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 1818 1882 ! … … 1822 1886 CASE( 'oce only' ) ! the required field is directly provided 1823 1887 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1888 ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero 1889 ! here so the only flux is the ocean only one. 1890 zqns_ice(:,:,:) = 0._wp 1824 1891 CASE( 'conservative' ) ! the required fields are directly provided 1825 1892 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) … … 1839 1906 ENDDO 1840 1907 ELSE 1841 qns_tot(:,:) =qns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1908 zqns_tot(:,:) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1842 1909 DO jl = 1, jpl 1843 zqns_tot(:,: ) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1844 1910 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1845 1911 END DO … … 1852 1918 zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:,jl) & 1853 1919 & + frcv(jpr_dqnsdt)%z3(:,:,jl) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:) & 1854 & 1920 & + pist(:,:,jl) * picefr(:,:) ) ) 1855 1921 END DO 1856 1922 ELSE … … 1858 1924 zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:, 1) & 1859 1925 & + frcv(jpr_dqnsdt)%z3(:,:, 1) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:) & 1860 & 1926 & + pist(:,:,jl) * picefr(:,:) ) ) 1861 1927 END DO 1862 1928 ENDIF … … 1964 2030 CASE( 'oce only' ) 1965 2031 zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 2032 ! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero 2033 ! here so the only flux is the ocean only one. 2034 zqsr_ice(:,:,:) = 0._wp 1966 2035 CASE( 'conservative' ) 1967 2036 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) … … 1982 2051 END DO 1983 2052 ELSE 1984 qsr_tot(:,: ) =qsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)2053 zqsr_tot(:,:) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1985 2054 DO jl = 1, jpl 1986 zqsr_tot(:,: ) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1987 2055 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1988 2056 END DO … … 2050 2118 ENDDO 2051 2119 ENDIF 2120 CASE( 'none' ) 2121 zdqns_ice(:,:,:) = 0._wp 2052 2122 END SELECT 2053 2123 … … 2065 2135 ! ! ========================= ! 2066 2136 CASE ('coupled') 2067 IF( ln_mixcpl ) THEN 2068 DO jl=1,jpl 2069 qml_ice(:,:,jl) = qml_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_topm)%z3(:,:,jl) * zmsk(:,:) 2070 qcn_ice(:,:,jl) = qcn_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_botm)%z3(:,:,jl) * zmsk(:,:) 2071 ENDDO 2137 IF (ln_scale_ice_flux) THEN 2138 WHERE( a_i(:,:,:) > 1.e-10_wp ) 2139 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 2140 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 2141 ELSEWHERE 2142 qml_ice(:,:,:) = 0.0_wp 2143 qcn_ice(:,:,:) = 0.0_wp 2144 END WHERE 2072 2145 ELSE 2073 2146 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) … … 2080 2153 IF( .NOT.ln_cndflx ) THEN !== No conduction flux as surface forcing ==! 2081 2154 ! 2082 ! ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 2083 ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission when hi>10cm (Grenfell Maykut 77) 2084 ! 2085 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 2086 zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( ztri + ( 1._wp - ztri ) * ( 1._wp - phi(:,:,:) * 10._wp ) ) 2087 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (ztri) when hi>10cm 2088 zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ztri 2089 ELSEWHERE ! zero when hs>0 2090 zqtr_ice_top(:,:,:) = 0._wp 2091 END WHERE 2155 IF( nn_qtrice == 0 ) THEN 2156 ! formulation derived from Grenfell and Maykut (1977), where transmission rate 2157 ! 1) depends on cloudiness 2158 ! ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 2159 ! ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm. 2160 ! 2) is 0 when there is any snow 2161 ! 3) tends to 1 for thin ice 2162 ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:) ! surface transmission when hi>10cm 2163 DO jl = 1, jpl 2164 WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 2165 zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 2166 ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm 2167 zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ztri(:,:) 2168 ELSEWHERE ! zero when hs>0 2169 zqtr_ice_top(:,:,jl) = 0._wp 2170 END WHERE 2171 ENDDO 2172 ELSEIF( nn_qtrice == 1 ) THEN 2173 ! formulation is derived from the thesis of M. Lebrun (2019). 2174 ! It represents the best fit using several sets of observations 2175 ! It comes with snow conductivities adapted to freezing/melting conditions (see icethd_zdf_bl99.F90) 2176 zqtr_ice_top(:,:,:) = 0.3_wp * zqsr_ice(:,:,:) 2177 ENDIF 2092 2178 ! 2093 2179 ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==! 2094 2180 ! 2095 ! 2096 ! 2181 ! ! ===> here we must receive the qtr_ice_top array from the coupler 2182 ! for now just assume zero (fully opaque ice) 2097 2183 zqtr_ice_top(:,:,:) = 0._wp 2098 2184 ! … … 2151 2237 ! 2152 2238 isec = ( kt - nit000 ) * NINT( rn_Dt ) ! date of exchanges 2239 info = OASIS_idle 2153 2240 2154 2241 zfr_l(:,:) = 1.- fr_i(:,:) … … 2289 2376 ENDIF 2290 2377 2378 #if defined key_si3 || defined key_cice 2379 ! If this coupling was successful then save ice fraction for use between coupling points. 2380 ! This is needed for some calculations where the ice fraction at the last coupling point 2381 ! is needed. 2382 IF( info == OASIS_Sent .OR. info == OASIS_ToRest .OR. & 2383 & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN 2384 IF ( sn_snd_thick%clcat == 'yes' ) THEN 2385 a_i_last_couple(:,:,1:jpl) = a_i(:,:,1:jpl) 2386 ENDIF 2387 ENDIF 2388 #endif 2389 2291 2390 IF( ssnd(jps_fice1)%laction ) THEN 2292 2391 SELECT CASE( sn_snd_thick1%clcat ) … … 2352 2451 SELECT CASE( sn_snd_mpnd%clcat ) 2353 2452 CASE( 'yes' ) 2354 ztmp3(:,:,1:jpl) = a_ip_ frac(:,:,1:jpl)2453 ztmp3(:,:,1:jpl) = a_ip_eff(:,:,1:jpl) 2355 2454 ztmp4(:,:,1:jpl) = h_ip(:,:,1:jpl) 2356 2455 CASE( 'no' ) … … 2358 2457 ztmp4(:,:,:) = 0.0 2359 2458 DO jl=1,jpl 2360 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 2361 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 2459 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 2460 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 2362 2461 ENDDO 2363 2462 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' ) … … 2420 2519 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 2421 2520 CASE( 'oce only' ) ! C-grid ==> T 2422 DO_2D _00_002521 DO_2D( 0, 0, 0, 0 ) 2423 2522 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) ) 2424 2523 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji ,jj-1,1,Kmm) ) 2425 2524 END_2D 2426 2525 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2427 DO_2D _00_002526 DO_2D( 0, 0, 0, 0 ) 2428 2527 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) 2429 2528 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) … … 2431 2530 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2432 2531 END_2D 2433 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1. , zity1, 'T', -1.)2532 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2434 2533 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2435 DO_2D _00_002534 DO_2D( 0, 0, 0, 0 ) 2436 2535 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) & 2437 2536 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) … … 2440 2539 END_2D 2441 2540 END SELECT 2442 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1. , zoty1, ssnd(jps_ocy1)%clgrid, -1.)2541 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp ) 2443 2542 ! 2444 2543 ENDIF … … 2497 2596 SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 2498 2597 CASE( 'oce only' ) ! C-grid ==> T 2499 DO_2D _00_002598 DO_2D( 0, 0, 0, 0 ) 2500 2599 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) ) 2501 2600 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) ) 2502 2601 END_2D 2503 2602 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2504 DO_2D _00_002603 DO_2D( 0, 0, 0, 0 ) 2505 2604 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) 2506 2605 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) … … 2508 2607 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2509 2608 END_2D 2510 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1. , zity1, 'T', -1.)2609 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2511 2610 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2512 DO_2D _00_002611 DO_2D( 0, 0, 0, 0 ) 2513 2612 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) & 2514 2613 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) … … 2517 2616 END_2D 2518 2617 END SELECT 2519 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1. , zoty1, ssnd(jps_ocyw)%clgrid, -1.)2618 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp ) 2520 2619 ! 2521 2620 !
Note: See TracChangeset
for help on using the changeset viewer.
