[888] | 1 | MODULE sbccpl |
---|
| 2 | !!====================================================================== |
---|
| 3 | !! *** MODULE sbccpl *** |
---|
| 4 | !! Ocean forcing: momentum, heat and freshwater coupled formulation |
---|
| 5 | !!===================================================================== |
---|
| 6 | !! History : 9.0 ! 06-07 (R. Redler, N. Keenlyside, W. Park) |
---|
| 7 | !! Original code split into flxmod & taumod |
---|
| 8 | !! 9.0 ! 06-07 (G. Madec) surface module |
---|
| 9 | !!---------------------------------------------------------------------- |
---|
| 10 | #if defined key_sbc_cpl |
---|
| 11 | !!---------------------------------------------------------------------- |
---|
| 12 | !! 'key_sbc_cpl' Coupled Ocean/Atmosphere formulation |
---|
| 13 | !!---------------------------------------------------------------------- |
---|
| 14 | !!---------------------------------------------------------------------- |
---|
| 15 | !! namsbc_cpl : coupled formulation namlist |
---|
| 16 | !! sbc_cpl : coupled formulation for the ocean surface boundary condition |
---|
| 17 | !!---------------------------------------------------------------------- |
---|
| 18 | USE oce ! ocean dynamics and tracers |
---|
| 19 | USE dom_oce ! ocean space and time domain |
---|
| 20 | USE phycst ! physical constants |
---|
| 21 | USE in_out_manager ! I/O manager |
---|
| 22 | USE lib_mpp ! distribued memory computing library |
---|
| 23 | USE lbclnk ! ocean lateral boundary conditions (or mpp link) |
---|
| 24 | USE daymod ! calendar |
---|
| 25 | |
---|
| 26 | USE cpl_oasis3 ! OASIS3 coupling (to ECHAM5) |
---|
| 27 | USE cpl_oasis4 ! OASIS4 coupling (to ECHAM5) |
---|
| 28 | USE geo2ocean, ONLY : repere, repcmo |
---|
| 29 | USE ice_2, only : frld ! : leads fraction = 1-a/totalarea |
---|
| 30 | |
---|
| 31 | USE sbc_oce ! Surface boundary condition: ocean fields |
---|
| 32 | |
---|
| 33 | USE iom ! NetCDF library |
---|
| 34 | |
---|
| 35 | IMPLICIT NONE |
---|
| 36 | PRIVATE |
---|
| 37 | |
---|
| 38 | PUBLIC sbc_cpl ! routine called by step.F90 |
---|
| 39 | |
---|
| 40 | LOGICAL, PUBLIC :: lk_sbc_cpl = .TRUE. !: coupled formulation flag |
---|
| 41 | |
---|
| 42 | INTEGER , PARAMETER :: jpfld = 5 ! maximum number of files to read |
---|
| 43 | INTEGER , PARAMETER :: jp_taux = 1 ! index of wind stress (i-component) file |
---|
| 44 | INTEGER , PARAMETER :: jp_tauy = 2 ! index of wind stress (j-component) file |
---|
| 45 | INTEGER , PARAMETER :: jp_qtot = 3 ! index of total (non solar+solar) heat file |
---|
| 46 | INTEGER , PARAMETER :: jp_qsr = 4 ! index of solar heat file |
---|
| 47 | INTEGER , PARAMETER :: jp_emp = 5 ! index of evaporation-precipation file |
---|
| 48 | |
---|
| 49 | !!wonsun |
---|
| 50 | REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & |
---|
| 51 | taux, tauy & !: surface stress components in (i,j) referential |
---|
| 52 | |
---|
| 53 | |
---|
| 54 | USE sbc_ice, only : dqns_ice , & ! : derivative of non solar heat flux on sea ice |
---|
| 55 | qsr_ice , & ! : solar flux over ice |
---|
| 56 | qns_ice , & ! : total non solar heat flux (Longwave downward radiation) over ice |
---|
| 57 | tn_ice , & ! : ice surface temperature |
---|
| 58 | alb_ice , & ! : albedo of ice |
---|
| 59 | sprecip , & ! : solid (snow) precipitation over water (!) what about ice? |
---|
| 60 | tprecip , & ! : total precipitation ( or liquid precip minus evaporation in coupled mode) |
---|
| 61 | calving , & ! : calving |
---|
| 62 | rrunoff , & ! : monthly runoff (kg/m2/s) |
---|
| 63 | fr1_i0 , & ! : 1st part of the fraction of sol.rad. which penetrate inside the ice cover |
---|
| 64 | fr2_i0 ! : 2nd part of the fraction of sol.rad. which penetrate inside the ice cover |
---|
| 65 | |
---|
| 66 | USE ice_2, only : hicif , & ! : ice thickness |
---|
| 67 | frld , & ! : leads fraction = 1-a/totalarea |
---|
| 68 | hsnif , & ! : snow thickness |
---|
| 69 | u_ice , v_ice ! : ice velocity |
---|
| 70 | |
---|
| 71 | USE sbc_oce, only : sst_m ! : sea surface temperature |
---|
| 72 | |
---|
| 73 | REAL(wp), PUBLIC :: & !!! surface fluxes namelist (namflx) |
---|
| 74 | q0 = 0.e0, & ! net heat flux |
---|
| 75 | qsr0 = 0.e0, & ! solar heat flux |
---|
| 76 | emp0 = 0.e0, & ! net freshwater flux |
---|
| 77 | dqdt0 = -40., & ! coefficient for SST damping (W/m2/K) |
---|
| 78 | deds0 = 27.7 ! coefficient for SSS damping (mm/day) |
---|
| 79 | |
---|
| 80 | REAL(wp), DIMENSION(jpi,jpj) :: qsr_oce_recv , qsr_ice_recv |
---|
| 81 | REAL(wp), DIMENSION(jpi,jpj) :: qns_oce_recv, qns_ice_recv |
---|
| 82 | REAL(wp), DIMENSION(jpi,jpj) :: dqns_ice_recv |
---|
| 83 | REAL(wp), DIMENSION(jpi,jpj) :: tprecip_recv , precip_recv |
---|
| 84 | REAL(wp), DIMENSION(jpi,jpj) :: fr1_i0_recv , fr2_i0_recv |
---|
| 85 | REAL(wp), DIMENSION(jpi,jpj) :: rrunoff_recv , calving_recv |
---|
| 86 | #if defined key_cpl_ocevel |
---|
| 87 | REAL(wp), DIMENSION(jpi,jpj) :: un_weighted, vn_weighted |
---|
| 88 | REAL(wp), DIMENSION(jpi,jpj) :: un_send , vn_send |
---|
| 89 | #endif |
---|
| 90 | REAL(wp), DIMENSION(jpi,jpj) :: zrunriv ! river discharge into ocean |
---|
| 91 | REAL(wp), DIMENSION(jpi,jpj) :: zruncot ! continental discharge into ocean |
---|
| 92 | |
---|
| 93 | REAL(wp), DIMENSION(jpi,jpj) :: zpew ! P-E over water |
---|
| 94 | REAL(wp), DIMENSION(jpi,jpj) :: zpei ! P-E over ice |
---|
| 95 | REAL(wp), DIMENSION(jpi,jpj) :: zpsol ! surface downward snow fall |
---|
| 96 | REAL(wp), DIMENSION(jpi,jpj) :: zevice ! surface upward snow flux where sea ice |
---|
| 97 | !!wonsun |
---|
| 98 | |
---|
| 99 | !! * Substitutions |
---|
| 100 | # include "domzgr_substitute.h90" |
---|
| 101 | !!---------------------------------------------------------------------- |
---|
| 102 | !! OPA 9.0 , LOCEAN-IPSL (2006) |
---|
| 103 | !! $ Id: $ |
---|
| 104 | !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) |
---|
| 105 | !!---------------------------------------------------------------------- |
---|
| 106 | |
---|
| 107 | CONTAINS |
---|
| 108 | |
---|
| 109 | SUBROUTINE sbc_cpl( kt ) |
---|
| 110 | !!--------------------------------------------------------------------- |
---|
| 111 | !! *** ROUTINE sbc_cpl *** |
---|
| 112 | !! |
---|
| 113 | !! ** Purpose : provide at each time step the surface ocean fluxes |
---|
| 114 | !! (momentum, heat, freshwater and runoff) in coupled mode |
---|
| 115 | !! |
---|
| 116 | !! ** Method : - Recieve from a Atmospheric model via OASIS coupler : |
---|
| 117 | !! i-component of the stress taux (N/m2) |
---|
| 118 | !! j-component of the stress tauy (N/m2) |
---|
| 119 | !! net downward heat flux qtot (watt/m2) |
---|
| 120 | !! net downward radiative flux qsr (watt/m2) |
---|
| 121 | !! net upward freshwater (evapo - precip) emp (kg/m2/s) |
---|
| 122 | !! - send to the Atmospheric model via OASIS coupler : |
---|
| 123 | !! |
---|
| 124 | !! ** Action : update at each time-step the two components of the |
---|
| 125 | !! surface stress in both (i,j) and geographical ref. |
---|
| 126 | !! |
---|
| 127 | !! |
---|
| 128 | !! CAUTION : - never mask the surface stress fields |
---|
| 129 | !! |
---|
| 130 | !! ** Action : update at each time-step |
---|
| 131 | !! - taux & tauy : stress components in (i,j) referential |
---|
| 132 | !! - qns : non solar heat flux |
---|
| 133 | !! - qsr : solar heat flux |
---|
| 134 | !! - emp : evap - precip (volume flux) |
---|
| 135 | !! - emps : evap - precip (concentration/dillution) |
---|
| 136 | !! |
---|
| 137 | !! References : The OASIS User Guide, Version 3.0 and 4.0 |
---|
| 138 | !!---------------------------------------------------------------------- |
---|
| 139 | INTEGER, INTENT(in) :: kt ! ocean time step |
---|
| 140 | !! |
---|
| 141 | INTEGER :: ji, jj ! dummy loop indices |
---|
| 142 | #if defined key_cpl_ocevel |
---|
| 143 | INTEGER :: ikchoix |
---|
| 144 | #endif |
---|
| 145 | INTEGER :: var_id, info |
---|
| 146 | INTEGER :: date !???? !!gm bug this is a real !!! |
---|
| 147 | REAL(wp) :: zfacflx, zfacwat, zfact |
---|
| 148 | |
---|
| 149 | REAL(wp), DIMENSION(jpi,jpj) :: ztaueuw, ztauevw ! eastward wind stress over water at U and V-points |
---|
| 150 | REAL(wp), DIMENSION(jpi,jpj) :: ztaunuw, ztaunvw ! northward wind stress over water at U and V-points |
---|
| 151 | REAL(wp), DIMENSION(jpi,jpj) :: ztaueui, ztauevi ! eastward wind stress over ice at U and V-points |
---|
| 152 | REAL(wp), DIMENSION(jpi,jpj) :: ztaunui, ztaunvi ! northward wind stress over ice at U and V-points |
---|
| 153 | REAL(wp), DIMENSION(jpi,jpj) :: ztaueu , ztauev ! eastward wind stress combined |
---|
| 154 | REAL(wp), DIMENSION(jpi,jpj) :: ztaunu , ztaunv ! northward wind stress combined |
---|
| 155 | !!--------------------------------------------------------------------- |
---|
| 156 | |
---|
| 157 | date = ( kt - nit000 ) * rdttra(1) ! date of exxhanges |
---|
| 158 | ! ! Conversion factor (ocean units are W/m2 and Kg/m2/s] |
---|
| 159 | zfacflx = 1.e0 ! no conversion [W/m2] ! W/m2 heat fluxes are send by the Atmosphere |
---|
| 160 | zfacwat = 1.e3 ! convert [m/s] to [kg/m2/s] ! m/s freshwater fluxes are send by the atmosphere |
---|
| 161 | |
---|
| 162 | |
---|
| 163 | ! ! =========================== ! |
---|
| 164 | ! ! Send Coupling fields ! |
---|
| 165 | ! ! =========================== ! |
---|
| 166 | ! |
---|
| 167 | !!gm bug ? here send instantaneous SST, not mean over the coupling period.... |
---|
| 168 | var_id = send_id(1) ; CALL cpl_prism_send( var_id, date, tn(:,:,1)+rt0, info ) ! ocean surface temperature [K] |
---|
| 169 | var_id = send_id(2) ; CALL cpl_prism_send( var_id, date, 1.0-frld , info ) ! fraction of ice-cover |
---|
| 170 | #if defined key_cpl_albedo |
---|
| 171 | DO jj = 1, jpj |
---|
| 172 | DO ji = 1, jpi |
---|
| 173 | IF( ( tn_ice(ji,jj) < 50 .OR. tn_ice(ji,jj) > 400 ) .AND. frld(ji,jj) < 1. ) THEN |
---|
| 174 | WRITE(numout,*) ' tn_ice, ERROR ', ji, jj, ' = ', tn_ice(ji,jj), & |
---|
| 175 | & ' qns_ice_recv=', qns_ice_recv(ji,jj), ' dqns_ice_recv=', dqns_ice_recv(ji,jj) |
---|
| 176 | ENDIF |
---|
| 177 | END DO |
---|
| 178 | END DO |
---|
| 179 | var_id = send_id(3) ; CALL cpl_prism_send( var_id, date, tn_ice , info ) ! ice surface temperature [K] |
---|
| 180 | var_id = send_id(4) ; CALL cpl_prism_send( var_id, date, alb_ice , info ) ! ice albedo [%] |
---|
| 181 | #else |
---|
| 182 | var_id = send_id(3) ; CALL cpl_prism_send( var_id, date, hicif , info ) ! ice thickness [m] |
---|
| 183 | var_id = send_id(4) ; CALL cpl_prism_send( var_id, date, hsnif , info ) ! snow thickness [m] |
---|
| 184 | #endif |
---|
| 185 | #if defined key_cpl_ocevel |
---|
| 186 | !!gm bug??? I have to check the grid point position... |
---|
| 187 | !! a priori there is a error here as un, vn are not at the same grid point.... |
---|
| 188 | !! there should be a averaged to set u and v at T-point.... with caution for sea-ice velocity at I-point.... |
---|
| 189 | un_weighted = un(:,:,1) * frld + u_ice * ( 1. - frld ) |
---|
| 190 | vn_weighted = vn(:,:,1) * frld + v_ice * ( 1. - frld ) |
---|
| 191 | ikchoix = - 1 ! converte from (i,j) to geographic referential |
---|
| 192 | CALL repere( un_weighted, vn_weighted, un_send, vn_send, ikchoix ) |
---|
| 193 | !!gm bug : at lbc_lnk is to be added on un_send and vn_send |
---|
| 194 | var_id = send_id(5) ; CALL cpl_prism_send( var_id, date, un_send , info ) ! surface current [m/s] |
---|
| 195 | var_id = send_id(6) ; CALL cpl_prism_send( var_id, date, vn_send , info ) ! surface current [m/s] |
---|
| 196 | #endif |
---|
| 197 | |
---|
| 198 | ! ! =========================== ! |
---|
| 199 | ! ! Recieve Momentum fluxes ! |
---|
| 200 | ! ! =========================== ! |
---|
| 201 | ! |
---|
| 202 | ! ... Receive wind stress fields in geographic component over water and ice |
---|
| 203 | var_id = recv_id(1) ; CALL cpl_prism_recv( var_id, date, ztaueuw, info ) ! ??? |
---|
| 204 | var_id = recv_id(2) ; CALL cpl_prism_recv( var_id, date, ztaunuw, info ) |
---|
| 205 | var_id = recv_id(3) ; CALL cpl_prism_recv( var_id, date, ztaueui, info ) |
---|
| 206 | var_id = recv_id(4) ; CALL cpl_prism_recv( var_id, date, ztaunui, info ) |
---|
| 207 | var_id = recv_id(5) ; CALL cpl_prism_recv( var_id, date, ztauevw, info ) |
---|
| 208 | var_id = recv_id(6) ; CALL cpl_prism_recv( var_id, date, ztaunvw, info ) |
---|
| 209 | var_id = recv_id(7) ; CALL cpl_prism_recv( var_id, date, ztauevi, info ) |
---|
| 210 | var_id = recv_id(8) ; CALL cpl_prism_recv( var_id, date, ztaunvi, info ) |
---|
| 211 | ! |
---|
| 212 | !!gm bug : keep separate ice and ocean stress ! |
---|
| 213 | ! ... combine water / ice stresses |
---|
| 214 | ztaueu(:,:) = ztaueuw(:,:) * frld(:,:) + ztaueui(:,:) * ( 1.0 - frld(:,:) ) |
---|
| 215 | ztaunu(:,:) = ztaunuw(:,:) * frld(:,:) + ztaunui(:,:) * ( 1.0 - frld(:,:) ) |
---|
| 216 | ztauev(:,:) = ztauevw(:,:) * frld(:,:) + ztauevi(:,:) * ( 1.0 - frld(:,:) ) |
---|
| 217 | ztaunv(:,:) = ztaunvw(:,:) * frld(:,:) + ztaunvi(:,:) * ( 1.0 - frld(:,:) ) |
---|
| 218 | ! |
---|
| 219 | ! ... rotate vector components from geographic to (i,j) referential |
---|
| 220 | CALL repcmo ( ztaueu, ztaunu, ztauev, ztaunv, utau, vtau, kt ) |
---|
| 221 | ! |
---|
| 222 | !!gm bug?? not sure but put that for security |
---|
| 223 | CALL lbc_lnk( utau , 'U', -1. ) |
---|
| 224 | CALL lbc_lnk( vtau , 'V', -1. ) |
---|
| 225 | !!gm end bug?? |
---|
| 226 | ! |
---|
| 227 | ! ! =========================== ! |
---|
| 228 | ! ! Recieve heat fluxes ! |
---|
| 229 | ! ! =========================== ! |
---|
| 230 | ! |
---|
| 231 | var_id = recv_id(13) ; CALL cpl_prism_recv( var_id, date, qsr_oce_recv , info ) ! ocean surface net downward shortwave flux |
---|
| 232 | var_id = recv_id(14) ; CALL cpl_prism_recv( var_id, date, qns_oce_recv , info ) ! ocean surface downward non-solar heat flux |
---|
| 233 | var_id = recv_id(15) ; CALL cpl_prism_recv( var_id, date, qsr_ice_recv , info ) ! ice solar heat flux |
---|
| 234 | var_id = recv_id(16) ; CALL cpl_prism_recv( var_id, date, qns_ice_recv , info ) ! ice non-solar heat flux |
---|
| 235 | var_id = recv_id(17) ; CALL cpl_prism_recv( var_id, date, dqns_ice_recv, info ) ! ice non-solar heat flux sensitivity |
---|
| 236 | |
---|
| 237 | qsr_oce_recv (:,:) = qsr_oce_recv (:,:) * tmask(:,:,1) * zfacflx |
---|
| 238 | qns_oce_recv (:,:) = qns_oce_recv (:,:) * tmask(:,:,1) * zfacflx |
---|
| 239 | qsr_ice_recv (:,:) = qsr_ice_recv (:,:) * tmask(:,:,1) * zfacflx |
---|
| 240 | qns_ice_recv (:,:) = qns_ice_recv (:,:) * tmask(:,:,1) * zfacflx |
---|
| 241 | dqns_ice_recv(:,:) = dqns_ice_recv(:,:) * tmask(:,:,1) * zfacflx |
---|
| 242 | |
---|
| 243 | IF( kt == nit000 ) THEN ! set once for all qsr penetration in sea-ice |
---|
| 244 | ! ! Since cloud cover catm not transmitted from atmosphere, it is set to 0. |
---|
| 245 | ! ! i.e. constant penetration fractions of 0.18 and 0.82 |
---|
| 246 | ! fraction of net shortwave radiation which is not absorbed in the thin surface layer and penetrates |
---|
| 247 | ! inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) |
---|
| 248 | fr1_i0_recv(:,:) = 0.18 |
---|
| 249 | fr2_i0_recv(:,:) = 0.82 |
---|
| 250 | ENDIF |
---|
| 251 | ! |
---|
| 252 | ! ! =========================== ! |
---|
| 253 | ! ! Recieve freshwater fluxes ! |
---|
| 254 | ! ! =========================== ! |
---|
| 255 | ! |
---|
| 256 | var_id = recv_id( 9) ; CALL cpl_prism_recv( var_id, date, zpew , info ) ! P-E over water |
---|
| 257 | var_id = recv_id(10) ; CALL cpl_prism_recv( var_id, date, zpei , info ) ! P-E over ice |
---|
| 258 | var_id = recv_id(11) ; CALL cpl_prism_recv( var_id, date, zpsol , info ) ! Snow fall over water and ice |
---|
| 259 | var_id = recv_id(12) ; CALL cpl_prism_recv( var_id, date, zevice, info ) ! Evaporation over ice (sublimination) |
---|
| 260 | ! |
---|
| 261 | ! ... calculate water flux (P-E over open ocean and ice) and solid precipitation (positive upward) |
---|
| 262 | tprecip_recv(:,:) = ( zpew (:,:) + zpei (:,:) ) * tmask(:,:,1) * zfacwat |
---|
| 263 | sprecip_recv(:,:) = ( zpsol(:,:) + zevice(:,:) ) * tmask(:,:,1) * zfacwat |
---|
| 264 | |
---|
| 265 | ! ... Control print & check |
---|
| 266 | IF(ln_ctl) THEN |
---|
| 267 | WRITE(numout,*) ' flx:tprecip_recv - Minimum value is ', MINVAL( tprecip_recv ) |
---|
| 268 | WRITE(numout,*) ' flx:tprecip_recv - Maximum value is ', MAXVAL( tprecip_recv ) |
---|
| 269 | WRITE(numout,*) ' flx:tprecip_recv - Sum value is ', SUM ( tprecip_recv ) |
---|
| 270 | ENDIF |
---|
| 271 | !!gm bug in mpp SUM require a mmp_sum call |
---|
| 272 | !!gm further more this test is quite expensive ... only needed at the first time-step??? |
---|
| 273 | IF( SUM( zpew*e1t*e2t ) /= SUM( zpew*e1t*e2t*tmask(:,:,1) ) ) THEN |
---|
| 274 | WRITE(numout,*) ' flx: Forcing values outside Orca mask' |
---|
| 275 | WRITE(numout,*) ' flx: Losses in water conservation' |
---|
| 276 | WRITE(numout,*) ' flx: Masked ', SUM(zpew*e1t*e2t*tmask(:,:,1)) |
---|
| 277 | WRITE(numout,*) ' flx: Unmasked ', SUM(zpew*e1t*e2t) |
---|
| 278 | WRITE(numout,*) ' flx: Simulation STOP' |
---|
| 279 | CALL FLUSH(numout) |
---|
| 280 | STOP |
---|
| 281 | END IF |
---|
| 282 | ! |
---|
| 283 | #if defined key_cpl_discharge |
---|
| 284 | ! Runoffs |
---|
| 285 | var_id = recv_id(18) ; CALL cpl_prism_recv ( var_id, date, calving_recv, info ) ! ice discharge into ocean |
---|
| 286 | var_id = recv_id(19) ; CALL cpl_prism_recv ( var_id, date, zrunriv , info ) ! river discharge into ocean |
---|
| 287 | var_id = recv_id(20) ; CALL cpl_prism_recv ( var_id, date, zruncot , info ) ! continental discharge into ocean |
---|
| 288 | |
---|
| 289 | DO jj = 1, jpj |
---|
| 290 | DO ji = 1, jpi |
---|
| 291 | zfact = zfacwat * tmask(ji,jj,1) |
---|
| 292 | calving_recv(ji,jj) = calving_recv(ji,jj) * zfact |
---|
| 293 | rrunoff_recv(ji,jj) = ( zrunriv(ji,jj) + zruncot(ji,jj) ) * zfact |
---|
| 294 | END DO |
---|
| 295 | END DO |
---|
| 296 | #else |
---|
| 297 | calving_recv(:,:) = 0. |
---|
| 298 | rrunoff_recv(:,:) = 0. |
---|
| 299 | #endif |
---|
| 300 | |
---|
| 301 | !!gm bug : this is not valid in mpp |
---|
| 302 | !!gm and I presum this is not required at all as a lbc_lnk is applied to all the fields at the end of the routine |
---|
| 303 | ! Oasis mask shift and update lateral boundary conditions (E. Maisonnave) |
---|
| 304 | ! not tested when mpp is used, W. Park |
---|
| 305 | !WSPTEST |
---|
| 306 | qsr_oce_recv (jpi-1,:) = qsr_oce_recv (1,:) |
---|
| 307 | qsr_ice_recv (jpi-1,:) = qsr_ice_recv (1,:) |
---|
| 308 | qns_oce_recv (jpi-1,:) = qns_oce_recv (1,:) |
---|
| 309 | qns_ice_recv (jpi-1,:) = qns_ice_recv (1,:) |
---|
| 310 | dqns_ice_recv(jpi-1,:) = dqns_ice_recv(1,:) |
---|
| 311 | tprecip_recv (jpi-1,:) = tprecip_recv (1,:) |
---|
| 312 | sprecip_recv (jpi-1,:) = sprecip_recv (1,:) |
---|
| 313 | fr1_i0_recv (jpi-1,:) = fr1_i0_recv (1,:) |
---|
| 314 | fr2_i0_recv (jpi-1,:) = fr2_i0_recv (1,:) |
---|
| 315 | rrunoff_recv (jpi-1,:) = rrunoff_recv (1,:) |
---|
| 316 | calving_recv (jpi-1,:) = calving_recv (1,:) |
---|
| 317 | !!gm end bug |
---|
| 318 | |
---|
| 319 | qsr (:,:) = qsr_oce_recv (:,:) ! ocean surface boundary condition |
---|
| 320 | qns (:,:) = qns_oce_recv (:,:) |
---|
| 321 | emp (:,:) = zpew (:,:) |
---|
| 322 | emps (:,:) = zpew (:,:) |
---|
| 323 | |
---|
| 324 | qsr_ice (:,:) = qsr_ice_recv (:,:) ! ice forcing fields |
---|
| 325 | qns_ice (:,:) = qns_ice_recv (:,:) |
---|
| 326 | dqns_ice(:,:) = dqns_ice_recv(:,:) |
---|
| 327 | tprecip (:,:) = tprecip_recv (:,:) |
---|
| 328 | sprecip (:,:) = sprecip_recv (:,:) |
---|
| 329 | fr1_i0 (:,:) = fr1_i0_recv (:,:) |
---|
| 330 | fr2_i0 (:,:) = fr2_i0_recv (:,:) |
---|
| 331 | |
---|
| 332 | !WSP rrunoff = rrunoff_recv |
---|
| 333 | !WSP calving = calving_recv |
---|
| 334 | rrunoff (:,:) = 0.e0 !WSP runoff and calving included in tprecip |
---|
| 335 | calving (:,:) = 0.e0 !WSP |
---|
| 336 | |
---|
| 337 | IF(ln_ctl) THEN |
---|
| 338 | WRITE(numout,*) 'flx:qsr_oce - Minimum value is ', MINVAL( qsr_oce ) |
---|
| 339 | WRITE(numout,*) 'flx:qsr_oce - Maximum value is ', MAXVAL( qsr_oce ) |
---|
| 340 | WRITE(numout,*) 'flx:qsr_oce - Sum value is ', SUM ( qsr_oce ) |
---|
| 341 | ! |
---|
| 342 | WRITE(numout,*) 'flx:tprecip - Minimum value is ', MINVAL( tprecip ) |
---|
| 343 | WRITE(numout,*) 'flx:tprecip - Maximum value is ', MAXVAL( tprecip ) |
---|
| 344 | WRITE(numout,*) 'flx:tprecip - Sum value is ', SUM ( tprecip ) |
---|
| 345 | ENDIF |
---|
| 346 | |
---|
| 347 | CALL lbc_lnk( qsr_oce , 'T', 1. ) |
---|
| 348 | CALL lbc_lnk( qsr_ice , 'T', 1. ) |
---|
| 349 | CALL lbc_lnk( qns_oce , 'T', 1. ) |
---|
| 350 | CALL lbc_lnk( qns_ice , 'T', 1. ) |
---|
| 351 | CALL lbc_lnk( tprecip , 'T', 1. ) |
---|
| 352 | CALL lbc_lnk( sprecip , 'T', 1. ) |
---|
| 353 | CALL lbc_lnk( rrunoff , 'T', 1. ) |
---|
| 354 | CALL lbc_lnk( dqns_ice, 'T', 1. ) |
---|
| 355 | CALL lbc_lnk( calving , 'T', 1. ) |
---|
| 356 | CALL lbc_lnk( fr1_i0 , 'T', 1. ) |
---|
| 357 | CALL lbc_lnk( fr2_i0 , 'T', 1. ) |
---|
| 358 | |
---|
| 359 | IF(ln_ctl) THEN |
---|
| 360 | WRITE(numout,*) 'flx(af lbc_lnk):qsr_oce - Minimum value is ', MINVAL( qsr_oce ) |
---|
| 361 | WRITE(numout,*) 'flx(af lbc_lnk):qsr_oce - Maximum value is ', MAXVAL( qsr_oce ) |
---|
| 362 | WRITE(numout,*) 'flx(af lbc_lnk):qsr_oce - Sum value is ', SUM ( qsr_oce ) |
---|
| 363 | ! |
---|
| 364 | WRITE(numout,*) 'flx(af lbc_lnk):tprecip - Minimum value is ', MINVAL( tprecip ) |
---|
| 365 | WRITE(numout,*) 'flx(af lbc_lnk):tprecip - Maximum value is ', MAXVAL( tprecip ) |
---|
| 366 | WRITE(numout,*) 'flx(af lbc_lnk):tprecip - Sum value is ', SUM ( tprecip ) |
---|
| 367 | ENDIF |
---|
| 368 | ! |
---|
| 369 | END SUBROUTINE sbc_cpl |
---|
| 370 | |
---|
| 371 | #else |
---|
| 372 | !!---------------------------------------------------------------------- |
---|
| 373 | !! Dummy routine NO sea surface restoring |
---|
| 374 | !!---------------------------------------------------------------------- |
---|
| 375 | LOGICAL, PUBLIC :: lk_sbc_cpl = .FALSE. !: coupled formulation flag |
---|
| 376 | CONTAINS |
---|
| 377 | SUBROUTINE sbc_cpl( kt ) ! Dummy routine |
---|
| 378 | WRITE(*,*) 'sbc_cpl: you should not have seen that print! error?', kt |
---|
| 379 | END SUBROUTINE sbc_cpl |
---|
| 380 | #endif |
---|
| 381 | |
---|
| 382 | !!====================================================================== |
---|
| 383 | END MODULE sbccpl |
---|