00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023 module CICE_RunMod
00024
00025
00026
00027 use ice_age
00028 use ice_aerosol
00029 use ice_atmo
00030 use ice_calendar
00031 use ice_communicate
00032 use ice_diagnostics
00033 use ice_domain
00034 use ice_dyn_evp
00035 use ice_fileunits
00036 use ice_flux
00037 use ice_forcing
00038 use ice_FY
00039 use ice_grid
00040 use ice_history
00041 use ice_restart
00042 use ice_itd
00043 use ice_kinds_mod
00044 use ice_mechred
00045 use ice_meltpond
00046 use ice_ocean
00047 use ice_orbital
00048 use ice_shortwave
00049 use ice_state
00050 use ice_therm_itd
00051 use ice_therm_vertical
00052 use ice_timers
00053 use ice_transport_driver
00054 use ice_transport_remap
00055
00056 implicit none
00057 private
00058 save
00059
00060
00061
00062 public :: step_therm1, coupling_prep
00063
00064
00065
00066
00067
00068 contains
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087 subroutine step_therm1(dt)
00088
00089
00090
00091
00092
00093 real (kind=dbl_kind), intent(in) ::
00094 dt
00095
00096
00097
00098 integer (kind=int_kind) ::
00099 iblk
00100
00101 call ice_timer_start(timer_column)
00102 call ice_timer_start(timer_thermo)
00103
00104 call init_history_therm
00105 call init_flux_ocn
00106
00107 if (oceanmixed_ice) &
00108 call ocean_mixed_layer (dt)
00109
00110
00111
00112
00113 do iblk = 1, nblocks
00114 call step_therm1_iblk(dt, iblk)
00115 end do
00116
00117
00118
00119 call ice_timer_stop(timer_thermo)
00120 call ice_timer_stop(timer_column)
00121
00122 end subroutine step_therm1
00123
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133
00134
00135
00136
00137
00138
00139
00140 subroutine step_therm1_iblk (dt, iblk)
00141
00142
00143
00144
00145
00146 real (kind=dbl_kind), intent(in) ::
00147 dt
00148
00149 integer (kind=int_kind), intent(in) ::
00150 iblk
00151
00152
00153
00154
00155 integer (kind=int_kind) ::
00156 i, j, ij ,
00157 ilo,ihi,jlo,jhi,
00158 n ,
00159 il1, il2 ,
00160 sl1, sl2
00161
00162 integer (kind=int_kind) ::
00163 icells
00164
00165 integer (kind=int_kind), dimension(nx_block*ny_block) ::
00166 indxi, indxj
00167
00168
00169
00170 real (kind=dbl_kind), dimension (nx_block,ny_block) ::
00171 fsensn ,
00172 fswabsn ,
00173 flwoutn ,
00174 evapn ,
00175 freshn ,
00176 fsaltn ,
00177 fhocnn ,
00178 strairxn ,
00179 strairyn ,
00180 Trefn ,
00181 Qrefn
00182
00183
00184 real (kind=dbl_kind), dimension (nx_block,ny_block) ::
00185 Tbot ,
00186 fbot ,
00187 shcoef ,
00188 lhcoef
00189
00190 real (kind=dbl_kind), dimension (nx_block,ny_block) ::
00191 melttn ,
00192 meltbn ,
00193 meltsn ,
00194 congeln ,
00195 snoicen
00196
00197
00198 real (kind=dbl_kind), dimension (nx_block,ny_block) ::
00199 vsno_old
00200
00201 type (block) ::
00202 this_block
00203
00204 logical (kind=log_kind) ::
00205 l_stop
00206
00207 integer (kind=int_kind) ::
00208 istop, jstop
00209
00210
00211 real (kind=dbl_kind), dimension (nx_block,ny_block) ::
00212 worka, workb
00213
00214 l_stop = .false.
00215
00216 worka(:,:) = c0
00217 workb(:,:) = c0
00218
00219 this_block = get_block(blocks_ice(iblk),iblk)
00220 ilo = this_block%ilo
00221 ihi = this_block%ihi
00222 jlo = this_block%jlo
00223 jhi = this_block%jhi
00224
00225
00226
00227
00228
00229
00230
00231 do j = 1, ny_block
00232 do i = 1, nx_block
00233 aice_init (i,j, iblk) = aice (i,j, iblk)
00234 enddo
00235 enddo
00236
00237 do n = 1, ncat
00238 do j = 1, ny_block
00239 do i = 1, nx_block
00240 aicen_init(i,j,n,iblk) = aicen(i,j,n,iblk)
00241 vicen_init(i,j,n,iblk) = vicen(i,j,n,iblk)
00242 enddo
00243 enddo
00244 enddo
00245
00246 if (mod(time-dt_thm,dt_dyn) == c0) then
00247 strairxT_accum(:,:,iblk) = c0
00248 strairyT_accum(:,:,iblk) = c0
00249 endif
00250
00251
00252
00253
00254
00255
00256
00257 call frzmlt_bottom_lateral &
00258 (nx_block, ny_block, &
00259 ilo, ihi, jlo, jhi, &
00260 dt, &
00261 aice (:,:, iblk), frzmlt(:,:, iblk), &
00262 eicen (:,:,:,iblk), esnon (:,:,:,iblk), &
00263 sst (:,:, iblk), Tf (:,:, iblk), &
00264 strocnxT(:,:,iblk), strocnyT(:,:,iblk), &
00265 Tbot, fbot, &
00266 rside (:,:, iblk) )
00267
00268
00269 do n = 1, ncat
00270
00271
00272
00273
00274
00275 icells = 0
00276 do j = jlo, jhi
00277 do i = ilo, ihi
00278 if (aicen(i,j,n,iblk) > puny) then
00279 icells = icells + 1
00280 indxi(icells) = i
00281 indxj(icells) = j
00282 endif
00283 enddo
00284 enddo
00285
00286 if (calc_Tsfc .or. calc_strair .and. icells > 0) then
00287
00288
00289
00290
00291
00292
00293
00294
00295
00296
00297 if (trim(atmbndy) == 'constant') then
00298 call atmo_boundary_const(nx_block, ny_block, &
00299 'ice', icells, &
00300 indxi, indxj, &
00301 uatm(:,:,iblk), vatm(:,:,iblk), &
00302 wind(:,:,iblk), rhoa(:,:,iblk), &
00303 strairxn, strairyn, &
00304 lhcoef, shcoef)
00305 else
00306 call atmo_boundary_layer(nx_block, ny_block, &
00307 'ice', icells, &
00308 indxi, indxj, &
00309 trcrn(:,:,nt_Tsfc,n,iblk), &
00310 potT(:,:,iblk), &
00311 uatm(:,:,iblk), vatm(:,:,iblk), &
00312 uvel(:,:,iblk), vvel(:,:,iblk), &
00313 wind(:,:,iblk), zlvl(:,:,iblk), &
00314 Qa (:,:,iblk), rhoa(:,:,iblk), &
00315 strairxn, strairyn, &
00316 Trefn, Qrefn, &
00317 worka, workb, &
00318 lhcoef, shcoef)
00319 endif
00320
00321 else
00322
00323
00324 Trefn (:,:) = c0
00325 Qrefn (:,:) = c0
00326 lhcoef(:,:) = c0
00327 shcoef(:,:) = c0
00328
00329 endif
00330
00331 if (.not.(calc_strair)) then
00332 strairxn(:,:) = strax(:,:,iblk)
00333 strairyn(:,:) = stray(:,:,iblk)
00334 endif
00335
00336
00337
00338
00339
00340
00341
00342 if (tr_iage) then
00343 call increment_age (nx_block, ny_block, &
00344 dt, icells, &
00345 indxi, indxj, &
00346 trcrn(:,:,nt_iage,n,iblk))
00347 endif
00348 if (tr_FY) then
00349 call update_FYarea (nx_block, ny_block, &
00350 dt, icells, &
00351 indxi, indxj, &
00352 lmask_n(:,:,iblk), &
00353 lmask_s(:,:,iblk), &
00354 trcrn(:,:,nt_FY,n,iblk))
00355 endif
00356
00357
00358
00359
00360
00361 il1 = ilyr1(n)
00362 il2 = ilyrn(n)
00363 sl1 = slyr1(n)
00364 sl2 = slyrn(n)
00365
00366 vsno_old = vsnon(:,:,n,iblk)
00367
00368 call thermo_vertical &
00369 (nx_block, ny_block, &
00370 dt, icells, &
00371 indxi, indxj, &
00372 aicen(:,:,n,iblk), &
00373 trcrn(:,:,:,n,iblk), &
00374 vicen(:,:,n,iblk), vsnon(:,:,n,iblk), &
00375 eicen (:,:,il1:il2,iblk), &
00376 esnon (:,:,sl1:sl2,iblk), &
00377 flw (:,:,iblk), potT (:,:,iblk), &
00378 Qa (:,:,iblk), rhoa (:,:,iblk), &
00379 fsnow (:,:,iblk), &
00380 fbot, Tbot, &
00381 lhcoef, shcoef, &
00382 fswsfcn(:,:,n,iblk), fswintn(:,:,n,iblk), &
00383 fswthrun(:,:,n,iblk), &
00384 Sswabsn(:,:,sl1:sl2,iblk), &
00385 Iswabsn(:,:,il1:il2,iblk), &
00386 fsurfn(:,:,n,iblk), fcondtopn(:,:,n,iblk),&
00387 fsensn, flatn(:,:,n,iblk), &
00388 fswabsn, flwoutn, &
00389 evapn, freshn, &
00390 fsaltn, fhocnn, &
00391 melttn, meltsn, &
00392 meltbn, &
00393 congeln, snoicen, &
00394 mlt_onset(:,:,iblk), frz_onset(:,:,iblk), &
00395 yday, l_stop, &
00396 istop, jstop)
00397
00398 if (l_stop) then
00399 write (nu_diag,*) 'istep1, my_task, iblk =', &
00400 istep1, my_task, iblk
00401 write (nu_diag,*) 'Global block:', this_block%block_id
00402 if (istop > 0 .and. jstop > 0) &
00403 write(nu_diag,*) 'Global i and j:', &
00404 this_block%i_glob(istop), &
00405 this_block%j_glob(jstop)
00406 write(nu_diag,*) 'Lat, Lon:', &
00407 TLAT(istop,jstop,iblk)*rad_to_deg, &
00408 TLON(istop,jstop,iblk)*rad_to_deg
00409 call abort_ice ('ice: Vertical thermo error')
00410 endif
00411
00412
00413
00414
00415 if (tr_aero) then
00416
00417 if (icells > 0) then
00418
00419 call update_aerosol (nx_block, ny_block, &
00420 dt, icells, &
00421 indxi, indxj, &
00422 melttn, meltsn, &
00423 meltbn, congeln, snoicen, &
00424 fsnow(:,:,iblk), &
00425 trcrn(:,:,:,n,iblk), &
00426 aicen_init(:,:,n,iblk), &
00427 vicen_init(:,:,n,iblk), &
00428 vsno_old, &
00429 vicen(:,:,n,iblk), &
00430 vsnon(:,:,n,iblk), &
00431 aicen(:,:,n,iblk),faero(:,:,:,iblk), &
00432 fsoot(:,:,:,iblk))
00433
00434 endif
00435
00436 endif
00437
00438
00439
00440
00441
00442 if (tr_pond) then
00443
00444 call compute_ponds(nx_block, ny_block, &
00445 ilo, ihi, jlo, jhi, &
00446 melttn, meltsn, frain(:,:,iblk), &
00447 aicen (:,:,n,iblk), vicen (:,:,n,iblk), &
00448 vsnon (:,:,n,iblk), trcrn (:,:,:,n,iblk),&
00449 apondn(:,:,n,iblk), hpondn(:,:,n,iblk))
00450
00451 endif
00452
00453
00454
00455
00456
00457 call merge_fluxes (nx_block, ny_block, &
00458 icells, &
00459 indxi, indxj, &
00460 aicen_init(:,:,n,iblk), &
00461 flw(:,:,iblk), coszen(:,:,iblk), &
00462 strairxn, strairyn, &
00463 fsurfn(:,:,n,iblk), fcondtopn(:,:,n,iblk),&
00464 fsensn, flatn(:,:,n,iblk), &
00465 fswabsn, flwoutn, &
00466 evapn, &
00467 Trefn, Qrefn, &
00468 freshn, fsaltn, &
00469 fhocnn, fswthrun(:,:,n,iblk), &
00470 strairxT(:,:,iblk), strairyT (:,:,iblk), &
00471 fsurf (:,:,iblk), fcondtop (:,:,iblk), &
00472 fsens (:,:,iblk), flat (:,:,iblk), &
00473 fswabs (:,:,iblk), flwout (:,:,iblk), &
00474 evap (:,:,iblk), &
00475 Tref (:,:,iblk), Qref (:,:,iblk), &
00476 fresh (:,:,iblk), fsalt (:,:,iblk), &
00477 fhocn (:,:,iblk), fswthru (:,:,iblk), &
00478 melttn, meltsn, meltbn, congeln, snoicen, &
00479 meltt (:,:,iblk), melts (:,:,iblk), &
00480 meltb (:,:,iblk), &
00481 congel (:,:,iblk), snoice (:,:,iblk))
00482
00483 enddo
00484
00485
00486
00487
00488
00489 if (dt_thm < dt_dyn) then
00490 strairxT_accum(:,:,iblk) = strairxT_accum(:,:,iblk) &
00491 + strairxT(:,:,iblk) * dt_thm / dt_dyn
00492 strairyT_accum(:,:,iblk) = strairyT_accum(:,:,iblk) &
00493 + strairyT(:,:,iblk) * dt_thm / dt_dyn
00494 else
00495 strairxT_accum(:,:,iblk) = strairxT(:,:,iblk)
00496 strairyT_accum(:,:,iblk) = strairyT(:,:,iblk)
00497 endif
00498
00499
00500
00501
00502
00503 if (oceanmixed_ice) then
00504 do j = jlo, jhi
00505 do i = ilo, ihi
00506 if (hmix(i,j,iblk) > puny) then
00507 sst(i,j,iblk) = sst(i,j,iblk) &
00508 + (fhocn(i,j,iblk) + fswthru(i,j,iblk))*dt &
00509 / (cprho*hmix(i,j,iblk))
00510 endif
00511 enddo
00512 enddo
00513 endif
00514
00515 end subroutine step_therm1_iblk
00516
00517
00518
00519
00520
00521
00522
00523
00524
00525
00526
00527
00528
00529
00530
00531
00532 subroutine coupling_prep
00533
00534
00535
00536
00537
00538
00539
00540 type (block) ::
00541 this_block
00542
00543 integer (kind=int_kind) ::
00544 iblk ,
00545 n ,
00546 i,j ,
00547 ilo,ihi,jlo,jhi
00548
00549 real (kind=dbl_kind) :: cszn
00550
00551 call ice_timer_start(timer_column)
00552
00553
00554
00555
00556
00557 if (oceanmixed_ice) &
00558 call ocean_mixed_layer (dt)
00559
00560 do iblk = 1, nblocks
00561
00562
00563
00564
00565
00566 do j = 1, ny_block
00567 do i = 1, nx_block
00568 alvdf(i,j,iblk) = c0
00569 alidf(i,j,iblk) = c0
00570 alvdr(i,j,iblk) = c0
00571 alidr(i,j,iblk) = c0
00572
00573 albice(i,j,iblk) = c0
00574 albsno(i,j,iblk) = c0
00575 albpnd(i,j,iblk) = c0
00576
00577
00578 cszn = c0
00579 if (coszen(i,j,iblk) > puny) cszn = c1
00580 do n = 1, nstreams
00581 albcnt(i,j,iblk,n) = albcnt(i,j,iblk,n) + cszn
00582 enddo
00583 enddo
00584 enddo
00585 do n = 1, ncat
00586 do j = 1, ny_block
00587 do i = 1, nx_block
00588 alvdf(i,j,iblk) = alvdf(i,j,iblk) &
00589 + alvdfn(i,j,n,iblk)*aicen(i,j,n,iblk)
00590 alidf(i,j,iblk) = alidf(i,j,iblk) &
00591 + alidfn(i,j,n,iblk)*aicen(i,j,n,iblk)
00592 alvdr(i,j,iblk) = alvdr(i,j,iblk) &
00593 + alvdrn(i,j,n,iblk)*aicen(i,j,n,iblk)
00594 alidr(i,j,iblk) = alidr(i,j,iblk) &
00595 + alidrn(i,j,n,iblk)*aicen(i,j,n,iblk)
00596
00597 if (coszen(i,j,iblk) > puny) then
00598 albice(i,j,iblk) = albice(i,j,iblk) &
00599 + albicen(i,j,n,iblk)*aicen(i,j,n,iblk)
00600 albsno(i,j,iblk) = albsno(i,j,iblk) &
00601 + albsnon(i,j,n,iblk)*aicen(i,j,n,iblk)
00602 albpnd(i,j,iblk) = albpnd(i,j,iblk) &
00603 + albpndn(i,j,n,iblk)*aicen(i,j,n,iblk)
00604 endif
00605 enddo
00606 enddo
00607 enddo
00608
00609
00610
00611
00612
00613 do j = 1, ny_block
00614 do i = 1, nx_block
00615 alvdf_gbm (i,j,iblk) = alvdf (i,j,iblk)
00616 alidf_gbm (i,j,iblk) = alidf (i,j,iblk)
00617 alvdr_gbm (i,j,iblk) = alvdr (i,j,iblk)
00618 alidr_gbm (i,j,iblk) = alidr (i,j,iblk)
00619 fresh_gbm (i,j,iblk) = fresh (i,j,iblk)
00620 fsalt_gbm (i,j,iblk) = fsalt (i,j,iblk)
00621 fhocn_gbm (i,j,iblk) = fhocn (i,j,iblk)
00622 fswthru_gbm(i,j,iblk) = fswthru(i,j,iblk)
00623
00624
00625
00626
00627
00628 if (istep > 0) then
00629
00630 scale_factor(i,j,iblk) = &
00631 swvdr(i,j,iblk)*(c1 - alvdr_gbm(i,j,iblk)) &
00632 + swvdf(i,j,iblk)*(c1 - alvdf_gbm(i,j,iblk)) &
00633 + swidr(i,j,iblk)*(c1 - alidr_gbm(i,j,iblk)) &
00634 + swidf(i,j,iblk)*(c1 - alidf_gbm(i,j,iblk))
00635
00636 endif
00637
00638
00639 enddo
00640 enddo
00641
00642 call scale_fluxes (nx_block, ny_block, &
00643 tmask (:,:,iblk), &
00644 aice (:,:,iblk), Tf (:,:,iblk), &
00645 Tair (:,:,iblk), Qa (:,:,iblk), &
00646 strairxT (:,:,iblk), strairyT(:,:,iblk), &
00647 fsens (:,:,iblk), flat (:,:,iblk), &
00648 fswabs (:,:,iblk), flwout (:,:,iblk), &
00649 evap (:,:,iblk), &
00650 Tref (:,:,iblk), Qref (:,:,iblk), &
00651 fresh (:,:,iblk), fsalt (:,:,iblk), &
00652 fhocn (:,:,iblk), fswthru (:,:,iblk), &
00653 fsoot (:,:,:,iblk), &
00654 alvdr (:,:,iblk), alidr (:,:,iblk), &
00655 alvdf (:,:,iblk), alidf (:,:,iblk))
00656
00657 enddo
00658
00659 call ice_timer_start(timer_bound)
00660 call ice_HaloUpdate (scale_factor, halo_info, &
00661 field_loc_center, field_type_scalar)
00662 call ice_timer_stop(timer_bound)
00663
00664 call ice_timer_stop(timer_column)
00665
00666 end subroutine coupling_prep
00667
00668
00669
00670 end module CICE_RunMod
00671
00672