- Timestamp:
- 2016-04-20T11:42:09+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6487 r6488 46 46 USE p4zflx, ONLY : oce_co2 47 47 #endif 48 #if defined key_cice49 USE ice_domain_size, only: ncat50 #endif51 48 #if defined key_lim3 52 49 USE limthd_dh ! for CALL lim_thd_snwblow … … 105 102 INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness 106 103 INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level 107 INTEGER, PARAMETER :: jprcv = 42 ! total number of fields received 104 INTEGER, PARAMETER :: jpr_ts_ice = 43 ! skin temperature of sea-ice (used for melt-ponds) 105 INTEGER, PARAMETER :: jpr_grnm = 44 ! Greenland ice mass 106 INTEGER, PARAMETER :: jpr_antm = 45 ! Antarctic ice mass 107 INTEGER, PARAMETER :: jprcv = 45 ! total number of fields received 108 108 109 109 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere … … 135 135 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 136 136 INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level 137 INTEGER, PARAMETER :: jpsnd = 28 ! total number of fields sended 137 INTEGER, PARAMETER :: jps_a_p = 29 ! meltpond fraction 138 INTEGER, PARAMETER :: jps_ht_p = 30 ! meltpond depth (m) 139 INTEGER, PARAMETER :: jps_kice = 31 ! ice surface layer thermal conductivity 140 INTEGER, PARAMETER :: jps_sstfrz = 32 ! sea-surface freezing temperature 141 INTEGER, PARAMETER :: jps_fice1 = 33 ! first-order ice concentration (for time-travelling ice coupling) 142 INTEGER, PARAMETER :: jpsnd = 33 ! total number of fields sended 138 143 139 144 ! !!** namelist namsbc_cpl ** … … 146 151 END TYPE FLD_C 147 152 ! Send to the atmosphere ! 148 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 153 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2, sn_snd_cond, sn_snd_mpnd, sn_snd_sstfrz, sn_snd_thick1 154 149 155 ! Received from the atmosphere ! 150 156 TYPE(FLD_C) :: sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 151 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 157 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_ts_ice, sn_rcv_grnm, sn_rcv_antm 152 158 ! Other namelist parameters ! 153 159 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data … … 216 222 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos 217 223 !! 218 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 219 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 220 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, & 221 & sn_rcv_co2 , nn_cplmodel , ln_usecplmask 224 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick , sn_snd_crt , sn_snd_co2, & 225 & sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1, & 226 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 227 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, & 228 & sn_rcv_co2 , sn_rcv_grnm , sn_rcv_antm , sn_rcv_ts_ice, nn_cplmodel , & 229 & ln_usecplmask, ln_coupled_iceshelf_fluxes, rn_greenland_calving_fraction, & 230 & rn_antarctica_calving_fraction, rn_iceshelf_fluxes_tolerance 222 231 !!--------------------------------------------------------------------- 223 232 ! … … 258 267 WRITE(numout,*)' runoffs = ', TRIM(sn_rcv_rnf%cldes ), ' (', TRIM(sn_rcv_rnf%clcat ), ')' 259 268 WRITE(numout,*)' calving = ', TRIM(sn_rcv_cal%cldes ), ' (', TRIM(sn_rcv_cal%clcat ), ')' 269 WRITE(numout,*)' Greenland ice mass = ', TRIM(sn_rcv_grnm%cldes ), ' (', TRIM(sn_rcv_grnm%clcat ), ')' 270 WRITE(numout,*)' Antarctica ice mass = ', TRIM(sn_rcv_antm%cldes ), ' (', TRIM(sn_rcv_antm%clcat ), ')' 260 271 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 261 272 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' … … 269 280 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 270 281 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 282 WRITE(numout,*)' ice effective conductivity = ', TRIM(sn_snd_cond%cldes ), ' (', TRIM(sn_snd_cond%clcat ), ')' 283 WRITE(numout,*)' meltponds fraction & depth = ', TRIM(sn_snd_mpnd%cldes ), ' (', TRIM(sn_snd_mpnd%clcat ), ')' 284 WRITE(numout,*)' sea surface freezing temp = ', TRIM(sn_snd_sstfrz%cldes ), ' (', TRIM(sn_snd_sstfrz%clcat ), ')' 285 271 286 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 272 287 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask 288 WRITE(numout,*)' ln_coupled_iceshelf_fluxes = ', ln_coupled_iceshelf_fluxes 289 WRITE(numout,*)' rn_greenland_calving_fraction = ', rn_greenland_calving_fraction 290 WRITE(numout,*)' rn_antarctica_calving_fraction = ', rn_antarctica_calving_fraction 291 WRITE(numout,*)' rn_iceshelf_fluxes_tolerance = ', rn_iceshelf_fluxes_tolerance 273 292 ENDIF 274 293 … … 383 402 srcv(jpr_snow)%clname = 'OTotSnow' ! Snow = solid precipitation 384 403 srcv(jpr_tevp)%clname = 'OTotEvap' ! total evaporation (over oce + ice sublimation) 385 srcv(jpr_ievp)%clname = 'OIceEv ap' ! evaporation over ice = sublimation404 srcv(jpr_ievp)%clname = 'OIceEvp' ! evaporation over ice = sublimation 386 405 srcv(jpr_sbpr)%clname = 'OSubMPre' ! sublimation - liquid precipitation - solid precipitation 387 406 srcv(jpr_semp)%clname = 'OISubMSn' ! ice solid water budget = sublimation - solid precipitation … … 396 415 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 397 416 END SELECT 398 417 !Set the number of categories for coupling of sublimation 418 IF ( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = jpl 419 ! 399 420 ! ! ------------------------- ! 400 421 ! ! Runoffs & Calving ! … … 410 431 ! 411 432 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 433 srcv(jpr_grnm )%clname = 'OGrnmass' ; IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled' ) srcv(jpr_grnm)%laction = .TRUE. 434 srcv(jpr_antm )%clname = 'OAntmass' ; IF( TRIM( sn_rcv_antm%cldes ) == 'coupled' ) srcv(jpr_antm)%laction = .TRUE. 435 412 436 413 437 ! ! ------------------------- ! … … 483 507 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 484 508 ENDIF 509 510 #if defined key_cice && ! defined key_cice4 511 ! ! ----------------------------- ! 512 ! ! sea-ice skin temperature ! 513 ! ! used in meltpond scheme ! 514 ! ! May be calculated in Atm ! 515 ! ! ----------------------------- ! 516 srcv(jpr_ts_ice)%clname = 'OTsfIce' 517 IF ( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' ) srcv(jpr_ts_ice)%laction = .TRUE. 518 IF ( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' ) srcv(jpr_ts_ice)%nct = jpl 519 !TODO: Should there be a consistency check here? 520 #endif 521 485 522 ! ! ------------------------------- ! 486 523 ! ! OPA-SAS coupling - rcv by opa ! … … 600 637 ! ! ------------------------- ! 601 638 ssnd(jps_toce)%clname = 'O_SSTSST' 602 ssnd(jps_tice)%clname = 'O _TepIce'639 ssnd(jps_tice)%clname = 'OTepIce' 603 640 ssnd(jps_tmix)%clname = 'O_TepMix' 604 641 SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 605 642 CASE( 'none' ) ! nothing to do 606 643 CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE. 607 CASE( 'oce and ice' , 'weighted oce and ice' )644 CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice') 608 645 ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 609 646 IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl … … 634 671 635 672 ! ! ------------------------- ! 636 ! ! Ice fraction & Thickness !673 ! ! Ice fraction & Thickness 637 674 ! ! ------------------------- ! 638 675 ssnd(jps_fice)%clname = 'OIceFrc' 639 676 ssnd(jps_hice)%clname = 'OIceTck' 640 677 ssnd(jps_hsnw)%clname = 'OSnwTck' 678 ssnd(jps_a_p)%clname = 'OPndFrc' 679 ssnd(jps_ht_p)%clname = 'OPndTck' 680 ssnd(jps_fice1)%clname = 'OIceFrd' 641 681 IF( k_ice /= 0 ) THEN 642 682 ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case) 683 ssnd(jps_fice1)%laction = .TRUE. ! First-order regridded ice concentration, to be used 684 ! in producing atmos-to-ice fluxes 643 685 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 644 686 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 687 IF ( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = jpl 645 688 ENDIF 646 689 … … 657 700 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 658 701 END SELECT 702 703 ! ! ------------------------- ! 704 ! ! Ice Meltponds ! 705 ! ! ------------------------- ! 706 #if defined key_cice && ! defined key_cice4 707 ! Meltponds only CICE5 708 ssnd(jps_a_p)%clname = 'OPndFrc' 709 ssnd(jps_ht_p)%clname = 'OPndTck' 710 SELECT CASE ( TRIM( sn_snd_mpnd%cldes ) ) 711 CASE ( 'none' ) 712 ssnd(jps_a_p)%laction = .FALSE. 713 ssnd(jps_ht_p)%laction = .FALSE. 714 CASE ( 'ice only' ) 715 ssnd(jps_a_p)%laction = .TRUE. 716 ssnd(jps_ht_p)%laction = .TRUE. 717 IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 718 ssnd(jps_a_p)%nct = jpl 719 ssnd(jps_ht_p)%nct = jpl 720 ELSE 721 IF ( jpl > 1 ) THEN 722 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 723 ENDIF 724 ENDIF 725 CASE ( 'weighted ice' ) 726 ssnd(jps_a_p)%laction = .TRUE. 727 ssnd(jps_ht_p)%laction = .TRUE. 728 IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 729 ssnd(jps_a_p)%nct = jpl 730 ssnd(jps_ht_p)%nct = jpl 731 ENDIF 732 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_mpnd%cldes' ) 733 END SELECT 734 #else 735 IF( TRIM( sn_snd_mpnd%cldes /= 'none' ) THEN 736 CALL ctl_stop('Meltponds can only be used with CICEv5') 737 ENDIF 738 #endif 659 739 660 740 ! ! ------------------------- ! … … 689 769 ! ! ------------------------- ! 690 770 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 771 ! 772 773 ! ! ------------------------- ! 774 ! ! Sea surface freezing temp ! 775 ! ! ------------------------- ! 776 ssnd(jps_sstfrz)%clname = 'O_SSTFrz' ; IF( TRIM(sn_snd_sstfrz%cldes) == 'coupled' ) ssnd(jps_sstfrz)%laction = .TRUE. 777 ! 778 ! ! ------------------------- ! 779 ! ! Ice conductivity ! 780 ! ! ------------------------- ! 781 ! Note that ultimately we will move to passing an ocean effective conductivity as well so there 782 ! will be some changes to the parts of the code which currently relate only to ice conductivity 783 ssnd(jps_kice )%clname = 'OIceKn' 784 SELECT CASE ( TRIM( sn_snd_cond%cldes ) ) 785 CASE ( 'none' ) 786 ssnd(jps_kice)%laction = .FALSE. 787 CASE ( 'ice only' ) 788 ssnd(jps_kice)%laction = .TRUE. 789 IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 790 ssnd(jps_kice)%nct = jpl 791 ELSE 792 IF ( jpl > 1 ) THEN 793 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 794 ENDIF 795 ENDIF 796 CASE ( 'weighted ice' ) 797 ssnd(jps_kice)%laction = .TRUE. 798 IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = jpl 799 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes' ) 800 END SELECT 801 ! 802 691 803 692 804 ! ! ------------------------------- ! … … 785 897 ncpl_qsr_freq = 86400 / ncpl_qsr_freq 786 898 899 IF( ln_coupled_iceshelf_fluxes ) THEN 900 ! Crude masks to separate the Antarctic and Greenland icesheets. Obviously something 901 ! more complicated could be done if required. 902 greenland_icesheet_mask = 0.0 903 WHERE( gphit >= 0.0 ) greenland_icesheet_mask = 1.0 904 antarctica_icesheet_mask = 0.0 905 WHERE( gphit < 0.0 ) antarctica_icesheet_mask = 1.0 906 907 ! initialise other variables 908 greenland_icesheet_mass_array(:,:) = 0.0 909 antarctica_icesheet_mass_array(:,:) = 0.0 910 911 IF( .not. ln_rstart ) THEN 912 greenland_icesheet_mass = 0.0 913 greenland_icesheet_mass_rate_of_change = 0.0 914 greenland_icesheet_timelapsed = 0.0 915 antarctica_icesheet_mass = 0.0 916 antarctica_icesheet_mass_rate_of_change = 0.0 917 antarctica_icesheet_timelapsed = 0.0 918 ENDIF 919 920 ENDIF 921 787 922 CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 788 923 ! … … 843 978 !! 844 979 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 845 INTEGER :: ji, jj, j n! dummy loop indices980 INTEGER :: ji, jj, jl, jn ! dummy loop indices 846 981 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) 847 982 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 983 REAL(wp) :: zgreenland_icesheet_mass_in, zantarctica_icesheet_mass_in 984 REAL(wp) :: zgreenland_icesheet_mass_b, zantarctica_icesheet_mass_b 985 REAL(wp) :: zmask_sum, zepsilon 848 986 REAL(wp) :: zcoef ! temporary scalar 849 987 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 … … 997 1135 #endif 998 1136 1137 #if defined key_cice && ! defined key_cice4 1138 ! ! Sea ice surface skin temp: 1139 IF( srcv(jpr_ts_ice)%laction ) THEN 1140 DO jl = 1, jpl 1141 DO jj = 1, jpj 1142 DO ji = 1, jpi 1143 IF (frcv(jpr_ts_ice)%z3(ji,jj,jl) > 0.0) THEN 1144 tsfc_ice(ji,jj,jl) = 0.0 1145 ELSE IF (frcv(jpr_ts_ice)%z3(ji,jj,jl) < -60.0) THEN 1146 tsfc_ice(ji,jj,jl) = -60.0 1147 ELSE 1148 tsfc_ice(ji,jj,jl) = frcv(jpr_ts_ice)%z3(ji,jj,jl) 1149 ENDIF 1150 END DO 1151 END DO 1152 END DO 1153 ENDIF 1154 #endif 1155 999 1156 ! Fields received by SAS when OASIS coupling 1000 1157 ! (arrays no more filled at sbcssm stage) … … 1112 1269 1113 1270 ENDIF 1271 1272 ! ! land ice masses : Greenland 1273 zepsilon = rn_iceshelf_fluxes_tolerance 1274 1275 IF( srcv(jpr_grnm)%laction ) THEN 1276 greenland_icesheet_mass_array(:,:) = frcv(jpr_grnm)%z3(:,:,1) 1277 ! take average over ocean points of input array to avoid cumulative error over time 1278 zgreenland_icesheet_mass_in = SUM( greenland_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1279 IF(lk_mpp) CALL mpp_sum( zgreenland_icesheet_mass_in ) 1280 zmask_sum = SUM( tmask(:,:,1) ) 1281 IF(lk_mpp) CALL mpp_sum( zmask_sum ) 1282 zgreenland_icesheet_mass_in = zgreenland_icesheet_mass_in / zmask_sum 1283 greenland_icesheet_timelapsed = greenland_icesheet_timelapsed + rdt 1284 IF( ABS( zgreenland_icesheet_mass_in - greenland_icesheet_mass ) > zepsilon ) THEN 1285 zgreenland_icesheet_mass_b = greenland_icesheet_mass 1286 1287 ! Only update the mass if it has increased 1288 IF ( (zgreenland_icesheet_mass_in - greenland_icesheet_mass) > 0.0 ) THEN 1289 greenland_icesheet_mass = zgreenland_icesheet_mass_in 1290 ENDIF 1291 1292 IF( zgreenland_icesheet_mass_b /= 0.0 ) & 1293 & greenland_icesheet_mass_rate_of_change = ( greenland_icesheet_mass - zgreenland_icesheet_mass_b ) / greenland_icesheet_timelapsed 1294 greenland_icesheet_timelapsed = 0.0_wp 1295 ENDIF 1296 IF(lwp) WRITE(numout,*) 'Greenland icesheet mass (kg) read in is ', zgreenland_icesheet_mass_in 1297 IF(lwp) WRITE(numout,*) 'Greenland icesheet mass (kg) used is ', greenland_icesheet_mass 1298 IF(lwp) WRITE(numout,*) 'Greenland icesheet mass rate of change (kg/s) is ', greenland_icesheet_mass_rate_of_change 1299 IF(lwp) WRITE(numout,*) 'Greenland icesheet seconds lapsed since last change is ', greenland_icesheet_timelapsed 1300 ENDIF 1301 1302 ! ! land ice masses : Antarctica 1303 IF( srcv(jpr_antm)%laction ) THEN 1304 antarctica_icesheet_mass_array(:,:) = frcv(jpr_antm)%z3(:,:,1) 1305 ! take average over ocean points of input array to avoid cumulative error from rounding errors over time 1306 zantarctica_icesheet_mass_in = SUM( antarctica_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1307 IF(lk_mpp) CALL mpp_sum( zantarctica_icesheet_mass_in ) 1308 zmask_sum = SUM( tmask(:,:,1) ) 1309 IF(lk_mpp) CALL mpp_sum( zmask_sum ) 1310 zantarctica_icesheet_mass_in = zantarctica_icesheet_mass_in / zmask_sum 1311 antarctica_icesheet_timelapsed = antarctica_icesheet_timelapsed + rdt 1312 IF( ABS( zantarctica_icesheet_mass_in - antarctica_icesheet_mass ) > zepsilon ) THEN 1313 zantarctica_icesheet_mass_b = antarctica_icesheet_mass 1314 1315 ! Only update the mass if it has increased 1316 IF ( (zantarctica_icesheet_mass_in - antarctica_icesheet_mass) > 0.0 ) THEN 1317 antarctica_icesheet_mass = zantarctica_icesheet_mass_in 1318 END IF 1319 1320 IF( zantarctica_icesheet_mass_b /= 0.0 ) & 1321 & antarctica_icesheet_mass_rate_of_change = ( antarctica_icesheet_mass - zantarctica_icesheet_mass_b ) / antarctica_icesheet_timelapsed 1322 antarctica_icesheet_timelapsed = 0.0_wp 1323 ENDIF 1324 IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass (kg) read in is ', zantarctica_icesheet_mass_in 1325 IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass (kg) used is ', antarctica_icesheet_mass 1326 IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass rate of change (kg/s) is ', antarctica_icesheet_mass_rate_of_change 1327 IF(lwp) WRITE(numout,*) 'Antarctica icesheet seconds lapsed since last change is ', antarctica_icesheet_timelapsed 1328 ENDIF 1329 1114 1330 ! 1115 1331 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) … … 1405 1621 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1406 1622 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1407 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1623 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1624 #if defined key_cice 1625 IF ( TRIM(sn_rcv_emp%clcat) == 'yes' ) THEN 1626 ! zemp_ice is the sum of frcv(jpr_ievp)%z3(:,:,1) over all layers - snow 1627 zemp_ice(:,:) = - frcv(jpr_snow)%z3(:,:,1) 1628 DO jl=1,jpl 1629 zemp_ice(:,: ) = zemp_ice(:,:) + frcv(jpr_ievp)%z3(:,:,jl) 1630 ENDDO 1631 ! latent heat coupled for each category in CICE 1632 qla_ice(:,:,1:jpl) = - frcv(jpr_ievp)%z3(:,:,1:jpl) * lsub 1633 ELSE 1634 ! If CICE has multicategories it still expects coupling fields for 1635 ! each even if we treat as a single field 1636 ! The latent heat flux is split between the ice categories according 1637 ! to the fraction of the ice in each category 1638 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1639 WHERE ( zicefr(:,:) /= 0._wp ) 1640 ztmp(:,:) = 1./zicefr(:,:) 1641 ELSEWHERE 1642 ztmp(:,:) = 0.e0 1643 END WHERE 1644 DO jl=1,jpl 1645 qla_ice(:,:,jl) = - a_i(:,:,jl) * ztmp(:,:) * frcv(jpr_ievp)%z3(:,:,1) * lsub 1646 END DO 1647 WHERE ( zicefr(:,:) == 0._wp ) qla_ice(:,:,1) = -frcv(jpr_ievp)%z3(:,:,1) * lsub 1648 ENDIF 1649 #else 1408 1650 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1651 #endif 1409 1652 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1410 1653 IF( iom_use('hflx_rain_cea') ) & … … 1760 2003 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1761 2004 END SELECT 2005 CASE( 'oce and weighted ice' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0 2006 SELECT CASE( sn_snd_temp%clcat ) 2007 CASE( 'yes' ) 2008 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2009 CASE( 'no' ) 2010 ztmp3(:,:,:) = 0.0 2011 DO jl=1,jpl 2012 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 2013 ENDDO 2014 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 2015 END SELECT 1762 2016 CASE( 'mixed oce-ice' ) 1763 2017 ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) … … 1830 2084 END SELECT 1831 2085 IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info ) 2086 ENDIF 2087 2088 ! Send ice fraction field (first order interpolation), for weighting UM fluxes to be passed to NEMO 2089 IF (ssnd(jps_fice1)%laction) THEN 2090 SELECT CASE (sn_snd_thick1%clcat) 2091 CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl) 2092 CASE( 'no' ) ; ztmp3(:,:,1) = fr_i(:,:) 2093 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' ) 2094 END SELECT 2095 CALL cpl_snd (jps_fice1, isec, ztmp3, info) 1832 2096 ENDIF 1833 2097 … … 1875 2139 IF( ssnd(jps_hsnw)%laction ) CALL cpl_snd( jps_hsnw, isec, ztmp4, info ) 1876 2140 ENDIF 2141 ! 2142 ! Send meltpond fields 2143 IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN 2144 SELECT CASE( sn_snd_mpnd%cldes) 2145 CASE( 'weighted ice' ) 2146 SELECT CASE( sn_snd_mpnd%clcat ) 2147 CASE( 'yes' ) 2148 ztmp3(:,:,1:jpl) = a_p(:,:,1:jpl) * a_i(:,:,1:jpl) 2149 ztmp4(:,:,1:jpl) = ht_p(:,:,1:jpl) * a_i(:,:,1:jpl) 2150 CASE( 'no' ) 2151 ztmp3(:,:,:) = 0.0 2152 ztmp4(:,:,:) = 0.0 2153 DO jl=1,jpl 2154 ztmp3(:,:,1) = ztmp3(:,:,1) + a_p(:,:,jpl) * a_i(:,:,jpl) 2155 ztmp4(:,:,1) = ztmp4(:,:,1) + ht_p(:,:,jpl) * a_i(:,:,jpl) 2156 ENDDO 2157 CASE default ; CALL ctl_stop( 'sbc_cpl_mpd: wrong definition of sn_snd_mpnd%clcat' ) 2158 END SELECT 2159 CASE( 'ice only' ) 2160 ztmp3(:,:,1:jpl) = a_p(:,:,1:jpl) 2161 ztmp4(:,:,1:jpl) = ht_p(:,:,1:jpl) 2162 END SELECT 2163 IF( ssnd(jps_a_p)%laction ) CALL cpl_snd( jps_a_p, isec, ztmp3, info ) 2164 IF( ssnd(jps_ht_p)%laction ) CALL cpl_snd( jps_ht_p, isec, ztmp4, info ) 2165 ! 2166 ! Send ice effective conductivity 2167 SELECT CASE( sn_snd_cond%cldes) 2168 CASE( 'weighted ice' ) 2169 SELECT CASE( sn_snd_cond%clcat ) 2170 CASE( 'yes' ) 2171 ztmp3(:,:,1:jpl) = kn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2172 CASE( 'no' ) 2173 ztmp3(:,:,:) = 0.0 2174 DO jl=1,jpl 2175 ztmp3(:,:,1) = ztmp3(:,:,1) + kn_ice(:,:,jl) * a_i(:,:,jl) 2176 ENDDO 2177 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' ) 2178 END SELECT 2179 CASE( 'ice only' ) 2180 ztmp3(:,:,1:jpl) = kn_ice(:,:,1:jpl) 2181 END SELECT 2182 IF( ssnd(jps_kice)%laction ) CALL cpl_snd( jps_kice, isec, ztmp3, info ) 2183 ENDIF 2184 ! 1877 2185 ! 1878 2186 #if defined key_cpl_carbon_cycle … … 2054 2362 IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info ) 2055 2363 IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 2056 2364 2365 ztmp1(:,:) = sstfrz(:,:) + rt0 2366 IF( ssnd(jps_sstfrz)%laction ) CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2367 ! 2057 2368 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 2058 2369 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )
Note: See TracChangeset
for help on using the changeset viewer.
