- Timestamp:
- 2017-12-01T14:53:57+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r8126_LIM3_couple/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r8878 r8879 29 29 USE ice ! ice variables 30 30 #endif 31 #if defined key_lim232 USE par_ice_2 ! ice parameters33 USE ice_2 ! ice variables34 #endif35 31 USE cpl_oasis3 ! OASIS3 coupling 36 32 USE geo2ocean ! 37 33 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 38 USE albedo!34 USE ocealb ! 39 35 USE eosbn2 ! 40 36 USE sbcrnf, ONLY : l_rnfcpl … … 44 40 #endif 45 41 #if defined key_lim3 46 USE limthd_dh ! for CALL lim_thd_snwblow42 USE icethd_dh ! for CALL ice_thd_snwblow 47 43 #endif 48 44 ! … … 58 54 59 55 PUBLIC sbc_cpl_init ! routine called by sbcmod.F90 60 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F9056 PUBLIC sbc_cpl_rcv ! routine called by icestp.F90 61 57 PUBLIC sbc_cpl_snd ! routine called by step.F90 62 PUBLIC sbc_cpl_ice_tau ! routine called by sbc_ice_lim(_2).F9063 PUBLIC sbc_cpl_ice_flx ! routine called by sbc_ice_lim(_2).F9058 PUBLIC sbc_cpl_ice_tau ! routine called by icestp.F90 59 PUBLIC sbc_cpl_ice_flx ! routine called by icestp.F90 64 60 PUBLIC sbc_cpl_alloc ! routine called in sbcice_cice.F90 65 61 … … 117 113 INTEGER, PARAMETER :: jpr_isf = 52 118 114 INTEGER, PARAMETER :: jpr_icb = 53 119 120 INTEGER, PARAMETER :: jprcv = 53 ! total number of fields received 115 INTEGER, PARAMETER :: jpr_ts_ice = 54 ! Sea ice surface temp 116 INTEGER, PARAMETER :: jpr_rcv = 55 117 118 INTEGER, PARAMETER :: jprcv = 55 ! total number of fields received 121 119 122 120 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere … … 152 150 INTEGER, PARAMETER :: jps_ocyw = 31 ! currents on grid 2 153 151 INTEGER, PARAMETER :: jps_wlev = 32 ! water level 154 INTEGER, PARAMETER :: jpsnd = 32 ! total number of fields sent 152 INTEGER, PARAMETER :: jps_fice1 = 33 ! first-order ice concentration (for semi-implicit coupling of atmos-ice fluxes) 153 INTEGER, PARAMETER :: jps_a_p = 34 ! meltpond area 154 INTEGER, PARAMETER :: jps_ht_p = 35 ! meltpond thickness 155 INTEGER, PARAMETER :: jps_kice = 36 ! sea ice effective conductivity 156 INTEGER, PARAMETER :: jps_sstfrz = 37 ! sea surface freezing temperature 157 INTEGER, PARAMETER :: jps_ttilyr = 38 ! sea ice top layer temp 158 INTEGER, PARAMETER :: jpsnd = 38 ! total number of fields sent 159 160 INTEGER :: nn_cats_cpl ! number of sea ice categories over which the coupling is carried out 155 161 156 162 ! !!** namelist namsbc_cpl ** … … 163 169 END TYPE FLD_C 164 170 ! ! Send to the atmosphere 165 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 171 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2, sn_snd_thick1, sn_snd_cond, sn_snd_mpnd, sn_snd_sstfrz, sn_snd_ttilyr 166 172 ! ! Received from the atmosphere 167 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 173 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, sn_rcv_ts_ice 168 174 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_mslp, sn_rcv_icb, sn_rcv_isf 169 175 ! Send to waves … … 181 187 TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere 182 188 183 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: alb edo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky)189 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: alb_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 184 190 185 191 REAL(wp) :: rpref = 101000._wp ! reference atmospheric pressure[N/m2] … … 205 211 ierr(:) = 0 206 212 ! 207 ALLOCATE( alb edo_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) )213 ALLOCATE( alb_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) ) 208 214 209 #if ! defined key_lim3 && ! defined key_ lim2 && ! defined key_cice215 #if ! defined key_lim3 && ! defined key_cice 210 216 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 211 217 #endif … … 242 248 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos 243 249 !! 250 LOGICAL :: ln_iceshelf_init_atmos 244 251 NAMELIST/namsbc_cpl/ sn_snd_temp , sn_snd_alb , sn_snd_thick , sn_snd_crt , sn_snd_co2, & 245 252 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 253 & sn_snd_thick1, sn_snd_cond, sn_snd_mpnd, sn_snd_sstfrz , sn_rcv_ts_ice, sn_snd_ttilyr, & 246 254 & sn_snd_ifrac, sn_snd_crtw , sn_snd_wlev , sn_rcv_hsig , sn_rcv_phioc , & 247 255 & sn_rcv_sdrfx, sn_rcv_sdrfy, sn_rcv_wper , sn_rcv_wnum , sn_rcv_wstrf , & 248 256 & sn_rcv_wdrag, sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , & 249 257 & sn_rcv_iceflx,sn_rcv_co2 , nn_cplmodel , ln_usecplmask, sn_rcv_mslp , & 250 & sn_rcv_icb , sn_rcv_isf 258 & sn_rcv_icb , sn_rcv_isf, ln_iceshelf_init_atmos, nn_cats_cpl 251 259 252 260 !!--------------------------------------------------------------------- … … 274 282 WRITE(numout,*)'~~~~~~~~~~~~' 275 283 ENDIF 284 285 !!!!! Getting NEMO4-LIM working at the Met Office: Hardcode number of ice cats to 5 during the initialisation 286 jpl = nn_cats_cpl 287 !!!!! 288 276 289 IF( lwp .AND. ln_cpl ) THEN ! control print 277 290 WRITE(numout,*)' received fields (mutiple ice categogies)' … … 300 313 WRITE(numout,*)' Stress frac adsorbed by waves = ', TRIM(sn_rcv_wstrf%cldes ), ' (', TRIM(sn_rcv_wstrf%clcat ), ')' 301 314 WRITE(numout,*)' Neutral surf drag coefficient = ', TRIM(sn_rcv_wdrag%cldes ), ' (', TRIM(sn_rcv_wdrag%clcat ), ')' 315 WRITE(numout,*)' Sea ice surface skin temperature = ', TRIM(sn_rcv_ts_ice%cldes ), ' (', TRIM(sn_rcv_ts_ice%clcat ), ')' 302 316 WRITE(numout,*)' sent fields (multiple ice categories)' 303 317 WRITE(numout,*)' surface temperature = ', TRIM(sn_snd_temp%cldes ), ' (', TRIM(sn_snd_temp%clcat ), ')' 318 WRITE(numout,*)' top ice layer temperature = ', TRIM(sn_snd_ttilyr%cldes ), ' (', TRIM(sn_snd_ttilyr%clcat ), ')' 304 319 WRITE(numout,*)' albedo = ', TRIM(sn_snd_alb%cldes ), ' (', TRIM(sn_snd_alb%clcat ), ')' 305 320 WRITE(numout,*)' ice/snow thickness = ', TRIM(sn_snd_thick%cldes ), ' (', TRIM(sn_snd_thick%clcat ), ')' … … 310 325 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 311 326 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 327 WRITE(numout,*)' ice effective conductivity = ', TRIM(sn_snd_cond%cldes ), ' (', TRIM(sn_snd_cond%clcat ), ')' 328 WRITE(numout,*)' meltponds fraction and depth = ', TRIM(sn_snd_mpnd%cldes ), ' (', TRIM(sn_snd_mpnd%clcat ), ')' 329 WRITE(numout,*)' sea surface freezing temp = ', TRIM(sn_snd_sstfrz%cldes ), ' (', TRIM(sn_snd_sstfrz%clcat ), ')' 312 330 WRITE(numout,*)' water level = ', TRIM(sn_snd_wlev%cldes ), ' (', TRIM(sn_snd_wlev%clcat ), ')' 313 331 WRITE(numout,*)' mean sea level pressure = ', TRIM(sn_rcv_mslp%cldes ), ' (', TRIM(sn_rcv_mslp%clcat ), ')' … … 318 336 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 319 337 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask 338 WRITE(numout,*)' nn_cats_cpl = ', nn_cats_cpl 320 339 ENDIF 321 340 … … 511 530 ! 512 531 ! non solar sensitivity mandatory for LIM ice model 513 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4 .AND. nn_components /= jp_iam_sas ) & 514 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 532 533 IF (.NOT. ln_meto_cpl) THEN 534 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 3 .AND. nn_components /= jp_iam_sas) & 535 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 536 ENDIF 537 515 538 ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique 516 539 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. TRIM( sn_rcv_qns%cldes ) == 'mixed oce-ice' ) & … … 557 580 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 558 581 ENDIF 582 ! ! ----------------------------- ! 583 584 !!!!! To get NEMO4-LIM working at Met Office 585 srcv(jpr_ts_ice)%clname = 'OTsfIce' 586 IF ( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' ) srcv(jpr_ts_ice)%laction = .TRUE. 587 IF ( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' ) srcv(jpr_ts_ice)%nct = jpl 588 IF ( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = jpl 589 !!!!! 590 559 591 ! ! ------------------------- ! 560 592 ! ! Wave breaking ! … … 719 751 ssnd(jps_toce)%clname = 'O_SSTSST' 720 752 ssnd(jps_tice)%clname = 'O_TepIce' 753 ssnd(jps_ttilyr)%clname = 'O_TtiLyr' 721 754 ssnd(jps_tmix)%clname = 'O_TepMix' 722 755 SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 723 756 CASE( 'none' ) ! nothing to do 724 757 CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE. 725 CASE( 'oce and ice' , 'weighted oce and ice' )758 CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice') 726 759 ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 727 760 IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl … … 746 779 ! 2. receiving mixed oce-ice solar radiation 747 780 IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 748 CALL albedo_oce( zaos, zacs )781 CALL oce_alb( zaos, zacs ) 749 782 ! Due to lack of information on nebulosity : mean clear/overcast sky 750 alb edo_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5783 alb_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5 751 784 ENDIF 752 785 … … 757 790 ssnd(jps_ficet)%clname = 'OIceFrcT' 758 791 ssnd(jps_hice)%clname = 'OIceTck' 792 ssnd(jps_a_p)%clname = 'OPndFrc' 793 ssnd(jps_ht_p)%clname = 'OPndTck' 759 794 ssnd(jps_hsnw)%clname = 'OSnwTck' 795 ssnd(jps_fice1)%clname = 'OIceFrd' 760 796 IF( k_ice /= 0 ) THEN 761 797 ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case) 798 ssnd(jps_fice1)%laction = .TRUE. ! First-order regridded ice concentration, to be used 799 ! producing atmos-to-ice fluxes 762 800 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 763 801 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 802 IF ( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = jpl 764 803 ENDIF 765 804 … … 779 818 END SELECT 780 819 820 ! ! ------------------------- ! 821 ! ! Ice Meltponds ! 822 ! ! ------------------------- ! 823 824 825 !!!!! Getting NEMO4-LIM to work at Met Office 826 ssnd(jps_a_p)%clname = 'OPndFrc' 827 ssnd(jps_ht_p)%clname = 'OPndTck' 828 SELECT CASE ( TRIM( sn_snd_mpnd%cldes ) ) 829 CASE ( 'none' ) 830 ssnd(jps_a_p)%laction = .FALSE. 831 ssnd(jps_ht_p)%laction = .FALSE. 832 CASE ( 'ice only' ) 833 ssnd(jps_a_p)%laction = .TRUE. 834 ssnd(jps_ht_p)%laction = .TRUE. 835 IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 836 ssnd(jps_a_p)%nct = jpl 837 ssnd(jps_ht_p)%nct = jpl 838 ELSE 839 IF ( jpl > 1 ) THEN 840 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 841 ENDIF 842 ENDIF 843 CASE ( 'weighted ice' ) 844 ssnd(jps_a_p)%laction = .TRUE. 845 ssnd(jps_ht_p)%laction = .TRUE. 846 IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 847 ssnd(jps_a_p)%nct = jpl 848 ssnd(jps_ht_p)%nct = jpl 849 ENDIF 850 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_mpnd%cldes; '//sn_snd_mpnd%cldes ) 851 END SELECT 852 !!!!! 853 781 854 ! ! ------------------------- ! 782 855 ! ! Surface current ! … … 828 901 ! ! ------------------------- ! 829 902 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 830 903 ! 904 905 !!!!! Getting NEMO4-LIM to work at the Met Office 906 ! ! ------------------------- ! 907 ! ! Sea surface freezing temp ! 908 ! ! ------------------------- ! 909 ssnd(jps_sstfrz)%clname = 'O_SSTFrz' ; IF( TRIM(sn_snd_sstfrz%cldes) == 'coupled' ) ssnd(jps_sstfrz)%laction = .TRUE. 910 !!!!! 911 912 ! 913 ! ! ------------------------- ! 914 ! ! Ice conductivity ! 915 ! ! ------------------------- ! 916 ! Note that ultimately we will move to passing an ocean effective conductivity as well so there 917 ! will be some changes to the parts of the code which currently relate only to ice conductivity 918 919 ssnd(jps_ttilyr )%clname = 'O_TtiLyr' 920 SELECT CASE ( TRIM( sn_snd_ttilyr%cldes ) ) 921 CASE ( 'none' ) 922 ssnd(jps_ttilyr)%laction = .FALSE. 923 CASE ( 'ice only' ) 924 ssnd(jps_ttilyr)%laction = .TRUE. 925 IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN 926 ssnd(jps_ttilyr)%nct = jpl 927 ELSE 928 IF ( jpl > 1 ) THEN 929 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' ) 930 ENDIF 931 ENDIF 932 CASE ( 'weighted ice' ) 933 ssnd(jps_ttilyr)%laction = .TRUE. 934 IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = jpl 935 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes ) 936 END SELECT 937 938 ssnd(jps_kice )%clname = 'OIceKn' 939 SELECT CASE ( TRIM( sn_snd_cond%cldes ) ) 940 CASE ( 'none' ) 941 ssnd(jps_kice)%laction = .FALSE. 942 CASE ( 'ice only' ) 943 ssnd(jps_kice)%laction = .TRUE. 944 IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 945 ssnd(jps_kice)%nct = jpl 946 ELSE 947 IF ( jpl > 1 ) THEN 948 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 949 ENDIF 950 ENDIF 951 CASE ( 'weighted ice' ) 952 ssnd(jps_kice)%laction = .TRUE. 953 IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = jpl 954 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes ) 955 END SELECT 956 ! 957 831 958 ! ! ------------------------- ! 832 959 ! ! Sea surface height ! … … 1161 1288 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 1162 1289 ! 1290 1291 !!!!! Getting NEMO4-LIM to work at the Met Office 1292 ! ! Sea ice surface skin temp: 1293 IF( srcv(jpr_ts_ice)%laction ) THEN 1294 DO jn = 1, jpl 1295 DO jj = 1, jpj 1296 DO ji = 1, jpi 1297 IF (frcv(jpr_ts_ice)%z3(ji,jj,jn) > 0.0) THEN 1298 tsfc_ice(ji,jj,jn) = 0.0 1299 ELSE IF (frcv(jpr_ts_ice)%z3(ji,jj,jn) < -60.0) THEN 1300 tsfc_ice(ji,jj,jn) = -60.0 1301 ELSE 1302 tsfc_ice(ji,jj,jn) = frcv(jpr_ts_ice)%z3(ji,jj,jn) 1303 ENDIF 1304 END DO 1305 END DO 1306 END DO 1307 ENDIF 1308 !!!!! 1309 1310 1163 1311 ! ! ========================= ! 1164 1312 ! ! Mean Sea Level Pressure ! (taum) … … 1248 1396 IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1249 1397 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 1250 ub (:,:,1) = ssu_m(:,:) ! will be used in sbcice_limin the call of lim_sbc_tau1398 ub (:,:,1) = ssu_m(:,:) ! will be used in icestp in the call of lim_sbc_tau 1251 1399 un (:,:,1) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1252 1400 CALL iom_put( 'ssu_m', ssu_m ) … … 1254 1402 IF( srcv(jpr_ocy1)%laction ) THEN 1255 1403 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 1256 vb (:,:,1) = ssv_m(:,:) ! will be used in sbcice_limin the call of lim_sbc_tau1404 vb (:,:,1) = ssv_m(:,:) ! will be used in icestp in the call of lim_sbc_tau 1257 1405 vn (:,:,1) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1258 1406 CALL iom_put( 'ssv_m', ssv_m ) … … 1558 1706 1559 1707 1560 SUBROUTINE sbc_cpl_ice_flx( p _frld, palbi, psst, pist)1708 SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist, phs, phi ) 1561 1709 !!---------------------------------------------------------------------- 1562 1710 !! *** ROUTINE sbc_cpl_ice_flx *** … … 1591 1739 !! 1592 1740 !! ** Details 1593 !! qns_tot = pfrld * qns_oce + ( 1 - pfrld ) * qns_ice=> provided1741 !! qns_tot = (1-a) * qns_oce + a * qns_ice => provided 1594 1742 !! + qemp_oce + qemp_ice => recalculated and added up to qns 1595 1743 !! 1596 !! qsr_tot = pfrld * qsr_oce + ( 1 - pfrld ) * qsr_ice=> provided1744 !! qsr_tot = (1-a) * qsr_oce + a * qsr_ice => provided 1597 1745 !! 1598 1746 !! emp_tot = emp_oce + emp_ice => calving is provided and added to emp_tot (and emp_oce). … … 1608 1756 !! sprecip solid precipitation over the ocean 1609 1757 !!---------------------------------------------------------------------- 1610 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! leadfraction [0 to 1]1758 REAL(wp), INTENT(in), DIMENSION(:,:) :: picefr ! ice fraction [0 to 1] 1611 1759 ! optional arguments, used only in 'mixed oce-ice' case 1612 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1613 REAL(wp), INTENT(in ), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1614 REAL(wp), INTENT(in ), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1615 ! 1616 INTEGER :: jl ! dummy loop index 1617 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw 1618 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice 1760 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1761 REAL(wp), INTENT(in), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1762 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1763 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: phs ! snow depth [m] 1764 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: phi ! ice thickness [m] 1765 ! 1766 INTEGER :: ji,jj,jl ! dummy loop index 1767 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw 1768 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zdevap_ice 1619 1769 REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1620 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice 1770 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zfrqsr_tr_i, zevap_ice 1621 1771 !!---------------------------------------------------------------------- 1622 1772 ! 1623 1773 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1624 1774 ! 1625 CALL wrk_alloc( jpi,jpj, zcptn, zcptrain, zcptsnw, zice fr, zmsk, zsnw )1626 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, z evap_ice, zdevap_ice )1775 CALL wrk_alloc( jpi,jpj, zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw ) 1776 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zdevap_ice ) 1627 1777 CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1628 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 1778 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zfrqsr_tr_i ) 1779 1780 IF (sn_rcv_emp%clcat == 'yes') THEN 1781 CALL wrk_alloc( jpi, jpj, jpl, zevap_ice) 1782 ELSE 1783 CALL wrk_alloc( jpi, jpj, 1, zevap_ice) 1784 ENDIF 1629 1785 1630 1786 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 1631 zice fr(:,:) = 1.- p_frld(:,:)1787 ziceld(:,:) = 1. - picefr(:,:) 1632 1788 zcptn(:,:) = rcp * sst_m(:,:) 1633 1789 ! … … 1645 1801 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1646 1802 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1647 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:)1803 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:) 1648 1804 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1649 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)1650 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:)1805 zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1806 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * picefr(:,:) 1651 1807 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1652 1808 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) … … 1654 1810 1655 1811 #if defined key_lim3 1656 ! zsnw = snow fraction over ice after wind blowing (= zicefr if no blowing)1657 zsnw(:,:) = 0._wp ; CALL lim_thd_snwblow( p_frld, zsnw )1812 ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 1813 zsnw(:,:) = 0._wp ; CALL ice_thd_snwblow( ziceld, zsnw ) 1658 1814 1659 1815 ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! 1660 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( zicefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip1816 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( picefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip 1661 1817 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) ! emp_oce = emp_tot - emp_ice 1662 1818 1663 1819 ! --- evaporation over ocean (used later for qemp) --- ! 1664 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)1820 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) 1665 1821 1666 1822 ! --- evaporation over ice (kg/m2/s) --- ! 1667 zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) 1823 IF (sn_rcv_emp%clcat == 'yes') THEN 1824 DO jl=1,jpl 1825 zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 1826 ENDDO 1827 ELSE 1828 zevap_ice(:,:,1) = frcv(jpr_ievp)%z3(:,:,1) 1829 ENDIF 1830 1668 1831 ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 1669 1832 ! therefore, sublimation is not redistributed over the ice categories when no subgrid scale fluxes are provided by atm. … … 1693 1856 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1694 1857 DO jl=1,jpl 1695 evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,: ) * zmsk(:,:)1858 evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:,1) * zmsk(:,:) 1696 1859 devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:) 1697 1860 ENDDO … … 1703 1866 tprecip(:,:) = ztprecip(:,:) 1704 1867 DO jl=1,jpl 1705 evap_ice (:,:,jl) = zevap_ice (:,:) 1868 IF (sn_rcv_emp%clcat == 'yes') THEN 1869 evap_ice (:,:,jl) = zevap_ice (:,:,jl) 1870 ELSE 1871 evap_ice (:,:,jl) = zevap_ice (:,:,1) 1872 ENDIF 1873 1706 1874 devap_ice(:,:,jl) = zdevap_ice(:,:) 1707 1875 ENDDO … … 1709 1877 1710 1878 #else 1711 zsnw(:,:) = zicefr(:,:)1879 zsnw(:,:) = picefr(:,:) 1712 1880 ! --- Continental fluxes --- ! 1713 1881 IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on) … … 1748 1916 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1749 1917 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1750 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average)1918 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) 1751 1919 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & 1752 & - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average)1920 & - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1753 1921 ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 1754 1922 ! … … 1768 1936 ENDIF 1769 1937 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1770 zqns_tot(:,:) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)1938 zqns_tot(:,:) = ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1771 1939 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1772 1940 DO jl=1,jpl … … 1775 1943 ENDDO 1776 1944 ELSE 1777 qns_tot(:,:) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1945 qns_tot(:,:) = qns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1778 1946 DO jl=1,jpl 1779 zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1947 zqns_tot(:,: ) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1780 1948 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1781 1949 ENDDO … … 1785 1953 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1786 1954 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1787 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) &1788 & + pist(:,:,1) * zicefr(:,:) ) )1955 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * ziceld(:,:) & 1956 & + pist(:,:,1) * picefr(:,:) ) ) 1789 1957 END SELECT 1790 1958 ! … … 1797 1965 #if defined key_lim3 1798 1966 ! --- non solar flux over ocean --- ! 1799 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax1967 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax 1800 1968 zqns_oce = 0._wp 1801 WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:)1969 WHERE( ziceld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / ziceld(:,:) 1802 1970 1803 1971 ! Heat content per unit mass of snow (J/kg) … … 1806 1974 ENDWHERE 1807 1975 ! Heat content per unit mass of rain (J/kg) 1808 zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * p_frld(:,:) )1976 zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) ) 1809 1977 1810 1978 ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! … … 1821 1989 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - lfus ) ! solid precip over ocean + snow melting 1822 1990 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptsnw (:,:) - lfus ) ! solid precip over ice (qevap_ice=0 since atm. does not take it into account) 1823 !! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptsnw (:,:) & ! ice evap1991 !! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * zcptsnw (:,:) & ! ice evap 1824 1992 !! & + zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhosn ! solid precip over ice 1825 1993 … … 1854 2022 ! clem: this formulation is certainly wrong... but better than it was... 1855 2023 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1856 & - ( p_frld(:,:) * zsprecip(:,:) * lfus ) & ! remove the latent heat flux of solid precip. melting2024 & - ( ziceld(:,:) * zsprecip(:,:) * lfus ) & ! remove the latent heat flux of solid precip. melting 1857 2025 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1858 2026 & - zemp_ice(:,:) ) * zcptn(:,:) 1859 2027 1860 2028 IF( ln_mixcpl ) THEN 1861 qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk2029 qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1862 2030 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 1863 2031 DO jl=1,jpl … … 1875 2043 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea', sprecip(:,:) * ( zcptsnw(:,:) - Lfus ) ) ! heat flux from snow (cell average) 1876 2044 IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea',( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average) 1877 IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea',(frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) & ! heat flux from from evap (cell average)2045 IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea',(frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) & ! heat flux from from evap (cell average) 1878 2046 & ) * zcptn(:,:) * tmask(:,:,1) ) 1879 2047 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea',sprecip(:,:) * (zcptsnw(:,:) - Lfus) * (1._wp - zsnw(:,:)) ) ! heat flux from snow (over ocean) … … 1899 2067 zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1900 2068 CASE( 'oce and ice' ) 1901 zqsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)2069 zqsr_tot(:,: ) = ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1902 2070 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1903 2071 DO jl=1,jpl … … 1906 2074 ENDDO 1907 2075 ELSE 1908 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)2076 qsr_tot(:,: ) = qsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1909 2077 DO jl=1,jpl 1910 zqsr_tot(:,: ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)2078 zqsr_tot(:,: ) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1911 2079 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1912 2080 ENDDO … … 1918 2086 ! ( see OASIS3 user guide, 5th edition, p39 ) 1919 2087 zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1920 & / ( 1.- ( alb edo_oce_mix(:,: ) * p_frld(:,:) &1921 & + palbi (:,:,1) * zicefr(:,:) ) )2088 & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) & 2089 & + palbi (:,:,1) * picefr(:,:) ) ) 1922 2090 END SELECT 1923 2091 IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle … … 1930 2098 #if defined key_lim3 1931 2099 ! --- solar flux over ocean --- ! 1932 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax2100 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax 1933 2101 zqsr_oce = 0._wp 1934 WHERE( p_frld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:)2102 WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:) 1935 2103 1936 2104 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) … … 1939 2107 1940 2108 IF( ln_mixcpl ) THEN 1941 qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk2109 qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1942 2110 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:) 1943 2111 DO jl=1,jpl … … 1971 2139 ENDIF 1972 2140 1973 ! ! ========================= ! 1974 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! topmelt and botmelt ! 1975 ! ! ========================= ! 1976 CASE ('coupled') 1977 topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:) 1978 botmelt(:,:,:)=frcv(jpr_botm)%z3(:,:,:) 1979 END SELECT 1980 1981 ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 ) 1982 ! Used for LIM2 and LIM3 1983 ! Coupled case: since cloud cover is not received from atmosphere 1984 ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 1985 fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 1986 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1987 1988 CALL wrk_dealloc( jpi,jpj, zcptn, zcptrain, zcptsnw, zicefr, zmsk, zsnw ) 1989 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 2141 IF( ln_meto_cpl ) THEN 2142 ! ! ========================= ! 2143 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! topmelt and botmelt ! 2144 ! ! ========================= ! 2145 CASE ('coupled') 2146 qml_ice(:,:,:)=frcv(jpr_topm)%z3(:,:,:) * a_i(:,:,:) 2147 qcn_ice(:,:,:)=frcv(jpr_botm)%z3(:,:,:) * a_i(:,:,:) 2148 END SELECT 2149 ENDIF 2150 2151 ! --- Transmitted shortwave radiation (W/m2) --- ! 2152 2153 IF ( nice_jules == 0 ) THEN 2154 2155 zfrqsr_tr_i(:,:,:) = 0._wp ! surface transmission parameter 2156 2157 ! former coding was 2158 ! Coupled case: since cloud cover is not received from atmosphere 2159 ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 2160 ! fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 2161 ! fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 2162 2163 ! to retrieve that coding, we needed to access h_i & h_s from here 2164 ! we could even retrieve cloud fraction from the coupler 2165 2166 DO jl = 1, jpl 2167 DO jj = 1 , jpj 2168 DO ji = 1, jpi 2169 2170 !--- surface transmission parameter (Grenfell Maykut 77) --- ! 2171 zfrqsr_tr_i(ji,jj,jl) = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice 2172 2173 ! --- influence of snow and thin ice --- ! 2174 IF ( phs(ji,jj,jl) >= 0.0_wp ) zfrqsr_tr_i(ji,jj,jl) = 0._wp ! snow fully opaque 2175 IF ( phi(ji,jj,jl) <= 0.1_wp ) zfrqsr_tr_i(ji,jj,jl) = 1._wp ! thin ice transmits all solar radiation 2176 END DO 2177 END DO 2178 END DO 2179 2180 qsr_ice_tr(:,:,:) = zfrqsr_tr_i(:,:,:) * qsr_ice(:,:,:) ! transmitted solar radiation 2181 2182 ENDIF 2183 2184 IF ( nice_jules == 2 ) THEN 2185 2186 ! here we must receive the qsr_ice_tr array from the coupler 2187 ! for now just assume zero 2188 2189 qsr_ice_tr(:,:,:) = 0.0_wp 2190 2191 ENDIF 2192 2193 2194 2195 CALL wrk_dealloc( jpi,jpj, zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw ) 2196 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zdevap_ice ) 1990 2197 CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1991 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 2198 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zfrqsr_tr_i ) 2199 IF (sn_rcv_emp%clcat == 'yes') THEN 2200 CALL wrk_dealloc( jpi,jpj,jpl,zevap_ice) 2201 ELSE 2202 CALL wrk_dealloc( jpi,jpj,1,zevap_ice) 2203 ENDIF 1992 2204 ! 1993 2205 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx') … … 2033 2245 ! we must send the surface potential temperature 2034 2246 IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 2035 ELSE 2247 ELSE ; ztmp1(:,:) = tsn(:,:,1,jp_tem) 2036 2248 ENDIF 2037 2249 ! … … 2061 2273 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 2062 2274 END SELECT 2275 CASE( 'oce and weighted ice') ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0 2276 SELECT CASE( sn_snd_temp%clcat ) 2277 CASE( 'yes' ) 2278 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2279 CASE( 'no' ) 2280 ztmp3(:,:,:) = 0.0 2281 DO jl=1,jpl 2282 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 2283 ENDDO 2284 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 2285 END SELECT 2063 2286 CASE( 'mixed oce-ice' ) 2064 2287 ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) … … 2073 2296 IF( ssnd(jps_tmix)%laction ) CALL cpl_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2074 2297 ENDIF 2298 2299 !!!!! Getting NEMO4-LIM working at Met Office 2300 ! Top layer ice temperature 2301 IF( ssnd(jps_ttilyr)%laction) THEN 2302 SELECT CASE( sn_snd_ttilyr%cldes) 2303 CASE ('weighted ice') 2304 ztmp3(:,:,1:jpl) = t1_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2305 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ttilyr%cldes' ) 2306 END SELECT 2307 IF( ssnd(jps_ttilyr)%laction ) CALL cpl_snd( jps_ttilyr, isec, ztmp3, info ) 2308 ENDIF 2309 !!!!! 2310 2311 2075 2312 ! ! ------------------------- ! 2076 2313 ! ! Albedo ! … … 2086 2323 ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 ) 2087 2324 ELSEWHERE 2088 ztmp1(:,:) = alb edo_oce_mix(:,:)2325 ztmp1(:,:) = alb_oce_mix(:,:) 2089 2326 END WHERE 2090 2327 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' ) … … 2114 2351 2115 2352 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean 2116 ztmp1(:,:) = alb edo_oce_mix(:,:) * zfr_l(:,:)2353 ztmp1(:,:) = alb_oce_mix(:,:) * zfr_l(:,:) 2117 2354 DO jl=1,jpl 2118 2355 ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) … … 2132 2369 IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info ) 2133 2370 ENDIF 2371 2372 IF( ssnd(jps_fice1)%laction ) THEN 2373 SELECT CASE( sn_snd_thick1%clcat ) 2374 CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl) 2375 CASE( 'no' ) ; ztmp3(:,:,1 ) = fr_i(:,: ) 2376 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' ) 2377 END SELECT 2378 CALL cpl_snd( jps_fice1, isec, ztmp3, info ) 2379 ENDIF 2134 2380 2135 2381 ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling) … … 2146 2392 SELECT CASE( sn_snd_thick%clcat ) 2147 2393 CASE( 'yes' ) 2148 ztmp3(:,:,1:jpl) = h t_i(:,:,1:jpl) * a_i(:,:,1:jpl)2149 ztmp4(:,:,1:jpl) = h t_s(:,:,1:jpl) * a_i(:,:,1:jpl)2394 ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl) * a_i(:,:,1:jpl) 2395 ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl) * a_i(:,:,1:jpl) 2150 2396 CASE( 'no' ) 2151 2397 ztmp3(:,:,:) = 0.0 ; ztmp4(:,:,:) = 0.0 2152 2398 DO jl=1,jpl 2153 ztmp3(:,:,1) = ztmp3(:,:,1) + h t_i(:,:,jl) * a_i(:,:,jl)2154 ztmp4(:,:,1) = ztmp4(:,:,1) + h t_s(:,:,jl) * a_i(:,:,jl)2399 ztmp3(:,:,1) = ztmp3(:,:,1) + h_i(:,:,jl) * a_i(:,:,jl) 2400 ztmp4(:,:,1) = ztmp4(:,:,1) + h_s(:,:,jl) * a_i(:,:,jl) 2155 2401 ENDDO 2156 2402 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) … … 2159 2405 SELECT CASE( sn_snd_thick%clcat ) 2160 2406 CASE( 'yes' ) 2161 ztmp3(:,:,1:jpl) = h t_i(:,:,1:jpl)2162 ztmp4(:,:,1:jpl) = h t_s(:,:,1:jpl)2407 ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl) 2408 ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl) 2163 2409 CASE( 'no' ) 2164 2410 WHERE( SUM( a_i, dim=3 ) /= 0. ) 2165 ztmp3(:,:,1) = SUM( h t_i * a_i, dim=3 ) / SUM( a_i, dim=3 )2166 ztmp4(:,:,1) = SUM( h t_s * a_i, dim=3 ) / SUM( a_i, dim=3 )2411 ztmp3(:,:,1) = SUM( h_i * a_i, dim=3 ) / SUM( a_i, dim=3 ) 2412 ztmp4(:,:,1) = SUM( h_s * a_i, dim=3 ) / SUM( a_i, dim=3 ) 2167 2413 ELSEWHERE 2168 2414 ztmp3(:,:,1) = 0. … … 2176 2422 IF( ssnd(jps_hsnw)%laction ) CALL cpl_snd( jps_hsnw, isec, ztmp4, info ) 2177 2423 ENDIF 2424 2425 ! 2426 ! Send meltpond fields 2427 IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN 2428 SELECT CASE( sn_snd_mpnd%cldes) 2429 CASE( 'weighted ice' ) 2430 SELECT CASE( sn_snd_mpnd%clcat ) 2431 CASE( 'yes' ) 2432 ztmp3(:,:,1:jpl) = a_ip(:,:,1:jpl) 2433 ztmp4(:,:,1:jpl) = v_ip(:,:,1:jpl) 2434 CASE( 'no' ) 2435 ztmp3(:,:,:) = 0.0 2436 ztmp4(:,:,:) = 0.0 2437 DO jl=1,jpl 2438 ztmp3(:,:,1) = ztmp3(:,:,1) + a_ip(:,:,jpl) 2439 ztmp4(:,:,1) = ztmp4(:,:,1) + v_ip(:,:,jpl) 2440 ENDDO 2441 CASE default ; CALL ctl_stop( 'sbc_cpl_mpd: wrong definition of sn_snd_mpnd%clcat' ) 2442 END SELECT 2443 CASE( 'default' ) ; CALL ctl_stop( 'sbc_cpl_mpd: wrong definition of sn_snd_mpnd%cldes' ) 2444 END SELECT 2445 IF( ssnd(jps_a_p)%laction ) CALL cpl_snd( jps_a_p, isec, ztmp3, info ) 2446 IF( ssnd(jps_ht_p)%laction ) CALL cpl_snd( jps_ht_p, isec, ztmp4, info ) 2447 ! 2448 ! Send ice effective conductivity 2449 SELECT CASE( sn_snd_cond%cldes) 2450 CASE( 'weighted ice' ) 2451 SELECT CASE( sn_snd_cond%clcat ) 2452 CASE( 'yes' ) 2453 ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2454 CASE( 'no' ) 2455 ztmp3(:,:,:) = 0.0 2456 DO jl=1,jpl 2457 ztmp3(:,:,1) = ztmp3(:,:,1) + cnd_ice(:,:,jl) * a_i(:,:,jl) 2458 ENDDO 2459 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' ) 2460 END SELECT 2461 CASE( 'ice only' ) 2462 ztmp3(:,:,1:jpl) = cnd_ice(:,:,1:jpl) 2463 END SELECT 2464 IF( ssnd(jps_kice)%laction ) CALL cpl_snd( jps_kice, isec, ztmp3, info ) 2465 ENDIF 2466 ! 2467 !!!!! 2468 2469 2178 2470 ! ! ------------------------- ! 2179 2471 ! ! CO2 flux from PISCES ! … … 2545 2837 IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 2546 2838 2839 CALL eos_fzp(tsn(:,:,1,jp_sal), sstfrz) 2840 ztmp1(:,:) = sstfrz(:,:) 2841 IF( ssnd(jps_sstfrz)%laction ) CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info) 2842 2547 2843 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 2548 2844 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )
Note: See TracChangeset
for help on using the changeset viewer.
