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 @ 12062

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

changes required by N.J. review

  • 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   !!----------------------------------------------------------------------
[5836]15   !
[11987]16   USE isf_oce                                      ! isf variables
[11852]17   USE isfload, ONLY: isf_load                      ! ice shelf load
18   USE isftbl , ONLY: isf_tbl_lvl                   ! ice shelf boundary layer
19   USE isfpar , ONLY: isf_par, isf_par_init         ! ice shelf parametrisation
20   USE isfcav , ONLY: isf_cav, isf_cav_init         ! ice shelf cavity
21   USE isfcpl , ONLY: isfcpl_rst_write, isfcpl_init ! isf variables
[4666]22
[11852]23   USE dom_oce, ONLY: ht_n, e3t_n, ln_isfcav, ln_linssh ! ocean space and time domain
24   USE domvvl,  ONLY: ln_vvl_zstar                      ! zstar logical
25   USE zdfdrg,  ONLY: r_Cdmin_top, r_ke0_top            ! vertical physics: top/bottom drag coef.
26   !
27   USE lib_mpp, ONLY: ctl_stop, ctl_nam
[11931]28   USE fldread, ONLY: FLD, FLD_N
[11852]29   USE in_out_manager ! I/O manager
[11876]30   USE timing
[11852]31
[4666]32   IMPLICIT NONE
[11395]33
[4666]34   PRIVATE
35
[11553]36   PUBLIC   isf_stp, isf_init, isf_nam  ! routine called in sbcmod and divhor
[4666]37
38   !!----------------------------------------------------------------------
[9598]39   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[5215]40   !! $Id$
[10068]41   !! Software governed by the CeCILL license (see ./LICENSE)
[4666]42   !!----------------------------------------------------------------------
43CONTAINS
44 
[11403]45  SUBROUTINE isf_stp( kt )
[5836]46      !!---------------------------------------------------------------------
[11403]47      !!                  ***  ROUTINE isf_stp  ***
[6140]48      !!
[11403]49      !! ** Purpose : compute total heat flux and total fwf due to ice shelf melt
[6140]50      !!
[11403]51      !! ** Method  : For each case (parametrisation or explicity cavity) :
52      !!              - define the before fields
53      !!              - compute top boundary layer properties
54      !!                (in case of parametrisation, this is the
55      !!                 depth range model array used to compute mean far fields properties)
56      !!              - compute fluxes
57      !!              - write restart variables
[11395]58      !!
[6140]59      !!----------------------------------------------------------------------
[9019]60      INTEGER, INTENT(in) ::   kt   ! ocean time step
[4666]61      !!---------------------------------------------------------------------
62      !
[11876]63      IF( ln_timing )   CALL timing_start('isf')
64      !
[11931]65      !=======================================================================
66      ! 1.: compute melt and associated heat fluxes in the ice shelf cavities
67      !=======================================================================
68      !
[11395]69      IF ( ln_isfcav_mlt ) THEN
[9019]70         !
[11931]71         ! 1.1: before time step
[11395]72         IF ( kt /= nit000 ) THEN
73            risf_cav_tsc_b (:,:,:) = risf_cav_tsc (:,:,:)
74            fwfisf_cav_b(:,:)      = fwfisf_cav(:,:)
75         END IF
[7788]76         !
[11931]77         ! 1.2: compute misfkb, rhisf_tbl, rfrac (deepest level, thickness, fraction of deepest cell affected by tbl)
[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         !
[11931]81         ! 1.3: compute ice shelf melt
[11395]82         CALL isf_cav( kt, risf_cav_tsc, fwfisf_cav)
83         !
84      END IF
[9019]85      !
[11931]86      !=================================================================================
87      ! 2.: compute melt and associated heat fluxes for not resolved ice shelf cavities
88      !=================================================================================
89      !
[11395]90      IF ( ln_isfpar_mlt ) THEN
[4666]91         !
[11931]92         ! 2.1: before time step
[11395]93         IF ( kt /= nit000 ) THEN
[11423]94            risf_par_tsc_b(:,:,:) = risf_par_tsc(:,:,:)
95            fwfisf_par_b  (:,:)   = fwfisf_par  (:,:)
[11395]96         END IF
[4666]97         !
[11931]98         ! 2.2: compute misfkb, rhisf_tbl, rfrac (deepest level, thickness, fraction of deepest cell affected by tbl)
99         ! by simplicity, we assume the top level where param applied do not change with time (done in init part)
[11541]100         rhisf_tbl_par(:,:) = rhisf0_tbl_par(:,:)
[11395]101         CALL isf_tbl_lvl(ht_n, e3t_n, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par)
102         !
[11931]103         ! 2.3: compute ice shelf melt
[11395]104         CALL isf_par( kt, risf_par_tsc, fwfisf_par)
105         !
106      END IF
107      !
[11931]108      !==================================================================================
109      ! 3.: output specific restart variable in case of coupling with an ice sheet model
110      !==================================================================================
111      !
[11852]112      IF ( ln_isfcpl .AND. lrst_oce ) CALL isfcpl_rst_write(kt)
113      !
[11876]114      IF( ln_timing )   CALL timing_stop('isf')
115      !
[11403]116   END SUBROUTINE isf_stp
[4666]117
[11553]118   SUBROUTINE isf_init
[6140]119      !!---------------------------------------------------------------------
[11403]120      !!                  ***  ROUTINE isfstp_init  ***
[6140]121      !!
[11403]122      !! ** Purpose :   Initialisation of the ice shelf public variables
[6140]123      !!
[11823]124      !! ** Method  :   Read the namisf namelist, check option compatibility and set derived parameters
[11395]125      !!
[11823]126      !! ** Action  : - read namisf parameters
[11403]127      !!              - allocate memory
[11823]128      !!              - output print
129      !!              - ckeck option compatibility
130      !!              - call cav/param/isfcpl init routine
[5836]131      !!----------------------------------------------------------------------
[11403]132      !
[11553]133      ! constrain: l_isfoasis need to be known
134      !
135      ! Read namelist
136      CALL isf_nam()
137      !
[11403]138      ! Allocate public array
139      CALL isf_alloc()
140      !
[11553]141      ! check option compatibility
142      CALL isf_ctl()
[11403]143      !
[11553]144      ! compute ice shelf load
145      IF ( ln_isfcav ) CALL isf_load( risfload )
[11403]146      !
[11553]147      ! terminate routine now if no ice shelf melt formulation specify
148      IF ( ln_isf ) THEN
149         !
150         !---------------------------------------------------------------------------------------------------------------------
151         ! initialisation melt in the cavity
[11852]152         IF ( ln_isfcav_mlt ) CALL isf_cav_init()
[11553]153         !
154         !---------------------------------------------------------------------------------------------------------------------
155         ! initialisation parametrised melt
[11852]156         IF ( ln_isfpar_mlt ) CALL isf_par_init()
[11553]157         !
[11852]158         !---------------------------------------------------------------------------------------------------------------------
159         ! initialisation ice sheet coupling
[11987]160         IF ( ln_isfcpl ) CALL isfcpl_init()
[11852]161         !
[11553]162      END IF
163         
164  END SUBROUTINE isf_init
165
[11823]166  SUBROUTINE isf_ctl()
167      !!---------------------------------------------------------------------
168      !!                  ***  ROUTINE isf_ctl  ***
169      !!
170      !! ** Purpose :   output print and option compatibility check
171      !!
172      !!----------------------------------------------------------------------
[11423]173      IF (lwp) THEN
174         WRITE(numout,*)
175         WRITE(numout,*) 'isf_init : ice shelf initialisation'
176         WRITE(numout,*) '~~~~~~~~~~~~'
177         WRITE(numout,*) '   Namelist namisf :'
178         !
[11489]179         WRITE(numout,*) '   ice shelf cavity (open or parametrised)  ln_isf = ', ln_isf
[11553]180         WRITE(numout,*)
[11489]181         !
182         IF ( ln_isf ) THEN
[11876]183            WRITE(numout,*) '      Add debug print in isf module           ln_isfdebug     = ', ln_isfdebug
184            WRITE(numout,*)
[11489]185            WRITE(numout,*) '      melt inside the cavity                  ln_isfcav_mlt   = ', ln_isfcav_mlt
[11541]186            IF ( ln_isfcav_mlt) THEN
[11987]187               WRITE(numout,*) '         melt formulation                         cn_isfcav_mlt= ', TRIM(cn_isfcav_mlt)
188               WRITE(numout,*) '         thickness of the top boundary layer      rn_htbl      = ', rn_htbl
189               WRITE(numout,*) '         gamma formulation                        cn_gammablk  = ', TRIM(cn_gammablk) 
[11489]190               IF ( TRIM(cn_gammablk) .NE. 'spe' ) THEN
[11987]191                  WRITE(numout,*) '         gammat coefficient                       rn_gammat0   = ', rn_gammat0 
192                  WRITE(numout,*) '         gammas coefficient                       rn_gammas0   = ', rn_gammas0 
193                  WRITE(numout,*) '         top background ke used (from namdrg_top) rn_ke0       = ', r_ke0_top
194                  WRITE(numout,*) '         top drag coef.    used (from namdrg_top) rn_Cd0       = ', r_Cdmin_top
[11489]195               END IF
[11423]196            END IF
[11489]197            WRITE(numout,*) ''
198            !
[11553]199            WRITE(numout,*) '      ice shelf melt parametrisation          ln_isfpar_mlt   = ', ln_isfpar_mlt
[11489]200            IF ( ln_isfpar_mlt ) THEN
201               WRITE(numout,*) '         isf parametrisation formulation         cn_isfpar_mlt   = ', TRIM(cn_isfpar_mlt)
202            END IF
203            WRITE(numout,*) ''
204            !
[11553]205            WRITE(numout,*) '      Coupling to an ice sheet model          ln_isfcpl       = ', ln_isfcpl
[11541]206            IF ( ln_isfcpl ) THEN
[11553]207               WRITE(numout,*) '         conservation activated ln_isfcpl_cons     = ', ln_isfcpl_cons
208               WRITE(numout,*) '         number of call of the extrapolation loop  = ', nn_drown
[11541]209            ENDIF
210            WRITE(numout,*) ''
211            !
[11489]212         ELSE
[11876]213            !
[11489]214            IF ( ln_isfcav ) THEN
215               WRITE(numout,*) ''
216               WRITE(numout,*) '   W A R N I N G: ice shelf cavities are open BUT no melt will be computed or read from file !'
217               WRITE(numout,*) ''
218            END IF
[11876]219            !
[6140]220         END IF
[11489]221
[12062]222         IF (ln_isfcav) THEN
223            WRITE(numout,*) '      Ice shelf load method                   cn_isfload        = ', TRIM(cn_isfload)
224            WRITE(numout,*) '         Temperature used to compute the ice shelf load            = ', rn_isfload_T
225            WRITE(numout,*) '         Salinity    used to compute the ice shelf load            = ', rn_isfload_S
226         END IF
[11521]227         WRITE(numout,*) ''
[11987]228         FLUSH(numout)
[11521]229
[11489]230      END IF
231      !
[11553]232
[11489]233      !---------------------------------------------------------------------------------------------------------------------
[11553]234      ! sanity check  ! issue ln_isfcav not yet known as well as l_isfoasis  => move this call in isf_stp ?
[11403]235      ! melt in the cavity without cavity
[11876]236      IF ( ln_isfcav_mlt .AND. (.NOT. ln_isfcav) ) &
[11553]237          &   CALL ctl_stop('ice shelf melt in the cavity activated (ln_isfcav_mlt) but no cavity detected in domcfg (ln_isfcav), STOP' )
[6140]238      !
[11489]239      ! ice sheet coupling without cavity
240      IF ( ln_isfcpl .AND. (.NOT. ln_isfcav) ) &
241         &   CALL ctl_stop('coupling with an ice sheet model detected (ln_isfcpl) but no cavity detected in domcfg (ln_isfcav), STOP' )
242      !
[11423]243      IF ( ln_isfcpl .AND. ln_isfcpl_cons .AND. ln_linssh ) &
244         &   CALL ctl_stop( 'The coupling between NEMO and an ice sheet model with the conservation option does not work with the linssh option' )
245      !
[11553]246      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' )
247      !
248      IF ( l_isfoasis .AND. ln_isf ) THEN
[11403]249         !
[11987]250         CALL ctl_stop( ' ln_ctl and ice shelf not tested' )
[11403]251         !
252         ! NEMO coupled to ATMO model with isf cavity need oasis method for melt computation
[11423]253         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' )
254         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]255         !
256         ! oasis melt computation not tested (coded but not tested)
257         IF ( ln_isfcav_mlt .OR. ln_isfpar_mlt ) THEN
258            IF ( TRIM(cn_isfcav_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfcav_mlt = oasis not tested' )
259            IF ( TRIM(cn_isfpar_mlt) == 'oasis' ) CALL ctl_stop( 'cn_isfpar_mlt = oasis not tested' )
260         END IF
261         !
262         ! oasis melt computation with cavity open and cavity parametrised (not coded)
263         IF ( ln_isfcav_mlt .AND. ln_isfpar_mlt ) THEN
264            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' )
265         END IF
[11553]266         !
[11823]267         ! compatibility ice shelf and vvl
268         IF( .NOT. ln_vvl_zstar .AND. ln_isf ) CALL ctl_stop( 'Only vvl_zstar has been tested with ice shelf cavity' )
269         !
[11403]270      END IF
[11553]271   END SUBROUTINE isf_ctl
272   !
273   SUBROUTINE isf_nam
274      !!---------------------------------------------------------------------
275      !!                  ***  ROUTINE isf_nam  ***
276      !!
277      !! ** Purpose :   Read ice shelf namelist cfg and ref
278      !!
279      !!----------------------------------------------------------------------
280      INTEGER               :: ios                  ! Local integer output status for namelist read
281      !!----------------------------------------------------------------------
[12062]282      NAMELIST/namisf/ ln_isf        ,                                                           & 
283         &             cn_gammablk   , rn_gammat0    , rn_gammas0    , rn_htbl, sn_isfcav_fwf,   &
284         &             ln_isfcav_mlt , cn_isfcav_mlt , sn_isfcav_fwf ,                           &
285         &             ln_isfpar_mlt , cn_isfpar_mlt , sn_isfpar_fwf ,                           &
286         &             sn_isfpar_zmin, sn_isfpar_zmax, sn_isfpar_Leff,                           &
287         &             ln_isfcpl     , nn_drown      , ln_isfcpl_cons, ln_isfdebug,              &
288         &             cn_isfload    , rn_isfload_T  , rn_isfload_S  , cn_isfdir
[11553]289      !!----------------------------------------------------------------------
[9019]290      !
[11553]291      REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs
292      READ  ( numnam_ref, namisf, IOSTAT = ios, ERR = 901)
293901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namisf in reference namelist', lwp )
294      !
295      REWIND( numnam_cfg )              ! Namelist namsbc_rnf in configuration namelist : Runoffs
296      READ  ( numnam_cfg, namisf, IOSTAT = ios, ERR = 902 )
297902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namisf in configuration namelist', lwp )
298      IF(lwm) WRITE ( numond, namisf )
299
300   END SUBROUTINE isf_nam
301   !!
[6140]302   !!======================================================================
[11403]303END MODULE isfstp
Note: See TracBrowser for help on using the repository browser.