00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024 module ice_flux
00025
00026
00027
00028 use ice_kinds_mod
00029 use ice_blocks
00030 use ice_domain_size
00031 use ice_constants
00032
00033
00034
00035 implicit none
00036 save
00037
00038
00039
00040
00041
00042 real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) ::
00043
00044
00045 strax , &
00046 stray , &
00047
00048
00049 uocn , &
00050 vocn , &
00051 ss_tltx , &
00052 ss_tlty , &
00053
00054
00055
00056 strairxT, &
00057 strairyT, &
00058
00059
00060
00061 strairxT_accum, &
00062 strairyT_accum, &
00063
00064
00065
00066 strocnxT, &
00067 strocnyT
00068
00069
00070
00071 real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) ::
00072 sig1 ,
00073 sig2 ,
00074 strairx ,
00075 strairy ,
00076 strocnx ,
00077 strocny ,
00078 strtltx ,
00079 strtlty ,
00080 strintx ,
00081 strinty ,
00082 daidtd ,
00083 dvidtd ,
00084 dardg1dt,
00085 dardg2dt,
00086 dvirdgdt,
00087 opening
00088
00089
00090
00091 real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) ::
00092
00093 stressp_1, stressp_2, stressp_3, stressp_4 , &
00094 stressm_1, stressm_2, stressm_3, stressm_4 , &
00095 stress12_1,stress12_2,stress12_3,stress12_4
00096
00097 logical (kind=log_kind),
00098 dimension (nx_block,ny_block,max_blocks) ::
00099 iceumask
00100
00101
00102
00103 real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) ::
00104 prs_sig ,
00105 fm
00106
00107
00108
00109
00110
00111
00112
00113 real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) ::
00114 zlvl ,
00115 uatm ,
00116 vatm ,
00117 wind ,
00118 potT ,
00119 Tair ,
00120 Qa ,
00121 rhoa ,
00122 swvdr ,
00123 swvdf ,
00124 swidr ,
00125 swidf ,
00126 flw
00127
00128
00129
00130
00131
00132
00133 real (kind=dbl_kind),
00134 dimension (nx_block,ny_block,ncat,max_blocks) ::
00135 fsurfn_f ,
00136 fcondtopn_f,
00137 flatn_f
00138
00139
00140
00141 real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) ::
00142 frain ,
00143 fsnow
00144
00145 real (kind=dbl_kind),
00146 dimension (nx_block,ny_block,n_aeromx,max_blocks) ::
00147 faero
00148
00149
00150
00151 real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) ::
00152 sss ,
00153 sst ,
00154 frzmlt ,
00155 Tf ,
00156 qdp ,
00157 hmix
00158
00159 character (char_len) ::
00160 Tfrzpt
00161
00162
00163
00164
00165
00166 real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) ::
00167 fsens ,
00168 flat ,
00169 fswabs ,
00170 flwout ,
00171 Tref ,
00172 Qref ,
00173 evap
00174
00175
00176 real (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) ::
00177 alvdr ,
00178 alidr ,
00179 alvdf ,
00180 alidf ,
00181
00182 alvdr_gbm, &
00183 alidr_gbm, &
00184 alvdf_gbm, &
00185 alidf_gbm, &
00186
00187 albice , &
00188 albsno , &
00189 albpnd
00190
00191 real (kind=dbl_kind),
00192 dimension(nx_block,ny_block,max_blocks,max_nstrm) ::
00193 albcnt
00194
00195
00196
00197
00198 real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) ::
00199 fresh ,
00200 fsalt ,
00201 fhocn ,
00202 fswthru
00203
00204 real (kind=dbl_kind),
00205 dimension (nx_block,ny_block,n_aeromx,max_blocks) ::
00206 fsoot
00207
00208
00209
00210 real (kind=dbl_kind),
00211 dimension (nx_block,ny_block,max_blocks) ::
00212 fswfac ,
00213 scale_factor
00214
00215 logical (kind=log_kind) ::
00216 update_ocn_f
00217
00218
00219
00220
00221
00222
00223 real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) ::
00224 strairx_ocn ,
00225 strairy_ocn ,
00226 fsens_ocn ,
00227 flat_ocn ,
00228 flwout_ocn ,
00229 evap_ocn ,
00230 alvdr_ocn ,
00231 alidr_ocn ,
00232 alvdf_ocn ,
00233 alidf_ocn ,
00234 Tref_ocn ,
00235 Qref_ocn
00236
00237
00238
00239
00240
00241 real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) ::
00242 fsurf ,
00243 fcondtop,
00244 congel,
00245 frazil,
00246 snoice,
00247 meltt ,
00248 melts ,
00249 meltb ,
00250 meltl ,
00251 daidtt,
00252 dvidtt,
00253 mlt_onset,
00254 frz_onset
00255
00256
00257 real (kind=dbl_kind),
00258 dimension (nx_block,ny_block,ncat,max_blocks) ::
00259 fsurfn,
00260 fcondtopn,
00261 flatn
00262
00263
00264
00265
00266
00267
00268
00269
00270 real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) ::
00271 fresh_gbm,
00272 fsalt_gbm,
00273 fhocn_gbm,
00274 fswthru_gbm
00275
00276
00277
00278
00279
00280 real (kind=dbl_kind), dimension (nx_block,ny_block,max_blocks) ::
00281 rside ,
00282 fsw ,
00283 coszen ,
00284 rdg_conv,
00285 rdg_shear
00286
00287
00288
00289 contains
00290
00291
00292
00293
00294
00295
00296
00297
00298 subroutine init_coupler_flux
00299
00300
00301
00302
00303
00304
00305
00306
00307
00308
00309
00310
00311
00312
00313
00314
00315 integer (kind=int_kind) :: i, j, n, iblk
00316
00317 logical (kind=log_kind), parameter ::
00318
00319 l_winter = .false.
00320
00321 real (kind=dbl_kind) :: fcondtopn_d(6), fsurfn_d(6)
00322
00323 data fcondtopn_d / -50.0_dbl_kind,-17.0_dbl_kind,-12.0_dbl_kind, &
00324 -9.0_dbl_kind, -7.0_dbl_kind, -3.0_dbl_kind /
00325 data fsurfn_d / 0.20_dbl_kind, 0.15_dbl_kind, 0.10_dbl_kind, &
00326 0.05_dbl_kind, 0.01_dbl_kind, 0.01_dbl_kind /
00327
00328
00329
00330
00331 zlvl (:,:,:) = c10
00332 rhoa (:,:,:) = 1.3_dbl_kind
00333 uatm (:,:,:) = c5
00334 vatm (:,:,:) = c5
00335 strax (:,:,:) = 0.05_dbl_kind
00336 stray (:,:,:) = 0.05_dbl_kind
00337 if (l_winter) then
00338
00339 potT (:,:,:) = 253.0_dbl_kind
00340 Tair (:,:,:) = 253.0_dbl_kind
00341 Qa (:,:,:) = 0.0006_dbl_kind
00342 swvdr (:,:,:) = c0
00343 swvdf (:,:,:) = c0
00344 swidr (:,:,:) = c0
00345 swidf (:,:,:) = c0
00346 flw (:,:,:) = c180
00347 frain (:,:,:) = c0
00348 fsnow (:,:,:) = 4.0e-6_dbl_kind
00349 do n = 1, ncat
00350 fcondtopn_f(:,:,n,:) = fcondtopn_d(n)
00351 enddo
00352 fsurfn_f = fcondtopn_f
00353 flatn_f(:,:,:,:) = c0
00354 else
00355
00356 potT (:,:,:) = 273.0_dbl_kind
00357 Tair (:,:,:) = 273.0_dbl_kind
00358 Qa (:,:,:) = 0.0035_dbl_kind
00359 swvdr (:,:,:) = 50._dbl_kind
00360 swvdf (:,:,:) = 50._dbl_kind
00361 swidr (:,:,:) = 50._dbl_kind
00362 swidf (:,:,:) = 50._dbl_kind
00363 flw (:,:,:) = 280.0_dbl_kind
00364 frain (:,:,:) = c0
00365 fsnow (:,:,:) = c0
00366 do n = 1, ncat
00367 fsurfn_f(:,:,n,:) = fsurfn_d(n)
00368 enddo
00369 fcondtopn_f(:,:,:,:) = 0.0_dbl_kind
00370 flatn_f(:,:,:,:) = -2.0_dbl_kind
00371 endif
00372
00373 faero (:,:,:,:) = c0
00374
00375
00376
00377
00378
00379 ss_tltx(:,:,:)= c0
00380 ss_tlty(:,:,:)= c0
00381 uocn (:,:,:) = c0
00382 vocn (:,:,:) = c0
00383 frzmlt(:,:,:) = c0
00384 sss (:,:,:) = 34.0_dbl_kind
00385 if (trim(Tfrzpt) == 'constant') then
00386 Tf (:,:,:) = -1.8_dbl_kind
00387 else
00388 Tf (:,:,:) = -depressT*sss(:,:,:)
00389 endif
00390 #ifndef CICE_IN_NEMO
00391 sst (:,:,:) = Tf(:,:,:)
00392 #endif
00393 qdp (:,:,:) = c0
00394 hmix (:,:,:) = c20
00395
00396
00397
00398
00399
00400
00401
00402
00403 strairxT(:,:,:) = c0
00404 strairyT(:,:,:) = c0
00405
00406 fsens (:,:,:) = c0
00407 flat (:,:,:) = c0
00408 fswabs (:,:,:) = c0
00409 flwout (:,:,:) = -stefan_boltzmann*Tffresh**4
00410
00411 evap (:,:,:) = c0
00412 Tref (:,:,:) = c0
00413 Qref (:,:,:) = c0
00414 alvdr (:,:,:) = c0
00415 alidr (:,:,:) = c0
00416 alvdf (:,:,:) = c0
00417 alidf (:,:,:) = c0
00418
00419
00420
00421
00422
00423 strocnxT(:,:,:) = c0
00424 strocnyT(:,:,:) = c0
00425 fresh (:,:,:) = c0
00426 fsalt (:,:,:) = c0
00427 fhocn (:,:,:) = c0
00428 fswthru (:,:,:) = c0
00429
00430
00431
00432
00433
00434 fsw (:,:,:) = c0
00435 scale_factor(:,:,:) = c0
00436 wind (:,:,:) = sqrt(uatm(:,:,:)**2 &
00437 + vatm(:,:,:)**2)
00438
00439 coszen (:,:,:) = c0
00440
00441 end subroutine init_coupler_flux
00442
00443
00444
00445
00446
00447
00448
00449
00450 subroutine init_flux_atm
00451
00452
00453
00454
00455
00456
00457
00458
00459
00460
00461
00462
00463
00464
00465
00466
00467
00468
00469
00470
00471 strairxT(:,:,:) = c0
00472 strairyT(:,:,:) = c0
00473 fsens (:,:,:) = c0
00474 flat (:,:,:) = c0
00475 fswabs (:,:,:) = c0
00476 flwout (:,:,:) = c0
00477 evap (:,:,:) = c0
00478 Tref (:,:,:) = c0
00479 Qref (:,:,:) = c0
00480
00481 end subroutine init_flux_atm
00482
00483
00484
00485
00486
00487
00488
00489
00490 subroutine init_flux_ocn
00491
00492
00493
00494
00495
00496
00497
00498
00499
00500
00501
00502
00503
00504
00505
00506
00507
00508
00509
00510
00511
00512
00513
00514
00515
00516
00517 fresh (:,:,:) = c0
00518 fsalt (:,:,:) = c0
00519 fhocn (:,:,:) = c0
00520 fsoot (:,:,:,:) = c0
00521 fswthru(:,:,:) = c0
00522
00523 end subroutine init_flux_ocn
00524
00525
00526
00527
00528
00529
00530
00531
00532 subroutine init_history_therm
00533
00534
00535
00536
00537
00538
00539
00540
00541
00542
00543
00544
00545
00546
00547
00548
00549
00550 use ice_state, only: aice, vice
00551
00552 fsurf (:,:,:) = c0
00553 fcondtop(:,:,:)= c0
00554 congel (:,:,:) = c0
00555 frazil (:,:,:) = c0
00556 snoice (:,:,:) = c0
00557 meltt (:,:,:) = c0
00558 melts (:,:,:) = c0
00559 meltb (:,:,:) = c0
00560 meltl (:,:,:) = c0
00561 daidtt (:,:,:) = aice(:,:,:)
00562 dvidtt (:,:,:) = vice(:,:,:)
00563 fsurfn (:,:,:,:) = c0
00564 fcondtopn (:,:,:,:) = c0
00565 flatn (:,:,:,:) = c0
00566 fresh_gbm (:,:,:) = c0
00567 fsalt_gbm (:,:,:) = c0
00568 fhocn_gbm (:,:,:) = c0
00569 fswthru_gbm(:,:,:) = c0
00570 albice (:,:,:) = c0
00571 albsno (:,:,:) = c0
00572 albpnd (:,:,:) = c0
00573
00574 end subroutine init_history_therm
00575
00576
00577
00578
00579
00580
00581
00582
00583 subroutine init_history_dyn
00584
00585
00586
00587
00588
00589
00590
00591
00592
00593
00594
00595
00596 use ice_state, only: aice, vice
00597
00598
00599
00600
00601
00602 sig1 (:,:,:) = c0
00603 sig2 (:,:,:) = c0
00604 strocnx (:,:,:) = c0
00605 strocny (:,:,:) = c0
00606 strairx (:,:,:) = c0
00607 strairy (:,:,:) = c0
00608 strtltx (:,:,:) = c0
00609 strtlty (:,:,:) = c0
00610 strintx (:,:,:) = c0
00611 strinty (:,:,:) = c0
00612 dardg1dt(:,:,:) = c0
00613 dardg2dt(:,:,:) = c0
00614 dvirdgdt(:,:,:) = c0
00615 opening (:,:,:) = c0
00616 daidtd (:,:,:) = aice(:,:,:)
00617 dvidtd (:,:,:) = vice(:,:,:)
00618 fm (:,:,:) = c0
00619 prs_sig (:,:,:) = c0
00620
00621 end subroutine init_history_dyn
00622
00623
00624
00625
00626
00627
00628
00629
00630 subroutine merge_fluxes (nx_block, ny_block, &
00631 icells, &
00632 indxi, indxj, &
00633 aicen, &
00634 flw, coszn, &
00635 strairxn, strairyn, &
00636 fsurfn, fcondtopn, &
00637 fsensn, flatn, &
00638 fswabsn, flwoutn, &
00639 evapn, &
00640 Trefn, Qrefn, &
00641 freshn, fsaltn, &
00642 fhocnn, fswthrun, &
00643 strairxT, strairyT, &
00644 fsurf, fcondtop, &
00645 fsens, flat, &
00646 fswabs, flwout, &
00647 evap, &
00648 Tref, Qref, &
00649 fresh, fsalt, &
00650 fhocn, fswthru, &
00651 melttn, meltsn, meltbn, congeln, snoicen, &
00652 meltt, melts, &
00653 meltb, &
00654 congel, snoice)
00655
00656
00657
00658
00659
00660
00661
00662
00663
00664
00665
00666
00667
00668
00669 integer (kind=int_kind), intent(in) ::
00670 nx_block, ny_block,
00671 icells
00672
00673 integer (kind=int_kind), dimension(nx_block*ny_block),
00674 intent(in) ::
00675 indxi, indxj
00676
00677
00678 real (kind=dbl_kind), dimension(nx_block,ny_block), intent(in)::
00679 aicen ,
00680 flw ,
00681 coszn ,
00682 strairxn,
00683 strairyn,
00684 fsurfn ,
00685 fcondtopn,
00686 fsensn ,
00687 flatn ,
00688 fswabsn ,
00689 flwoutn ,
00690 evapn ,
00691 Trefn ,
00692 Qrefn ,
00693 freshn ,
00694 fsaltn ,
00695 fhocnn ,
00696 fswthrun,
00697 melttn ,
00698 meltbn ,
00699 meltsn ,
00700 congeln ,
00701 snoicen
00702
00703
00704 real (kind=dbl_kind), dimension(nx_block,ny_block),
00705 intent(inout)::
00706 strairxT,
00707 strairyT,
00708 fsurf ,
00709 fcondtop,
00710 fsens ,
00711 flat ,
00712 fswabs ,
00713 flwout ,
00714 evap ,
00715 Tref ,
00716 Qref ,
00717 fresh ,
00718 fsalt ,
00719 fhocn ,
00720 fswthru ,
00721 meltt ,
00722 meltb ,
00723 melts ,
00724 congel ,
00725 snoice
00726
00727
00728
00729
00730 integer (kind=int_kind) ::
00731 ij, i, j
00732
00733
00734
00735
00736
00737
00738
00739
00740 do ij = 1, icells
00741 i = indxi(ij)
00742 j = indxj(ij)
00743
00744
00745
00746 strairxT (i,j) = strairxT(i,j) + strairxn(i,j)*aicen(i,j)
00747 strairyT (i,j) = strairyT(i,j) + strairyn(i,j)*aicen(i,j)
00748 fsurf (i,j) = fsurf (i,j) + fsurfn (i,j)*aicen(i,j)
00749 fcondtop (i,j) = fcondtop(i,j) + fcondtopn(i,j)*aicen(i,j)
00750 fsens (i,j) = fsens (i,j) + fsensn (i,j)*aicen(i,j)
00751 flat (i,j) = flat (i,j) + flatn (i,j)*aicen(i,j)
00752 fswabs (i,j) = fswabs (i,j) + fswabsn (i,j)*aicen(i,j)
00753 flwout (i,j) = flwout (i,j) &
00754 + (flwoutn(i,j) - (c1-emissivity)*flw(i,j))*aicen(i,j)
00755 evap (i,j) = evap (i,j) + evapn (i,j)*aicen(i,j)
00756 Tref (i,j) = Tref (i,j) + Trefn (i,j)*aicen(i,j)
00757 Qref (i,j) = Qref (i,j) + Qrefn (i,j)*aicen(i,j)
00758
00759
00760
00761 fresh (i,j) = fresh (i,j) + freshn (i,j)*aicen(i,j)
00762 fsalt (i,j) = fsalt (i,j) + fsaltn (i,j)*aicen(i,j)
00763 fhocn (i,j) = fhocn (i,j) + fhocnn (i,j)*aicen(i,j)
00764 fswthru (i,j) = fswthru (i,j) + fswthrun(i,j)*aicen(i,j)
00765
00766
00767
00768 meltt (i,j) = meltt (i,j) + melttn (i,j)*aicen(i,j)
00769 meltb (i,j) = meltb (i,j) + meltbn (i,j)*aicen(i,j)
00770 melts (i,j) = melts (i,j) + meltsn (i,j)*aicen(i,j)
00771 congel (i,j) = congel (i,j) + congeln (i,j)*aicen(i,j)
00772 snoice (i,j) = snoice (i,j) + snoicen (i,j)*aicen(i,j)
00773
00774 enddo
00775
00776 end subroutine merge_fluxes
00777
00778
00779
00780
00781
00782
00783
00784
00785
00786
00787
00788
00789
00790
00791
00792 subroutine scale_fluxes (nx_block, ny_block, &
00793 tmask, &
00794 aice, Tf, &
00795 Tair, Qa, &
00796 strairxT, strairyT, &
00797 fsens, flat, &
00798 fswabs, flwout, &
00799 evap, &
00800 Tref, Qref, &
00801 fresh, fsalt, &
00802 fhocn, fswthru, &
00803 fsoot, &
00804 alvdr, alidr, &
00805 alvdf, alidf)
00806
00807
00808
00809
00810
00811
00812
00813
00814
00815 integer (kind=int_kind), intent(in) ::
00816 nx_block, ny_block
00817
00818 logical (kind=log_kind), dimension (nx_block,ny_block),
00819 intent(in) ::
00820 tmask
00821
00822
00823 real (kind=dbl_kind), dimension(nx_block,ny_block),
00824 intent(in)::
00825 aice ,
00826 Tf ,
00827 Tair ,
00828 Qa
00829
00830 real (kind=dbl_kind), dimension(nx_block,ny_block),
00831 intent(inout)::
00832 strairxT,
00833 strairyT,
00834 fsens ,
00835 flat ,
00836 fswabs ,
00837 flwout ,
00838 evap ,
00839 Tref ,
00840 Qref ,
00841 fresh ,
00842 fsalt ,
00843 fhocn ,
00844 fswthru ,
00845 alvdr ,
00846 alidr ,
00847 alvdf ,
00848 alidf
00849
00850 real (kind=dbl_kind), dimension(nx_block,ny_block,n_aeromx),
00851 intent(inout)::
00852 fsoot
00853
00854
00855
00856 real (kind=dbl_kind) :: ar
00857
00858 integer (kind=int_kind) ::
00859 i, j
00860
00861
00862
00863
00864
00865 do j = 1, ny_block
00866 do i = 1, nx_block
00867 if (tmask(i,j) .and. aice(i,j) > c0) then
00868 ar = c1 / aice(i,j)
00869 strairxT(i,j) = strairxT(i,j) * ar
00870 strairyT(i,j) = strairyT(i,j) * ar
00871 fsens (i,j) = fsens (i,j) * ar
00872 flat (i,j) = flat (i,j) * ar
00873 fswabs (i,j) = fswabs (i,j) * ar
00874 flwout (i,j) = flwout (i,j) * ar
00875 evap (i,j) = evap (i,j) * ar
00876 Tref (i,j) = Tref (i,j) * ar
00877 Qref (i,j) = Qref (i,j) * ar
00878 fresh (i,j) = fresh (i,j) * ar
00879 fsalt (i,j) = fsalt (i,j) * ar
00880 fhocn (i,j) = fhocn (i,j) * ar
00881 fswthru (i,j) = fswthru (i,j) * ar
00882 alvdr (i,j) = alvdr (i,j) * ar
00883 alidr (i,j) = alidr (i,j) * ar
00884 alvdf (i,j) = alvdf (i,j) * ar
00885 alidf (i,j) = alidf (i,j) * ar
00886 fsoot (i,j,:) = fsoot (i,j,:) * ar
00887 else
00888 strairxT(i,j) = c0
00889 strairyT(i,j) = c0
00890 fsens (i,j) = c0
00891 flat (i,j) = c0
00892 fswabs (i,j) = c0
00893 flwout (i,j) = -stefan_boltzmann *(Tf(i,j) + Tffresh)**4
00894
00895 evap (i,j) = c0
00896 Tref (i,j) = Tair(i,j)
00897 Qref (i,j) = Qa (i,j)
00898 fresh (i,j) = c0
00899 fsalt (i,j) = c0
00900 fhocn (i,j) = c0
00901 fsoot (i,j,:) = c0
00902 fswthru (i,j) = c0
00903 alvdr (i,j) = c0
00904 alidr (i,j) = c0
00905 alvdf (i,j) = c0
00906 alidf (i,j) = c0
00907 endif
00908 enddo
00909 enddo
00910
00911 end subroutine scale_fluxes
00912
00913
00914
00915 end module ice_flux
00916
00917