!!---------------------------------------------------------------------- !! *** flx_oasis_ice.h90 *** !!---------------------------------------------------------------------- !! flx : define the thermohaline fluxes for the ocean in !! coupled ocean/atmosphere case with sea-ice !!---------------------------------------------------------------------- REAL(wp) :: zcatm1 (1:jpi,1:jpj) ! cloud fraction REAL(wp) :: qsr_oce_recv (1:jpi,1:jpj) REAL(wp) :: qsr_ice_recv (1:jpi,1:jpj) REAL(wp) :: qnsr_oce_recv (1:jpi,1:jpj) REAL(wp) :: qnsr_ice_recv (1:jpi,1:jpj) REAL(wp) :: dqns_ice_recv (1:jpi,1:jpj) REAL(wp) :: tprecip_recv (1:jpi,1:jpj) REAL(wp) :: sprecip_recv (1:jpi,1:jpj) REAL(wp) :: fr1_i0_recv (1:jpi,1:jpj) REAL(wp) :: fr2_i0_recv (1:jpi,1:jpj) REAL(wp) :: rrunoff_recv (1:jpi,1:jpj) REAL(wp) :: calving_recv (1:jpi,1:jpj) #if defined key_cpl_ocevel REAL(wp) :: un_weighted (1:jpi,1:jpj) REAL(wp) :: vn_weighted (1:jpi,1:jpj) REAL(wp) :: un_send (1:jpi,1:jpj) REAL(wp) :: vn_send (1:jpi,1:jpj) #endif REAL(wp) :: zrunriv (1:jpi,1:jpj) ! river discharge into ocean REAL(wp) :: zruncot (1:jpi,1:jpj) ! continental discharge into ocean REAL(wp) :: zpew (1:jpi,1:jpj) ! P-E over water REAL(wp) :: zpei (1:jpi,1:jpj) ! P-E over ice REAL(wp) :: zpsol (1:jpi,1:jpj) ! surface downward snow fall REAL(wp) :: zevice (1:jpi,1:jpj) ! surface upward snow flux where sea ice !! * Modules used C A U T I O N already defined in flxmod.F90 !! !! * Module variables LOGICAL :: lfirstf=.TRUE. !!---------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2006) !! $Header$ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE flx( kt ) !!--------------------------------------------------------------------- !! *** ROUTINE flx *** !! !! ** Purpose : exchange the thermohaline fields (heat and freshwater) !! with the atmosphere at each ocean time step. !! !! ** Method : Receive and send fluxes from/to a coupled atmospheric model !! !! References : The OASIS User Guide, Version 3.0 !! !! History : !! 9.0 ! 04-11 (R. Redler) Original code !! ! 05-05 (W. Park, N. Keenlyside) Separation of recv and pass variables (ref.icestp.F90) !! ! 05-09 (W. Park, N. Keenlyside) Implementation of ocean velocity !! ! 06-06 (E. Maisonnave, W. Park) Oasis mask adaptation !!---------------------------------------------------------------------- !! * Modules used USE in_out_manager, only: numout ! I/O manager !! * Arguments INTEGER, INTENT( in ) :: kt ! ocean time step !! * Local declarations INTEGER :: ji, jj #if defined key_cpl_ocevel INTEGER :: ikchoix=-1 #endif INTEGER :: var_id INTEGER :: info, date, n REAL(wp) :: zfacflx REAL(wp) :: zfacwat ! !!--------------------------------------------------------------------- ! ! Initialization ! -------------- ! ! caution, I presume that you have good UNIT system from coupler to OPA ! that is : ! watt/m2 for znsolc and zqsrc ! kg/m2/s for evaporation, precipitation and runoff zfacflx = 1.e0 zfacwat = 1.e3 ! convert [m/s] to [kg/m**2/s] ! date = ( kt - nit000 ) * rdttra(1) ! ! 1. Send coupling fields !------------------------ ! var_id = send_id(1) CALL cpl_prism_send ( var_id, date, tn(:,:,1)+rt0, info ) var_id = send_id(2) CALL cpl_prism_send ( var_id, date, 1.0-frld, info ) #if defined key_cpl_albedo DO jj = 1, jpj DO ji = 1, jpi if (((tn_ice(ji,jj).lt.50).or.(tn_ice(ji,jj).gt.400)) .and. frld(ji,jj).lt.1.) then WRITE(numout,*) ' tn_ice, ERROR ',ji,jj, ' = ', tn_ice(ji,jj), & ' qnsr_ice_recv=', qnsr_ice_recv(ji,jj), ' dqns_ice_recv=', dqns_ice_recv(ji,jj) endif ENDDO ENDDO var_id = send_id(3) CALL cpl_prism_send ( var_id, date, tn_ice, info ) var_id = send_id(4) CALL cpl_prism_send ( var_id, date, alb_ice, info ) #else var_id = send_id(3) CALL cpl_prism_send ( var_id, date, hicif, info ) var_id = send_id(4) CALL cpl_prism_send ( var_id, date, hsnif, info ) #endif #if defined key_cpl_ocevel un_weighted = un(:,:,1) * frld + u_ice * ( 1. - frld ) vn_weighted = vn(:,:,1) * frld + v_ice * ( 1. - frld ) CALL repere ( un_weighted, vn_weighted, un_send, vn_send, ikchoix ) var_id = send_id(5) CALL cpl_prism_send ( var_id, date, un_send, info ) var_id = send_id(6) CALL cpl_prism_send ( var_id, date, vn_send, info ) #endif ! ! 2. Receive and build flux fields !--------------------------------- ! ! I.) Precipitation/Evaporation ! ----------------------------- ! ! ... a) P-E over water ! var_id = recv_id(9) CALL cpl_prism_recv ( var_id, date, zpew, info ) ! ! ... b) P-E over ice ! var_id = recv_id(10) CALL cpl_prism_recv ( var_id, date, zpei, info ) ! ! ... c) Snow fall over water and ice ! var_id = recv_id(11) CALL cpl_prism_recv ( var_id, date, zpsol, info ) ! ! ... d) Evaporation over ice (sublimination) ! var_id = recv_id(12) CALL cpl_prism_recv ( var_id, date, zevice, info ) ! ! calculate water flux (PE over water and ice) (positive upward) DO jj = 1, jpj DO ji = 1, jpi tprecip_recv(ji,jj) = ( zpew(ji,jj) + zpei(ji,jj) ) * tmask(ji,jj,1) * zfacwat ENDDO ENDDO IF (ln_ctl) THEN WRITE(numout,*) ' flx:tprecip_recv - Minimum value is ', MINVAL(tprecip_recv) WRITE(numout,*) ' flx:tprecip_recv - Maximum value is ', MAXVAL(tprecip_recv) WRITE(numout,*) ' flx:tprecip_recv - Sum value is ', SUM(tprecip_recv) ENDIF IF ( SUM(zpew*e1t*e2t) /= SUM(zpew*e1t*e2t*tmask(:,:,1)) ) THEN WRITE(numout,*) ' flx: Forcing values outside Orca mask' WRITE(numout,*) ' flx: Losses in water conservation' WRITE(numout,*) ' flx: Masked ', SUM(zpew*e1t*e2t*tmask(:,:,1)) WRITE(numout,*) ' flx: Unmasked ', SUM(zpew*e1t*e2t) WRITE(numout,*) ' flx: Simulation STOP' CALL FLUSH(numout) STOP END IF ! ! calculate solid precipitation (positive upward) DO jj = 1, jpj DO ji = 1, jpi sprecip_recv(ji,jj) = ( zpsol(ji,jj) + zevice(ji,jj) ) * tmask(ji,jj,1) * zfacwat ENDDO ENDDO ! ! ! II.) Solar fluxes ! ------------------ ! ! ... a) surface net downward shortwave flux ! var_id = recv_id(13) CALL cpl_prism_recv ( var_id, date, qsr_oce_recv, info ) DO jj = 1, jpj DO ji = 1, jpi qsr_oce_recv(ji,jj) = qsr_oce_recv(ji,jj) * tmask(ji,jj,1) * zfacflx ENDDO ENDDO ! ! ... b) surface downward non-solar heat flux in air ! var_id = recv_id(14) CALL cpl_prism_recv ( var_id, date, qnsr_oce_recv, info) DO jj = 1, jpj DO ji = 1, jpi qnsr_oce_recv(ji,jj) = qnsr_oce_recv(ji,jj) * tmask(ji,jj,1) * zfacflx ENDDO ENDDO ! ! ... c) solar heat flux on sea ice ! var_id = recv_id(15) CALL cpl_prism_recv ( var_id, date, qsr_ice_recv, info ) DO jj = 1, jpj DO ji = 1, jpi qsr_ice_recv(ji,jj) = qsr_ice_recv(ji,jj) * tmask(ji,jj,1) * zfacflx ENDDO ENDDO ! ! ... d) non-solar heat flux on sea ice ! var_id = recv_id(16) CALL cpl_prism_recv ( var_id, date, qnsr_ice_recv, info) DO jj = 1, jpj DO ji = 1, jpi qnsr_ice_recv(ji,jj) = qnsr_ice_recv(ji,jj) * tmask(ji,jj,1) * zfacflx ENDDO ENDDO ! ! ... e) non solar heat flux derivative over ice ! var_id = recv_id(17) CALL cpl_prism_recv ( var_id, date, dqns_ice_recv, info) DO jj = 1, jpj DO ji = 1, jpi dqns_ice_recv(ji,jj) = dqns_ice_recv(ji,jj) * tmask(ji,jj,1) * zfacflx ENDDO ENDDO ! ! Since cloud cover catm not transmitted from atmosphere, init =0. ! catm(:, :) = 0. DO jj = 1, jpj DO ji = 1, jpi zcatm1(ji,jj) = 1.0 - catm (ji,jj) ! fractional cloud cover END DO END DO ! fraction of net shortwave radiation which is not absorbed in the ! thin surface layer and penetrates inside the ice cover ! ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) !------------------------------------------------------------------ DO jj = 1, jpj DO ji = 1, jpi fr1_i0_recv(ji,jj) = 0.18 * zcatm1(ji,jj) + 0.35 * catm(ji,jj) fr2_i0_recv(ji,jj) = 0.82 * zcatm1(ji,jj) + 0.65 * catm(ji,jj) END DO END DO ! #if defined key_cpl_discharge ! III.) Runoff ! ----------- ! ! ... a) ice discharge into ocean ! var_id = recv_id(18) CALL cpl_prism_recv ( var_id, date, calving_recv, info ) DO jj = 1, jpj DO ji = 1, jpi calving_recv(ji,jj) = calving_recv(ji,jj) * tmask(ji,jj,1) * zfacwat ENDDO ENDDO ! ! ... b) river discharge into ocean ! var_id = recv_id(19) CALL cpl_prism_recv ( var_id, date, zrunriv, info ) ! ! ... c) continental discharge into ocean ! var_id = recv_id(20) CALL cpl_prism_recv ( var_id, date, zruncot, info) DO jj = 1, jpj DO ji = 1, jpi rrunoff_recv(ji,jj) = ( zrunriv(ji,jj) + zruncot (ji,jj) ) * tmask(ji,jj,1) * zfacwat ENDDO ENDDO ! #else calving_recv = 0. rrunoff_recv = 0. #endif ! Oasis mask shift and update lateral boundary conditions (E. Maisonnave) ! not tested when mpp is used, W. Park !WSPTEST qsr_oce_recv(jpi-1,:) = qsr_oce_recv(1,:) qsr_ice_recv(jpi-1,:) = qsr_ice_recv(1,:) qnsr_oce_recv(jpi-1,:) = qnsr_oce_recv(1,:) qnsr_ice_recv(jpi-1,:) = qnsr_ice_recv(1,:) dqns_ice_recv(jpi-1,:) = dqns_ice_recv(1,:) tprecip_recv(jpi-1,:) = tprecip_recv(1,:) sprecip_recv(jpi-1,:) = sprecip_recv(1,:) fr1_i0_recv(jpi-1,:) = fr1_i0_recv(1,:) fr2_i0_recv(jpi-1,:) = fr2_i0_recv(1,:) rrunoff_recv(jpi-1,:) = rrunoff_recv(1,:) calving_recv(jpi-1,:) = calving_recv(1,:) qsr_oce = qsr_oce_recv qsr_ice = qsr_ice_recv qnsr_oce = qnsr_oce_recv qnsr_ice = qnsr_ice_recv dqns_ice = dqns_ice_recv tprecip = tprecip_recv sprecip = sprecip_recv fr1_i0 = fr1_i0_recv fr2_i0 = fr2_i0_recv !WSP rrunoff = rrunoff_recv !WSP calving = calving_recv rrunoff = 0. !WSP runoff and calving included in tprecip calving = 0. !WSP IF(ln_ctl) THEN write(numout,*) 'flx:qsr_oce - Minimum value is ', minval(qsr_oce) write(numout,*) 'flx:qsr_oce - Maximum value is ', maxval(qsr_oce) write(numout,*) 'flx:qsr_oce - Sum value is ', SUM(qsr_oce) write(numout,*) 'flx:tprecip - Minimum value is ', minval(tprecip) write(numout,*) 'flx:tprecip - Maximum value is ', maxval(tprecip) write(numout,*) 'flx:tprecip - Sum value is ', SUM(tprecip) ENDIF CALL lbc_lnk( qsr_oce , 'T', 1. ) CALL lbc_lnk( qsr_ice , 'T', 1. ) CALL lbc_lnk( qnsr_oce, 'T', 1. ) CALL lbc_lnk( qnsr_ice, 'T', 1. ) CALL lbc_lnk( tprecip , 'T', 1. ) CALL lbc_lnk( sprecip , 'T', 1. ) CALL lbc_lnk( rrunoff , 'T', 1. ) CALL lbc_lnk( dqns_ice, 'T', 1. ) CALL lbc_lnk( calving , 'T', 1. ) CALL lbc_lnk( fr1_i0 , 'T', 1. ) CALL lbc_lnk( fr2_i0 , 'T', 1. ) IF(ln_ctl) THEN write(numout,*) 'flx(af lbc_lnk):qsr_oce - Minimum value is ', minval(qsr_oce) write(numout,*) 'flx(af lbc_lnk):qsr_oce - Maximum value is ', maxval(qsr_oce) write(numout,*) 'flx(af lbc_lnk):qsr_oce - Sum value is ', SUM(qsr_oce) write(numout,*) 'flx(af lbc_lnk):tprecip - Minimum value is ', minval(tprecip) write(numout,*) 'flx(af lbc_lnk):tprecip - Maximum value is ', maxval(tprecip) write(numout,*) 'flx(af lbc_lnk):tprecip - Sum value is ', SUM(tprecip) ENDIF END SUBROUTINE flx