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.
isfpar.F90 in NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/ISF – NEMO

source: NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/ISF/isfpar.F90 @ 13630

Last change on this file since 13630 was 13630, checked in by mocavero, 4 years ago

Add neighborhood collectives calls in the NEMO src - ticket #2496
File size: 8.3 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.1  !  2019-09  (P. Mathiot) Restructuration
11   !!----------------------------------------------------------------------
12
13   !!----------------------------------------------------------------------
14   !!   isfpar       : compute ice shelf melt using a prametrisation of ice shelf cavities
15   !!----------------------------------------------------------------------
16   USE isf_oce        ! ice shelf
17   !
18   USE isfrst   , ONLY: isfrst_write, isfrst_read ! ice shelf restart read/write subroutine
19   USE isftbl   , ONLY: isf_tbl_ktop, isf_tbl_lvl ! ice shelf top boundary layer properties subroutine
20   USE isfparmlt, ONLY: isfpar_mlt                ! ice shelf melt formulation subroutine
21   USE isfdiags , ONLY: isf_diags_flx             ! ice shelf diags subroutine
22   USE isfutils , ONLY: debug, read_2dcstdta      ! ice shelf debug subroutine
23   !
24   USE dom_oce  , ONLY: bathy          ! ocean space and time domain
25   USE par_oce  , ONLY: jpi,jpj        ! ocean space and time domain
26   USE phycst   , ONLY: r1_rho0_rcp    ! physical constants
27   !
28   USE in_out_manager ! I/O manager
29   USE iom            ! I/O library
30   USE fldread        ! read input field at current time step
31   USE lbclnk         ! lbc_lnk
32
33   IMPLICIT NONE
34   PRIVATE
35
36   PUBLIC   isf_par, isf_par_init
37
38   !!----------------------------------------------------------------------
39   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
40   !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
41   !! Software governed by the CeCILL license (see ./LICENSE)
42   !!----------------------------------------------------------------------
43CONTAINS
44 
45   SUBROUTINE isf_par( kt, Kmm, ptsc, pqfwf )
46      !!---------------------------------------------------------------------
47      !!                     ***  ROUTINE isf_par ***     
48      !!
49      !! ** Purpose : compute the heat and fresh water due to ice shelf melting/freezing using a parametrisation
50      !!
51      !! ** Comment : in isf_par and all its call tree,
52      !!              'tbl' means parametrisation layer (ie how the far field temperature/salinity is computed)
53      !!              instead of in a proper top boundary layer as at the ice shelf ocean interface
54      !!              as the action to compute the properties of the tbl or the parametrisation layer are the same,
55      !!              (ie average T/S over a specific depth (can be across multiple levels))
56      !!              the name tbl was kept.
57      !!
58      !!---------------------------------------------------------------------
59      !!-------------------------- OUT --------------------------------------
60      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(inout) :: pqfwf
61      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(inout) :: ptsc
62      !!-------------------------- IN  --------------------------------------
63      INTEGER, INTENT(in) ::   kt                                     ! ocean time step
64      INTEGER, INTENT(in) ::   Kmm                                    ! ocean time level index
65      !!---------------------------------------------------------------------
66      REAL(wp), DIMENSION(jpi,jpj) :: zqoce, zqhc, zqlat, zqh
67      !!---------------------------------------------------------------------
68      !
69      ! compute heat content, latent heat and melt fluxes (2d)
70      CALL isfpar_mlt( kt, Kmm, zqhc, zqoce, pqfwf  )
71      !
72      ! compute heat and water flux ( > 0 out )
73      pqfwf(:,:) = pqfwf(:,:) * mskisf_par(:,:)
74      zqoce(:,:) = zqoce(:,:) * mskisf_par(:,:)
75      zqhc (:,:) = zqhc(:,:)  * mskisf_par(:,:)
76      !
77      ! compute heat content flux ( > 0 out )
78      zqlat(:,:) = pqfwf(:,:) * rLfusisf    ! 2d latent heat flux (W/m2)
79      !
80      ! total heat flux ( > 0 out )
81      zqh(:,:) = ( zqhc (:,:) + zqoce(:,:) )
82      !
83      ! lbclnk on melt and heat fluxes
84#if defined key_mpi3
85      CALL lbc_lnk_nc_multi( 'isfmlt', zqh, 'T', 1.0_wp, pqfwf, 'T', 1.0_wp)
86#else
87      CALL lbc_lnk_multi( 'isfmlt', zqh, 'T', 1.0_wp, pqfwf, 'T', 1.0_wp)
88#endif
89      !
90      ! output fluxes
91      CALL isf_diags_flx( Kmm, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, 'par', pqfwf, zqoce, zqlat, zqhc)
92      !
93      ! set temperature content
94      ptsc(:,:,jp_tem) = zqh(:,:) * r1_rho0_rcp
95      !
96      ! write restart variables (qoceisf, qhcisf, fwfisf for now and before)
97      IF (lrst_oce) CALL isfrst_write(kt, 'par', ptsc, pqfwf)
98      !
99      IF ( ln_isfdebug ) THEN
100         CALL debug('isf_par: ptsc T',ptsc(:,:,1))
101         CALL debug('isf_par: ptsc S',ptsc(:,:,2))
102         CALL debug('isf_par: pqfwf fwf',pqfwf(:,:))
103      END IF
104      !
105   END SUBROUTINE isf_par
106
107   SUBROUTINE isf_par_init
108      !!---------------------------------------------------------------------
109      !!                  ***  ROUTINE isf_par_init  ***
110      !!
111      !! ** Purpose : initialisation of the variable needed for the parametrisation of ice shelf melt
112      !!
113      !!----------------------------------------------------------------------
114      INTEGER               :: ierr
115      REAL(wp), DIMENSION(jpi,jpj) :: ztblmax, ztblmin
116      !!----------------------------------------------------------------------
117      !
118      ! allocation
119      CALL isf_alloc_par()
120      !
121      ! initialisation
122      misfkt_par(:,:)     = 1         ; misfkb_par(:,:)       = 1         
123      rhisf_tbl_par(:,:)  = 1e-20     ; rfrac_tbl_par(:,:)    = 0.0_wp
124      !
125      ! define isf tbl tickness, top and bottom indice
126      CALL read_2dcstdta(TRIM(sn_isfpar_zmax%clname), TRIM(sn_isfpar_zmax%clvar), ztblmax)
127      CALL read_2dcstdta(TRIM(sn_isfpar_zmin%clname), TRIM(sn_isfpar_zmin%clvar), ztblmin)
128      !
129      ! mask ice shelf parametrisation location
130      ztblmax(:,:) = ztblmax(:,:) * ssmask(:,:)
131      ztblmin(:,:) = ztblmin(:,:) * ssmask(:,:)
132      !
133      ! if param used under an ice shelf overwrite ztblmin by the ice shelf draft
134      WHERE ( risfdep > 0._wp .AND. ztblmin > 0._wp )
135         ztblmin(:,:) = risfdep(:,:)
136      END WHERE
137      !
138      ! ensure ztblmax <= bathy
139      WHERE ( ztblmax(:,:) > bathy(:,:) )
140         ztblmax(:,:) = bathy(:,:)
141      END WHERE
142      !
143      ! compute ktop and update ztblmin to gdepw_0(misfkt_par)
144      CALL isf_tbl_ktop(ztblmin, misfkt_par) !   out: misfkt_par
145      !                                      ! inout: ztblmin
146      !
147      ! initial tbl thickness
148      rhisf0_tbl_par(:,:) = ztblmax(:,:) - ztblmin(:,:)
149      !
150      ! define iceshelf parametrisation mask
151      mskisf_par = 0
152      WHERE ( rhisf0_tbl_par(:,:) > 0._wp )
153         mskisf_par(:,:) = 1._wp
154      END WHERE
155      !
156      ! read par variable from restart
157      IF ( ln_rstart ) CALL isfrst_read('par', risf_par_tsc, fwfisf_par, risf_par_tsc_b, fwfisf_par_b)
158      !
159      SELECT CASE ( TRIM(cn_isfpar_mlt) )
160         !
161      CASE ( 'spe' )
162         !
163         ALLOCATE( sf_isfpar_fwf(1), STAT=ierr )
164         ALLOCATE( sf_isfpar_fwf(1)%fnow(jpi,jpj,1), sf_isfpar_fwf(1)%fdta(jpi,jpj,1,2) )
165         CALL fld_fill( sf_isfpar_fwf, (/ sn_isfpar_fwf /), cn_isfdir, 'isf_par_init', 'read fresh water flux isf data', 'namisf' )
166         !
167         IF(lwp) WRITE(numout,*)
168         IF(lwp) WRITE(numout,*) '      ==>>>   ice melt read from forcing field (cn_isfmlt_par = spe)'
169         !
170      CASE ( 'bg03' )
171         !
172         IF(lwp) WRITE(numout,*)
173         IF(lwp) WRITE(numout,*) '      ==>>>   bg03 parametrisation (cn_isfmlt_par = bg03)'
174         !
175         ! read effective length
176         CALL read_2dcstdta(TRIM(sn_isfpar_Leff%clname), TRIM(sn_isfpar_Leff%clvar), risfLeff)
177         risfLeff = risfLeff*1000.0_wp           !: convertion in m
178         !
179      CASE ( 'oasis' )
180         !
181         IF(lwp) WRITE(numout,*)
182         IF(lwp) WRITE(numout,*) '      ==>>>    isf melt provided by OASIS (cn_isfmlt_par = oasis)'
183         !
184      CASE DEFAULT
185         CALL ctl_stop( 'sbc_isf_init: wrong value of nn_isf' )
186      END SELECT
187      !
188   END SUBROUTINE isf_par_init
189
190END MODULE isfpar
Note: See TracBrowser for help on using the repository browser.