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

Last change on this file since 11423 was 11423, checked in by mathiot, 15 months ago

ENHANCE-02_ISF_nemo : add UKESM ice sheet coupling method (ticket #2142)

File size: 6.6 KB
Line 
1MODULE isfpar
2   !!======================================================================
3   !!                       ***  MODULE  isfpar  ***
4   !! ice shelf module :  update ocean boundary condition under ice
5   !!                   shelf
6   !!======================================================================
7   !! History :  3.2  !  2011-02  (C.Harris  ) Original code isf cav
8   !!            X.X  !  2006-02  (C. Wang   ) Original code bg03
9   !!            3.4  !  2013-03  (P. Mathiot) Merging + parametrization
10   !!            4.0  !  2019-09  (P. Mathiot) Restructuration
11   !!----------------------------------------------------------------------
12
13   !!----------------------------------------------------------------------
14   !!   isf_par       : compute ice shelf melt using a prametrisation of ice shelf cavities
15   !!----------------------------------------------------------------------
16   USE oce            ! ocean dynamics and tracers
17   USE isf
18   USE isfparmlt
19   USE isftbl
20   USE isfdiags
21   USE isfutils
22   USE dom_oce        ! ocean space and time domain
23   USE phycst         ! physical constants
24   USE eosbn2         ! equation of state
25   !
26   USE in_out_manager ! I/O manager
27   USE iom            ! I/O library
28   USE fldread        ! read input field at current time step
29   USE lbclnk         !
30
31   IMPLICIT NONE
32   PRIVATE
33
34   PUBLIC   isf_par, isf_par_init
35
36   !!----------------------------------------------------------------------
37   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
38   !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
39   !! Software governed by the CeCILL license (see ./LICENSE)
40   !!----------------------------------------------------------------------
41CONTAINS
42 
43   SUBROUTINE isf_par( kt, ptsc, pqfwf )
44      !!---------------------------------------------------------------------
45      !!                     ***  ROUTINE sbc_isf_cav  ***
46      !!
47      !! ** Purpose :   
48      !!
49      !! ** Method  :
50      !!
51      !! ** Action  :   
52      !!               
53      !!---------------------------------------------------------------------
54      !!-------------------------- OUT --------------------------------------
55      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(inout) :: pqfwf
56      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(inout) :: ptsc
57      !!-------------------------- IN  --------------------------------------
58      INTEGER, INTENT(in) ::   kt                                           ! ocean time step
59      !!---------------------------------------------------------------------
60      REAL(wp), DIMENSION(jpi,jpj) :: zqoce, zqhc, zqlat, zqh
61      !!---------------------------------------------------------------------
62      !
63      ! compute misfkb_par, rhisf_tbl
64      rhisf_tbl_par(:,:) = rhisf0_tbl_par(:,:)
65      CALL isf_tbl_lvl( ht_n, e3t_n, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par )
66      !
67      ! compute heat content, latent heat and melt fluxes (2d)
68      CALL isfpar_mlt( kt, zqhc, zqoce, pqfwf  )
69      !
70      ! compute heat and water flux  (change signe directly in the melt subroutine)
71      pqfwf(:,:) = pqfwf(:,:) * mskisf_par(:,:)
72      zqoce(:,:) = zqoce(:,:) * mskisf_par(:,:)
73      zqhc (:,:) = zqhc(:,:)  * mskisf_par(:,:)
74      !
75      ! compute heat content flux
76      zqlat(:,:) = pqfwf(:,:) * rLfusisf    ! 2d latent heat flux (W/m2)
77      !
78      ! total heat flux
79      zqh(:,:) = ( zqhc (:,:) + zqoce(:,:) )
80      !
81      ! lbclnk on melt
82      CALL lbc_lnk_multi( 'isfmlt', zqh, 'T', 1., pqfwf, 'T', 1.)
83      !
84      ! output fluxes
85      CALL isf_diags_flx( misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, 'par', pqfwf, zqoce, zqlat, zqhc)
86      !
87      ! set temperature content
88      ptsc(:,:,jp_tem) = zqh(:,:) * r1_rau0_rcp
89      !
90   END SUBROUTINE isf_par
91
92   SUBROUTINE isf_par_init
93      !!---------------------------------------------------------------------
94      !!                  ***  ROUTINE isf_par_init  ***
95      !!
96      !! ** Purpose :
97      !!
98      !! ** Method  : 
99      !!----------------------------------------------------------------------
100      INTEGER               :: ierr
101      REAL(wp), DIMENSION(jpi,jpj) :: ztblmax, ztblmin
102      !!----------------------------------------------------------------------
103      !
104      ! allocation
105      CALL isf_alloc_par()
106      !
107      ! par
108      misfkt_par(:,:)     = 1         ; misfkb_par(:,:)       = 1         
109      rhisf_tbl_par(:,:)  = 1e-20     ; rfrac_tbl_par(:,:)    = 0.0_wp
110      !
111      mskisf_par(:,:) = 0
112      !
113      ! define isf tbl tickness, top and bottom indice
114      CALL read_2dcstdta(TRIM(sn_isfpar_zmax%clname), TRIM(sn_isfpar_zmax%clvar), ztblmax)
115      CALL read_2dcstdta(TRIM(sn_isfpar_zmin%clname), TRIM(sn_isfpar_zmin%clvar), ztblmin)
116      !
117      ! mask ice shelf parametrisation location
118      ztblmax(:,:) = ztblmax(:,:) * ssmask(:,:)
119      ztblmin(:,:) = ztblmin(:,:) * ssmask(:,:)
120      !
121      ! if param used under an ice shelf overwrite ztblmax by the ice shelf draft
122      WHERE ( risfdep > 0._wp )
123         ztblmin(:,:) = risfdep(:,:)
124      END WHERE
125      !
126      ! compute ktop
127      CALL isftbl_ktop(ztblmin, misfkt_par)
128      !
129      ! initial tbl thickness
130      rhisf0_tbl_par(:,:) = ztblmax(:,:) - ztblmin(:,:)
131      !
132      ! compute misfkb_par, rhisf_tbl
133      rhisf_tbl_par(:,:) = rhisf0_tbl_par(:,:)
134      CALL isf_tbl_lvl( ht_n, e3t_n, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par )
135      !
136      ! define iceshelf parametrisation mask
137      mskisf_par = 0
138      WHERE ( ztblmax > 0._wp )
139         mskisf_par(:,:) = 1._wp
140      END WHERE
141      !
142      SELECT CASE ( TRIM(cn_isfpar_mlt) )
143         !
144      CASE ( 'spe' )
145
146         ALLOCATE( sf_isfpar_fwf(1), STAT=ierr )
147         ALLOCATE( sf_isfpar_fwf(1)%fnow(jpi,jpj,1), sf_isfpar_fwf(1)%fdta(jpi,jpj,1,2) )
148         CALL fld_fill( sf_isfpar_fwf, (/ sn_isfpar_fwf /), cn_isfdir, 'isf_par_init', 'read fresh water flux isf data', 'namisf' )
149
150         IF(lwp) WRITE(numout,*)
151         IF(lwp) WRITE(numout,*) '      ==>>>   ice melt read from forcing field (cn_isfmlt_par = spe)'
152
153      CASE ( 'bg03' )
154         !
155         IF(lwp) WRITE(numout,*)
156         IF(lwp) WRITE(numout,*) '      ==>>>   bg03 parametrisation (cn_isfmlt_par = bg03)'
157         !
158         ! read effective length
159         CALL read_2dcstdta(TRIM(sn_isfpar_Leff%clname), TRIM(sn_isfpar_Leff%clvar), risfLeff)
160         risfLeff = risfLeff*1000.0_wp           !: convertion in m
161         !
162      CASE ( 'oasis' )
163
164         IF(lwp) WRITE(numout,*)
165         IF(lwp) WRITE(numout,*) '      ==>>>    isf melt provided by OASIS (cn_isfmlt_par = oasis)'
166
167      CASE DEFAULT
168         CALL ctl_stop( 'sbc_isf_init: wrong value of nn_isf' )
169      END SELECT
170      !
171   END SUBROUTINE isf_par_init
172
173   END MODULE isfpar
Note: See TracBrowser for help on using the repository browser.