- Timestamp:
- 2016-05-03T14:28:12+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r6501_GO6_package_trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6503 r6507 106 106 INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness 107 107 INTEGER, PARAMETER :: jpr_fraqsr = 42 ! fraction of solar net radiation absorbed in the first ocean level 108 INTEGER, PARAMETER :: jprcv = 42 ! total number of fields received 108 INTEGER, PARAMETER :: jpr_ts_ice = 43 ! skin temperature of sea-ice (used for melt-ponds) 109 INTEGER, PARAMETER :: jpr_grnm = 44 ! Greenland ice mass 110 INTEGER, PARAMETER :: jpr_antm = 45 ! Antarctic ice mass 111 INTEGER, PARAMETER :: jprcv = 45 ! total number of fields received 109 112 110 113 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere … … 136 139 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 137 140 INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level 138 INTEGER, PARAMETER :: jpsnd = 28 ! total number of fields sended 141 INTEGER, PARAMETER :: jps_a_p = 29 ! meltpond fraction 142 INTEGER, PARAMETER :: jps_ht_p = 30 ! meltpond depth (m) 143 INTEGER, PARAMETER :: jps_kice = 31 ! ice surface layer thermal conductivity 144 INTEGER, PARAMETER :: jps_sstfrz = 32 ! sea-surface freezing temperature 145 INTEGER, PARAMETER :: jps_fice1 = 33 ! first-order ice concentration (for time-travelling ice coupling) 146 INTEGER, PARAMETER :: jpsnd = 33 ! total number of fields sended 139 147 140 148 ! !!** namelist namsbc_cpl ** … … 147 155 END TYPE FLD_C 148 156 ! ! Send to the atmosphere 149 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 157 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 158 150 159 ! ! Received from the atmosphere 151 160 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 152 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2 161 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_ts_ice, sn_rcv_grnm, sn_rcv_antm 153 162 ! ! Other namelist parameters 154 163 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data … … 214 223 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos 215 224 !! 216 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 217 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 218 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, & 219 & sn_rcv_co2 , nn_cplmodel , ln_usecplmask 225 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick , sn_snd_crt , sn_snd_co2, & 226 & sn_snd_cond, sn_snd_mpnd , sn_snd_sstfrz, sn_snd_thick1, & 227 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 228 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, & 229 & sn_rcv_co2 , sn_rcv_grnm , sn_rcv_antm , sn_rcv_ts_ice, nn_cplmodel , & 230 & ln_usecplmask, ln_coupled_iceshelf_fluxes, rn_greenland_calving_fraction, & 231 & rn_antarctica_calving_fraction, rn_iceshelf_fluxes_tolerance 220 232 !!--------------------------------------------------------------------- 221 233 ! … … 256 268 WRITE(numout,*)' runoffs = ', TRIM(sn_rcv_rnf%cldes ), ' (', TRIM(sn_rcv_rnf%clcat ), ')' 257 269 WRITE(numout,*)' calving = ', TRIM(sn_rcv_cal%cldes ), ' (', TRIM(sn_rcv_cal%clcat ), ')' 270 WRITE(numout,*)' Greenland ice mass = ', TRIM(sn_rcv_grnm%cldes ), ' (', TRIM(sn_rcv_grnm%clcat ), ')' 271 WRITE(numout,*)' Antarctica ice mass = ', TRIM(sn_rcv_antm%cldes ), ' (', TRIM(sn_rcv_antm%clcat ), ')' 258 272 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 259 273 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' … … 267 281 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 268 282 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 283 WRITE(numout,*)' ice effective conductivity = ', TRIM(sn_snd_cond%cldes ), ' (', TRIM(sn_snd_cond%clcat ), ')' 284 WRITE(numout,*)' meltponds fraction & depth = ', TRIM(sn_snd_mpnd%cldes ), ' (', TRIM(sn_snd_mpnd%clcat ), ')' 285 WRITE(numout,*)' sea surface freezing temp = ', TRIM(sn_snd_sstfrz%cldes ), ' (', TRIM(sn_snd_sstfrz%clcat ), ')' 286 269 287 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 270 288 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask 289 WRITE(numout,*)' ln_coupled_iceshelf_fluxes = ', ln_coupled_iceshelf_fluxes 290 WRITE(numout,*)' rn_greenland_calving_fraction = ', rn_greenland_calving_fraction 291 WRITE(numout,*)' rn_antarctica_calving_fraction = ', rn_antarctica_calving_fraction 292 WRITE(numout,*)' rn_iceshelf_fluxes_tolerance = ', rn_iceshelf_fluxes_tolerance 271 293 ENDIF 272 294 … … 381 403 srcv(jpr_snow)%clname = 'OTotSnow' ! Snow = solid precipitation 382 404 srcv(jpr_tevp)%clname = 'OTotEvap' ! total evaporation (over oce + ice sublimation) 383 srcv(jpr_ievp)%clname = 'OIceEv ap' ! evaporation over ice = sublimation405 srcv(jpr_ievp)%clname = 'OIceEvp' ! evaporation over ice = sublimation 384 406 srcv(jpr_sbpr)%clname = 'OSubMPre' ! sublimation - liquid precipitation - solid precipitation 385 407 srcv(jpr_semp)%clname = 'OISubMSn' ! ice solid water budget = sublimation - solid precipitation … … 395 417 END SELECT 396 418 ! 419 !Set the number of categories for coupling of sublimation 420 IF ( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = jpl 421 ! 397 422 ! ! ------------------------- ! 398 423 ! ! Runoffs & Calving ! … … 408 433 ! 409 434 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 435 srcv(jpr_grnm )%clname = 'OGrnmass' ; IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled' ) srcv(jpr_grnm)%laction = .TRUE. 436 srcv(jpr_antm )%clname = 'OAntmass' ; IF( TRIM( sn_rcv_antm%cldes ) == 'coupled' ) srcv(jpr_antm)%laction = .TRUE. 410 437 ! 411 438 ! ! ------------------------- ! … … 481 508 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 482 509 ENDIF 510 511 #if defined key_cice && ! defined key_cice4 512 ! ! ----------------------------- ! 513 ! ! sea-ice skin temperature ! 514 ! ! used in meltpond scheme ! 515 ! ! May be calculated in Atm ! 516 ! ! ----------------------------- ! 517 srcv(jpr_ts_ice)%clname = 'OTsfIce' 518 IF ( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' ) srcv(jpr_ts_ice)%laction = .TRUE. 519 IF ( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' ) srcv(jpr_ts_ice)%nct = jpl 520 !TODO: Should there be a consistency check here? 521 #endif 522 483 523 ! ! ------------------------------- ! 484 524 ! ! OPA-SAS coupling - rcv by opa ! … … 598 638 ! ! ------------------------- ! 599 639 ssnd(jps_toce)%clname = 'O_SSTSST' 600 ssnd(jps_tice)%clname = 'O _TepIce'640 ssnd(jps_tice)%clname = 'OTepIce' 601 641 ssnd(jps_tmix)%clname = 'O_TepMix' 602 642 SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 603 643 CASE( 'none' ) ! nothing to do 604 644 CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE. 605 CASE( 'oce and ice' , 'weighted oce and ice' )645 CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice') 606 646 ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 607 647 IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl … … 637 677 ssnd(jps_hice)%clname = 'OIceTck' 638 678 ssnd(jps_hsnw)%clname = 'OSnwTck' 679 ssnd(jps_a_p)%clname = 'OPndFrc' 680 ssnd(jps_ht_p)%clname = 'OPndTck' 681 ssnd(jps_fice1)%clname = 'OIceFrd' 639 682 IF( k_ice /= 0 ) THEN 640 683 ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case) 684 ssnd(jps_fice1)%laction = .TRUE. ! First-order regridded ice concentration, to be used 685 ! in producing atmos-to-ice fluxes 641 686 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 642 687 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl … … 655 700 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 656 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 657 739 658 740 ! ! ------------------------- ! … … 687 769 ! ! ------------------------- ! 688 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 689 803 690 804 ! ! ------------------------------- ! … … 783 897 ncpl_qsr_freq = 86400 / ncpl_qsr_freq 784 898 785 CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 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 922 CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 786 923 ! 787 924 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_init') … … 841 978 !! 842 979 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 843 INTEGER :: ji, jj, j n! dummy loop indices980 INTEGER :: ji, jj, jl, jn ! dummy loop indices 844 981 INTEGER :: isec ! number of seconds since nit000 (assuming rdt did not change since nit000) 845 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 846 986 REAL(wp) :: zcoef ! temporary scalar 847 987 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 … … 894 1034 IF( srcv(jpr_otx2)%laction ) THEN 895 1035 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 896 ELSE 1036 ELSE 897 1037 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 898 1038 ENDIF … … 991 1131 #endif 992 1132 1133 #if defined key_cice && ! defined key_cice4 1134 ! ! Sea ice surface skin temp: 1135 IF( srcv(jpr_ts_ice)%laction ) THEN 1136 DO jl = 1, jpl 1137 DO jj = 1, jpj 1138 DO ji = 1, jpi 1139 IF (frcv(jpr_ts_ice)%z3(ji,jj,jl) > 0.0) THEN 1140 tsfc_ice(ji,jj,jl) = 0.0 1141 ELSE IF (frcv(jpr_ts_ice)%z3(ji,jj,jl) < -60.0) THEN 1142 tsfc_ice(ji,jj,jl) = -60.0 1143 ELSE 1144 tsfc_ice(ji,jj,jl) = frcv(jpr_ts_ice)%z3(ji,jj,jl) 1145 ENDIF 1146 END DO 1147 END DO 1148 END DO 1149 ENDIF 1150 #endif 1151 993 1152 ! Fields received by SAS when OASIS coupling 994 1153 ! (arrays no more filled at sbcssm stage) … … 1105 1264 ! 1106 1265 ENDIF 1266 1267 ! ! land ice masses : Greenland 1268 zepsilon = rn_iceshelf_fluxes_tolerance 1269 1270 IF( srcv(jpr_grnm)%laction ) THEN 1271 greenland_icesheet_mass_array(:,:) = frcv(jpr_grnm)%z3(:,:,1) 1272 ! take average over ocean points of input array to avoid cumulative error over time 1273 zgreenland_icesheet_mass_in = SUM( greenland_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1274 IF(lk_mpp) CALL mpp_sum( zgreenland_icesheet_mass_in ) 1275 zmask_sum = SUM( tmask(:,:,1) ) 1276 IF(lk_mpp) CALL mpp_sum( zmask_sum ) 1277 zgreenland_icesheet_mass_in = zgreenland_icesheet_mass_in / zmask_sum 1278 greenland_icesheet_timelapsed = greenland_icesheet_timelapsed + rdt 1279 IF( ABS( zgreenland_icesheet_mass_in - greenland_icesheet_mass ) > zepsilon ) THEN 1280 zgreenland_icesheet_mass_b = greenland_icesheet_mass 1281 1282 ! Only update the mass if it has increased 1283 IF ( (zgreenland_icesheet_mass_in - greenland_icesheet_mass) > 0.0 ) THEN 1284 greenland_icesheet_mass = zgreenland_icesheet_mass_in 1285 ENDIF 1286 1287 IF( zgreenland_icesheet_mass_b /= 0.0 ) & 1288 & greenland_icesheet_mass_rate_of_change = ( greenland_icesheet_mass - zgreenland_icesheet_mass_b ) / greenland_icesheet_timelapsed 1289 greenland_icesheet_timelapsed = 0.0_wp 1290 ENDIF 1291 IF(lwp) WRITE(numout,*) 'Greenland icesheet mass (kg) read in is ', zgreenland_icesheet_mass_in 1292 IF(lwp) WRITE(numout,*) 'Greenland icesheet mass (kg) used is ', greenland_icesheet_mass 1293 IF(lwp) WRITE(numout,*) 'Greenland icesheet mass rate of change (kg/s) is ', greenland_icesheet_mass_rate_of_change 1294 IF(lwp) WRITE(numout,*) 'Greenland icesheet seconds lapsed since last change is ', greenland_icesheet_timelapsed 1295 ENDIF 1296 1297 ! ! land ice masses : Antarctica 1298 IF( srcv(jpr_antm)%laction ) THEN 1299 antarctica_icesheet_mass_array(:,:) = frcv(jpr_antm)%z3(:,:,1) 1300 ! take average over ocean points of input array to avoid cumulative error from rounding errors over time 1301 zantarctica_icesheet_mass_in = SUM( antarctica_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1302 IF(lk_mpp) CALL mpp_sum( zantarctica_icesheet_mass_in ) 1303 zmask_sum = SUM( tmask(:,:,1) ) 1304 IF(lk_mpp) CALL mpp_sum( zmask_sum ) 1305 zantarctica_icesheet_mass_in = zantarctica_icesheet_mass_in / zmask_sum 1306 antarctica_icesheet_timelapsed = antarctica_icesheet_timelapsed + rdt 1307 IF( ABS( zantarctica_icesheet_mass_in - antarctica_icesheet_mass ) > zepsilon ) THEN 1308 zantarctica_icesheet_mass_b = antarctica_icesheet_mass 1309 1310 ! Only update the mass if it has increased 1311 IF ( (zantarctica_icesheet_mass_in - antarctica_icesheet_mass) > 0.0 ) THEN 1312 antarctica_icesheet_mass = zantarctica_icesheet_mass_in 1313 END IF 1314 1315 IF( zantarctica_icesheet_mass_b /= 0.0 ) & 1316 & antarctica_icesheet_mass_rate_of_change = ( antarctica_icesheet_mass - zantarctica_icesheet_mass_b ) / antarctica_icesheet_timelapsed 1317 antarctica_icesheet_timelapsed = 0.0_wp 1318 ENDIF 1319 IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass (kg) read in is ', zantarctica_icesheet_mass_in 1320 IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass (kg) used is ', antarctica_icesheet_mass 1321 IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass rate of change (kg/s) is ', antarctica_icesheet_mass_rate_of_change 1322 IF(lwp) WRITE(numout,*) 'Antarctica icesheet seconds lapsed since last change is ', antarctica_icesheet_timelapsed 1323 ENDIF 1324 1107 1325 ! 1108 1326 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) … … 1400 1618 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1401 1619 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1620 #if defined key_cice 1621 IF ( TRIM(sn_rcv_emp%clcat) == 'yes' ) THEN 1622 ! zemp_ice is the sum of frcv(jpr_ievp)%z3(:,:,1) over all layers - snow 1623 zemp_ice(:,:) = - frcv(jpr_snow)%z3(:,:,1) 1624 DO jl=1,jpl 1625 zemp_ice(:,: ) = zemp_ice(:,:) + frcv(jpr_ievp)%z3(:,:,jl) 1626 ENDDO 1627 ! latent heat coupled for each category in CICE 1628 qla_ice(:,:,1:jpl) = - frcv(jpr_ievp)%z3(:,:,1:jpl) * lsub 1629 ELSE 1630 ! If CICE has multicategories it still expects coupling fields for 1631 ! each even if we treat as a single field 1632 ! The latent heat flux is split between the ice categories according 1633 ! to the fraction of the ice in each category 1634 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1635 WHERE ( zicefr(:,:) /= 0._wp ) 1636 ztmp(:,:) = 1./zicefr(:,:) 1637 ELSEWHERE 1638 ztmp(:,:) = 0.e0 1639 END WHERE 1640 DO jl=1,jpl 1641 qla_ice(:,:,jl) = - a_i(:,:,jl) * ztmp(:,:) * frcv(jpr_ievp)%z3(:,:,1) * lsub 1642 END DO 1643 WHERE ( zicefr(:,:) == 0._wp ) qla_ice(:,:,1) = -frcv(jpr_ievp)%z3(:,:,1) * lsub 1644 ENDIF 1645 #else 1402 1646 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1647 #endif 1403 1648 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1404 1649 IF( iom_use('hflx_rain_cea') ) & … … 1795 2040 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1796 2041 END SELECT 2042 CASE( 'oce and weighted ice' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0 2043 SELECT CASE( sn_snd_temp%clcat ) 2044 CASE( 'yes' ) 2045 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2046 CASE( 'no' ) 2047 ztmp3(:,:,:) = 0.0 2048 DO jl=1,jpl 2049 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 2050 ENDDO 2051 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 2052 END SELECT 1797 2053 CASE( 'mixed oce-ice' ) 1798 2054 ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) … … 1865 2121 END SELECT 1866 2122 IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info ) 2123 ENDIF 2124 2125 ! Send ice fraction field (first order interpolation), for weighting UM fluxes to be passed to NEMO 2126 IF (ssnd(jps_fice1)%laction) THEN 2127 SELECT CASE (sn_snd_thick1%clcat) 2128 CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl) 2129 CASE( 'no' ) ; ztmp3(:,:,1) = fr_i(:,:) 2130 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' ) 2131 END SELECT 2132 CALL cpl_snd (jps_fice1, isec, ztmp3, info) 1867 2133 ENDIF 1868 2134 … … 1910 2176 IF( ssnd(jps_hsnw)%laction ) CALL cpl_snd( jps_hsnw, isec, ztmp4, info ) 1911 2177 ENDIF 2178 ! 2179 ! Send meltpond fields 2180 IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN 2181 SELECT CASE( sn_snd_mpnd%cldes) 2182 CASE( 'weighted ice' ) 2183 SELECT CASE( sn_snd_mpnd%clcat ) 2184 CASE( 'yes' ) 2185 ztmp3(:,:,1:jpl) = a_p(:,:,1:jpl) * a_i(:,:,1:jpl) 2186 ztmp4(:,:,1:jpl) = ht_p(:,:,1:jpl) * a_i(:,:,1:jpl) 2187 CASE( 'no' ) 2188 ztmp3(:,:,:) = 0.0 2189 ztmp4(:,:,:) = 0.0 2190 DO jl=1,jpl 2191 ztmp3(:,:,1) = ztmp3(:,:,1) + a_p(:,:,jpl) * a_i(:,:,jpl) 2192 ztmp4(:,:,1) = ztmp4(:,:,1) + ht_p(:,:,jpl) * a_i(:,:,jpl) 2193 ENDDO 2194 CASE default ; CALL ctl_stop( 'sbc_cpl_mpd: wrong definition of sn_snd_mpnd%clcat' ) 2195 END SELECT 2196 CASE( 'ice only' ) 2197 ztmp3(:,:,1:jpl) = a_p(:,:,1:jpl) 2198 ztmp4(:,:,1:jpl) = ht_p(:,:,1:jpl) 2199 END SELECT 2200 IF( ssnd(jps_a_p)%laction ) CALL cpl_snd( jps_a_p, isec, ztmp3, info ) 2201 IF( ssnd(jps_ht_p)%laction ) CALL cpl_snd( jps_ht_p, isec, ztmp4, info ) 2202 ! 2203 ! Send ice effective conductivity 2204 SELECT CASE( sn_snd_cond%cldes) 2205 CASE( 'weighted ice' ) 2206 SELECT CASE( sn_snd_cond%clcat ) 2207 CASE( 'yes' ) 2208 ztmp3(:,:,1:jpl) = kn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2209 CASE( 'no' ) 2210 ztmp3(:,:,:) = 0.0 2211 DO jl=1,jpl 2212 ztmp3(:,:,1) = ztmp3(:,:,1) + kn_ice(:,:,jl) * a_i(:,:,jl) 2213 ENDDO 2214 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' ) 2215 END SELECT 2216 CASE( 'ice only' ) 2217 ztmp3(:,:,1:jpl) = kn_ice(:,:,1:jpl) 2218 END SELECT 2219 IF( ssnd(jps_kice)%laction ) CALL cpl_snd( jps_kice, isec, ztmp3, info ) 2220 ENDIF 2221 ! 1912 2222 ! 1913 2223 #if defined key_cpl_carbon_cycle … … 2089 2399 IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info ) 2090 2400 IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 2091 2401 2402 ztmp1(:,:) = sstfrz(:,:) + rt0 2403 IF( ssnd(jps_sstfrz)%laction ) CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2404 ! 2092 2405 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 2093 2406 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )
Note: See TracChangeset
for help on using the changeset viewer.
