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.
isfparmlt.F90 in NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/ISF – NEMO

source: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/ISF/isfparmlt.F90 @ 15540

Last change on this file since 15540 was 15540, checked in by sparonuz, 3 years ago

Mixed precision version, tested up to 30 years on ORCA2.
File size: 11.6 KB
Line 
1MODULE isfparmlt
2   !!======================================================================
3   !!                       ***  MODULE  isfparmlt  ***
4   !! Ice shelf parametrisation module :  update surface ocean boundary condition under ice
5   !!                   shelf using an ice shelf melt parametrisation
6   !!======================================================================
7   !! History :  4.0  ! original code
8   !!----------------------------------------------------------------------
9
10   USE isf_oce                  ! ice shelf
11   USE isftbl , ONLY: isf_tbl   ! ice shelf depth average
12
13   USE dom_oce                  ! ocean space and time domain
14   USE oce    , ONLY: ts        ! ocean dynamics and tracers
15   USE phycst , ONLY: rcp, rho0 ! physical constants
16   USE eosbn2 , ONLY: eos_fzp   ! equation of state
17
18   USE in_out_manager              ! I/O manager
19   USE iom        , ONLY: iom_put  ! I/O library
20   USE fldread    , ONLY: fld_read, FLD, FLD_N !
21   USE lib_fortran, ONLY: glob_sum !
22   USE lib_mpp    , ONLY: ctl_stop !
23
24   IMPLICIT NONE
25
26   PRIVATE
27
28   PUBLIC  isfpar_mlt 
29   
30#  include "single_precision_substitute.h90"
31   !!----------------------------------------------------------------------
32   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
33   !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
34   !! Software governed by the CeCILL license (see ./LICENSE)
35   !!----------------------------------------------------------------------
36CONTAINS
37
38! -------------------------------------------------------------------------------------------------------
39! -------------------------------- PUBLIC SUBROUTINE ----------------------------------------------------
40! -------------------------------------------------------------------------------------------------------
41
42  SUBROUTINE isfpar_mlt( kt, Kmm, pqhc, pqoce, pqfwf )
43      !!---------------------------------------------------------------------
44      !!                  ***  ROUTINE isfpar_mlt  ***
45      !!
46      !! ** Purpose : Compute Salt and Heat fluxes related to ice_shelf
47      !!              melting and freezing
48      !!
49      !! ** Method  :  2 parameterizations are available according
50      !!                        1 : Specified melt flux
51      !!                        2 : Beckmann & Goose parameterization
52      !!
53      !!-------------------------- OUT -------------------------------------
54      REAL(dp), DIMENSION(jpi,jpj), INTENT(inout) :: pqfwf, pqoce, pqhc  ! fresh water, ice-ocean heat and heat content fluxes
55      !!-------------------------- IN  -------------------------------------
56      INTEGER, INTENT(in) ::   kt   ! ocean time step
57      INTEGER, INTENT(in) ::   Kmm  ! ocean time level index
58      !!---------------------------------------------------------------------
59      !
60      ! Choose among the available ice shelf parametrisation
61      SELECT CASE ( cn_isfpar_mlt )
62      CASE ( 'spe' )    ! specified runoff in depth (Mathiot et al., 2017 in preparation)
63         CALL isfpar_mlt_spe(kt, Kmm, pqhc, pqoce, pqfwf)
64      CASE ( 'bg03' )    ! Beckmann and Goosse parametrisation
65         CALL isfpar_mlt_bg03(kt, Kmm, pqhc, pqoce, pqfwf)
66      CASE ( 'oasis' )
67         CALL isfpar_mlt_oasis( kt, Kmm, pqhc, pqoce, pqfwf)
68      CASE DEFAULT
69         CALL ctl_stop('STOP', 'unknown isf melt formulation : cn_isfpar (should not see this)')
70      END SELECT
71      !
72   END SUBROUTINE isfpar_mlt
73
74! -------------------------------------------------------------------------------------------------------
75! -------------------------------- PRIVATE SUBROUTINE ---------------------------------------------------
76! -------------------------------------------------------------------------------------------------------
77
78   SUBROUTINE isfpar_mlt_spe(kt, Kmm, pqhc, pqoce, pqfwf)
79      !!---------------------------------------------------------------------
80      !!                  ***  ROUTINE isfpar_mlt_spe  ***
81      !!
82      !! ** Purpose : prescribed ice shelf melting in case ice shelf cavities are closed.
83      !!              data read into a forcing files.
84      !!
85      !!-------------------------- OUT -------------------------------------
86      REAL(dp), DIMENSION(jpi,jpj), INTENT(inout) :: pqhc, pqfwf, pqoce  ! fresh water and ice-ocean heat fluxes
87      !!-------------------------- IN  -------------------------------------
88      INTEGER,  INTENT(in) :: kt
89      INTEGER,  INTENT(in) :: Kmm    !  ocean time level index
90      !!--------------------------------------------------------------------
91      INTEGER :: jk
92      REAL(dp), DIMENSION(jpi,jpj,jpk)  :: ztfrz3d
93      REAL(dp), DIMENSION(jpi,jpj)      :: ztfrz
94      !!--------------------------------------------------------------------
95      !
96      ! 0. ------------Read specified runoff
97      CALL fld_read ( kt, 1, sf_isfpar_fwf   )
98      !
99      ! compute ptfrz
100      ! 1. ------------Mean freezing point
101      DO jk = 1,jpk
102         CALL eos_fzp(ts(:,:,jk,jp_sal,Kmm), ztfrz3d(:,:,jk), gdept(:,:,jk,Kmm))
103      END DO
104      CALL isf_tbl(Kmm, ztfrz3d, ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par )
105      !
106      pqfwf(:,:) = - sf_isfpar_fwf(1)%fnow(:,:,1)      ! fresh water flux from the isf (fwfisf <0 mean melting)
107      pqoce(:,:) =   pqfwf(:,:) * rLfusisf             ! ocean/ice shelf flux assume to be equal to latent heat flux
108      pqhc (:,:) =   pqfwf(:,:) * ztfrz(:,:) * rcp     ! heat content flux
109      !
110      CALL iom_put('isftfrz_par', ztfrz )
111      !
112   END SUBROUTINE isfpar_mlt_spe
113
114   SUBROUTINE isfpar_mlt_bg03(kt, Kmm, pqhc, pqoce, pqfwf)
115      !!---------------------------------------------------------------------
116      !!                  ***  ROUTINE isfpar_mlt_bg03  ***
117      !!
118      !! ** Purpose : compute an estimate of ice shelf melting and
119      !!              latent, ocean-ice and heat content heat fluxes
120      !!              in case cavities are closed based on the far fields T and S properties.
121      !!
122      !! ** Method  : The ice shelf melt is computed as proportional to the differences between the
123      !!              mean temperature and mean freezing point in front of the ice shelf averaged
124      !!              over the ice shelf min ice shelf draft and max ice shelf draft and the freezing point
125      !!
126      !! ** Reference : Beckmann and Goosse (2003), "A parameterization of ice shelf-ocean
127      !!                interaction for climate models", Ocean Modelling 5(2003) 157-170.
128      !!----------------------------------------------------------------------
129      !!-------------------------- OUT -------------------------------------
130      REAL(dp), DIMENSION(jpi,jpj), INTENT(inout) :: pqhc, pqfwf, pqoce  ! fresh water and ice-ocean heat fluxes
131      !!-------------------------- IN  -------------------------------------
132      INTEGER,  INTENT(in) :: kt
133      INTEGER,  INTENT(in) :: Kmm    !  ocean time level index
134      !!--------------------------------------------------------------------
135      INTEGER :: jk
136      REAL(dp), DIMENSION(jpi,jpj,jpk) :: ztfrz3d        ! freezing point
137      REAL(dp), DIMENSION(jpi,jpj)     :: ztfrz          ! freezing point
138      REAL(dp), DIMENSION(jpi,jpj)     :: ztavg          ! temperature avg
139      !!----------------------------------------------------------------------
140      !
141      ! 0. ------------Mean freezing point
142      DO jk = 1,jpk
143         CALL eos_fzp(ts(:,:,jk,jp_sal,Kmm), ztfrz3d(:,:,jk), gdept(:,:,jk,Kmm))
144      END DO
145      CALL isf_tbl(Kmm, ztfrz3d, ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par )
146      !
147      ! 1. ------------Mean temperature
148      CALL isf_tbl(Kmm, ts(:,:,jk,jp_tem,Kmm), ztavg, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par )
149      !
150      ! 2. ------------Net heat flux and fresh water flux due to the ice shelf
151      pqoce(:,:) =   rho0 * rcp * rn_gammat0 * risfLeff(:,:) * e1t(:,:) * ( ztavg(:,:) - ztfrz(:,:) ) * r1_e1e2t(:,:)
152      pqfwf(:,:) = - pqoce(:,:) / rLfusisf             ! derived from the latent heat flux
153      pqhc (:,:) =   pqfwf(:,:) * ztfrz(:,:) * rcp     ! heat content flux
154      !
155      ! 3. ------------BG03 output
156      ! output ttbl
157      CALL iom_put('ttbl_par', ztavg(:,:) * mskisf_par(:,:) )
158      !
159      ! output thermal driving
160      CALL iom_put('isfthermald_par',( ztfrz(:,:) - ztavg(:,:) ) * mskisf_par(:,:))
161      !
162      ! output freezing point used to define the thermal driving and heat content fluxes
163      CALL iom_put('isftfrz_par', ztfrz )
164      !
165   END SUBROUTINE isfpar_mlt_bg03
166
167   SUBROUTINE isfpar_mlt_oasis(kt, Kmm, pqhc , pqoce, pqfwf )
168      !!----------------------------------------------------------------------
169      !!                  ***  ROUTINE isfpar_mlt_oasis  ***
170      !!
171      !! ** Purpose    : scale the fwf read from input file by the total amount received by the sbccpl interface
172      !!
173      !! ** Purpose    : - read ice shelf melt from forcing file and scale it by the input file total amount => pattern
174      !!                 - compute total amount of fwf given by sbccpl (fwfisf_oasis)
175      !!                 - scale fwf and compute heat fluxes
176      !!
177      !!---------------------------------------------------------------------
178      !!-------------------------- OUT -------------------------------------
179      REAL(dp), DIMENSION(jpi,jpj), INTENT(  out) :: pqhc, pqoce, pqfwf  ! heat content, latent heat and fwf fluxes
180      !!-------------------------- IN  -------------------------------------
181      INTEGER                     , INTENT(in   ) :: kt                  ! current time step
182      INTEGER                     , INTENT(in   ) :: Kmm                 !  ocean time level index
183      !!--------------------------------------------------------------------
184      INTEGER                           :: jk                            ! loop index
185      REAL(dp)                          :: zfwf_fld, zfwf_oasis          ! total fwf in the forcing fields (pattern) and from the cpl interface (amount)
186      REAL(dp), DIMENSION(jpi,jpj)      :: ztfrz                         ! tbl freezing temperature
187      REAL(dp), DIMENSION(jpi,jpj)      :: zfwf                          ! 2d fwf map after scaling
188      REAL(dp), DIMENSION(jpi,jpj,jpk)  :: ztfrz3d
189      !!--------------------------------------------------------------------
190      !
191      ! 0. ------------Read specified runoff
192      CALL fld_read ( kt, 1, sf_isfpar_fwf   )
193      !
194      ! 1. ------------Mean freezing point (needed for heat content flux)
195      DO jk = 1,jpk
196         CALL eos_fzp(ts(:,:,jk,jp_sal,Kmm), ztfrz3d(:,:,jk), gdept(:,:,jk,Kmm))
197      END DO
198      CALL isf_tbl(Kmm, ztfrz3d, ztfrz, 'T', misfkt_par, rhisf_tbl_par, misfkb_par, rfrac_tbl_par )
199      !
200      ! 2. ------------Scale isf melt pattern with total amount from oasis
201      ! ice shelf 2d map
202      zfwf(:,:) = - sf_isfpar_fwf(1)%fnow(:,:,1)
203      !
204      ! compute glob sum from input file
205      ! (PM) should we consider delay sum as in fwb ? (it will offset by 1 time step if I understood well)
206      zfwf_fld = glob_sum('isfcav_mlt', e1e2t(:,:) * zfwf(:,:))
207      !
208      ! compute glob sum from atm->oce ice shelf fwf
209      ! (PM) should we consider delay sum as in fwb ?
210      zfwf_oasis = glob_sum('isfcav_mlt', e1e2t(:,:) * fwfisf_oasis(:,:))
211      !
212      ! scale fwf
213      zfwf(:,:) = zfwf(:,:) * zfwf_oasis / zfwf_fld
214      !
215      ! 3. -----------Define fwf and qoce
216      ! ocean heat flux is assume to be equal to the latent heat
217      pqfwf(:,:) =   zfwf(:,:)                         ! fwf                ( >0 out )
218      pqoce(:,:) = - pqfwf(:,:) * rLfusisf             ! ocean heat flux    ( >0 out ) (assumed to be the latent heat flux)
219      pqhc (:,:) =   pqfwf(:,:) * ztfrz(:,:) * rcp     ! heat content flux  ( >0 out )
220      !
221      CALL iom_put('isftfrz_par', ztfrz )
222      !
223   END SUBROUTINE isfpar_mlt_oasis
224
225END MODULE isfparmlt
Note: See TracBrowser for help on using the repository browser.