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/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ISF – NEMO

source: NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/ISF/isfstp.F90 @ 14219

Last change on this file since 14219 was 14219, checked in by mcastril, 3 years ago

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