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/trunk/src/OCE/ISF – NEMO

source: NEMO/trunk/src/OCE/ISF/isfpar.F90

Last change on this file was 15084, checked in by clem, 3 years ago

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