Changeset 5663 for branches/UKMO/dev_r5518_CICE_coupling_GSI7_GSI8/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
- Timestamp:
- 2015-08-03T15:53:06+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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 )
Note: See TracChangeset
for help on using the changeset viewer.