[532] | 1 | !!---------------------------------------------------------------------- |
---|
| 2 | !! *** flx_oasis_ice.h90 *** |
---|
| 3 | !!---------------------------------------------------------------------- |
---|
| 4 | !! flx : define the thermohaline fluxes for the ocean in |
---|
| 5 | !! coupled ocean/atmosphere case with sea-ice |
---|
| 6 | !!---------------------------------------------------------------------- |
---|
| 7 | |
---|
| 8 | REAL(wp) :: zcatm1 (1:jpi,1:jpj) ! cloud fraction |
---|
| 9 | |
---|
| 10 | REAL(wp) :: qsr_oce_recv (1:jpi,1:jpj) |
---|
| 11 | REAL(wp) :: qsr_ice_recv (1:jpi,1:jpj) |
---|
| 12 | REAL(wp) :: qnsr_oce_recv (1:jpi,1:jpj) |
---|
| 13 | REAL(wp) :: qnsr_ice_recv (1:jpi,1:jpj) |
---|
| 14 | REAL(wp) :: dqns_ice_recv (1:jpi,1:jpj) |
---|
| 15 | REAL(wp) :: tprecip_recv (1:jpi,1:jpj) |
---|
| 16 | REAL(wp) :: sprecip_recv (1:jpi,1:jpj) |
---|
| 17 | REAL(wp) :: fr1_i0_recv (1:jpi,1:jpj) |
---|
| 18 | REAL(wp) :: fr2_i0_recv (1:jpi,1:jpj) |
---|
| 19 | REAL(wp) :: rrunoff_recv (1:jpi,1:jpj) |
---|
| 20 | REAL(wp) :: calving_recv (1:jpi,1:jpj) |
---|
| 21 | #if defined key_cpl_ocevel |
---|
| 22 | REAL(wp) :: un_weighted (1:jpi,1:jpj) |
---|
| 23 | REAL(wp) :: vn_weighted (1:jpi,1:jpj) |
---|
| 24 | REAL(wp) :: un_send (1:jpi,1:jpj) |
---|
| 25 | REAL(wp) :: vn_send (1:jpi,1:jpj) |
---|
| 26 | #endif |
---|
| 27 | REAL(wp) :: zrunriv (1:jpi,1:jpj) ! river discharge into ocean |
---|
| 28 | REAL(wp) :: zruncot (1:jpi,1:jpj) ! continental discharge into ocean |
---|
| 29 | |
---|
| 30 | REAL(wp) :: zpew (1:jpi,1:jpj) ! P-E over water |
---|
| 31 | REAL(wp) :: zpei (1:jpi,1:jpj) ! P-E over ice |
---|
| 32 | REAL(wp) :: zpsol (1:jpi,1:jpj) ! surface downward snow fall |
---|
| 33 | REAL(wp) :: zevice (1:jpi,1:jpj) ! surface upward snow flux where sea ice |
---|
| 34 | |
---|
| 35 | !! * Modules used C A U T I O N already defined in flxmod.F90 |
---|
| 36 | !! |
---|
| 37 | !! * Module variables |
---|
| 38 | LOGICAL :: lfirstf=.TRUE. |
---|
| 39 | !!---------------------------------------------------------------------- |
---|
| 40 | !! OPA 9.0 , LOCEAN-IPSL (2006) |
---|
| 41 | !! $Header$ |
---|
| 42 | !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) |
---|
| 43 | !!---------------------------------------------------------------------- |
---|
| 44 | |
---|
| 45 | CONTAINS |
---|
| 46 | |
---|
| 47 | SUBROUTINE flx( kt ) |
---|
| 48 | !!--------------------------------------------------------------------- |
---|
| 49 | !! *** ROUTINE flx *** |
---|
| 50 | !! |
---|
| 51 | !! ** Purpose : exchange the thermohaline fields (heat and freshwater) |
---|
| 52 | !! with the atmosphere at each ocean time step. |
---|
| 53 | !! |
---|
| 54 | !! ** Method : Receive and send fluxes from/to a coupled atmospheric model |
---|
| 55 | !! |
---|
| 56 | !! References : The OASIS User Guide, Version 3.0 |
---|
| 57 | !! |
---|
| 58 | !! History : |
---|
| 59 | !! 9.0 ! 04-11 (R. Redler) Original code |
---|
| 60 | !! ! 05-05 (W. Park, N. Keenlyside) Separation of recv and pass variables (ref.icestp.F90) |
---|
| 61 | !! ! 05-09 (W. Park, N. Keenlyside) Implementation of ocean velocity |
---|
| 62 | !! ! 06-06 (E. Maisonnave, W. Park) Oasis mask adaptation |
---|
| 63 | !!---------------------------------------------------------------------- |
---|
| 64 | !! * Modules used |
---|
| 65 | USE in_out_manager, only: numout ! I/O manager |
---|
| 66 | |
---|
| 67 | !! * Arguments |
---|
| 68 | INTEGER, INTENT( in ) :: kt ! ocean time step |
---|
| 69 | |
---|
| 70 | !! * Local declarations |
---|
| 71 | INTEGER :: ji, jj |
---|
| 72 | |
---|
| 73 | #if defined key_cpl_ocevel |
---|
| 74 | INTEGER :: ikchoix=-1 |
---|
| 75 | #endif |
---|
| 76 | |
---|
| 77 | INTEGER :: var_id |
---|
| 78 | INTEGER :: info, date, n |
---|
| 79 | |
---|
| 80 | REAL(wp) :: zfacflx |
---|
| 81 | REAL(wp) :: zfacwat |
---|
| 82 | ! |
---|
| 83 | !!--------------------------------------------------------------------- |
---|
| 84 | ! |
---|
| 85 | ! Initialization |
---|
| 86 | ! -------------- |
---|
| 87 | ! |
---|
| 88 | ! caution, I presume that you have good UNIT system from coupler to OPA |
---|
| 89 | ! that is : |
---|
| 90 | ! watt/m2 for znsolc and zqsrc |
---|
| 91 | ! kg/m2/s for evaporation, precipitation and runoff |
---|
| 92 | zfacflx = 1.e0 |
---|
| 93 | zfacwat = 1.e3 ! convert [m/s] to [kg/m**2/s] |
---|
| 94 | ! |
---|
| 95 | date = ( kt - nit000 ) * rdttra(1) |
---|
| 96 | ! |
---|
| 97 | ! 1. Send coupling fields |
---|
| 98 | !------------------------ |
---|
| 99 | ! |
---|
| 100 | var_id = send_id(1) |
---|
| 101 | CALL cpl_prism_send ( var_id, date, tn(:,:,1)+rt0, info ) |
---|
| 102 | var_id = send_id(2) |
---|
| 103 | CALL cpl_prism_send ( var_id, date, 1.0-frld, info ) |
---|
| 104 | |
---|
| 105 | #if defined key_cpl_albedo |
---|
| 106 | DO jj = 1, jpj |
---|
| 107 | DO ji = 1, jpi |
---|
| 108 | if (((tn_ice(ji,jj).lt.50).or.(tn_ice(ji,jj).gt.400)) .and. frld(ji,jj).lt.1.) then |
---|
| 109 | WRITE(numout,*) ' tn_ice, ERROR ',ji,jj, ' = ', tn_ice(ji,jj), & |
---|
| 110 | ' qnsr_ice_recv=', qnsr_ice_recv(ji,jj), ' dqns_ice_recv=', dqns_ice_recv(ji,jj) |
---|
| 111 | endif |
---|
| 112 | ENDDO |
---|
| 113 | ENDDO |
---|
| 114 | var_id = send_id(3) |
---|
| 115 | CALL cpl_prism_send ( var_id, date, tn_ice, info ) |
---|
| 116 | |
---|
| 117 | var_id = send_id(4) |
---|
| 118 | CALL cpl_prism_send ( var_id, date, alb_ice, info ) |
---|
| 119 | #else |
---|
| 120 | var_id = send_id(3) |
---|
| 121 | CALL cpl_prism_send ( var_id, date, hicif, info ) |
---|
| 122 | |
---|
| 123 | var_id = send_id(4) |
---|
| 124 | CALL cpl_prism_send ( var_id, date, hsnif, info ) |
---|
| 125 | #endif |
---|
| 126 | |
---|
| 127 | #if defined key_cpl_ocevel |
---|
| 128 | un_weighted = un(:,:,1) * frld + u_ice * ( 1. - frld ) |
---|
| 129 | vn_weighted = vn(:,:,1) * frld + v_ice * ( 1. - frld ) |
---|
| 130 | CALL repere ( un_weighted, vn_weighted, un_send, vn_send, ikchoix ) |
---|
| 131 | |
---|
| 132 | var_id = send_id(5) |
---|
| 133 | CALL cpl_prism_send ( var_id, date, un_send, info ) |
---|
| 134 | |
---|
| 135 | var_id = send_id(6) |
---|
| 136 | CALL cpl_prism_send ( var_id, date, vn_send, info ) |
---|
| 137 | #endif |
---|
| 138 | ! |
---|
| 139 | ! 2. Receive and build flux fields |
---|
| 140 | !--------------------------------- |
---|
| 141 | ! |
---|
| 142 | ! I.) Precipitation/Evaporation |
---|
| 143 | ! ----------------------------- |
---|
| 144 | ! |
---|
| 145 | ! ... a) P-E over water |
---|
| 146 | ! |
---|
| 147 | var_id = recv_id(9) |
---|
| 148 | CALL cpl_prism_recv ( var_id, date, zpew, info ) |
---|
| 149 | ! |
---|
| 150 | ! ... b) P-E over ice |
---|
| 151 | ! |
---|
| 152 | var_id = recv_id(10) |
---|
| 153 | CALL cpl_prism_recv ( var_id, date, zpei, info ) |
---|
| 154 | ! |
---|
| 155 | ! ... c) Snow fall over water and ice |
---|
| 156 | ! |
---|
| 157 | var_id = recv_id(11) |
---|
| 158 | CALL cpl_prism_recv ( var_id, date, zpsol, info ) |
---|
| 159 | ! |
---|
| 160 | ! ... d) Evaporation over ice (sublimination) |
---|
| 161 | ! |
---|
| 162 | var_id = recv_id(12) |
---|
| 163 | CALL cpl_prism_recv ( var_id, date, zevice, info ) |
---|
| 164 | ! |
---|
| 165 | ! calculate water flux (PE over water and ice) (positive upward) |
---|
| 166 | DO jj = 1, jpj |
---|
| 167 | DO ji = 1, jpi |
---|
| 168 | tprecip_recv(ji,jj) = ( zpew(ji,jj) + zpei(ji,jj) ) * tmask(ji,jj,1) * zfacwat |
---|
| 169 | ENDDO |
---|
| 170 | ENDDO |
---|
| 171 | IF (ln_ctl) THEN |
---|
| 172 | WRITE(numout,*) ' flx:tprecip_recv - Minimum value is ', MINVAL(tprecip_recv) |
---|
| 173 | WRITE(numout,*) ' flx:tprecip_recv - Maximum value is ', MAXVAL(tprecip_recv) |
---|
| 174 | WRITE(numout,*) ' flx:tprecip_recv - Sum value is ', SUM(tprecip_recv) |
---|
| 175 | ENDIF |
---|
| 176 | |
---|
| 177 | IF ( SUM(zpew*e1t*e2t) /= SUM(zpew*e1t*e2t*tmask(:,:,1)) ) THEN |
---|
| 178 | WRITE(numout,*) ' flx: Forcing values outside Orca mask' |
---|
| 179 | WRITE(numout,*) ' flx: Losses in water conservation' |
---|
| 180 | WRITE(numout,*) ' flx: Masked ', SUM(zpew*e1t*e2t*tmask(:,:,1)) |
---|
| 181 | WRITE(numout,*) ' flx: Unmasked ', SUM(zpew*e1t*e2t) |
---|
| 182 | WRITE(numout,*) ' flx: Simulation STOP' |
---|
| 183 | CALL FLUSH(numout) |
---|
| 184 | STOP |
---|
| 185 | END IF |
---|
| 186 | |
---|
| 187 | ! |
---|
| 188 | ! calculate solid precipitation (positive upward) |
---|
| 189 | DO jj = 1, jpj |
---|
| 190 | DO ji = 1, jpi |
---|
| 191 | sprecip_recv(ji,jj) = ( zpsol(ji,jj) + zevice(ji,jj) ) * tmask(ji,jj,1) * zfacwat |
---|
| 192 | ENDDO |
---|
| 193 | ENDDO |
---|
| 194 | ! |
---|
| 195 | ! |
---|
| 196 | ! II.) Solar fluxes |
---|
| 197 | ! ------------------ |
---|
| 198 | ! |
---|
| 199 | ! ... a) surface net downward shortwave flux |
---|
| 200 | ! |
---|
| 201 | var_id = recv_id(13) |
---|
| 202 | CALL cpl_prism_recv ( var_id, date, qsr_oce_recv, info ) |
---|
| 203 | |
---|
| 204 | DO jj = 1, jpj |
---|
| 205 | DO ji = 1, jpi |
---|
| 206 | qsr_oce_recv(ji,jj) = qsr_oce_recv(ji,jj) * tmask(ji,jj,1) * zfacflx |
---|
| 207 | ENDDO |
---|
| 208 | ENDDO |
---|
| 209 | ! |
---|
| 210 | ! ... b) surface downward non-solar heat flux in air |
---|
| 211 | ! |
---|
| 212 | var_id = recv_id(14) |
---|
| 213 | CALL cpl_prism_recv ( var_id, date, qnsr_oce_recv, info) |
---|
| 214 | |
---|
| 215 | DO jj = 1, jpj |
---|
| 216 | DO ji = 1, jpi |
---|
| 217 | qnsr_oce_recv(ji,jj) = qnsr_oce_recv(ji,jj) * tmask(ji,jj,1) * zfacflx |
---|
| 218 | ENDDO |
---|
| 219 | ENDDO |
---|
| 220 | ! |
---|
| 221 | ! ... c) solar heat flux on sea ice |
---|
| 222 | ! |
---|
| 223 | var_id = recv_id(15) |
---|
| 224 | CALL cpl_prism_recv ( var_id, date, qsr_ice_recv, info ) |
---|
| 225 | |
---|
| 226 | DO jj = 1, jpj |
---|
| 227 | DO ji = 1, jpi |
---|
| 228 | qsr_ice_recv(ji,jj) = qsr_ice_recv(ji,jj) * tmask(ji,jj,1) * zfacflx |
---|
| 229 | ENDDO |
---|
| 230 | ENDDO |
---|
| 231 | ! |
---|
| 232 | ! ... d) non-solar heat flux on sea ice |
---|
| 233 | ! |
---|
| 234 | var_id = recv_id(16) |
---|
| 235 | CALL cpl_prism_recv ( var_id, date, qnsr_ice_recv, info) |
---|
| 236 | |
---|
| 237 | DO jj = 1, jpj |
---|
| 238 | DO ji = 1, jpi |
---|
| 239 | qnsr_ice_recv(ji,jj) = qnsr_ice_recv(ji,jj) * tmask(ji,jj,1) * zfacflx |
---|
| 240 | ENDDO |
---|
| 241 | ENDDO |
---|
| 242 | ! |
---|
| 243 | ! ... e) non solar heat flux derivative over ice |
---|
| 244 | ! |
---|
| 245 | var_id = recv_id(17) |
---|
| 246 | CALL cpl_prism_recv ( var_id, date, dqns_ice_recv, info) |
---|
| 247 | |
---|
| 248 | DO jj = 1, jpj |
---|
| 249 | DO ji = 1, jpi |
---|
| 250 | dqns_ice_recv(ji,jj) = dqns_ice_recv(ji,jj) * tmask(ji,jj,1) * zfacflx |
---|
| 251 | ENDDO |
---|
| 252 | ENDDO |
---|
| 253 | ! |
---|
| 254 | ! Since cloud cover catm not transmitted from atmosphere, init =0. |
---|
| 255 | ! |
---|
| 256 | catm(:, :) = 0. |
---|
| 257 | DO jj = 1, jpj |
---|
| 258 | DO ji = 1, jpi |
---|
| 259 | zcatm1(ji,jj) = 1.0 - catm (ji,jj) ! fractional cloud cover |
---|
| 260 | END DO |
---|
| 261 | END DO |
---|
| 262 | |
---|
| 263 | ! fraction of net shortwave radiation which is not absorbed in the |
---|
| 264 | ! thin surface layer and penetrates inside the ice cover |
---|
| 265 | ! ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) |
---|
| 266 | !------------------------------------------------------------------ |
---|
| 267 | DO jj = 1, jpj |
---|
| 268 | DO ji = 1, jpi |
---|
| 269 | fr1_i0_recv(ji,jj) = 0.18 * zcatm1(ji,jj) + 0.35 * catm(ji,jj) |
---|
| 270 | fr2_i0_recv(ji,jj) = 0.82 * zcatm1(ji,jj) + 0.65 * catm(ji,jj) |
---|
| 271 | END DO |
---|
| 272 | END DO |
---|
| 273 | ! |
---|
| 274 | #if defined key_cpl_discharge |
---|
| 275 | ! III.) Runoff |
---|
| 276 | ! ----------- |
---|
| 277 | ! |
---|
| 278 | ! ... a) ice discharge into ocean |
---|
| 279 | ! |
---|
| 280 | var_id = recv_id(18) |
---|
| 281 | CALL cpl_prism_recv ( var_id, date, calving_recv, info ) |
---|
| 282 | |
---|
| 283 | DO jj = 1, jpj |
---|
| 284 | DO ji = 1, jpi |
---|
| 285 | calving_recv(ji,jj) = calving_recv(ji,jj) * tmask(ji,jj,1) * zfacwat |
---|
| 286 | ENDDO |
---|
| 287 | ENDDO |
---|
| 288 | ! |
---|
| 289 | ! ... b) river discharge into ocean |
---|
| 290 | ! |
---|
| 291 | var_id = recv_id(19) |
---|
| 292 | CALL cpl_prism_recv ( var_id, date, zrunriv, info ) |
---|
| 293 | ! |
---|
| 294 | ! ... c) continental discharge into ocean |
---|
| 295 | ! |
---|
| 296 | var_id = recv_id(20) |
---|
| 297 | CALL cpl_prism_recv ( var_id, date, zruncot, info) |
---|
| 298 | |
---|
| 299 | DO jj = 1, jpj |
---|
| 300 | DO ji = 1, jpi |
---|
| 301 | rrunoff_recv(ji,jj) = ( zrunriv(ji,jj) + zruncot (ji,jj) ) * tmask(ji,jj,1) * zfacwat |
---|
| 302 | ENDDO |
---|
| 303 | ENDDO |
---|
| 304 | ! |
---|
| 305 | #else |
---|
| 306 | calving_recv = 0. |
---|
| 307 | rrunoff_recv = 0. |
---|
| 308 | #endif |
---|
| 309 | |
---|
| 310 | ! Oasis mask shift and update lateral boundary conditions (E. Maisonnave) |
---|
| 311 | ! not tested when mpp is used, W. Park |
---|
| 312 | !WSPTEST |
---|
| 313 | qsr_oce_recv(jpi-1,:) = qsr_oce_recv(1,:) |
---|
| 314 | qsr_ice_recv(jpi-1,:) = qsr_ice_recv(1,:) |
---|
| 315 | qnsr_oce_recv(jpi-1,:) = qnsr_oce_recv(1,:) |
---|
| 316 | qnsr_ice_recv(jpi-1,:) = qnsr_ice_recv(1,:) |
---|
| 317 | dqns_ice_recv(jpi-1,:) = dqns_ice_recv(1,:) |
---|
| 318 | tprecip_recv(jpi-1,:) = tprecip_recv(1,:) |
---|
| 319 | sprecip_recv(jpi-1,:) = sprecip_recv(1,:) |
---|
| 320 | fr1_i0_recv(jpi-1,:) = fr1_i0_recv(1,:) |
---|
| 321 | fr2_i0_recv(jpi-1,:) = fr2_i0_recv(1,:) |
---|
| 322 | rrunoff_recv(jpi-1,:) = rrunoff_recv(1,:) |
---|
| 323 | calving_recv(jpi-1,:) = calving_recv(1,:) |
---|
| 324 | |
---|
| 325 | qsr_oce = qsr_oce_recv |
---|
| 326 | qsr_ice = qsr_ice_recv |
---|
| 327 | qnsr_oce = qnsr_oce_recv |
---|
| 328 | qnsr_ice = qnsr_ice_recv |
---|
| 329 | dqns_ice = dqns_ice_recv |
---|
| 330 | tprecip = tprecip_recv |
---|
| 331 | sprecip = sprecip_recv |
---|
| 332 | fr1_i0 = fr1_i0_recv |
---|
| 333 | fr2_i0 = fr2_i0_recv |
---|
| 334 | !WSP rrunoff = rrunoff_recv |
---|
| 335 | !WSP calving = calving_recv |
---|
| 336 | rrunoff = 0. !WSP runoff and calving included in tprecip |
---|
| 337 | calving = 0. !WSP |
---|
| 338 | |
---|
| 339 | IF(ln_ctl) THEN |
---|
| 340 | write(numout,*) 'flx:qsr_oce - Minimum value is ', minval(qsr_oce) |
---|
| 341 | write(numout,*) 'flx:qsr_oce - Maximum value is ', maxval(qsr_oce) |
---|
| 342 | write(numout,*) 'flx:qsr_oce - Sum value is ', SUM(qsr_oce) |
---|
| 343 | |
---|
| 344 | write(numout,*) 'flx:tprecip - Minimum value is ', minval(tprecip) |
---|
| 345 | write(numout,*) 'flx:tprecip - Maximum value is ', maxval(tprecip) |
---|
| 346 | write(numout,*) 'flx:tprecip - Sum value is ', SUM(tprecip) |
---|
| 347 | ENDIF |
---|
| 348 | |
---|
| 349 | CALL lbc_lnk( qsr_oce , 'T', 1. ) |
---|
| 350 | CALL lbc_lnk( qsr_ice , 'T', 1. ) |
---|
| 351 | CALL lbc_lnk( qnsr_oce, 'T', 1. ) |
---|
| 352 | CALL lbc_lnk( qnsr_ice, 'T', 1. ) |
---|
| 353 | CALL lbc_lnk( tprecip , 'T', 1. ) |
---|
| 354 | CALL lbc_lnk( sprecip , 'T', 1. ) |
---|
| 355 | CALL lbc_lnk( rrunoff , 'T', 1. ) |
---|
| 356 | CALL lbc_lnk( dqns_ice, 'T', 1. ) |
---|
| 357 | CALL lbc_lnk( calving , 'T', 1. ) |
---|
| 358 | CALL lbc_lnk( fr1_i0 , 'T', 1. ) |
---|
| 359 | CALL lbc_lnk( fr2_i0 , 'T', 1. ) |
---|
| 360 | |
---|
| 361 | IF(ln_ctl) THEN |
---|
| 362 | write(numout,*) 'flx(af lbc_lnk):qsr_oce - Minimum value is ', minval(qsr_oce) |
---|
| 363 | write(numout,*) 'flx(af lbc_lnk):qsr_oce - Maximum value is ', maxval(qsr_oce) |
---|
| 364 | write(numout,*) 'flx(af lbc_lnk):qsr_oce - Sum value is ', SUM(qsr_oce) |
---|
| 365 | |
---|
| 366 | write(numout,*) 'flx(af lbc_lnk):tprecip - Minimum value is ', minval(tprecip) |
---|
| 367 | write(numout,*) 'flx(af lbc_lnk):tprecip - Maximum value is ', maxval(tprecip) |
---|
| 368 | write(numout,*) 'flx(af lbc_lnk):tprecip - Sum value is ', SUM(tprecip) |
---|
| 369 | ENDIF |
---|
| 370 | |
---|
| 371 | END SUBROUTINE flx |
---|