source: NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/OCE/ISF/isfpar.F90 @ 13257

Last change on this file since 13257 was 12546, checked in by orioltp, 9 months ago

Adding precision specification in hardcoded reals and other modifications to allow compilation without forcing reals without precision specification to a certain value through compiler flags

File size: 8.2 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      CALL lbc_lnk_multi( 'isfmlt', zqh, 'T', 1.0_wp, pqfwf, 'T', 1.0_wp)
85      !
86      ! output fluxes
87      CALL isf_diags_flx( Kmm, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, 'par', pqfwf, zqoce, zqlat, zqhc)
88      !
89      ! set temperature content
90      ptsc(:,:,jp_tem) = zqh(:,:) * r1_rho0_rcp
91      !
92      ! write restart variables (qoceisf, qhcisf, fwfisf for now and before)
93      IF (lrst_oce) CALL isfrst_write(kt, 'par', ptsc, pqfwf)
94      !
95      IF ( ln_isfdebug ) THEN
96         CALL debug('isf_par: ptsc T',ptsc(:,:,1))
97         CALL debug('isf_par: ptsc S',ptsc(:,:,2))
98         CALL debug('isf_par: pqfwf fwf',pqfwf(:,:))
99      END IF
100      !
101   END SUBROUTINE isf_par
102
103   SUBROUTINE isf_par_init
104      !!---------------------------------------------------------------------
105      !!                  ***  ROUTINE isf_par_init  ***
106      !!
107      !! ** Purpose : initialisation of the variable needed for the parametrisation of ice shelf melt
108      !!
109      !!----------------------------------------------------------------------
110      INTEGER               :: ierr
111      REAL(wp), DIMENSION(jpi,jpj) :: ztblmax, ztblmin
112      !!----------------------------------------------------------------------
113      !
114      ! allocation
115      CALL isf_alloc_par()
116      !
117      ! initialisation
118      misfkt_par(:,:)     = 1         ; misfkb_par(:,:)       = 1         
119      rhisf_tbl_par(:,:)  = 1e-20     ; rfrac_tbl_par(:,:)    = 0.0_wp
120      !
121      ! define isf tbl tickness, top and bottom indice
122      CALL read_2dcstdta(TRIM(sn_isfpar_zmax%clname), TRIM(sn_isfpar_zmax%clvar), ztblmax)
123      CALL read_2dcstdta(TRIM(sn_isfpar_zmin%clname), TRIM(sn_isfpar_zmin%clvar), ztblmin)
124      !
125      ! mask ice shelf parametrisation location
126      ztblmax(:,:) = ztblmax(:,:) * ssmask(:,:)
127      ztblmin(:,:) = ztblmin(:,:) * ssmask(:,:)
128      !
129      ! if param used under an ice shelf overwrite ztblmin by the ice shelf draft
130      WHERE ( risfdep > 0._wp .AND. ztblmin > 0._wp )
131         ztblmin(:,:) = risfdep(:,:)
132      END WHERE
133      !
134      ! ensure ztblmax <= bathy
135      WHERE ( ztblmax(:,:) > bathy(:,:) )
136         ztblmax(:,:) = bathy(:,:)
137      END WHERE
138      !
139      ! compute ktop and update ztblmin to gdepw_0(misfkt_par)
140      CALL isf_tbl_ktop(ztblmin, misfkt_par) !   out: misfkt_par
141      !                                      ! inout: ztblmin
142      !
143      ! initial tbl thickness
144      rhisf0_tbl_par(:,:) = ztblmax(:,:) - ztblmin(:,:)
145      !
146      ! define iceshelf parametrisation mask
147      mskisf_par = 0
148      WHERE ( rhisf0_tbl_par(:,:) > 0._wp )
149         mskisf_par(:,:) = 1._wp
150      END WHERE
151      !
152      ! read par variable from restart
153      IF ( ln_rstart ) CALL isfrst_read('par', risf_par_tsc, fwfisf_par, risf_par_tsc_b, fwfisf_par_b)
154      !
155      SELECT CASE ( TRIM(cn_isfpar_mlt) )
156         !
157      CASE ( 'spe' )
158         !
159         ALLOCATE( sf_isfpar_fwf(1), STAT=ierr )
160         ALLOCATE( sf_isfpar_fwf(1)%fnow(jpi,jpj,1), sf_isfpar_fwf(1)%fdta(jpi,jpj,1,2) )
161         CALL fld_fill( sf_isfpar_fwf, (/ sn_isfpar_fwf /), cn_isfdir, 'isf_par_init', 'read fresh water flux isf data', 'namisf' )
162         !
163         IF(lwp) WRITE(numout,*)
164         IF(lwp) WRITE(numout,*) '      ==>>>   ice melt read from forcing field (cn_isfmlt_par = spe)'
165         !
166      CASE ( 'bg03' )
167         !
168         IF(lwp) WRITE(numout,*)
169         IF(lwp) WRITE(numout,*) '      ==>>>   bg03 parametrisation (cn_isfmlt_par = bg03)'
170         !
171         ! read effective length
172         CALL read_2dcstdta(TRIM(sn_isfpar_Leff%clname), TRIM(sn_isfpar_Leff%clvar), risfLeff)
173         risfLeff = risfLeff*1000.0_wp           !: convertion in m
174         !
175      CASE ( 'oasis' )
176         !
177         IF(lwp) WRITE(numout,*)
178         IF(lwp) WRITE(numout,*) '      ==>>>    isf melt provided by OASIS (cn_isfmlt_par = oasis)'
179         !
180      CASE DEFAULT
181         CALL ctl_stop( 'sbc_isf_init: wrong value of nn_isf' )
182      END SELECT
183      !
184   END SUBROUTINE isf_par_init
185
186END MODULE isfpar
Note: See TracBrowser for help on using the repository browser.