Changeset 6659 for branches/UKMO/dev_r5518_GSI7_GSI8_landice_bitcomp_medusa/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
- Timestamp:
- 2016-06-02T16:40:33+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GSI7_GSI8_landice_bitcomp_medusa/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r6658 r6659 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 53 50 #endif 51 USE lib_fortran, ONLY: glob_sum 54 52 55 53 IMPLICIT NONE … … 105 103 INTEGER, PARAMETER :: jpr_e3t1st = 41 ! first T level thickness 106 104 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 105 INTEGER, PARAMETER :: jpr_ts_ice = 43 ! skin temperature of sea-ice (used for melt-ponds) 106 INTEGER, PARAMETER :: jpr_grnm = 44 ! Greenland ice mass 107 INTEGER, PARAMETER :: jpr_antm = 45 ! Antarctic ice mass 108 INTEGER, PARAMETER :: jprcv = 45 ! total number of fields received 108 109 109 110 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere … … 135 136 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 136 137 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 138 INTEGER, PARAMETER :: jps_a_p = 29 ! meltpond fraction 139 INTEGER, PARAMETER :: jps_ht_p = 30 ! meltpond depth (m) 140 INTEGER, PARAMETER :: jps_kice = 31 ! ice surface layer thermal conductivity 141 INTEGER, PARAMETER :: jps_sstfrz = 32 ! sea-surface freezing temperature 142 INTEGER, PARAMETER :: jps_fice1 = 33 ! first-order ice concentration (for time-travelling ice coupling) 143 INTEGER, PARAMETER :: jpsnd = 33 ! total number of fields sended 138 144 139 145 ! !!** namelist namsbc_cpl ** … … 146 152 END TYPE FLD_C 147 153 ! Send to the atmosphere ! 148 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 154 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 155 149 156 ! Received from the atmosphere ! 150 157 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 158 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_ts_ice, sn_rcv_grnm, sn_rcv_antm 152 159 ! Other namelist parameters ! 153 160 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data … … 216 223 REAL(wp), POINTER, DIMENSION(:,:) :: zacs, zaos 217 224 !! 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 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 222 232 !!--------------------------------------------------------------------- 223 233 ! … … 258 268 WRITE(numout,*)' runoffs = ', TRIM(sn_rcv_rnf%cldes ), ' (', TRIM(sn_rcv_rnf%clcat ), ')' 259 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 ), ')' 260 272 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 261 273 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' … … 269 281 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 270 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 271 287 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 272 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 273 293 ENDIF 274 294 … … 383 403 srcv(jpr_snow)%clname = 'OTotSnow' ! Snow = solid precipitation 384 404 srcv(jpr_tevp)%clname = 'OTotEvap' ! total evaporation (over oce + ice sublimation) 385 srcv(jpr_ievp)%clname = 'OIceEv ap' ! evaporation over ice = sublimation405 srcv(jpr_ievp)%clname = 'OIceEvp' ! evaporation over ice = sublimation 386 406 srcv(jpr_sbpr)%clname = 'OSubMPre' ! sublimation - liquid precipitation - solid precipitation 387 407 srcv(jpr_semp)%clname = 'OISubMSn' ! ice solid water budget = sublimation - solid precipitation … … 396 416 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 397 417 END SELECT 398 418 !Set the number of categories for coupling of sublimation 419 IF ( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = jpl 420 ! 399 421 ! ! ------------------------- ! 400 422 ! ! Runoffs & Calving ! … … 410 432 ! 411 433 srcv(jpr_cal )%clname = 'OCalving' ; IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' ) srcv(jpr_cal)%laction = .TRUE. 434 srcv(jpr_grnm )%clname = 'OGrnmass' ; IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled' ) srcv(jpr_grnm)%laction = .TRUE. 435 srcv(jpr_antm )%clname = 'OAntmass' ; IF( TRIM( sn_rcv_antm%cldes ) == 'coupled' ) srcv(jpr_antm)%laction = .TRUE. 436 412 437 413 438 ! ! ------------------------- ! … … 483 508 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 484 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 485 523 ! ! ------------------------------- ! 486 524 ! ! OPA-SAS coupling - rcv by opa ! … … 600 638 ! ! ------------------------- ! 601 639 ssnd(jps_toce)%clname = 'O_SSTSST' 602 ssnd(jps_tice)%clname = 'O _TepIce'640 ssnd(jps_tice)%clname = 'OTepIce' 603 641 ssnd(jps_tmix)%clname = 'O_TepMix' 604 642 SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 605 643 CASE( 'none' ) ! nothing to do 606 644 CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE. 607 CASE( 'oce and ice' , 'weighted oce and ice' )645 CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice') 608 646 ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 609 647 IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl … … 634 672 635 673 ! ! ------------------------- ! 636 ! ! Ice fraction & Thickness !674 ! ! Ice fraction & Thickness 637 675 ! ! ------------------------- ! 638 676 ssnd(jps_fice)%clname = 'OIceFrc' 639 677 ssnd(jps_hice)%clname = 'OIceTck' 640 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' 641 682 IF( k_ice /= 0 ) THEN 642 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 643 686 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 644 687 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 688 IF ( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = jpl 645 689 ENDIF 646 690 … … 657 701 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 658 702 END SELECT 703 704 ! ! ------------------------- ! 705 ! ! Ice Meltponds ! 706 ! ! ------------------------- ! 707 #if defined key_cice && ! defined key_cice4 708 ! Meltponds only CICE5 709 ssnd(jps_a_p)%clname = 'OPndFrc' 710 ssnd(jps_ht_p)%clname = 'OPndTck' 711 SELECT CASE ( TRIM( sn_snd_mpnd%cldes ) ) 712 CASE ( 'none' ) 713 ssnd(jps_a_p)%laction = .FALSE. 714 ssnd(jps_ht_p)%laction = .FALSE. 715 CASE ( 'ice only' ) 716 ssnd(jps_a_p)%laction = .TRUE. 717 ssnd(jps_ht_p)%laction = .TRUE. 718 IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 719 ssnd(jps_a_p)%nct = jpl 720 ssnd(jps_ht_p)%nct = jpl 721 ELSE 722 IF ( jpl > 1 ) THEN 723 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 724 ENDIF 725 ENDIF 726 CASE ( 'weighted ice' ) 727 ssnd(jps_a_p)%laction = .TRUE. 728 ssnd(jps_ht_p)%laction = .TRUE. 729 IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 730 ssnd(jps_a_p)%nct = jpl 731 ssnd(jps_ht_p)%nct = jpl 732 ENDIF 733 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_mpnd%cldes' ) 734 END SELECT 735 #else 736 IF( TRIM( sn_snd_mpnd%cldes ) /= 'none' ) THEN 737 CALL ctl_stop('Meltponds can only be used with CICEv5') 738 ENDIF 739 #endif 659 740 660 741 ! ! ------------------------- ! … … 689 770 ! ! ------------------------- ! 690 771 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 772 ! 773 774 ! ! ------------------------- ! 775 ! ! Sea surface freezing temp ! 776 ! ! ------------------------- ! 777 ssnd(jps_sstfrz)%clname = 'O_SSTFrz' ; IF( TRIM(sn_snd_sstfrz%cldes) == 'coupled' ) ssnd(jps_sstfrz)%laction = .TRUE. 778 ! 779 ! ! ------------------------- ! 780 ! ! Ice conductivity ! 781 ! ! ------------------------- ! 782 ! Note that ultimately we will move to passing an ocean effective conductivity as well so there 783 ! will be some changes to the parts of the code which currently relate only to ice conductivity 784 ssnd(jps_kice )%clname = 'OIceKn' 785 SELECT CASE ( TRIM( sn_snd_cond%cldes ) ) 786 CASE ( 'none' ) 787 ssnd(jps_kice)%laction = .FALSE. 788 CASE ( 'ice only' ) 789 ssnd(jps_kice)%laction = .TRUE. 790 IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 791 ssnd(jps_kice)%nct = jpl 792 ELSE 793 IF ( jpl > 1 ) THEN 794 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 795 ENDIF 796 ENDIF 797 CASE ( 'weighted ice' ) 798 ssnd(jps_kice)%laction = .TRUE. 799 IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = jpl 800 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes' ) 801 END SELECT 802 ! 803 691 804 692 805 ! ! ------------------------------- ! … … 785 898 ncpl_qsr_freq = 86400 / ncpl_qsr_freq 786 899 900 IF( ln_coupled_iceshelf_fluxes ) THEN 901 ! Crude masks to separate the Antarctic and Greenland icesheets. Obviously something 902 ! more complicated could be done if required. 903 greenland_icesheet_mask = 0.0 904 WHERE( gphit >= 0.0 ) greenland_icesheet_mask = 1.0 905 antarctica_icesheet_mask = 0.0 906 WHERE( gphit < 0.0 ) antarctica_icesheet_mask = 1.0 907 908 ! initialise other variables 909 greenland_icesheet_mass_array(:,:) = 0.0 910 antarctica_icesheet_mass_array(:,:) = 0.0 911 912 IF( .not. ln_rstart ) THEN 913 greenland_icesheet_mass = 0.0 914 greenland_icesheet_mass_rate_of_change = 0.0 915 greenland_icesheet_timelapsed = 0.0 916 antarctica_icesheet_mass = 0.0 917 antarctica_icesheet_mass_rate_of_change = 0.0 918 antarctica_icesheet_timelapsed = 0.0 919 ENDIF 920 921 ENDIF 922 787 923 CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 788 924 ! … … 843 979 !! 844 980 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 845 INTEGER :: ji, jj, j n! dummy loop indices981 INTEGER :: ji, jj, jl, jn ! dummy loop indices 846 982 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) 847 983 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 984 REAL(wp) :: zgreenland_icesheet_mass_in, zantarctica_icesheet_mass_in 985 REAL(wp) :: zgreenland_icesheet_mass_b, zantarctica_icesheet_mass_b 986 REAL(wp) :: zmask_sum, zepsilon 848 987 REAL(wp) :: zcoef ! temporary scalar 849 988 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 … … 997 1136 #endif 998 1137 1138 #if defined key_cice && ! defined key_cice4 1139 ! ! Sea ice surface skin temp: 1140 IF( srcv(jpr_ts_ice)%laction ) THEN 1141 DO jl = 1, jpl 1142 DO jj = 1, jpj 1143 DO ji = 1, jpi 1144 IF (frcv(jpr_ts_ice)%z3(ji,jj,jl) > 0.0) THEN 1145 tsfc_ice(ji,jj,jl) = 0.0 1146 ELSE IF (frcv(jpr_ts_ice)%z3(ji,jj,jl) < -60.0) THEN 1147 tsfc_ice(ji,jj,jl) = -60.0 1148 ELSE 1149 tsfc_ice(ji,jj,jl) = frcv(jpr_ts_ice)%z3(ji,jj,jl) 1150 ENDIF 1151 END DO 1152 END DO 1153 END DO 1154 ENDIF 1155 #endif 1156 999 1157 ! Fields received by SAS when OASIS coupling 1000 1158 ! (arrays no more filled at sbcssm stage) … … 1110 1268 1111 1269 ENDIF 1270 1271 ! ! land ice masses : Greenland 1272 zepsilon = rn_iceshelf_fluxes_tolerance 1273 1274 1275 ! See if we need zmask_sum... 1276 IF ( srcv(jpr_grnm)%laction .OR. srcv(jpr_antm)%laction ) THEN 1277 zmask_sum = glob_sum( tmask(:,:,1) ) 1278 ENDIF 1279 1280 IF( srcv(jpr_grnm)%laction ) THEN 1281 greenland_icesheet_mass_array(:,:) = frcv(jpr_grnm)%z3(:,:,1) 1282 ! take average over ocean points of input array to avoid cumulative error over time 1283 1284 ! The following must be bit reproducible over different PE decompositions 1285 zgreenland_icesheet_mass_in = glob_sum( greenland_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1286 1287 zgreenland_icesheet_mass_in = zgreenland_icesheet_mass_in / zmask_sum 1288 greenland_icesheet_timelapsed = greenland_icesheet_timelapsed + rdt 1289 IF( ABS( zgreenland_icesheet_mass_in - greenland_icesheet_mass ) > zepsilon ) THEN 1290 zgreenland_icesheet_mass_b = greenland_icesheet_mass 1291 1292 ! Only update the mass if it has increased 1293 IF ( (zgreenland_icesheet_mass_in - greenland_icesheet_mass) > 0.0 ) THEN 1294 greenland_icesheet_mass = zgreenland_icesheet_mass_in 1295 ENDIF 1296 1297 IF( zgreenland_icesheet_mass_b /= 0.0 ) & 1298 & greenland_icesheet_mass_rate_of_change = ( greenland_icesheet_mass - zgreenland_icesheet_mass_b ) / greenland_icesheet_timelapsed 1299 greenland_icesheet_timelapsed = 0.0_wp 1300 ENDIF 1301 IF(lwp) WRITE(numout,*) 'Greenland icesheet mass (kg) read in is ', zgreenland_icesheet_mass_in 1302 IF(lwp) WRITE(numout,*) 'Greenland icesheet mass (kg) used is ', greenland_icesheet_mass 1303 IF(lwp) WRITE(numout,*) 'Greenland icesheet mass rate of change (kg/s) is ', greenland_icesheet_mass_rate_of_change 1304 IF(lwp) WRITE(numout,*) 'Greenland icesheet seconds lapsed since last change is ', greenland_icesheet_timelapsed 1305 ENDIF 1306 1307 ! ! land ice masses : Antarctica 1308 IF( srcv(jpr_antm)%laction ) THEN 1309 antarctica_icesheet_mass_array(:,:) = frcv(jpr_antm)%z3(:,:,1) 1310 ! take average over ocean points of input array to avoid cumulative error from rounding errors over time 1311 ! The following must be bit reproducible over different PE decompositions 1312 zantarctica_icesheet_mass_in = glob_sum( antarctica_icesheet_mass_array(:,:) * tmask(:,:,1) ) 1313 1314 zantarctica_icesheet_mass_in = zantarctica_icesheet_mass_in / zmask_sum 1315 antarctica_icesheet_timelapsed = antarctica_icesheet_timelapsed + rdt 1316 IF( ABS( zantarctica_icesheet_mass_in - antarctica_icesheet_mass ) > zepsilon ) THEN 1317 zantarctica_icesheet_mass_b = antarctica_icesheet_mass 1318 1319 ! Only update the mass if it has increased 1320 IF ( (zantarctica_icesheet_mass_in - antarctica_icesheet_mass) > 0.0 ) THEN 1321 antarctica_icesheet_mass = zantarctica_icesheet_mass_in 1322 END IF 1323 1324 IF( zantarctica_icesheet_mass_b /= 0.0 ) & 1325 & antarctica_icesheet_mass_rate_of_change = ( antarctica_icesheet_mass - zantarctica_icesheet_mass_b ) / antarctica_icesheet_timelapsed 1326 antarctica_icesheet_timelapsed = 0.0_wp 1327 ENDIF 1328 IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass (kg) read in is ', zantarctica_icesheet_mass_in 1329 IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass (kg) used is ', antarctica_icesheet_mass 1330 IF(lwp) WRITE(numout,*) 'Antarctica icesheet mass rate of change (kg/s) is ', antarctica_icesheet_mass_rate_of_change 1331 IF(lwp) WRITE(numout,*) 'Antarctica icesheet seconds lapsed since last change is ', antarctica_icesheet_timelapsed 1332 ENDIF 1333 1112 1334 ! 1113 1335 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) … … 1403 1625 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1404 1626 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1405 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1627 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1628 #if defined key_cice 1629 IF ( TRIM(sn_rcv_emp%clcat) == 'yes' ) THEN 1630 ! zemp_ice is the sum of frcv(jpr_ievp)%z3(:,:,1) over all layers - snow 1631 zemp_ice(:,:) = - frcv(jpr_snow)%z3(:,:,1) 1632 DO jl=1,jpl 1633 zemp_ice(:,: ) = zemp_ice(:,:) + frcv(jpr_ievp)%z3(:,:,jl) 1634 ENDDO 1635 ! latent heat coupled for each category in CICE 1636 qla_ice(:,:,1:jpl) = - frcv(jpr_ievp)%z3(:,:,1:jpl) * lsub 1637 ELSE 1638 ! If CICE has multicategories it still expects coupling fields for 1639 ! each even if we treat as a single field 1640 ! The latent heat flux is split between the ice categories according 1641 ! to the fraction of the ice in each category 1642 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1643 WHERE ( zicefr(:,:) /= 0._wp ) 1644 ztmp(:,:) = 1./zicefr(:,:) 1645 ELSEWHERE 1646 ztmp(:,:) = 0.e0 1647 END WHERE 1648 DO jl=1,jpl 1649 qla_ice(:,:,jl) = - a_i(:,:,jl) * ztmp(:,:) * frcv(jpr_ievp)%z3(:,:,1) * lsub 1650 END DO 1651 WHERE ( zicefr(:,:) == 0._wp ) qla_ice(:,:,1) = -frcv(jpr_ievp)%z3(:,:,1) * lsub 1652 ENDIF 1653 #else 1406 1654 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1655 #endif 1407 1656 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1408 1657 IF( iom_use('hflx_rain_cea') ) & … … 1758 2007 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1759 2008 END SELECT 2009 CASE( 'oce and weighted ice' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0 2010 SELECT CASE( sn_snd_temp%clcat ) 2011 CASE( 'yes' ) 2012 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2013 CASE( 'no' ) 2014 ztmp3(:,:,:) = 0.0 2015 DO jl=1,jpl 2016 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 2017 ENDDO 2018 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 2019 END SELECT 1760 2020 CASE( 'mixed oce-ice' ) 1761 2021 ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) … … 1799 2059 END SELECT 1800 2060 IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info ) 2061 ENDIF 2062 2063 ! Send ice fraction field (first order interpolation), for weighting UM fluxes to be passed to NEMO 2064 IF (ssnd(jps_fice1)%laction) THEN 2065 SELECT CASE (sn_snd_thick1%clcat) 2066 CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl) 2067 CASE( 'no' ) ; ztmp3(:,:,1) = fr_i(:,:) 2068 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' ) 2069 END SELECT 2070 CALL cpl_snd (jps_fice1, isec, ztmp3, info) 1801 2071 ENDIF 1802 2072 … … 1844 2114 IF( ssnd(jps_hsnw)%laction ) CALL cpl_snd( jps_hsnw, isec, ztmp4, info ) 1845 2115 ENDIF 2116 ! 2117 #if defined key_cice && ! defined key_cice4 2118 ! Send meltpond fields 2119 IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN 2120 SELECT CASE( sn_snd_mpnd%cldes) 2121 CASE( 'weighted ice' ) 2122 SELECT CASE( sn_snd_mpnd%clcat ) 2123 CASE( 'yes' ) 2124 ztmp3(:,:,1:jpl) = a_p(:,:,1:jpl) * a_i(:,:,1:jpl) 2125 ztmp4(:,:,1:jpl) = ht_p(:,:,1:jpl) * a_i(:,:,1:jpl) 2126 CASE( 'no' ) 2127 ztmp3(:,:,:) = 0.0 2128 ztmp4(:,:,:) = 0.0 2129 DO jl=1,jpl 2130 ztmp3(:,:,1) = ztmp3(:,:,1) + a_p(:,:,jpl) * a_i(:,:,jpl) 2131 ztmp4(:,:,1) = ztmp4(:,:,1) + ht_p(:,:,jpl) * a_i(:,:,jpl) 2132 ENDDO 2133 CASE default ; CALL ctl_stop( 'sbc_cpl_mpd: wrong definition of sn_snd_mpnd%clcat' ) 2134 END SELECT 2135 CASE( 'ice only' ) 2136 ztmp3(:,:,1:jpl) = a_p(:,:,1:jpl) 2137 ztmp4(:,:,1:jpl) = ht_p(:,:,1:jpl) 2138 END SELECT 2139 IF( ssnd(jps_a_p)%laction ) CALL cpl_snd( jps_a_p, isec, ztmp3, info ) 2140 IF( ssnd(jps_ht_p)%laction ) CALL cpl_snd( jps_ht_p, isec, ztmp4, info ) 2141 ! 2142 ! Send ice effective conductivity 2143 SELECT CASE( sn_snd_cond%cldes) 2144 CASE( 'weighted ice' ) 2145 SELECT CASE( sn_snd_cond%clcat ) 2146 CASE( 'yes' ) 2147 ztmp3(:,:,1:jpl) = kn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2148 CASE( 'no' ) 2149 ztmp3(:,:,:) = 0.0 2150 DO jl=1,jpl 2151 ztmp3(:,:,1) = ztmp3(:,:,1) + kn_ice(:,:,jl) * a_i(:,:,jl) 2152 ENDDO 2153 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' ) 2154 END SELECT 2155 CASE( 'ice only' ) 2156 ztmp3(:,:,1:jpl) = kn_ice(:,:,1:jpl) 2157 END SELECT 2158 IF( ssnd(jps_kice)%laction ) CALL cpl_snd( jps_kice, isec, ztmp3, info ) 2159 ENDIF 2160 #endif 2161 ! 1846 2162 ! 1847 2163 #if defined key_cpl_carbon_cycle … … 2023 2339 IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info ) 2024 2340 IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 2025 2341 2342 #if defined key_cice 2343 ztmp1(:,:) = sstfrz(:,:) + rt0 2344 IF( ssnd(jps_sstfrz)%laction ) CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2345 #endif 2346 ! 2026 2347 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 2027 2348 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 )
Note: See TracChangeset
for help on using the changeset viewer.
