- Timestamp:
- 2017-11-24T17:56:51+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r8637 r8813 971 971 !! emp upward mass flux [evap. - precip. (- runoffs) (- calving)] (ocean only case) 972 972 !!---------------------------------------------------------------------- 973 USE zdf_oce, ONLY : ln_zdfswm 974 975 IMPLICIT NONE 976 977 INTEGER, INTENT(in) :: kt ! ocean model time step index 978 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 979 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 973 USE zdf_oce, ONLY : ln_zdfswm 974 ! 975 INTEGER, INTENT(in) :: kt ! ocean model time step index 976 INTEGER, INTENT(in) :: k_fsbc ! frequency of sbc (-> ice model) computation 977 INTEGER, INTENT(in) :: k_ice ! ice management in the sbc (=0/1/2/3) 980 978 !! 981 979 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? … … 1170 1168 ! Calculate the 3D Stokes drift both in coupled and not fully uncoupled mode 1171 1169 IF( srcv(jpr_sdrftx)%laction .OR. srcv(jpr_sdrfty)%laction .OR. srcv(jpr_wper)%laction & 1172 1170 & .OR. srcv(jpr_hsig)%laction ) THEN 1173 1171 CALL sbc_stokes() 1174 1172 ENDIF … … 1525 1523 1526 1524 1527 SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist )1525 SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist, phs, phi ) 1528 1526 !!---------------------------------------------------------------------- 1529 1527 !! *** ROUTINE sbc_cpl_ice_flx *** … … 1576 1574 !!---------------------------------------------------------------------- 1577 1575 REAL(wp), INTENT(in), DIMENSION(:,:) :: picefr ! ice fraction [0 to 1] 1578 ! optional arguments, used only in 'mixed oce-ice' case1576 ! !! ! optional arguments, used only in 'mixed oce-ice' case 1579 1577 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1580 1578 REAL(wp), INTENT(in), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1581 1579 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1582 ! 1583 INTEGER :: jl ! dummy loop index 1584 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw 1585 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice 1586 REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1587 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice 1580 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: phs ! snow depth [m] 1581 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: phi ! ice thickness [m] 1582 ! 1583 INTEGER :: ji, jj, jl ! dummy loop index 1584 REAL(wp) :: ztri ! local scalar 1585 REAL(wp), DIMENSION(jpi,jpj) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw 1586 REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zevap_ice, zdevap_ice 1587 REAL(wp), DIMENSION(jpi,jpj) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1588 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice !!gm , zfrqsr_tr_i 1588 1589 !!---------------------------------------------------------------------- 1589 1590 ! 1590 1591 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1591 1592 ! 1592 CALL wrk_alloc( jpi,jpj, zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw )1593 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice )1594 CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice )1595 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice )1596 1597 1593 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 1598 ziceld(:,:) = 1. - picefr(:,:)1599 zcptn (:,:) = rcp * sst_m(:,:)1594 ziceld(:,:) = 1._wp - picefr(:,:) 1595 zcptn (:,:) = rcp * sst_m(:,:) 1600 1596 ! 1601 1597 ! ! ========================= ! … … 1622 1618 #if defined key_lim3 1623 1619 ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 1624 zsnw(:,:) = 0._wp ;CALL ice_thd_snwblow( ziceld, zsnw )1620 zsnw(:,:) = 0._wp ; CALL ice_thd_snwblow( ziceld, zsnw ) 1625 1621 1626 1622 ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! … … 1659 1655 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1660 1656 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1661 DO jl =1,jpl1657 DO jl = 1, jpl 1662 1658 evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:) * zmsk(:,:) 1663 1659 devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:) 1664 END DO1660 END DO 1665 1661 ELSE 1666 emp_tot(:,:) = 1667 emp_ice(:,:) = 1668 emp_oce(:,:) = 1669 sprecip(:,:) = 1670 tprecip(:,:) = 1671 DO jl =1,jpl1662 emp_tot(:,:) = zemp_tot(:,:) 1663 emp_ice(:,:) = zemp_ice(:,:) 1664 emp_oce(:,:) = zemp_oce(:,:) 1665 sprecip(:,:) = zsprecip(:,:) 1666 tprecip(:,:) = ztprecip(:,:) 1667 DO jl = 1, jpl 1672 1668 evap_ice (:,:,jl) = zevap_ice (:,:) 1673 1669 devap_ice(:,:,jl) = zdevap_ice(:,:) 1674 END DO1670 END DO 1675 1671 ENDIF 1676 1672 … … 1691 1687 fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1) 1692 1688 ENDIF 1693 1689 ! 1694 1690 IF( ln_mixcpl ) THEN 1695 1691 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) … … 1703 1699 tprecip(:,:) = ztprecip(:,:) 1704 1700 ENDIF 1705 1701 ! 1706 1702 #endif 1703 1707 1704 ! outputs 1708 1705 !! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff … … 1730 1727 zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 1731 1728 ELSE 1732 DO jl =1,jpl1729 DO jl = 1, jpl 1733 1730 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) ! Set all category values equal 1734 END DO1731 END DO 1735 1732 ENDIF 1736 1733 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes … … 1743 1740 ELSE 1744 1741 qns_tot(:,:) = qns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1745 DO jl =1,jpl1742 DO jl = 1, jpl 1746 1743 zqns_tot(:,: ) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1747 1744 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1748 END DO1745 END DO 1749 1746 ENDIF 1750 1747 CASE( 'mixed oce-ice' ) ! the ice flux is cumputed from the total flux, the SST and ice informations … … 1766 1763 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax 1767 1764 zqns_oce = 0._wp 1768 WHERE( ziceld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / ziceld(:,:)1765 WHERE( ziceld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / ziceld(:,:) 1769 1766 1770 1767 ! Heat content per unit mass of snow (J/kg) … … 1859 1856 ELSE 1860 1857 ! Set all category values equal for the moment 1861 DO jl =1,jpl1858 DO jl = 1, jpl 1862 1859 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1863 END DO1860 END DO 1864 1861 ENDIF 1865 1862 zqsr_tot(:,: ) = frcv(jpr_qsrmix)%z3(:,:,1) … … 1868 1865 zqsr_tot(:,: ) = ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1869 1866 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1870 DO jl =1,jpl1867 DO jl = 1, jpl 1871 1868 zqsr_tot(:,: ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl) 1872 1869 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl) 1873 END DO1870 END DO 1874 1871 ELSE 1875 1872 qsr_tot(:,: ) = qsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1876 DO jl =1,jpl1873 DO jl = 1, jpl 1877 1874 zqsr_tot(:,: ) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1878 1875 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1879 END DO1876 END DO 1880 1877 ENDIF 1881 1878 CASE( 'mixed oce-ice' ) … … 1890 1887 IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle 1891 1888 zqsr_tot(:,: ) = sbc_dcy( zqsr_tot(:,: ) ) 1892 DO jl =1,jpl1889 DO jl = 1, jpl 1893 1890 zqsr_ice(:,:,jl) = sbc_dcy( zqsr_ice(:,:,jl) ) 1894 END DO1891 END DO 1895 1892 ENDIF 1896 1893 … … 1908 1905 qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1909 1906 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:) 1910 DO jl =1,jpl1907 DO jl = 1, jpl 1911 1908 qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:) 1912 END DO1909 END DO 1913 1910 ELSE 1914 1911 qsr_tot(:,: ) = zqsr_tot(:,: ) … … 1946 1943 END SELECT 1947 1944 1948 ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 ) 1949 ! Used for LIM3 1950 ! Coupled case: since cloud cover is not received from atmosphere 1951 ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 1952 fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 1953 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1954 1955 CALL wrk_dealloc( jpi,jpj, zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw ) 1956 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1957 CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1958 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 1945 ! ! ========================= ! 1946 ! ! Transmitted Qsr ! [W/m2] 1947 ! ! ========================= ! 1948 SELECT CASE( nice_jules ) 1949 CASE( np_jules_OFF ) !== No Jules coupler ==! 1950 ! 1951 !!gm ! former coding was 1952 !!gm ! Coupled case: since cloud cover is not received from atmosphere 1953 !!gm ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 1954 !!gm ! fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 1955 !!gm ! fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1956 !!gm 1957 !!gm ! to retrieve that coding, we needed to access h_i & h_s from here 1958 !!gm ! we could even retrieve cloud fraction from the coupler 1959 !!gm ! 1960 !!gm zfrqsr_tr_i(:,:,:) = 0._wp ! surface transmission parameter 1961 !!gm ! 1962 !!gm DO jl = 1, jpl 1963 !!gm DO jj = 1 , jpj 1964 !!gm DO ji = 1, jpi 1965 !!gm ! !--- surface transmission parameter (Grenfell Maykut 77) --- ! 1966 !!gm zfrqsr_tr_i(ji,jj,jl) = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice 1967 !!gm ! 1968 !!gm ! ! --- influence of snow and thin ice --- ! 1969 !!gm IF ( phs(ji,jj,jl) >= 0.0_wp ) zfrqsr_tr_i(ji,jj,jl) = 0._wp ! snow fully opaque 1970 !!gm IF ( phi(ji,jj,jl) <= 0.1_wp ) zfrqsr_tr_i(ji,jj,jl) = 1._wp ! thin ice transmits all solar radiation 1971 !!gm END DO 1972 !!gm END DO 1973 !!gm END DO 1974 !!gm ! 1975 !!gm qsr_ice_tr(:,:,:) = zfrqsr_tr_i(:,:,:) * qsr_ice(:,:,:) ! transmitted solar radiation 1976 !!gm ! 1977 !!gm better coding of the above calculation: 1978 ! 1979 ! ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 1980 ztri = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ! surface transmission parameter (Grenfell Maykut 77) 1981 ! 1982 qsr_ice_tr(:,:,:) = ztri * qsr_ice(:,:,:) 1983 WHERE( phs(:,:,:) >= 0.0_wp ) qsr_ice_tr(:,:,:) = 0._wp ! snow fully opaque 1984 WHERE( phi(:,:,:) <= 0.1_wp ) qsr_ice_tr(:,:,:) = qsr_ice(:,:,:) ! thin ice transmits all solar radiation 1985 !!gm end 1986 ! 1987 CASE( np_jules_ACTIVE ) !== Jules coupler is active ==! 1988 ! 1989 ! ! ===> here we must receive the qsr_ice_tr array from the coupler 1990 ! for now just assume zero (fully opaque ice) 1991 qsr_ice_tr(:,:,:) = 0._wp 1992 ! 1993 END SELECT 1959 1994 ! 1960 1995 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx') … … 2081 2116 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean 2082 2117 ztmp1(:,:) = alb_oce_mix(:,:) * zfr_l(:,:) 2083 DO jl =1,jpl2118 DO jl = 1, jpl 2084 2119 ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl) 2085 2120 END DO
Note: See TracChangeset
for help on using the changeset viewer.
