- Timestamp:
- 2020-09-29T12:41:06+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/r12377_ticket2386
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/SBC/sbccpl.F90 (modified) (47 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r12377_ticket2386
- 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@13507 sette
-
- Property svn:externals
-
NEMO/branches/2020/r12377_ticket2386/src/OCE/SBC/sbccpl.F90
r12511 r13540 41 41 #endif 42 42 #if defined key_si3 43 USE ice thd_dh ! for CALL ice_thd_snwblow43 USE icevar ! for CALL ice_var_snwblow 44 44 #endif 45 45 ! … … 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 … … 152 156 INTEGER, PARAMETER :: jps_wlev = 32 ! water level 153 157 INTEGER, PARAMETER :: jps_fice1 = 33 ! first-order ice concentration (for semi-implicit coupling of atmos-ice fluxes) 154 INTEGER, PARAMETER :: jps_a_p = 34 ! meltpond area 158 INTEGER, PARAMETER :: jps_a_p = 34 ! meltpond area fraction 155 159 INTEGER, PARAMETER :: jps_ht_p = 35 ! meltpond thickness 156 160 INTEGER, PARAMETER :: jps_kice = 36 ! sea ice effective conductivity … … 159 163 160 164 INTEGER, PARAMETER :: jpsnd = 38 ! total number of fields sent 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 161 173 162 174 ! !!** namelist namsbc_cpl ** … … 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_flux ! use ice fluxes that are already "ice weighted" ( i.e. multiplied ice concentration) 199 186 200 TYPE :: DYNARR 187 201 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3 … … 191 205 192 206 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: alb_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 207 #if defined key_si3 || defined key_cice 208 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_last_couple !: Ice fractional area at last coupling time 209 #endif 193 210 194 211 REAL(wp) :: rpref = 101000._wp ! reference atmospheric pressure[N/m2] … … 199 216 !! Substitution 200 217 # include "do_loop_substitute.h90" 218 # include "domzgr_substitute.h90" 201 219 !!---------------------------------------------------------------------- 202 220 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 210 228 !! *** FUNCTION sbc_cpl_alloc *** 211 229 !!---------------------------------------------------------------------- 212 INTEGER :: ierr( 4)230 INTEGER :: ierr(5) 213 231 !!---------------------------------------------------------------------- 214 232 ierr(:) = 0 … … 220 238 #endif 221 239 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 222 ! 223 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) ) 240 #if defined key_si3 || defined key_cice 241 ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(4) ) 242 #endif 243 ! 244 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(5) ) 224 245 225 246 sbc_cpl_alloc = MAXVAL( ierr ) … … 248 269 REAL(wp), DIMENSION(jpi,jpj) :: zacs, zaos 249 270 !! 250 NAMELIST/namsbc_cpl/ sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2 , & 271 NAMELIST/namsbc_cpl/ nn_cplmodel , ln_usecplmask, nn_cats_cpl , ln_scale_ice_flux, & 272 & sn_snd_temp , sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2 , & 251 273 & sn_snd_ttilyr, sn_snd_cond , sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1, & 252 & sn_snd_ifrac , sn_snd_crtw , sn_snd_wlev , sn_rcv_hsig , sn_rcv_phioc ,&253 & sn_rcv_w10m , sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr ,&274 & sn_snd_ifrac , sn_snd_crtw , sn_snd_wlev , sn_rcv_hsig , sn_rcv_phioc , & 275 & sn_rcv_w10m , sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr , & 254 276 & sn_rcv_sdrfx , sn_rcv_sdrfy , sn_rcv_wper , sn_rcv_wnum , sn_rcv_tauwoc, & 255 & sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal ,&256 & sn_rcv_iceflx, sn_rcv_co2 , nn_cplmodel , ln_usecplmask, sn_rcv_mslp ,&257 & sn_rcv_icb , sn_rcv_isf , sn_rcv_wfreq , sn_rcv_tauw, nn_cats_cpl ,&277 & sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , & 278 & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_mslp , & 279 & sn_rcv_icb , sn_rcv_isf , sn_rcv_wfreq, sn_rcv_tauw , & 258 280 & sn_rcv_ts_ice 259 260 281 !!--------------------------------------------------------------------- 261 282 ! … … 277 298 ENDIF 278 299 IF( lwp .AND. ln_cpl ) THEN ! control print 300 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 301 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask 302 WRITE(numout,*)' ln_scale_ice_flux = ', ln_scale_ice_flux 303 WRITE(numout,*)' nn_cats_cpl = ', nn_cats_cpl 279 304 WRITE(numout,*)' received fields (mutiple ice categogies)' 280 305 WRITE(numout,*)' 10m wind module = ', TRIM(sn_rcv_w10m%cldes ), ' (', TRIM(sn_rcv_w10m%clcat ), ')' … … 325 350 WRITE(numout,*)' - orientation = ', sn_snd_crtw%clvor 326 351 WRITE(numout,*)' - mesh = ', sn_snd_crtw%clvgrd 327 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel328 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask329 WRITE(numout,*)' nn_cats_cpl = ', nn_cats_cpl330 352 ENDIF 331 353 … … 364 386 ! 365 387 ! Vectors: change of sign at north fold ONLY if on the local grid 366 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 388 IF( TRIM( sn_rcv_tau%cldes ) == 'oce only' .OR. TRIM( sn_rcv_tau%cldes ) == 'oce and ice' & 389 .OR. TRIM( sn_rcv_tau%cldes ) == 'mixed oce-ice' ) THEN ! avoid working with the atmospheric fields if they are not coupled 390 ! 367 391 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 368 392 … … 695 719 ! Change first letter to couple with atmosphere if already coupled OPA 696 720 ! this is nedeed as each variable name used in the namcouple must be unique: 697 ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere721 ! for example O_Runoff received by OPA from SAS and therefore S_Runoff received by SAS from the Atmosphere 698 722 DO jn = 1, jprcv 699 723 IF( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) … … 819 843 END SELECT 820 844 845 ! Initialise ice fractions from last coupling time to zero (needed by Met-Office) 846 #if defined key_si3 || defined key_cice 847 a_i_last_couple(:,:,:) = 0._wp 848 #endif 821 849 ! ! ------------------------- ! 822 850 ! ! Ice Meltponds ! … … 1036 1064 xcplmask(:,:,:) = 0. 1037 1065 CALL iom_open( 'cplmask', inum ) 1038 CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1: nlci,1:nlcj,1:nn_cplmodel), &1039 & kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) )1066 CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:jpi,1:jpj,1:nn_cplmodel), & 1067 & kstart = (/ mig(1),mjg(1),1 /), kcount = (/ jpi,jpj,nn_cplmodel /) ) 1040 1068 CALL iom_close( inum ) 1041 1069 ELSE … … 1107 1135 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 1108 1136 REAL(wp) :: zzx, zzy ! temporary variables 1109 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr 1137 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr, zcloud_fra 1110 1138 !!---------------------------------------------------------------------- 1111 1139 ! … … 1115 1143 IF( ln_dm2dc .AND. ncpl_qsr_freq /= 86400 ) & 1116 1144 & CALL ctl_stop( 'sbc_cpl_rcv: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' ) 1117 ncpl_qsr_freq = 86400 / ncpl_qsr_freq ! used by top 1145 1146 IF( ncpl_qsr_freq /= 0) ncpl_qsr_freq = 86400 / ncpl_qsr_freq ! used by top 1147 1118 1148 ENDIF 1119 1149 ! … … 1165 1195 ! 1166 1196 IF( srcv(jpr_otx1)%clgrid == 'T' ) THEN 1167 DO_2D _00_001197 DO_2D( 0, 0, 0, 0 ) ! T ==> (U,V) 1168 1198 frcv(jpr_otx1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_otx1)%z3(ji+1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) ) 1169 1199 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 1170 1200 END_2D 1171 CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U', -1. , frcv(jpr_oty1)%z3(:,:,1), 'V', -1.)1201 CALL lbc_lnk_multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U', -1.0_wp, frcv(jpr_oty1)%z3(:,:,1), 'V', -1.0_wp ) 1172 1202 ENDIF 1173 1203 llnewtx = .TRUE. … … 1189 1219 ! => need to be done only when otx1 was changed 1190 1220 IF( llnewtx ) THEN 1191 DO_2D _00_001221 DO_2D( 0, 0, 0, 0 ) 1192 1222 zzx = frcv(jpr_otx1)%z3(ji-1,jj ,1) + frcv(jpr_otx1)%z3(ji,jj,1) 1193 1223 zzy = frcv(jpr_oty1)%z3(ji ,jj-1,1) + frcv(jpr_oty1)%z3(ji,jj,1) 1194 1224 frcv(jpr_taum)%z3(ji,jj,1) = 0.5 * SQRT( zzx * zzx + zzy * zzy ) 1195 1225 END_2D 1196 CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1. )1226 CALL lbc_lnk( 'sbccpl', frcv(jpr_taum)%z3(:,:,1), 'T', 1.0_wp ) 1197 1227 llnewtau = .TRUE. 1198 1228 ELSE … … 1214 1244 IF( llnewtau ) THEN 1215 1245 zcoef = 1. / ( zrhoa * zcdrag ) 1216 DO_2D _11_111246 DO_2D( 1, 1, 1, 1 ) 1217 1247 frcv(jpr_w10m)%z3(ji,jj,1) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef ) 1218 1248 END_2D 1219 1249 ENDIF 1220 1250 ENDIF 1221 1251 !!$ ! ! ========================= ! 1252 !!$ SELECT CASE( TRIM( sn_rcv_clouds%cldes ) ) ! cloud fraction ! 1253 !!$ ! ! ========================= ! 1254 !!$ cloud_fra(:,:) = frcv(jpr_clfra)*z3(:,:,1) 1255 !!$ END SELECT 1256 !!$ 1257 zcloud_fra(:,:) = pp_cldf ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm. 1258 IF( ln_mixcpl ) THEN 1259 cloud_fra(:,:) = cloud_fra(:,:) * xcplmask(:,:,0) + zcloud_fra(:,:)* zmsk(:,:) 1260 ELSE 1261 cloud_fra(:,:) = zcloud_fra(:,:) 1262 ENDIF 1263 ! ! ========================= ! 1222 1264 ! u(v)tau and taum will be modified by ice model 1223 1265 ! -> need to be reset before each call of the ice/fsbc … … 1479 1521 INTEGER :: ji, jj ! dummy loop indices 1480 1522 INTEGER :: itx ! index of taux over ice 1523 REAL(wp) :: zztmp1, zztmp2 1481 1524 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty 1482 1525 !!---------------------------------------------------------------------- … … 1542 1585 p_taui(:,:) = frcv(jpr_itx1)%z3(:,:,1) ! (U,V) ==> (U,V) 1543 1586 p_tauj(:,:) = frcv(jpr_ity1)%z3(:,:,1) 1544 CASE( 'F' ) 1545 DO_2D_00_00 1546 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji,jj,1) + frcv(jpr_itx1)%z3(ji ,jj-1,1) ) 1547 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji,jj,1) + frcv(jpr_ity1)%z3(ji-1,jj ,1) ) 1587 CASE( 'T' ) 1588 DO_2D( 0, 0, 0, 0 ) ! T ==> (U,V) 1589 ! take care of the land-sea mask to avoid "pollution" of coastal stress. p[uv]taui used in frazil and rheology 1590 zztmp1 = 0.5_wp * ( 2. - umask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji+1,jj ,1) ) 1591 zztmp2 = 0.5_wp * ( 2. - vmask(ji,jj,1) ) * MAX( tmask(ji,jj,1),tmask(ji ,jj+1,1) ) 1592 p_taui(ji,jj) = zztmp1 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 1593 p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1548 1594 END_2D 1549 CASE( 'T' ) 1550 DO_2D_00_00 1551 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj ,1) + frcv(jpr_itx1)%z3(ji,jj,1) ) 1552 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1553 END_2D 1554 CASE( 'I' ) 1555 DO_2D_00_00 1556 p_taui(ji,jj) = 0.5 * ( frcv(jpr_itx1)%z3(ji+1,jj+1,1) + frcv(jpr_itx1)%z3(ji+1,jj ,1) ) 1557 p_tauj(ji,jj) = 0.5 * ( frcv(jpr_ity1)%z3(ji+1,jj+1,1) + frcv(jpr_ity1)%z3(ji ,jj+1,1) ) 1558 END_2D 1595 CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U', -1., p_tauj, 'V', -1. ) 1559 1596 END SELECT 1560 IF( srcv(jpr_itx1)%clgrid /= 'U' ) THEN1561 CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U', -1., p_tauj, 'V', -1. )1562 ENDIF1563 1597 1564 1598 ENDIF … … 1626 1660 ! 1627 1661 INTEGER :: ji, jj, jl ! dummy loop index 1628 REAL(wp) :: ztri ! local scalar1629 1662 REAL(wp), DIMENSION(jpi,jpj) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw 1630 1663 REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice 1631 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 1632 1666 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice, zqtr_ice_top, ztsu 1667 REAL(wp), DIMENSION(jpi,jpj) :: ztri 1633 1668 !!---------------------------------------------------------------------- 1634 1669 ! … … 1650 1685 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1651 1686 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1652 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:)1653 1687 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1654 1688 zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) … … 1662 1696 1663 1697 #if defined key_si3 1698 1699 ! --- evaporation over ice (kg/m2/s) --- ! 1700 IF (ln_scale_ice_flux) THEN ! typically met-office requirements 1701 IF (sn_rcv_emp%clcat == 'yes') THEN 1702 WHERE( a_i(:,:,:) > 1.e-10 ) ; zevap_ice(:,:,:) = frcv(jpr_ievp)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 1703 ELSEWHERE ; zevap_ice(:,:,:) = 0._wp 1704 END WHERE 1705 WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:) 1706 ELSEWHERE ; zevap_ice_total(:,:) = 0._wp 1707 END WHERE 1708 ELSE 1709 WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) * SUM( a_i_last_couple, dim=3 ) / picefr(:,:) 1710 ELSEWHERE ; zevap_ice(:,:,1) = 0._wp 1711 END WHERE 1712 zevap_ice_total(:,:) = zevap_ice(:,:,1) 1713 DO jl = 2, jpl 1714 zevap_ice(:,:,jl) = zevap_ice(:,:,1) 1715 ENDDO 1716 ENDIF 1717 ELSE 1718 IF (sn_rcv_emp%clcat == 'yes') THEN 1719 zevap_ice(:,:,1:jpl) = frcv(jpr_ievp)%z3(:,:,1:jpl) 1720 WHERE( picefr(:,:) > 1.e-10 ) ; zevap_ice_total(:,:) = SUM( zevap_ice(:,:,:) * a_i(:,:,:), dim=3 ) / picefr(:,:) 1721 ELSEWHERE ; zevap_ice_total(:,:) = 0._wp 1722 END WHERE 1723 ELSE 1724 zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) 1725 zevap_ice_total(:,:) = zevap_ice(:,:,1) 1726 DO jl = 2, jpl 1727 zevap_ice(:,:,jl) = zevap_ice(:,:,1) 1728 ENDDO 1729 ENDIF 1730 ENDIF 1731 1732 IF ( TRIM( sn_rcv_emp%cldes ) == 'conservative' ) THEN 1733 ! For conservative case zemp_ice has not been defined yet. Do it now. 1734 zemp_ice(:,:) = zevap_ice_total(:,:) * picefr(:,:) - frcv(jpr_snow)%z3(:,:,1) * picefr(:,:) 1735 ENDIF 1736 1664 1737 ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 1665 zsnw(:,:) = 0._wp ; CALL ice_ thd_snwblow( ziceld, zsnw )1738 zsnw(:,:) = 0._wp ; CALL ice_var_snwblow( ziceld, zsnw ) 1666 1739 1667 1740 ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! … … 1670 1743 1671 1744 ! --- evaporation over ocean (used later for qemp) --- ! 1672 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) 1673 1674 ! --- evaporation over ice (kg/m2/s) --- ! 1675 DO jl=1,jpl 1676 IF(sn_rcv_emp%clcat == 'yes') THEN ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 1677 ELSE ; zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 ) ; ENDIF 1678 ENDDO 1745 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - zevap_ice_total(:,:) * picefr(:,:) 1679 1746 1680 1747 ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 … … 1754 1821 !! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff 1755 1822 !! IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1) ) ! iceshelf 1756 IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving1757 IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs1758 IF( iom_use('snowpre') ) CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow1759 IF( iom_use('precip') ) CALL iom_put( 'precip' , tprecip(:,:) ) ! total precipitation1760 IF( iom_use('rain') ) CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation1761 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average)1762 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average)1763 IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:) ) ! liquid precipitation over ocean (cell average)1764 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)1765 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) &1766 & - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) )! ice-free oce evap (cell average)1823 IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving 1824 IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs 1825 IF( iom_use('snowpre') ) CALL iom_put( 'snowpre' , sprecip(:,:) ) ! Snow 1826 IF( iom_use('precip') ) CALL iom_put( 'precip' , tprecip(:,:) ) ! total precipitation 1827 IF( iom_use('rain') ) CALL iom_put( 'rain' , tprecip(:,:) - sprecip(:,:) ) ! liquid precipitation 1828 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1829 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1830 IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:) ) ! liquid precipitation over ocean (cell average) 1831 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) 1832 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & 1833 & - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1767 1834 ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 1768 1835 ! … … 1772 1839 CASE( 'oce only' ) ! the required field is directly provided 1773 1840 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1841 ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero 1842 ! here so the only flux is the ocean only one. 1843 zqns_ice(:,:,:) = 0._wp 1774 1844 CASE( 'conservative' ) ! the required fields are directly provided 1775 1845 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) … … 1789 1859 ENDDO 1790 1860 ELSE 1791 qns_tot(:,:) =qns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1861 zqns_tot(:,:) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1792 1862 DO jl = 1, jpl 1793 zqns_tot(:,: ) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1794 1863 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1795 1864 END DO … … 1802 1871 zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:,jl) & 1803 1872 & + frcv(jpr_dqnsdt)%z3(:,:,jl) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:) & 1804 & 1873 & + pist(:,:,jl) * picefr(:,:) ) ) 1805 1874 END DO 1806 1875 ELSE … … 1808 1877 zqns_ice(:,:,jl) = frcv(jpr_qnsmix)%z3(:,:, 1) & 1809 1878 & + frcv(jpr_dqnsdt)%z3(:,:, 1) * ( pist(:,:,jl) - ( ( rt0 + psst(:,:) ) * ziceld(:,:) & 1810 & 1879 & + pist(:,:,jl) * picefr(:,:) ) ) 1811 1880 END DO 1812 1881 ENDIF … … 1914 1983 CASE( 'oce only' ) 1915 1984 zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 1985 ! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero 1986 ! here so the only flux is the ocean only one. 1987 zqsr_ice(:,:,:) = 0._wp 1916 1988 CASE( 'conservative' ) 1917 1989 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) … … 1932 2004 END DO 1933 2005 ELSE 1934 qsr_tot(:,: ) =qsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)2006 zqsr_tot(:,:) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1935 2007 DO jl = 1, jpl 1936 zqsr_tot(:,: ) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1937 2008 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1938 2009 END DO … … 2000 2071 ENDDO 2001 2072 ENDIF 2073 CASE( 'none' ) 2074 zdqns_ice(:,:,:) = 0._wp 2002 2075 END SELECT 2003 2076 … … 2015 2088 ! ! ========================= ! 2016 2089 CASE ('coupled') 2017 IF( ln_mixcpl ) THEN 2018 DO jl=1,jpl 2019 qml_ice(:,:,jl) = qml_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_topm)%z3(:,:,jl) * zmsk(:,:) 2020 qcn_ice(:,:,jl) = qcn_ice(:,:,jl) * xcplmask(:,:,0) + frcv(jpr_botm)%z3(:,:,jl) * zmsk(:,:) 2021 ENDDO 2090 IF (ln_scale_ice_flux) THEN 2091 WHERE( a_i(:,:,:) > 1.e-10_wp ) 2092 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 2093 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 2094 ELSEWHERE 2095 qml_ice(:,:,:) = 0.0_wp 2096 qcn_ice(:,:,:) = 0.0_wp 2097 END WHERE 2022 2098 ELSE 2023 2099 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) … … 2030 2106 IF( .NOT.ln_cndflx ) THEN !== No conduction flux as surface forcing ==! 2031 2107 ! 2032 ! ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 2033 ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission when hi>10cm (Grenfell Maykut 77) 2034 ! 2035 WHERE ( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 2036 zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ( ztri + ( 1._wp - ztri ) * ( 1._wp - phi(:,:,:) * 10._wp ) ) 2037 ELSEWHERE( phs(:,:,:) <= 0._wp .AND. phi(:,:,:) >= 0.1_wp ) ! constant (ztri) when hi>10cm 2038 zqtr_ice_top(:,:,:) = qsr_ice(:,:,:) * ztri 2039 ELSEWHERE ! zero when hs>0 2040 zqtr_ice_top(:,:,:) = 0._wp 2041 END WHERE 2108 IF( nn_qtrice == 0 ) THEN 2109 ! formulation derived from Grenfell and Maykut (1977), where transmission rate 2110 ! 1) depends on cloudiness 2111 ! ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 2112 ! ! should be real cloud fraction instead (as in the bulk) but needs to be read from atm. 2113 ! 2) is 0 when there is any snow 2114 ! 3) tends to 1 for thin ice 2115 ztri(:,:) = 0.18 * ( 1.0 - cloud_fra(:,:) ) + 0.35 * cloud_fra(:,:) ! surface transmission when hi>10cm 2116 DO jl = 1, jpl 2117 WHERE ( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) < 0.1_wp ) ! linear decrease from hi=0 to 10cm 2118 zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ( ztri(:,:) + ( 1._wp - ztri(:,:) ) * ( 1._wp - phi(:,:,jl) * 10._wp ) ) 2119 ELSEWHERE( phs(:,:,jl) <= 0._wp .AND. phi(:,:,jl) >= 0.1_wp ) ! constant (ztri) when hi>10cm 2120 zqtr_ice_top(:,:,jl) = zqsr_ice(:,:,jl) * ztri(:,:) 2121 ELSEWHERE ! zero when hs>0 2122 zqtr_ice_top(:,:,jl) = 0._wp 2123 END WHERE 2124 ENDDO 2125 ELSEIF( nn_qtrice == 1 ) THEN 2126 ! formulation is derived from the thesis of M. Lebrun (2019). 2127 ! It represents the best fit using several sets of observations 2128 ! It comes with snow conductivities adapted to freezing/melting conditions (see icethd_zdf_bl99.F90) 2129 zqtr_ice_top(:,:,:) = 0.3_wp * zqsr_ice(:,:,:) 2130 ENDIF 2042 2131 ! 2043 2132 ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==! 2044 2133 ! 2045 ! 2046 ! 2134 ! ! ===> here we must receive the qtr_ice_top array from the coupler 2135 ! for now just assume zero (fully opaque ice) 2047 2136 zqtr_ice_top(:,:,:) = 0._wp 2048 2137 ! … … 2101 2190 ! 2102 2191 isec = ( kt - nit000 ) * NINT( rn_Dt ) ! date of exchanges 2192 info = OASIS_idle 2103 2193 2104 2194 zfr_l(:,:) = 1.- fr_i(:,:) … … 2239 2329 ENDIF 2240 2330 2331 #if defined key_si3 || defined key_cice 2332 ! If this coupling was successful then save ice fraction for use between coupling points. 2333 ! This is needed for some calculations where the ice fraction at the last coupling point 2334 ! is needed. 2335 IF( info == OASIS_Sent .OR. info == OASIS_ToRest .OR. & 2336 & info == OASIS_SentOut .OR. info == OASIS_ToRestOut ) THEN 2337 IF ( sn_snd_thick%clcat == 'yes' ) THEN 2338 a_i_last_couple(:,:,1:jpl) = a_i(:,:,1:jpl) 2339 ENDIF 2340 ENDIF 2341 #endif 2342 2241 2343 IF( ssnd(jps_fice1)%laction ) THEN 2242 2344 SELECT CASE( sn_snd_thick1%clcat ) … … 2302 2404 SELECT CASE( sn_snd_mpnd%clcat ) 2303 2405 CASE( 'yes' ) 2304 ztmp3(:,:,1:jpl) = a_ip_ frac(:,:,1:jpl)2406 ztmp3(:,:,1:jpl) = a_ip_eff(:,:,1:jpl) 2305 2407 ztmp4(:,:,1:jpl) = h_ip(:,:,1:jpl) 2306 2408 CASE( 'no' ) … … 2308 2410 ztmp4(:,:,:) = 0.0 2309 2411 DO jl=1,jpl 2310 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 2311 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 2412 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip_frac(:,:,jpl) 2413 ztmp4(:,:,1) = ztmp4(:,:,1) + h_ip(:,:,jpl) 2312 2414 ENDDO 2313 2415 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_mpnd%clcat' ) … … 2370 2472 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 2371 2473 CASE( 'oce only' ) ! C-grid ==> T 2372 DO_2D _00_002474 DO_2D( 0, 0, 0, 0 ) 2373 2475 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) ) 2374 2476 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji ,jj-1,1,Kmm) ) 2375 2477 END_2D 2376 2478 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2377 DO_2D _00_002479 DO_2D( 0, 0, 0, 0 ) 2378 2480 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) 2379 2481 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) … … 2381 2483 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2382 2484 END_2D 2383 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1. , zity1, 'T', -1.)2485 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2384 2486 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2385 DO_2D _00_002487 DO_2D( 0, 0, 0, 0 ) 2386 2488 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) & 2387 2489 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) … … 2390 2492 END_2D 2391 2493 END SELECT 2392 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1. , zoty1, ssnd(jps_ocy1)%clgrid, -1.)2494 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp ) 2393 2495 ! 2394 2496 ENDIF … … 2447 2549 SELECT CASE( TRIM( sn_snd_crtw%cldes ) ) 2448 2550 CASE( 'oce only' ) ! C-grid ==> T 2449 DO_2D _00_002551 DO_2D( 0, 0, 0, 0 ) 2450 2552 zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) ) 2451 2553 zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) ) 2452 2554 END_2D 2453 2555 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2454 DO_2D _00_002556 DO_2D( 0, 0, 0, 0 ) 2455 2557 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) 2456 2558 zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) … … 2458 2560 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2459 2561 END_2D 2460 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1. , zity1, 'T', -1.)2562 CALL lbc_lnk_multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2461 2563 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2462 DO_2D _00_002564 DO_2D( 0, 0, 0, 0 ) 2463 2565 zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) & 2464 2566 & + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj) … … 2467 2569 END_2D 2468 2570 END SELECT 2469 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1. , zoty1, ssnd(jps_ocyw)%clgrid, -1.)2571 CALL lbc_lnk_multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp ) 2470 2572 ! 2471 2573 !
Note: See TracChangeset
for help on using the changeset viewer.
