New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
isfcav.F90 in NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF – NEMO

source: NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF/isfcav.F90 @ 11395

Last change on this file since 11395 was 11395, checked in by mathiot, 5 years ago

ENHANCE-02_ISF_nemo : Initial commit isf simplification (add ISF directory, moved isf routine in and split isf cavity and isf parametrisation, ...) (ticket #2142)
File size: 8.2 KB
Line 
1MODULE isfcav
2   !!======================================================================
3   !!                       ***  MODULE  sbcisf  ***
4   !! Surface module :  update surface ocean boundary condition under ice
5   !!                   shelf
6   !!======================================================================
7   !! History :  3.2  !  2011-02  (C.Harris  ) Original code isf cav
8   !!            X.X  !  2006-02  (C. Wang   ) Original code bg03
9   !!            3.4  !  2013-03  (P. Mathiot) Merging + parametrization
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   sbc_isf       : update sbc under ice shelf
14   !!----------------------------------------------------------------------
15   USE oce            ! ocean dynamics and tracers
16   USE isf            !
17   USE isftbl         !
18   USE isfcavmlt
19   USE isfgammats
20   USE isfdiags
21   USE dom_oce        ! ocean space and time domain
22   USE phycst         ! physical constants
23   USE eosbn2         ! equation of state
24   USE zdfdrg         ! vertical physics: top/bottom drag coef.
25   !
26   USE in_out_manager ! I/O manager
27   USE iom            ! I/O library
28   USE fldread        ! read input field at current time step
29   USE lbclnk         !
30
31   IMPLICIT NONE
32
33   PRIVATE
34
35   PUBLIC   isf_cav, isf_cav_init ! routine called in isfmlt
36
37   !!----------------------------------------------------------------------
38   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
39   !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
40   !! Software governed by the CeCILL license (see ./LICENSE)
41   !!----------------------------------------------------------------------
42CONTAINS
43
44   SUBROUTINE isf_cav( kt, ptsc, pqfwf )
45      !!---------------------------------------------------------------------
46      !!                     ***  ROUTINE sbc_isf_cav  ***
47      !!
48      !! ** Purpose :   handle surface boundary condition under ice shelf
49      !!
50      !! ** Method  : -
51      !!
52      !! ** Action  :   utau, vtau : remain unchanged
53      !!                taum, wndm : remain unchanged
54      !!                qns        : update heat flux below ice shelf
55      !!                emp, emps  : update freshwater flux below ice shelf
56      !!---------------------------------------------------------------------
57      !!-------------------------- OUT --------------------------------------
58      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(inout) :: pqfwf
59      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(inout) :: ptsc
60      !!-------------------------- IN  --------------------------------------
61      INTEGER, INTENT(in) ::   kt   ! ocean time step
62      !!---------------------------------------------------------------------
63      LOGICAL :: lit
64      INTEGER :: nit
65      REAL(wp) :: zerr
66      REAL(wp), DIMENSION(jpi,jpj) :: zqlat, zqoce, zqhc, zqh
67      REAL(wp), DIMENSION(jpi,jpj) :: zqoce_b
68      REAL(wp), DIMENSION(jpi,jpj) :: zgammat, zgammas
69      REAL(wp), DIMENSION(jpi,jpj) :: zttbl, zstbl
70      !!---------------------------------------------------------------------
71      !
72      ! compute misfkb_par, rhisf_tbl
73      rhisf_tbl_cav(:,:) = rn_htbl
74      CALL isf_tbl_lvl( ht_n, e3t_n, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav )
75      !
76      ! compute T/S/U/V for the top boundary layer
77      CALL isf_tbl(tsn(:,:,:,jp_tem),zttbl(:,:),'T', misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav )
78      CALL isf_tbl(tsn(:,:,:,jp_sal),zstbl(:,:),'T', misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav )
79      !
80      ! output T/S/U/V for the top boundary layer
81      CALL iom_put('ttbl_cav',zttbl(:,:))
82      CALL iom_put('stbl'    ,zstbl(:,:))
83      !
84      ! initialisation
85      IF (TRIM(cn_gammablk) == 'HJ99' ) zqoce_b (:,:) = ptsc(:,:,jp_tem) * rau0_rcp ! last time step total heat fluxes (to speed up convergence)
86      !
87      ! compute ice shelf melting
88      nit = 1 ; lit = .TRUE.
89      DO WHILE ( lit )    ! maybe just a constant number of iteration as in blk_core is fine
90         !
91         ! compute gammat every where (2d)
92         ! useless if melt specified
93         IF ( TRIM(cn_isfcav_mlt) .NE. 'spe' ) THEN
94            CALL isfcav_gammats( zttbl, zstbl, zqoce  , pqfwf,  &
95               &                               zgammat, zgammas )
96         END IF
97         !   
98         ! compute tfrz, latent heat and melt (2d)
99         CALL isfcav_mlt(kt, zgammat, zgammas, zttbl, zstbl, &
100            &                         zqhc   , zqoce, pqfwf  )
101         !
102         ! define if we need to iterate (nn_gammablk 0/1 do not need iteration)
103         SELECT CASE ( cn_gammablk )
104         CASE ( 'spe','ad15' )
105            ! no convergence needed
106            lit = .FALSE.
107         CASE ( 'hj99' )
108            ! compute error between 2 iterations
109            zerr = MAXVAL(ABS(zqoce(:,:) - zqoce_b(:,:)))
110            !
111            ! define if iteration needed
112            IF (nit >= 100) THEN              ! too much iteration
113               CALL ctl_stop( 'STOP', 'isf_cav: HJ99 gamma formulation had too many iterations ...' )
114            ELSE IF ( zerr <= 0.01_wp ) THEN  ! convergence is achieve
115               lit = .FALSE.
116            ELSE                              ! converge is not yet achieve
117               nit = nit + 1
118               zqoce_b(:,:) = zqoce(:,:)
119            END IF
120         END SELECT
121
122      END DO
123      !
124      ! compute heat and water flux  (change signe directly in the melt subroutine)
125      pqfwf(:,:) = pqfwf(:,:) * mskisf_cav(:,:)
126      zqoce(:,:) = zqoce(:,:) * mskisf_cav(:,:)
127      zqhc (:,:) = zqhc(:,:)  * mskisf_cav(:,:)
128      !
129      ! compute heat content flux
130      zqlat(:,:) = - pqfwf(:,:) * rLfusisf    ! 2d latent heat flux (W/m2) ( > 0 out )
131      !
132      ! total heat flux ( >0 out )
133      zqh(:,:) = ( zqhc (:,:) + zqoce(:,:) )
134      !
135      ! lbclnk on melt
136      CALL lbc_lnk_multi( 'isfmlt', zqh, 'T', 1., pqfwf, 'T', 1.)
137      !
138      ! output fluxes
139      CALL isf_diags_flx( misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav, 'cav', pqfwf, zqoce, zqlat, zqhc)
140      !
141      ! set temperature content
142      ptsc(:,:,jp_tem) = - zqh(:,:) * r1_rau0_rcp
143      !
144   END SUBROUTINE isf_cav
145
146   SUBROUTINE isf_cav_init
147      !!---------------------------------------------------------------------
148      !!                  ***  ROUTINE isf_diags_2dto3d ***
149      !!
150      !! ** Purpose :
151      !!
152      !!----------------------------------------------------------------------
153      INTEGER :: ierr
154      !!---------------------------------------------------------------------
155
156      ! allocation isfcav gamtisf, gamsisf,
157      CALL isf_alloc_cav()
158
159      ! initialisation
160      mskisf_cav(:,:) = (1._wp - tmask(:,:,1)) * ssmask(:,:)
161      !
162      misfkt_cav(:,:) = mikt(:,:)
163      !
164      SELECT CASE ( TRIM(cn_isfcav_mlt) )
165      CASE( 'spe' )
166
167         ALLOCATE( sf_isfcav_fwf(1), STAT=ierr )
168         ALLOCATE( sf_isfcav_fwf(1)%fnow(jpi,jpj,1), sf_isfcav_fwf(1)%fdta(jpi,jpj,1,2) )
169         CALL fld_fill( sf_isfcav_fwf, (/ sn_isfcav_fwf /), cn_dirisf, 'isf_cav_init', 'read fresh water flux isf data', 'namisf' )
170
171         IF(lwp) WRITE(numout,*)
172         IF(lwp) WRITE(numout,*) '  ==>> The ice shelf melt inside the cavity is read from forcing files'
173
174      CASE( '2eq' )
175         IF(lwp) WRITE(numout,*)
176         IF(lwp) WRITE(numout,*) '  ==>> The original ISOMIP melt formulation is used to compute melt under the ice shelves'
177
178      CASE( '3eq' )
179         ! coeficient for linearisation of potential tfreez
180         ! Crude approximation for pressure (but commonly used)
181         IF ( l_useCT ) THEN   ! linearisation from Jourdain et al. (2017)
182            risf_lamb1 =-0.0564_wp
183            risf_lamb2 = 0.0773_wp
184            risf_lamb3 =-7.8633e-8 * grav * rau0
185         ELSE                  ! linearisation from table 4 (Asay-Davis et al., 2015)
186            risf_lamb1 =-0.0573_wp
187            risf_lamb2 = 0.0832_wp
188            risf_lamb3 =-7.5300e-8 * grav * rau0
189         ENDIF
190
191         IF(lwp) WRITE(numout,*)
192         IF(lwp) WRITE(numout,*) '  ==>> The 3 equations melt formulation is used to compute melt under the ice shelves'
193
194      CASE DEFAULT
195         CALL ctl_stop(' cn_isfcav_mlt method unknown (spe, 2eq, 3eq), check namelist')
196      END SELECT
197      !
198   END SUBROUTINE isf_cav_init
199
200END MODULE isfcav
Note: See TracBrowser for help on using the repository browser.