Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
MODULE sbcice_if
!!======================================================================
!! *** MODULE sbcice ***
!! Surface module : update surface ocean boundary condition over ice
!! covered area using ice-if model
!!======================================================================
!! History : 3.0 ! 2006-06 (G. Madec) Original code
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
!! sbc_ice_if : update sbc in ice-covered area
!!----------------------------------------------------------------------
USE oce ! ocean dynamics and tracers
USE dom_oce ! ocean space and time domain
USE phycst ! physical constants
USE eosbn2 ! equation of state
USE sbc_oce ! surface boundary condition: ocean fields
#if defined key_si3
USE ice , ONLY : a_i
#else
USE sbc_ice , ONLY : a_i
#endif
!
USE in_out_manager ! I/O manager
USE iom ! I/O manager library
USE fldread ! read input field
USE lib_mpp ! MPP library
USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
IMPLICIT NONE
PRIVATE
PUBLIC sbc_ice_if ! routine called in sbcmod
TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ice ! structure of input ice-cover (file informations, fields read)
!! * Substitutions
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: sbcice_if.F90 13295 2020-07-10 18:24:21Z acc $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
SUBROUTINE sbc_ice_if( kt, Kbb, Kmm )
!!---------------------------------------------------------------------
!! *** ROUTINE sbc_ice_if ***
!!
!! ** Purpose : handle surface boundary condition over ice cover area
!! when sea-ice model are not used
!!
!! ** Method : - read sea-ice cover climatology
!! - blah blah blah, ...
!!
!! ** Action : utau, vtau : remain unchanged
!! taum, wndm : remain unchanged
!! qns, qsr : update heat flux below sea-ice
!! emp, sfx : update freshwater flux below sea-ice
!! fr_i : update the ice fraction
!!---------------------------------------------------------------------
INTEGER, INTENT(in) :: kt ! ocean time step
INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices
!
INTEGER :: ji, jj ! dummy loop indices
INTEGER :: ierror ! return error code
INTEGER :: ios ! Local integer output status for namelist read
REAL(wp) :: ztrp, zsice, zt_fzp, zfr_obs
REAL(wp) :: zqri, zqrj, zqrp, zqi
!!
CHARACTER(len=100) :: cn_dir ! Root directory for location of ice-if files
TYPE(FLD_N) :: sn_ice ! informations about the fields to be read
NAMELIST/namsbc_iif/ cn_dir, sn_ice
!!---------------------------------------------------------------------
! ! ====================== !
IF( kt == nit000 ) THEN ! First call kt=nit000 !
! ! ====================== !
! set file information
READ ( numnam_ref, namsbc_iif, IOSTAT = ios, ERR = 901)
901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_iif in reference namelist' )
READ ( numnam_cfg, namsbc_iif, IOSTAT = ios, ERR = 902 )
902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_iif in configuration namelist' )
IF(lwm) WRITE ( numond, namsbc_iif )
ALLOCATE( sf_ice(1), STAT=ierror )
IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ice_if: unable to allocate sf_ice structure' )
ALLOCATE( sf_ice(1)%fnow(jpi,jpj,1) )
IF( sn_ice%ln_tint ) ALLOCATE( sf_ice(1)%fdta(jpi,jpj,1,2) )
! fill sf_ice with sn_ice and control print
CALL fld_fill( sf_ice, (/ sn_ice /), cn_dir, 'sbc_ice_if', 'ice-if sea-ice model', 'namsbc_iif' )
!
ENDIF
CALL fld_read( kt, nn_fsbc, sf_ice ) ! Read input fields and provides the
! ! input fields at the current time-step
IF( MOD( kt-1, nn_fsbc) == 0 ) THEN
!
ztrp = -40. ! restoring terme for temperature (w/m2/k)
zsice = - 0.04 / 0.8 ! ratio of isohaline compressibility over isotherme compressibility
! ( d rho / dt ) / ( d rho / ds ) ( s = 34, t = -1.8 )
CALL eos_fzp( sss_m(:,:), fr_i(:,:) ) ! sea surface freezing temperature [Celsius]
fr_i(:,:) = fr_i(:,:) * tmask(:,:,1)
IF( ln_cpl ) a_i(:,:,1) = fr_i(:,:)
! Flux and ice fraction computation
DO_2D( 1, 1, 1, 1 )
!
zt_fzp = fr_i(ji,jj) ! freezing point temperature
zfr_obs = sf_ice(1)%fnow(ji,jj,1) ! observed ice cover
! ! ocean ice fraction (0/1) from the freezing point temperature
IF( sst_m(ji,jj) <= zt_fzp ) THEN ; fr_i(ji,jj) = 1.e0
ELSE ; fr_i(ji,jj) = 0.e0
ENDIF
ts(ji,jj,1,jp_tem,Kmm) = MAX( ts(ji,jj,1,jp_tem,Kmm), zt_fzp ) ! avoid over-freezing point temperature
qsr(ji,jj) = ( 1. - zfr_obs ) * qsr(ji,jj) ! solar heat flux : zero below observed ice cover
! ! non solar heat flux : add a damping term
! # ztrp*(t-(tgel-1.)) if observed ice and no opa ice (zfr_obs=1 fr_i=0)
! # ztrp*min(0,t-tgel) if observed ice and opa ice (zfr_obs=1 fr_i=1)
zqri = ztrp * ( ts(ji,jj,1,jp_tem,Kbb) - ( zt_fzp - 1.) )
zqrj = ztrp * MIN( 0., ts(ji,jj,1,jp_tem,Kbb) - zt_fzp )
zqrp = ( zfr_obs * ( (1. - fr_i(ji,jj) ) * zqri &
& + fr_i(ji,jj) * zqrj ) ) * tmask(ji,jj,1)
! ! non-solar heat flux
! # qns unchanged if no climatological ice (zfr_obs=0)
! # qns = zqrp if climatological ice and no opa ice (zfr_obs=1, fr_i=0)
! # qns = zqrp -2(-4) watt/m2 if climatological ice and opa ice (zfr_obs=1, fr_i=1)
! (-2=arctic, -4=antarctic)
zqi = -3. + SIGN( 1._wp, ff_f(ji,jj) )
qns(ji,jj) = ( ( 1.- zfr_obs ) * qns(ji,jj) &
& + zfr_obs * fr_i(ji,jj) * zqi ) * tmask(ji,jj,1) &
& + zqrp
END_2D
!
ENDIF
!
END SUBROUTINE sbc_ice_if
!!======================================================================
END MODULE sbcice_if