- Timestamp:
- 2017-11-20T13:54:32+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r8751 r8752 32 32 USE geo2ocean ! 33 33 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 34 USE albedooce!34 USE ocealb ! 35 35 USE eosbn2 ! 36 36 USE sbcrnf, ONLY : l_rnfcpl … … 178 178 TYPE( DYNARR ), SAVE, DIMENSION(jprcv) :: frcv ! all fields recieved from the atmosphere 179 179 180 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: alb edo_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky)180 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: alb_oce_mix ! ocean albedo sent to atmosphere (mix clear/overcast sky) 181 181 182 182 REAL(wp) :: rpref = 101000._wp ! reference atmospheric pressure[N/m2] … … 202 202 ierr(:) = 0 203 203 ! 204 ALLOCATE( alb edo_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) )204 ALLOCATE( alb_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) ) 205 205 206 206 #if ! defined key_lim3 && ! defined key_cice … … 737 737 ! 2. receiving mixed oce-ice solar radiation 738 738 IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 739 CALL albedo_oce( zaos, zacs )739 CALL oce_alb( zaos, zacs ) 740 740 ! Due to lack of information on nebulosity : mean clear/overcast sky 741 alb edo_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5741 alb_oce_mix(:,:) = ( zacs(:,:) + zaos(:,:) ) * 0.5 742 742 ENDIF 743 743 … … 1530 1530 1531 1531 1532 SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist )1532 SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist, phs, phi ) 1533 1533 !!---------------------------------------------------------------------- 1534 1534 !! *** ROUTINE sbc_cpl_ice_flx *** … … 1585 1585 REAL(wp), INTENT(in), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1586 1586 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1587 ! 1588 INTEGER :: jl ! dummy loop index 1587 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: phs ! snow depth [m] 1588 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: phi ! ice thickness [m] 1589 ! 1590 INTEGER :: ji,jj,jl ! dummy loop index 1589 1591 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw 1590 1592 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice 1591 1593 REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1592 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice 1594 REAL(wp), POINTER, DIMENSION(:,:,:) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zfrqsr_tr_i 1593 1595 !!---------------------------------------------------------------------- 1594 1596 ! … … 1598 1600 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1599 1601 CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1600 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice )1602 CALL wrk_alloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zfrqsr_tr_i ) 1601 1603 1602 1604 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1890 1892 ! ( see OASIS3 user guide, 5th edition, p39 ) 1891 1893 zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1892 & / ( 1.- ( alb edo_oce_mix(:,: ) * ziceld(:,:) &1894 & / ( 1.- ( alb_oce_mix(:,: ) * ziceld(:,:) & 1893 1895 & + palbi (:,:,1) * picefr(:,:) ) ) 1894 1896 END SELECT … … 1951 1953 END SELECT 1952 1954 1953 ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 ) 1954 ! Used for LIM3 1955 ! Coupled case: since cloud cover is not received from atmosphere 1956 ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 1957 fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 1958 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1955 ! --- Transmitted shortwave radiation (W/m2) --- ! 1956 1957 IF ( nice_jules == 0 ) THEN 1958 1959 zfrqsr_tr_i(:,:,:) = 0._wp ! surface transmission parameter 1960 1961 ! former coding was 1962 ! Coupled case: since cloud cover is not received from atmosphere 1963 ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) 1964 ! fr1_i0(:,:) = ( 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice ) 1965 ! fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1966 1967 ! to retrieve that coding, we needed to access h_i & h_s from here 1968 ! we could even retrieve cloud fraction from the coupler 1969 1970 DO jl = 1, jpl 1971 DO jj = 1 , jpj 1972 DO ji = 1, jpi 1973 1974 !--- surface transmission parameter (Grenfell Maykut 77) --- ! 1975 zfrqsr_tr_i(ji,jj,jl) = 0.18 * ( 1.0 - cldf_ice ) + 0.35 * cldf_ice 1976 1977 ! --- influence of snow and thin ice --- ! 1978 IF ( phs(ji,jj,jl) >= 0.0_wp ) zfrqsr_tr_i(ji,jj,jl) = 0._wp ! snow fully opaque 1979 IF ( phi(ji,jj,jl) <= 0.1_wp ) zfrqsr_tr_i(ji,jj,jl) = 1._wp ! thin ice transmits all solar radiation 1980 END DO 1981 END DO 1982 END DO 1983 1984 qsr_ice_tr(:,:,:) = zfrqsr_tr_i(:,:,:) * qsr_ice(:,:,:) ! transmitted solar radiation 1985 1986 ENDIF 1987 1988 IF ( nice_jules == 2 ) THEN 1989 1990 ! here we must receive the qsr_ice_tr array from the coupler 1991 ! for now just assume zero 1992 1993 qsr_ice_tr(:,:,:) = 0.0_wp 1994 1995 ENDIF 1996 1997 1959 1998 1960 1999 CALL wrk_dealloc( jpi,jpj, zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw ) 1961 2000 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1962 2001 CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 1963 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice )2002 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zfrqsr_tr_i ) 1964 2003 ! 1965 2004 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_ice_flx') … … 2057 2096 ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 ) 2058 2097 ELSEWHERE 2059 ztmp1(:,:) = alb edo_oce_mix(:,:)2098 ztmp1(:,:) = alb_oce_mix(:,:) 2060 2099 END WHERE 2061 2100 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' ) … … 2085 2124 2086 2125 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean 2087 ztmp1(:,:) = alb edo_oce_mix(:,:) * zfr_l(:,:)2126 ztmp1(:,:) = alb_oce_mix(:,:) * zfr_l(:,:) 2088 2127 DO jl=1,jpl 2089 2128 ztmp1(:,:) = ztmp1(:,:) + alb_ice(:,:,jl) * a_i(:,:,jl)
Note: See TracChangeset
for help on using the changeset viewer.
