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/trunk/tests/ISOMIP+/MY_SRC – NEMO

source: NEMO/trunk/tests/ISOMIP+/MY_SRC/isfstp.F90 @ 12377

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

include ENHANCE-02_ISF_nemo in UKMO merge branch

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