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.
isfpar.F90 in NEMO/branches/2019/UKMO_MERGE_2019/src/OCE/ISF – NEMO

source: NEMO/branches/2019/UKMO_MERGE_2019/src/OCE/ISF/isfpar.F90 @ 12068

Last change on this file since 12068 was 12068, checked in by davestorkey, 4 years ago

2019/UKMO_MERGE_2019 : Merging in changes from ENHANCE-02_ISF_nemo.
File size: 7.6 KB
Line 
1MODULE isfpar
2   !!======================================================================
3   !!                       ***  MODULE  isfpar  ***
4   !! ice shelf module :  update 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   !!            4.1  !  2019-09  (P. Mathiot) Restructuration
11   !!----------------------------------------------------------------------
12
13   !!----------------------------------------------------------------------
14   !!   isfpar       : compute ice shelf melt using a prametrisation of ice shelf cavities
15   !!----------------------------------------------------------------------
16   USE isf            ! ice shelf
17   !
18   USE isfrst   , ONLY: isfrst_write, isfrst_read ! ice shelf restart read/write subroutine
19   USE isftbl   , ONLY: isf_tbl_ktop, isf_tbl_lvl ! ice shelf top boundary layer properties subroutine
20   USE isfutils , ONLY: debug, read_2dcstdta      ! ice shelf debug subroutine
21   USE isfparmlt, ONLY: isfpar_mlt     ! ice shelf melt formulation subroutine
22   USE isfdiags , ONLY: isf_diags_flx  ! ice shelf diags subroutine
23   !
24   USE dom_oce  , ONLY: bathy          ! ocean space and time domain
25   USE par_oce  , ONLY: jpi,jpj        ! ocean space and time domain
26   USE phycst   , ONLY: r1_rau0_rcp    ! physical constants
27   !
28   USE in_out_manager ! I/O manager
29   USE iom            ! I/O library
30   USE fldread        ! read input field at current time step
31   USE lbclnk         ! lbc_lnk
32
33   IMPLICIT NONE
34   PRIVATE
35
36   PUBLIC   isf_par, isf_par_init
37
38   !!----------------------------------------------------------------------
39   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
40   !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
41   !! Software governed by the CeCILL license (see ./LICENSE)
42   !!----------------------------------------------------------------------
43CONTAINS
44 
45   SUBROUTINE isf_par( kt, Kmm, ptsc, pqfwf )
46      !!---------------------------------------------------------------------
47      !!                     ***  ROUTINE isf_par ***     
48      !!
49      !! ** Purpose : compute the heat and fresh water due to ice shelf melting/freezing using a parametrisation
50      !!
51      !!---------------------------------------------------------------------
52      !!-------------------------- OUT --------------------------------------
53      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(inout) :: pqfwf
54      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(inout) :: ptsc
55      !!-------------------------- IN  --------------------------------------
56      INTEGER, INTENT(in) ::   kt                                     ! ocean time step
57      INTEGER, INTENT(in) ::   Kmm                                    ! ocean time level index
58      !!---------------------------------------------------------------------
59      REAL(wp), DIMENSION(jpi,jpj) :: zqoce, zqhc, zqlat, zqh
60      !!---------------------------------------------------------------------
61      !
62      ! compute heat content, latent heat and melt fluxes (2d)
63      CALL isfpar_mlt( kt, Kmm, zqhc, zqoce, pqfwf  )
64      !
65      ! compute heat and water flux ( > 0 out )
66      pqfwf(:,:) = pqfwf(:,:) * mskisf_par(:,:)
67      zqoce(:,:) = zqoce(:,:) * mskisf_par(:,:)
68      zqhc (:,:) = zqhc(:,:)  * mskisf_par(:,:)
69      !
70      ! compute heat content flux ( > 0 out )
71      zqlat(:,:) = pqfwf(:,:) * rLfusisf    ! 2d latent heat flux (W/m2)
72      !
73      ! total heat flux ( > 0 out )
74      zqh(:,:) = ( zqhc (:,:) + zqoce(:,:) )
75      !
76      ! lbclnk on melt and heat fluxes
77      CALL lbc_lnk_multi( 'isfmlt', zqh, 'T', 1., pqfwf, 'T', 1.)
78      !
79      ! output fluxes
80      CALL isf_diags_flx( Kmm, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, 'par', pqfwf, zqoce, zqlat, zqhc)
81      !
82      ! set temperature content
83      ptsc(:,:,jp_tem) = zqh(:,:) * r1_rau0_rcp
84      !
85      ! write restart variables (qoceisf, qhcisf, fwfisf for now and before)
86      IF (lrst_oce) CALL isfrst_write(kt, 'par', ptsc, pqfwf)
87      !
88      IF ( ln_isfdebug ) THEN
89         CALL debug('isf_par: ptsc T',ptsc(:,:,1))
90         CALL debug('isf_par: ptsc S',ptsc(:,:,2))
91         CALL debug('isf_par: pqfwf fwf',pqfwf(:,:))
92      END IF
93      !
94   END SUBROUTINE isf_par
95
96   SUBROUTINE isf_par_init
97      !!---------------------------------------------------------------------
98      !!                  ***  ROUTINE isf_par_init  ***
99      !!
100      !! ** Purpose : initialisation of the variable needed for the parametrisation of ice shelf melt
101      !!
102      !!----------------------------------------------------------------------
103      INTEGER               :: ierr
104      REAL(wp), DIMENSION(jpi,jpj) :: ztblmax, ztblmin
105      !!----------------------------------------------------------------------
106      !
107      ! allocation
108      CALL isf_alloc_par()
109      !
110      ! initialisation
111      misfkt_par(:,:)     = 1         ; misfkb_par(:,:)       = 1         
112      rhisf_tbl_par(:,:)  = 1e-20     ; rfrac_tbl_par(:,:)    = 0.0_wp
113      !
114      ! define isf tbl tickness, top and bottom indice
115      CALL read_2dcstdta(TRIM(sn_isfpar_zmax%clname), TRIM(sn_isfpar_zmax%clvar), ztblmax)
116      CALL read_2dcstdta(TRIM(sn_isfpar_zmin%clname), TRIM(sn_isfpar_zmin%clvar), ztblmin)
117      !
118      ! mask ice shelf parametrisation location
119      ztblmax(:,:) = ztblmax(:,:) * ssmask(:,:)
120      ztblmin(:,:) = ztblmin(:,:) * ssmask(:,:)
121      !
122      ! if param used under an ice shelf overwrite ztblmin by the ice shelf draft
123      WHERE ( risfdep > 0._wp .AND. ztblmin > 0._wp )
124         ztblmin(:,:) = risfdep(:,:)
125      END WHERE
126      !
127      ! ensure ztblmax <= bathy
128      WHERE ( ztblmax(:,:) > bathy(:,:) )
129         ztblmax(:,:) = bathy(:,:)
130      END WHERE
131      !
132      ! compute ktop and update ztblmin to gdepw_0(misfkt_par)
133      CALL isf_tbl_ktop(ztblmin, misfkt_par) !   out: misfkt_par
134      !                                      ! inout: ztblmin
135      !
136      ! initial tbl thickness
137      rhisf0_tbl_par(:,:) = ztblmax(:,:) - ztblmin(:,:)
138      !
139      ! define iceshelf parametrisation mask
140      mskisf_par = 0
141      WHERE ( rhisf0_tbl_par(:,:) > 0._wp )
142         mskisf_par(:,:) = 1._wp
143      END WHERE
144      !
145      ! read par variable from restart
146      IF ( ln_rstart ) CALL isfrst_read('par', risf_par_tsc, fwfisf_par, risf_par_tsc_b, fwfisf_par_b)
147      !
148      SELECT CASE ( TRIM(cn_isfpar_mlt) )
149         !
150      CASE ( 'spe' )
151         !
152         ALLOCATE( sf_isfpar_fwf(1), STAT=ierr )
153         ALLOCATE( sf_isfpar_fwf(1)%fnow(jpi,jpj,1), sf_isfpar_fwf(1)%fdta(jpi,jpj,1,2) )
154         CALL fld_fill( sf_isfpar_fwf, (/ sn_isfpar_fwf /), cn_isfdir, 'isf_par_init', 'read fresh water flux isf data', 'namisf' )
155         !
156         IF(lwp) WRITE(numout,*)
157         IF(lwp) WRITE(numout,*) '      ==>>>   ice melt read from forcing field (cn_isfmlt_par = spe)'
158         !
159      CASE ( 'bg03' )
160         !
161         IF(lwp) WRITE(numout,*)
162         IF(lwp) WRITE(numout,*) '      ==>>>   bg03 parametrisation (cn_isfmlt_par = bg03)'
163         !
164         ! read effective length
165         CALL read_2dcstdta(TRIM(sn_isfpar_Leff%clname), TRIM(sn_isfpar_Leff%clvar), risfLeff)
166         risfLeff = risfLeff*1000.0_wp           !: convertion in m
167         !
168      CASE ( 'oasis' )
169         !
170         IF(lwp) WRITE(numout,*)
171         IF(lwp) WRITE(numout,*) '      ==>>>    isf melt provided by OASIS (cn_isfmlt_par = oasis)'
172         !
173      CASE DEFAULT
174         CALL ctl_stop( 'sbc_isf_init: wrong value of nn_isf' )
175      END SELECT
176      !
177   END SUBROUTINE isf_par_init
178
179END MODULE isfpar
Note: See TracBrowser for help on using the repository browser.