- Timestamp:
- 2015-08-03T15:53:06+02:00 (9 years ago)
- Location:
- branches/UKMO/dev_r5518_CICE_coupling_GSI7_GSI8/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_CICE_coupling_GSI7_GSI8/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r5662 r5663 68 68 REAL(wp), PUBLIC :: rcdsn = 0.31_wp !: thermal conductivity of snow 69 69 REAL(wp), PUBLIC :: cpic = 2067.0_wp !: specific heat for ice 70 #if defined key_cice 71 REAL(wp), PUBLIC :: lsub = 2.835e+6_wp !: pure ice latent heat of sublimation [J/kg] 72 #else 70 73 REAL(wp), PUBLIC :: lsub = 2.834e+6_wp !: pure ice latent heat of sublimation [J/kg] 74 #endif 71 75 REAL(wp), PUBLIC :: lfus = 0.334e+6_wp !: latent heat of fusion of fresh ice [J/kg] 72 76 REAL(wp), PUBLIC :: tmut = 0.054_wp !: decrease of seawater meltpoint with salinity -
branches/UKMO/dev_r5518_CICE_coupling_GSI7_GSI8/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r5662 r5663 101 101 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_iu !: ice fraction at NEMO U point 102 102 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_iv !: ice fraction at NEMO V point 103 103 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sstfrz !: sea surface freezing temperature 104 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tsfc_ice !: sea-ice surface skin temperature (on categories) 105 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: kn_ice !: sea-ice surface layer thermal conductivity (on cats) 106 104 107 ! variables used in the coupled interface 105 108 INTEGER , PUBLIC, PARAMETER :: jpl = ncat 106 109 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice ! jpi, jpj 110 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_p, ht_p ! Meltpond fraction and depth 107 111 #endif 108 112 … … 152 156 153 157 #if defined key_cice 154 ALLOCATE( qla_ice(jpi,jpj, 1), qlw_ice(jpi,jpj,1) , qsr_ice(jpi,jpj,1) , &158 ALLOCATE( qla_ice(jpi,jpj,ncat) , qlw_ice(jpi,jpj,1) , qsr_ice(jpi,jpj,1) , & 155 159 wndi_ice(jpi,jpj) , tatm_ice(jpi,jpj) , qatm_ice(jpi,jpj) , & 156 160 wndj_ice(jpi,jpj) , nfrzmlt(jpi,jpj) , ss_iou(jpi,jpj) , & 157 161 ss_iov(jpi,jpj) , fr_iu(jpi,jpj) , fr_iv(jpi,jpj) , & 158 162 a_i(jpi,jpj,ncat) , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 159 STAT= ierr(1) ) 160 IF( ln_cpl ) ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , & 163 sstfrz(jpi,jpj) , STAT= ierr(1) ) 164 ! Alex West: Allocating tn_ice with 5 categories. When NEMO is used with CICE, this variable 165 ! represents top layer ice temperature, which is multi-category. 166 IF( ln_cpl ) ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,jpl) , & 161 167 & v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1) , & 162 168 & emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , & 163 & STAT= ierr(2) ) 169 & a_p(jpi,jpj,jpl) , ht_p(jpi,jpj,jpl) , tsfc_ice(jpi,jpj,jpl) , & 170 & kn_ice(jpi,jpj,jpl) , STAT=ierr(2) ) 164 171 165 172 #endif -
branches/UKMO/dev_r5518_CICE_coupling_GSI7_GSI8/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5662 r5663 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 :: jprcv = 43 ! total number of fields received 108 106 109 107 INTEGER, PARAMETER :: jps_fice = 1 ! ice fraction sent to the atmosphere … … 135 133 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 136 134 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 135 INTEGER, PARAMETER :: jps_a_p = 29 ! meltpond fraction 136 INTEGER, PARAMETER :: jps_ht_p = 30 ! meltpond depth (m) 137 INTEGER, PARAMETER :: jps_kice = 31 ! ice surface layer thermal conductivity 138 INTEGER, PARAMETER :: jps_sstfrz = 32 ! sea-surface freezing temperature 139 INTEGER, PARAMETER :: jps_fice1 = 33 ! first-order ice concentration (for time-travelling ice coupling) 140 INTEGER, PARAMETER :: jpsnd = 33 ! total number of fields sended 138 141 139 142 ! !!** namelist namsbc_cpl ** … … 146 149 END TYPE FLD_C 147 150 ! Send to the atmosphere ! 148 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2 151 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 152 149 153 ! Received from the atmosphere ! 150 154 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 155 TYPE(FLD_C) :: sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_ts_ice 152 156 ! Other namelist parameters ! 153 157 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data … … 217 221 !! 218 222 NAMELIST/namsbc_cpl/ sn_snd_temp, sn_snd_alb , sn_snd_thick, sn_snd_crt , sn_snd_co2, & 223 & sn_snd_cond, sn_snd_mpnd, sn_snd_sstfrz, & 219 224 & sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau , sn_rcv_dqnsdt, sn_rcv_qsr, & 220 225 & sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , sn_rcv_iceflx, & 221 & sn_rcv_co2 , nn_cplmodel, ln_usecplmask226 & sn_rcv_co2 , sn_rcv_ts_ice, nn_cplmodel , ln_usecplmask 222 227 !!--------------------------------------------------------------------- 223 228 ! … … 269 274 WRITE(numout,*)' - mesh = ', sn_snd_crt%clvgrd 270 275 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 276 WRITE(numout,*)' ice effective conductivity = ', TRIM(sn_snd_cond%cldes ), ' (', TRIM(sn_snd_cond%clcat ), ')' 277 WRITE(numout,*)' meltponds fraction & depth = ', TRIM(sn_snd_mpnd%cldes ), ' (', TRIM(sn_snd_mpnd%clcat ), ')' 278 WRITE(numout,*)' sea surface freezing temp = ', TRIM(sn_snd_sstfrz%cldes ), ' (', TRIM(sn_snd_sstfrz%clcat ), ')' 279 271 280 WRITE(numout,*)' nn_cplmodel = ', nn_cplmodel 272 281 WRITE(numout,*)' ln_usecplmask = ', ln_usecplmask … … 383 392 srcv(jpr_snow)%clname = 'OTotSnow' ! Snow = solid precipitation 384 393 srcv(jpr_tevp)%clname = 'OTotEvap' ! total evaporation (over oce + ice sublimation) 385 srcv(jpr_ievp)%clname = 'OIceEv ap' ! evaporation over ice = sublimation394 srcv(jpr_ievp)%clname = 'OIceEvp' ! evaporation over ice = sublimation 386 395 srcv(jpr_sbpr)%clname = 'OSubMPre' ! sublimation - liquid precipitation - solid precipitation 387 396 srcv(jpr_semp)%clname = 'OISubMSn' ! ice solid water budget = sublimation - solid precipitation … … 396 405 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 397 406 END SELECT 398 407 !Set the number of categories for coupling of sublimation 408 IF ( TRIM( sn_rcv_emp%clcat ) == 'yes' ) srcv(jpr_ievp)%nct = jpl 409 ! 399 410 ! ! ------------------------- ! 400 411 ! ! Runoffs & Calving ! … … 483 494 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 484 495 ENDIF 496 497 #if defined key_cice && ! defined key_cice4 498 ! ! ----------------------------- ! 499 ! ! sea-ice skin temperature ! 500 ! ! used in meltpond scheme ! 501 ! ! May be calculated in Atm ! 502 ! ! ----------------------------- ! 503 srcv(jpr_ts_ice)%clname = 'OTsfIce' 504 IF ( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' ) srcv(jpr_ts_ice)%laction = .TRUE. 505 IF ( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' ) srcv(jpr_ts_ice)%nct = jpl 506 !TODO: Should there be a consistency check here? 507 #endif 508 485 509 ! ! ------------------------------- ! 486 510 ! ! OPA-SAS coupling - rcv by opa ! … … 600 624 ! ! ------------------------- ! 601 625 ssnd(jps_toce)%clname = 'O_SSTSST' 602 ssnd(jps_tice)%clname = 'O _TepIce'626 ssnd(jps_tice)%clname = 'OTepIce' 603 627 ssnd(jps_tmix)%clname = 'O_TepMix' 604 628 SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 605 629 CASE( 'none' ) ! nothing to do 606 630 CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE. 607 CASE( 'oce and ice' , 'weighted oce and ice' )631 CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice') 608 632 ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 609 633 IF ( TRIM( sn_snd_temp%clcat ) == 'yes' ) ssnd(jps_tice)%nct = jpl … … 634 658 635 659 ! ! ------------------------- ! 636 ! ! Ice fraction & Thickness !660 ! ! Ice fraction & Thickness 637 661 ! ! ------------------------- ! 638 662 ssnd(jps_fice)%clname = 'OIceFrc' 639 663 ssnd(jps_hice)%clname = 'OIceTck' 640 664 ssnd(jps_hsnw)%clname = 'OSnwTck' 665 ssnd(jps_a_p)%clname = 'OPndFrc' 666 ssnd(jps_ht_p)%clname = 'OPndTck' 667 ssnd(jps_fice1)%clname = 'OIceFrd' 641 668 IF( k_ice /= 0 ) THEN 642 669 ssnd(jps_fice)%laction = .TRUE. ! if ice treated in the ocean (even in climato case) 670 ssnd(jps_fice1)%laction = .TRUE. ! First-order regridded ice concentration, to be used 671 ! in producing atmos-to-ice fluxes 643 672 ! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 644 673 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_fice)%nct = jpl 674 IF ( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = jpl 645 675 ENDIF 646 676 … … 657 687 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 658 688 END SELECT 689 690 ! ! ------------------------- ! 691 ! ! Ice Meltponds ! 692 ! ! ------------------------- ! 693 #if defined key_cice && ! defined key_cice4 694 ! Meltponds only CICE5 695 ssnd(jps_a_p)%clname = 'OPndFrc' 696 ssnd(jps_ht_p)%clname = 'OPndTck' 697 SELECT CASE ( TRIM( sn_snd_mpnd%cldes ) ) 698 CASE ( 'none' ) 699 ssnd(jps_a_p)%laction = .FALSE. 700 ssnd(jps_ht_p)%laction = .FALSE. 701 CASE ( 'ice only' ) 702 ssnd(jps_a_p)%laction = .TRUE. 703 ssnd(jps_ht_p)%laction = .TRUE. 704 IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 705 ssnd(jps_a_p)%nct = jpl 706 ssnd(jps_ht_p)%nct = jpl 707 ELSE 708 IF ( jpl > 1 ) THEN 709 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' ) 710 ENDIF 711 ENDIF 712 CASE ( 'weighted ice' ) 713 ssnd(jps_a_p)%laction = .TRUE. 714 ssnd(jps_ht_p)%laction = .TRUE. 715 IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN 716 ssnd(jps_a_p)%nct = jpl 717 ssnd(jps_ht_p)%nct = jpl 718 ENDIF 719 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_mpnd%cldes' ) 720 END SELECT 721 #else 722 IF( TRIM( sn_snd_mpnd%cldes /= 'none' ) THEN 723 CALL ctl_stop('Meltponds can only be used with CICEv5') 724 ENDIF 725 #endif 659 726 660 727 ! ! ------------------------- ! … … 689 756 ! ! ------------------------- ! 690 757 ssnd(jps_co2)%clname = 'O_CO2FLX' ; IF( TRIM(sn_snd_co2%cldes) == 'coupled' ) ssnd(jps_co2 )%laction = .TRUE. 758 ! 759 760 ! ! ------------------------- ! 761 ! ! Sea surface freezing temp ! 762 ! ! ------------------------- ! 763 ssnd(jps_sstfrz)%clname = 'O_SSTFrz' ; IF( TRIM(sn_snd_sstfrz%cldes) == 'coupled' ) ssnd(jps_sstfrz)%laction = .TRUE. 764 ! 765 ! ! ------------------------- ! 766 ! ! Ice conductivity ! 767 ! ! ------------------------- ! 768 ! Note that ultimately we will move to passing an ocean effective conductivity as well so there 769 ! will be some changes to the parts of the code which currently relate only to ice conductivity 770 ssnd(jps_kice )%clname = 'OIceKn' 771 SELECT CASE ( TRIM( sn_snd_cond%cldes ) ) 772 CASE ( 'none' ) 773 ssnd(jps_kice)%laction = .FALSE. 774 CASE ( 'ice only' ) 775 ssnd(jps_kice)%laction = .TRUE. 776 IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN 777 ssnd(jps_kice)%nct = jpl 778 ELSE 779 IF ( jpl > 1 ) THEN 780 CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' ) 781 ENDIF 782 ENDIF 783 CASE ( 'weighted ice' ) 784 ssnd(jps_kice)%laction = .TRUE. 785 IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = jpl 786 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes' ) 787 END SELECT 788 ! 789 691 790 692 791 ! ! ------------------------------- ! … … 843 942 !! 844 943 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 845 INTEGER :: ji, jj, j n! dummy loop indices944 INTEGER :: ji, jj, jl, jn ! dummy loop indices 846 945 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) 847 946 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars … … 995 1094 ! ! ================== ! 996 1095 IF( srcv(jpr_co2)%laction ) atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1) 1096 #endif 1097 1098 #if defined key_cice && ! defined key_cice4 1099 ! ! Sea ice surface skin temp: 1100 IF( srcv(jpr_ts_ice)%laction ) THEN 1101 DO jl = 1, jpl 1102 DO jj = 1, jpj 1103 DO ji = 1, jpi 1104 IF (frcv(jpr_ts_ice)%z3(ji,jj,jl) > 0.0) THEN 1105 tsfc_ice(ji,jj,jl) = 0.0 1106 ELSE IF (frcv(jpr_ts_ice)%z3(ji,jj,jl) < -60.0) THEN 1107 tsfc_ice(ji,jj,jl) = -60.0 1108 ELSE 1109 tsfc_ice(ji,jj,jl) = frcv(jpr_ts_ice)%z3(ji,jj,jl) 1110 ENDIF 1111 END DO 1112 END DO 1113 END DO 1114 ENDIF 997 1115 #endif 998 1116 … … 1403 1521 zsprecip(:,:) = frcv(jpr_snow)%z3(:,:,1) ! May need to ensure positive here 1404 1522 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1405 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1523 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1524 #if defined key_cice 1525 IF ( TRIM(sn_rcv_emp%clcat) == 'yes' ) THEN 1526 ! zemp_ice is the sum of frcv(jpr_ievp)%z3(:,:,1) over all layers - snow 1527 zemp_ice(:,:) = - frcv(jpr_snow)%z3(:,:,1) 1528 DO jl=1,jpl 1529 zemp_ice(:,: ) = zemp_ice(:,:) + frcv(jpr_ievp)%z3(:,:,jl) 1530 ENDDO 1531 ! latent heat coupled for each category in CICE 1532 qla_ice(:,:,1:jpl) = - frcv(jpr_ievp)%z3(:,:,1:jpl) * lsub 1533 ELSE 1534 ! If CICE has multicategories it still expects coupling fields for 1535 ! each even if we treat as a single field 1536 ! The latent heat flux is split between the ice categories according 1537 ! to the fraction of the ice in each category 1538 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1539 WHERE ( zicefr(:,:) /= 0._wp ) 1540 ztmp(:,:) = 1./zicefr(:,:) 1541 ELSEWHERE 1542 ztmp(:,:) = 0.e0 1543 END WHERE 1544 DO jl=1,jpl 1545 qla_ice(:,:,jl) = - a_i(:,:,jl) * ztmp(:,:) * frcv(jpr_ievp)%z3(:,:,1) * lsub 1546 END DO 1547 WHERE ( zicefr(:,:) == 0._wp ) qla_ice(:,:,1) = -frcv(jpr_ievp)%z3(:,:,1) * lsub 1548 ENDIF 1549 #else 1406 1550 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1551 #endif 1407 1552 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1408 1553 IF( iom_use('hflx_rain_cea') ) & … … 1758 1903 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1759 1904 END SELECT 1905 CASE( 'oce and weighted ice' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0 1906 SELECT CASE( sn_snd_temp%clcat ) 1907 CASE( 'yes' ) 1908 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1909 CASE( 'no' ) 1910 ztmp3(:,:,:) = 0.0 1911 DO jl=1,jpl 1912 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 1913 ENDDO 1914 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1915 END SELECT 1760 1916 CASE( 'mixed oce-ice' ) 1761 1917 ztmp1(:,:) = ( ztmp1(:,:) + rt0 ) * zfr_l(:,:) … … 1799 1955 END SELECT 1800 1956 IF( ssnd(jps_fice)%laction ) CALL cpl_snd( jps_fice, isec, ztmp3, info ) 1957 ENDIF 1958 1959 ! Send ice fraction field (first order interpolation), for weighting UM fluxes to be passed to NEMO 1960 IF (ssnd(jps_fice1)%laction) THEN 1961 SELECT CASE (sn_snd_thick1%clcat) 1962 CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl) 1963 CASE( 'no' ) ; ztmp3(:,:,1) = fr_i(:,:) 1964 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick1%clcat' ) 1965 END SELECT 1966 CALL cpl_snd (jps_fice1, isec, ztmp3, info) 1801 1967 ENDIF 1802 1968 … … 1844 2010 IF( ssnd(jps_hsnw)%laction ) CALL cpl_snd( jps_hsnw, isec, ztmp4, info ) 1845 2011 ENDIF 2012 ! 2013 ! Send meltpond fields 2014 IF( ssnd(jps_a_p)%laction .OR. ssnd(jps_ht_p)%laction ) THEN 2015 SELECT CASE( sn_snd_mpnd%cldes) 2016 CASE( 'weighted ice' ) 2017 SELECT CASE( sn_snd_mpnd%clcat ) 2018 CASE( 'yes' ) 2019 ztmp3(:,:,1:jpl) = a_p(:,:,1:jpl) * a_i(:,:,1:jpl) 2020 ztmp4(:,:,1:jpl) = ht_p(:,:,1:jpl) * a_i(:,:,1:jpl) 2021 CASE( 'no' ) 2022 ztmp3(:,:,:) = 0.0 2023 ztmp4(:,:,:) = 0.0 2024 DO jl=1,jpl 2025 ztmp3(:,:,1) = ztmp3(:,:,1) + a_p(:,:,jpl) * a_i(:,:,jpl) 2026 ztmp4(:,:,1) = ztmp4(:,:,1) + ht_p(:,:,jpl) * a_i(:,:,jpl) 2027 ENDDO 2028 CASE default ; CALL ctl_stop( 'sbc_cpl_mpd: wrong definition of sn_snd_mpnd%clcat' ) 2029 END SELECT 2030 CASE( 'ice only' ) 2031 ztmp3(:,:,1:jpl) = a_p(:,:,1:jpl) 2032 ztmp4(:,:,1:jpl) = ht_p(:,:,1:jpl) 2033 END SELECT 2034 IF( ssnd(jps_a_p)%laction ) CALL cpl_snd( jps_a_p, isec, ztmp3, info ) 2035 IF( ssnd(jps_ht_p)%laction ) CALL cpl_snd( jps_ht_p, isec, ztmp4, info ) 2036 ! 2037 ! Send ice effective conductivity 2038 SELECT CASE( sn_snd_cond%cldes) 2039 CASE( 'weighted ice' ) 2040 SELECT CASE( sn_snd_cond%clcat ) 2041 CASE( 'yes' ) 2042 ztmp3(:,:,1:jpl) = kn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 2043 CASE( 'no' ) 2044 ztmp3(:,:,:) = 0.0 2045 DO jl=1,jpl 2046 ztmp3(:,:,1) = ztmp3(:,:,1) + kn_ice(:,:,jl) * a_i(:,:,jl) 2047 ENDDO 2048 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_cond%clcat' ) 2049 END SELECT 2050 CASE( 'ice only' ) 2051 ztmp3(:,:,1:jpl) = kn_ice(:,:,1:jpl) 2052 END SELECT 2053 IF( ssnd(jps_kice)%laction ) CALL cpl_snd( jps_kice, isec, ztmp3, info ) 2054 ENDIF 2055 ! 1846 2056 ! 1847 2057 #if defined key_cpl_carbon_cycle … … 2023 2233 IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info ) 2024 2234 IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info ) 2025 2235 2236 ztmp1(:,:) = sstfrz(:,:) + rt0 2237 IF( ssnd(jps_sstfrz)%laction ) CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 2238 ! 2026 2239 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 2027 2240 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) -
branches/UKMO/dev_r5518_CICE_coupling_GSI7_GSI8/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r5662 r5663 15 15 USE dom_oce ! ocean space and time domain 16 16 USE domvvl 17 USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic 17 USE eosbn2, only : eos_fzp ! Function to calculate freezing point of seawater 18 USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic, rt0 18 19 USE in_out_manager ! I/O manager 19 20 USE iom, ONLY : iom_put,iom_use ! I/O manager library !!Joakim edit … … 37 38 USE ice_gather_scatter 38 39 USE ice_calendar, only: dt 40 # if defined key_cice4 39 41 USE ice_state, only: aice,aicen,uvel,vvel,vsno,vsnon,vice,vicen 40 # if defined key_cice441 42 USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow, & 42 43 strocnxT,strocnyT, & … … 45 46 flatn_f,fsurfn_f,fcondtopn_f, & 46 47 uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl, & 47 swvdr,swvdf,swidr,swidf 48 swvdr,swvdf,swidr,swidf,Tf 48 49 USE ice_therm_vertical, only: calc_Tsfc 49 50 #else 51 USE ice_state, only: aice,aicen,uvel,nt_hpnd,trcrn,vvel,vsno,& 52 vsnon,vice,vicen,nt_Tsfc 50 53 USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow, & 51 54 strocnxT,strocnyT, & 52 sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_ai, &53 fresh_ai,fhocn_ai,fswthru_ai,frzmlt, &55 sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_ai, & 56 fresh_ai,fhocn_ai,fswthru_ai,frzmlt, & 54 57 flatn_f,fsurfn_f,fcondtopn_f, & 55 58 uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl, & 56 swvdr,swvdf,swidr,swidf 57 USE ice_therm_shared, only: calc_Tsfc 59 swvdr,swvdf,swidr,swidf,Tf, & 60 !! When using NEMO with CICE, this change requires use of 61 !! one of the following two CICE branches: 62 !! - at CICE5.0, hadax/r1015_GSI8_with_GSI7 63 !! - at CICE5.1.2, hadax/vn5.1.2_GSI8 64 keffn_top,Tn_top 65 66 USE ice_therm_shared, only: calc_Tsfc, heat_capacity 67 USE ice_shortwave, only: apeffn 58 68 #endif 59 69 USE ice_forcing, only: frcvdr,frcvdf,frcidr,frcidf … … 161 171 INTEGER, INTENT( in ) :: ksbc ! surface forcing type 162 172 REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 173 REAL(wp), DIMENSION(:,:,:), POINTER :: ztfrz3d 163 174 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar 164 175 INTEGER :: ji, jj, jl, jk ! dummy loop indices … … 173 184 ji_off = INT ( (jpiglo - nx_global) / 2 ) 174 185 jj_off = INT ( (jpjglo - ny_global) / 2 ) 186 187 ! Set freezing temperatures and ensure consistencey between NEMO and CICE 188 CALL wrk_alloc( jpi,jpj,jpk, ztfrz3d ) 189 DO jk=1,jpk 190 ztfrz3d(:,:,jk) = eos_fzp( tsn(:,:,jk,jp_sal), fsdept_n(:,:,jk) ) 191 ENDDO 192 193 !Ensure that no temperature points are below freezing if not a NEMO restart 194 IF( .NOT. ln_rstart ) THEN 195 tsn(:,:,:,jp_tem) = MAX (tsn(:,:,:,jp_tem),ztfrz3d) 196 tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) 197 ENDIF 175 198 176 199 #if defined key_nemocice_decomp … … 202 225 IF( sbc_ice_cice_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_ice_cice_alloc : unable to allocate cice arrays' ) 203 226 204 ! Ensure ocean temperatures are nowhere below freezing if not a NEMO restart 205 IF( .NOT. ln_rstart ) THEN 206 tsn(:,:,:,jp_tem) = MAX (tsn(:,:,:,jp_tem),Tocnfrz) 207 tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) 208 ENDIF 227 ! Populate the surface freezing temperature array 228 sstfrz(:,:)=ztfrz3d(:,:,1) 209 229 210 230 fr_iu(:,:)=0.0 … … 283 303 284 304 CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 305 CALL wrk_dealloc( jpi,jpj,jpk, ztfrz3d ) 285 306 ! 286 307 IF( nn_timing == 1 ) CALL timing_stop('cice_sbc_init') … … 343 364 CALL nemo2cice(ztmp,stray,'F', -1. ) 344 365 366 367 ! Alex West: From configuration GSI8 onwards, when NEMO is used with CICE in 368 ! HadGEM3 the 'time-travelling ice' coupling approach is used, whereby 369 ! atmosphere-ice fluxes are passed as pseudo-local values, formed by dividing 370 ! gridbox mean fluxes in the UM by future ice concentration obtained through 371 ! OASIS. This allows for a much more realistic apportionment of energy through 372 ! the ice - and conserves energy. 373 ! Therefore the fluxes are now divided by ice concentration in the coupled 374 ! formulation (jp_purecpl) as well as for jp_flx. This NEMO branch should only 375 ! be used at UM10.2 onwards (unless an explicit GSI8 UM branch is included), at 376 ! which point the GSI8 UM changes were committed. 377 345 378 ! Surface downward latent heat flux (CI_5) 346 IF (ksbc == jp_flx ) THEN379 IF (ksbc == jp_flx .OR. ksbc == jp_purecpl) THEN 347 380 DO jl=1,ncat 348 381 ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) 349 382 ENDDO 350 383 ELSE 351 ! emp_ice is set in sbc_cpl_ice_flx as sublimation-snow 352 qla_ice(:,:,1)= - ( emp_ice(:,:)+sprecip(:,:) ) * Lsub 353 ! End of temporary code 354 DO jj=1,jpj 355 DO ji=1,jpi 356 IF (fr_i(ji,jj).eq.0.0) THEN 357 DO jl=1,ncat 358 ztmpn(ji,jj,jl)=0.0 359 ENDDO 360 ! This will then be conserved in CICE 361 ztmpn(ji,jj,1)=qla_ice(ji,jj,1) 362 ELSE 363 DO jl=1,ncat 364 ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj) 365 ENDDO 366 ENDIF 367 ENDDO 368 ENDDO 384 !In coupled mode - qla_ice calculated in sbc_cpl for each category 385 ztmpn(:,:,1:ncat)=qla_ice(:,:,1:ncat) 369 386 ENDIF 387 370 388 DO jl=1,ncat 371 389 CALL nemo2cice(ztmpn(:,:,jl),flatn_f(:,:,jl,:),'T', 1. ) … … 373 391 ! GBM conductive flux through ice (CI_6) 374 392 ! Convert to GBM 375 IF (ksbc == jp_flx ) THEN393 IF (ksbc == jp_flx .OR. ksbc == jp_purecpl) THEN 376 394 ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 377 395 ELSE … … 382 400 ! GBM surface heat flux (CI_7) 383 401 ! Convert to GBM 384 IF (ksbc == jp_flx ) THEN402 IF (ksbc == jp_flx .OR. ksbc == jp_purecpl) THEN 385 403 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl) 386 404 ELSE … … 442 460 CALL nemo2cice(ztmp,frain,'T', 1. ) 443 461 462 ! Recalculate freezing temperature and send to CICE 463 sstfrz(:,:)=eos_fzp(sss_m(:,:), fsdept_n(:,:,1)) 464 CALL nemo2cice(sstfrz,Tf,'T', 1. ) 465 444 466 ! Freezing/melting potential 445 467 ! Calculated over NEMO leapfrog timestep (hence 2*dt) 446 nfrzmlt(:,:)=rau0*rcp*fse3t_m(:,:)*(Tocnfrz-sst_m(:,:))/(2.0*dt) 447 448 ztmp(:,:) = nfrzmlt(:,:) 449 CALL nemo2cice(ztmp,frzmlt,'T', 1. ) 468 nfrzmlt(:,:)=rau0*rcp*fse3t_m(:,:)*(sstfrz(:,:)-sst_m(:,:))/(2.0*dt) 469 CALL nemo2cice(nfrzmlt,frzmlt,'T', 1. ) 450 470 451 471 ! SST and SSS … … 453 473 CALL nemo2cice(sst_m,sst,'T', 1. ) 454 474 CALL nemo2cice(sss_m,sss,'T', 1. ) 475 476 ! Sea ice surface skin temperature 477 DO jl=1,ncat 478 CALL nemo2cice(tsfc_ice(:,:,jl), trcrn(:,:,nt_tsfc,jl,:),'T',1.) 479 ENDDO 455 480 456 481 ! x comp and y comp of surface ocean current … … 730 755 CALL cice2nemo(vicen(:,:,jl,:),ht_i(:,:,jl),'T', 1. ) 731 756 ENDDO 757 758 #if ! defined key_cice4 759 ! Meltpond fraction and depth 760 DO jl = 1,ncat 761 CALL cice2nemo(apeffn(:,:,jl,:),a_p(:,:,jl),'T', 1. ) 762 CALL cice2nemo(trcrn(:,:,nt_hpnd,jl,:),ht_p(:,:,jl),'T', 1. ) 763 ENDDO 764 #endif 765 766 767 ! If using multilayers thermodynamics in CICE then get top layer temperature 768 ! and effective conductivity 769 !! When using NEMO with CICE, this change requires use of 770 !! one of the following two CICE branches: 771 !! - at CICE5.0, hadax/r1015_GSI8_with_GSI7 772 !! - at CICE5.1.2, hadax/vn5.1.2_GSI8 773 IF (heat_capacity) THEN 774 DO jl = 1,ncat 775 CALL cice2nemo(Tn_top(:,:,jl,:),tn_ice(:,:,jl),'T', 1. ) 776 CALL cice2nemo(keffn_top(:,:,jl,:),kn_ice(:,:,jl),'T', 1. ) 777 ENDDO 778 ! Convert surface temperature to Kelvin 779 tn_ice(:,:,:)=tn_ice(:,:,:)+rt0 780 ELSE 781 tn_ice(:,:,:) = 0.0 782 kn_ice(:,:,:) = 0.0 783 ENDIF 784 732 785 ! 733 786 IF( nn_timing == 1 ) CALL timing_stop('cice_sbc_hadgam')
Note: See TracChangeset
for help on using the changeset viewer.