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.
isfstp.F90 in NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF – NEMO

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

Last change on this file since 11823 was 11823, checked in by mathiot, 4 years ago

rm useless USE statement, option compatibility test + minor changes

  • Property svn:keywords set to Id
File size: 14.8 KB
RevLine 
[11403]1MODULE isfstp
[4666]2   !!======================================================================
[11403]3   !!                       ***  MODULE  isfstp  ***
4   !! Surface module :  compute iceshelf load, melt and heat flux
[4666]5   !!======================================================================
[9019]6   !! History :  3.2  !  2011-02  (C.Harris  ) Original code isf cav
7   !!            X.X  !  2006-02  (C. Wang   ) Original code bg03
8   !!            3.4  !  2013-03  (P. Mathiot) Merging + parametrization
[11395]9   !!            4.1  !  2019-09  (P. Mathiot) Split param/explicit ice shelf and re-organisation
[4666]10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
[11403]13   !!   isfstp       : compute iceshelf melt and heat flux
[4666]14   !!----------------------------------------------------------------------
[9019]15   USE oce            ! ocean dynamics and tracers
16   USE dom_oce        ! ocean space and time domain
[11823]17   USE domvvl, ONLY : ln_vvl_zstar
[9019]18   USE phycst         ! physical constants
19   USE eosbn2         ! equation of state
20   USE sbc_oce        ! surface boundary condition: ocean fields
21   USE zdfdrg         ! vertical physics: top/bottom drag coef.
[5836]22   !
[9019]23   USE in_out_manager ! I/O manager
24   USE iom            ! I/O library
25   USE fldread        ! read input field at current time step
26   USE lbclnk         !
27   USE lib_fortran    ! glob_sum
[11395]28   !
29   USE isfrst         ! iceshelf restart
30   USE isftbl         ! ice shelf boundary layer
31   USE isfpar         ! ice shelf parametrisation
32   USE isfcav         ! ice shelf cavity
[11403]33   USE isfload        ! ice shelf load
[11423]34   USE isfcpl         ! isf variables
[11395]35   USE isf            ! isf variables
[11521]36   USE isfutils
[4666]37
38   IMPLICIT NONE
[11395]39
[4666]40   PRIVATE
41
[11553]42   PUBLIC   isf_stp, isf_init, isf_nam  ! routine called in sbcmod and divhor
[4666]43
44   !!----------------------------------------------------------------------
[9598]45   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[5215]46   !! $Id$
[10068]47   !! Software governed by the CeCILL license (see ./LICENSE)
[4666]48   !!----------------------------------------------------------------------
49CONTAINS
50 
[11403]51  SUBROUTINE isf_stp( kt )
[5836]52      !!---------------------------------------------------------------------
[11403]53      !!                  ***  ROUTINE isf_stp  ***
[6140]54      !!
[11403]55      !! ** Purpose : compute total heat flux and total fwf due to ice shelf melt
[6140]56      !!
[11403]57      !! ** Method  : For each case (parametrisation or explicity cavity) :
58      !!              - define the before fields
59      !!              - compute top boundary layer properties
60      !!                (in case of parametrisation, this is the
61      !!                 depth range model array used to compute mean far fields properties)
62      !!              - compute fluxes
63      !!              - write restart variables
[11395]64      !!
[6140]65      !!----------------------------------------------------------------------
[9019]66      INTEGER, INTENT(in) ::   kt   ! ocean time step
[4666]67      !!---------------------------------------------------------------------
68      !
[11395]69      IF ( ln_isfcav_mlt ) THEN
[9019]70         !
[11395]71         ! before time step
72         IF ( kt /= nit000 ) THEN
73            risf_cav_tsc_b (:,:,:) = risf_cav_tsc (:,:,:)
74            fwfisf_cav_b(:,:)      = fwfisf_cav(:,:)
75         END IF
[7788]76         !
[11395]77         ! compute tbl lvl/h
[11541]78         rhisf_tbl_cav(:,:) = rn_htbl * mskisf_cav(:,:)
[11395]79         CALL isf_tbl_lvl(ht_n, e3t_n, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav)
80         !
81         ! compute ice shelf melt
82         CALL isf_cav( kt, risf_cav_tsc, fwfisf_cav)
83         !
[11486]84         ! write restart variables (risf_cav_tsc, fwfisf for now and before)
[11395]85         IF (lrst_oce) CALL isfrst_write(kt, 'cav', risf_cav_tsc, fwfisf_cav)
86         !
87      END IF
[9019]88      !
[11395]89      IF ( ln_isfpar_mlt ) THEN
[4666]90         !
[11395]91         ! before time step
92         IF ( kt /= nit000 ) THEN
[11423]93            risf_par_tsc_b(:,:,:) = risf_par_tsc(:,:,:)
94            fwfisf_par_b  (:,:)   = fwfisf_par  (:,:)
[11395]95         END IF
[4666]96         !
[11395]97         ! compute misfkb, rhisf_tbl, rfrac (deepest level, thickness, fraction of deepest cell affected by tbl)
[11541]98         rhisf_tbl_par(:,:) = rhisf0_tbl_par(:,:)
[11395]99         CALL isf_tbl_lvl(ht_n, e3t_n, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par)
100         !
101         ! compute ice shelf melt
102         CALL isf_par( kt, risf_par_tsc, fwfisf_par)
103         !
104         ! write restart variables (qoceisf, qhcisf, fwfisf for now and before)
105         IF (lrst_oce) CALL isfrst_write(kt, 'par', risf_par_tsc, fwfisf_par)
106         !
107      END IF
[11423]108
[11529]109      IF ( ln_isfcpl ) THEN
110         !
[11423]111         IF (lrst_oce) CALL isfcpl_rst_write(kt)
[11529]112         !
[11423]113      END IF
[11395]114      !
[11403]115   END SUBROUTINE isf_stp
[4666]116
[11553]117   SUBROUTINE isf_init
[6140]118      !!---------------------------------------------------------------------
[11403]119      !!                  ***  ROUTINE isfstp_init  ***
[6140]120      !!
[11403]121      !! ** Purpose :   Initialisation of the ice shelf public variables
[6140]122      !!
[11823]123      !! ** Method  :   Read the namisf namelist, check option compatibility and set derived parameters
[11395]124      !!
[11823]125      !! ** Action  : - read namisf parameters
[11403]126      !!              - allocate memory
[11823]127      !!              - output print
128      !!              - ckeck option compatibility
129      !!              - call cav/param/isfcpl init routine
[5836]130      !!----------------------------------------------------------------------
[11403]131      !
[11553]132      ! constrain: l_isfoasis need to be known
133      !
134      ! Read namelist
135      CALL isf_nam()
136      !
[11403]137      ! Allocate public array
138      CALL isf_alloc()
139      !
[11553]140      ! check option compatibility
141      CALL isf_ctl()
[11403]142      !
[11553]143      ! compute ice shelf load
144      IF ( ln_isfcav ) CALL isf_load( risfload )
[11403]145      !
[11553]146      ! terminate routine now if no ice shelf melt formulation specify
147      IF ( ln_isf ) THEN
148         !
149         !---------------------------------------------------------------------------------------------------------------------
[11823]150         ! initialisation ice sheet coupling
151         IF( ln_isfcpl ) THEN 
152            !
153            ! start on an euler time step
154            neuler = 0
155            !
156            ! ice sheet coupling: extrapolation of restart to fill new wet cell and compute divergence correction
157            CALL isfcpl_init()
158            !
159            ! all before fields set to now values
160            tsb  (:,:,:,:) = tsn  (:,:,:,:)
161            ub   (:,:,:)   = un   (:,:,:)
162            vb   (:,:,:)   = vn   (:,:,:)
163            sshb (:,:)     = sshn (:,:)
164            e3t_b(:,:,:)   = e3t_n(:,:,:)
165 
166            ! prepare writing restart
167            IF( lwxios ) CALL iom_set_rstw_var_active('ssmask')
168            IF( lwxios ) CALL iom_set_rstw_var_active('tmask')
169            IF( lwxios ) CALL iom_set_rstw_var_active('e3t_n')
170            IF( lwxios ) CALL iom_set_rstw_var_active('e3u_n')
171            IF( lwxios ) CALL iom_set_rstw_var_active('e3v_n')
172            !
173         END IF
174         !
175         !---------------------------------------------------------------------------------------------------------------------
[11553]176         ! initialisation melt in the cavity
177         IF ( ln_isfcav_mlt ) THEN
178            !
179            ! initialisation  of cav variable
180            CALL isf_cav_init()
181            !
182            ! read cav variable from restart
183            IF ( ln_rstart ) CALL isfrst_read('cav', risf_cav_tsc, fwfisf_cav, risf_cav_tsc_b, fwfisf_cav_b)
184            !
185         END IF
186         !
187         !---------------------------------------------------------------------------------------------------------------------
188         ! initialisation parametrised melt
189         IF ( ln_isfpar_mlt ) THEN
190            !
191            ! initialisation  of par variable
192            CALL isf_par_init()
193            !
194            ! read par variable from restart
195            IF ( ln_rstart ) CALL isfrst_read('par', risf_par_tsc, fwfisf_par, risf_par_tsc_b, fwfisf_par_b)
196            !
197         END IF
198         !
199      END IF
200         
201  END SUBROUTINE isf_init
202
[11823]203  SUBROUTINE isf_ctl()
204      !!---------------------------------------------------------------------
205      !!                  ***  ROUTINE isf_ctl  ***
206      !!
207      !! ** Purpose :   output print and option compatibility check
208      !!
209      !!----------------------------------------------------------------------
[11423]210      IF (lwp) THEN
211         WRITE(numout,*)
212         WRITE(numout,*) 'isf_init : ice shelf initialisation'
213         WRITE(numout,*) '~~~~~~~~~~~~'
214         WRITE(numout,*) '   Namelist namisf :'
215         !
[11489]216         WRITE(numout,*) '   ice shelf cavity (open or parametrised)  ln_isf = ', ln_isf
[11553]217         WRITE(numout,*)
[11489]218         !
219         IF ( ln_isf ) THEN
220            WRITE(numout,*) '      melt inside the cavity                  ln_isfcav_mlt   = ', ln_isfcav_mlt
[11541]221            IF ( ln_isfcav_mlt) THEN
[11489]222               WRITE(numout,*) '         melt formulation                        cn_isfcav_mlt   = ', TRIM(cn_isfcav_mlt)
223               WRITE(numout,*) '         thickness of the top boundary layer     rn_htbl     = ', rn_htbl
224               WRITE(numout,*) '         gamma formulation                       cn_gammablk = ', TRIM(cn_gammablk) 
225               IF ( TRIM(cn_gammablk) .NE. 'spe' ) THEN
226                  WRITE(numout,*) '            gammat coefficient                      rn_gammat0  = ', rn_gammat0 
227                  WRITE(numout,*) '            gammas coefficient                      rn_gammas0  = ', rn_gammas0 
228                  WRITE(numout,*) '            top drag coef. used (from namdrg_top)   rn_Cd0      = ', r_Cdmin_top 
229               END IF
[11423]230            END IF
[11489]231            WRITE(numout,*) ''
232            !
[11553]233            WRITE(numout,*) '      ice shelf melt parametrisation          ln_isfpar_mlt   = ', ln_isfpar_mlt
[11489]234            IF ( ln_isfpar_mlt ) THEN
235               WRITE(numout,*) '         isf parametrisation formulation         cn_isfpar_mlt   = ', TRIM(cn_isfpar_mlt)
236            END IF
237            WRITE(numout,*) ''
238            !
[11553]239            WRITE(numout,*) '      Coupling to an ice sheet model          ln_isfcpl       = ', ln_isfcpl
[11541]240            IF ( ln_isfcpl ) THEN
[11553]241               WRITE(numout,*) '         conservation activated ln_isfcpl_cons     = ', ln_isfcpl_cons
242               WRITE(numout,*) '         number of call of the extrapolation loop  = ', nn_drown
[11541]243            ENDIF
244            WRITE(numout,*) ''
245            !
[11489]246         ELSE
[11541]247
[11489]248            IF ( ln_isfcav ) THEN
249               WRITE(numout,*) ''
250               WRITE(numout,*) '   W A R N I N G: ice shelf cavities are open BUT no melt will be computed or read from file !'
251               WRITE(numout,*) ''
252            END IF
[6140]253         END IF
[11489]254
[11521]255         IF (ln_isfcav) WRITE(numout,*) '      Ice shelf load method                   cn_isfload        = ', TRIM(cn_isfload)
256         WRITE(numout,*) ''
257
[11489]258      END IF
259      !
[11553]260
[11489]261      !---------------------------------------------------------------------------------------------------------------------
[11553]262      ! sanity check  ! issue ln_isfcav not yet known as well as l_isfoasis  => move this call in isf_stp ?
[11403]263      ! melt in the cavity without cavity
[11553]264       IF ( ln_isfcav_mlt .AND. (.NOT. ln_isfcav) ) &
265          &   CALL ctl_stop('ice shelf melt in the cavity activated (ln_isfcav_mlt) but no cavity detected in domcfg (ln_isfcav), STOP' )
[6140]266      !
[11489]267      ! ice sheet coupling without cavity
268      IF ( ln_isfcpl .AND. (.NOT. ln_isfcav) ) &
269         &   CALL ctl_stop('coupling with an ice sheet model detected (ln_isfcpl) but no cavity detected in domcfg (ln_isfcav), STOP' )
270      !
[11423]271      IF ( ln_isfcpl .AND. ln_isfcpl_cons .AND. ln_linssh ) &
272         &   CALL ctl_stop( 'The coupling between NEMO and an ice sheet model with the conservation option does not work with the linssh option' )
273      !
[11553]274      IF ( l_isfoasis .AND. .NOT. ln_isf ) CALL ctl_stop( ' OASIS send ice shelf fluxes to NEMO but NEMO does not have the isf module activated' )
275      !
276      IF ( l_isfoasis .AND. ln_isf ) THEN
[11403]277         !
278         CALL ctl_stop( ' ln_ctl and ice shelf not tested' )
279         !
280         ! NEMO coupled to ATMO model with isf cavity need oasis method for melt computation
[11423]281         IF ( ln_isfcav_mlt .AND. TRIM(cn_isfcav_mlt) /= 'oasis' ) CALL ctl_stop( 'cn_isfcav_mlt = oasis is the only option availble if fwf send by oasis' )
282         IF ( ln_isfpar_mlt .AND. TRIM(cn_isfpar_mlt) /= 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis is the only option availble if fwf send by oasis' )
[11403]283         !
284         ! oasis melt computation not tested (coded but not tested)
285         IF ( ln_isfcav_mlt .OR. ln_isfpar_mlt ) THEN
286            IF ( TRIM(cn_isfcav_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfcav_mlt = oasis not tested' )
287            IF ( TRIM(cn_isfpar_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis not tested' )
288         END IF
289         !
290         ! oasis melt computation with cavity open and cavity parametrised (not coded)
291         IF ( ln_isfcav_mlt .AND. ln_isfpar_mlt ) THEN
292            IF ( TRIM(cn_isfpar_mlt) == 'oasis' .AND. TRIM(cn_isfcav_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis and cn_isfcav_mlt = oasis not coded' )
293         END IF
[11553]294         !
[11823]295         ! compatibility ice shelf and vvl
296         IF( .NOT. ln_vvl_zstar .AND. ln_isf ) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' )
297         !
[11403]298      END IF
[11553]299   END SUBROUTINE isf_ctl
300   !
301   SUBROUTINE isf_nam
302      !!---------------------------------------------------------------------
303      !!                  ***  ROUTINE isf_nam  ***
304      !!
305      !! ** Purpose :   Read ice shelf namelist cfg and ref
306      !!
307      !!----------------------------------------------------------------------
308      INTEGER               :: ios                  ! Local integer output status for namelist read
309      !!----------------------------------------------------------------------
310      NAMELIST/namisf/ ln_isf       ,                                                                               & 
311         &             ln_isfcav_mlt, cn_isfcav_mlt, cn_gammablk, rn_gammat0, rn_gammas0, rn_htbl, sn_isfcav_fwf,   &
312         &             ln_isfpar_mlt, cn_isfpar_mlt, sn_isfpar_fwf, sn_isfpar_zmin, sn_isfpar_zmax, sn_isfpar_Leff, &
313         &             ln_isfcpl    , nn_drown, ln_isfcpl_cons,                                                     &
314         &             cn_isfload   , cn_isfdir
315      !!----------------------------------------------------------------------
[9019]316      !
[11553]317      REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs
318      READ  ( numnam_ref, namisf, IOSTAT = ios, ERR = 901)
319901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namisf in reference namelist', lwp )
320      !
321      REWIND( numnam_cfg )              ! Namelist namsbc_rnf in configuration namelist : Runoffs
322      READ  ( numnam_cfg, namisf, IOSTAT = ios, ERR = 902 )
323902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namisf in configuration namelist', lwp )
324      IF(lwm) WRITE ( numond, namisf )
325
326   END SUBROUTINE isf_nam
327   !!
[6140]328   !!======================================================================
[11403]329END MODULE isfstp
Note: See TracBrowser for help on using the repository browser.