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.
isfnxt.F90 in NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF – NEMO

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

Last change on this file since 11852 was 11852, checked in by mathiot, 5 years ago

ENHANCE-02_ISF_nemo: fix WED025 restartability, finish removing useless USE, remove useless lbc_lnk

File size: 4.2 KB
Line 
1MODULE isfnxt
2   !!=========================================================================
3   !!                       ***  MODULE  isfnxt  ***
4   !! Ice shelf update: compute the dynnxt ice shelf contribution
5   !!=========================================================================
6   !! History :  OPA  !  2019-09  (P. Mathiot)  Original code
7   !!-------------------------------------------------------------------------
8 
9   !!-------------------------------------------------------------------------
10   !!   isfnxt       : aplly correction needed for the ice shelf to ensure conservation
11   !!-------------------------------------------------------------------------
12
13   USE isf
14
15   USE phycst , ONLY: r1_rau0                ! physical constant
16   USE dom_oce, ONLY: e3t_b, e3t_n, r1_e1e2t ! time and space domain
17
18   USE in_out_manager
19
20   IMPLICIT NONE
21
22   PRIVATE
23
24   PUBLIC isf_dynnxt
25
26CONTAINS
27
28   SUBROUTINE isf_dynnxt ( kt, pcoef )
29      !!--------------------------------------------------------------------
30      !!                  ***  ROUTINE isf_dynnxt  ***
31      !!
32      !! ** Purpose : compute the ice shelf volume filter correction for cavity, param, ice sheet coupling case
33      !!
34      !!--------------------------------------------------------------------
35      !!-------------------------- OUT -------------------------------------
36      INTEGER ,                     INTENT(in   ) :: kt
37      !
38      REAL(wp),                     INTENT(in   ) :: pcoef           ! atfp * rdt * r1_rau0
39      !!-------------------------- IN  -------------------------------------
40      !!--------------------------------------------------------------------
41      INTEGER :: jk  ! loop index
42      !!--------------------------------------------------------------------
43      !
44      ! ice shelf cavity
45      IF ( ln_isfcav_mlt ) CALL isf_dynnxt_mlt(misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav, fwfisf_cav, fwfisf_cav_b, pcoef)
46      !
47      ! ice shelf parametrised
48      IF ( ln_isfpar_mlt ) CALL isf_dynnxt_mlt(misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, fwfisf_par, fwfisf_par_b, pcoef)
49      !
50      IF ( ln_isfcpl .AND. ln_rstart .AND. kt == nit000+1 ) THEN
51         DO jk = 1, jpkm1
52            e3t_b(:,:,jk) =   e3t_b(:,:,jk) - pcoef * risfcpl_vol(:,:,jk) * r1_e1e2t(:,:)
53         END DO
54      END IF
55      !
56   END SUBROUTINE isf_dynnxt
57
58   SUBROUTINE isf_dynnxt_mlt ( ktop, kbot, phtbl, pfrac, pfwf, pfwf_b, pcoef )
59      !!--------------------------------------------------------------------
60      !!                  ***  ROUTINE isf_dynnxt_mlt  ***
61      !!
62      !! ** Purpose : compute the ice shelf volume filter correction for cavity or param
63      !!
64      !!--------------------------------------------------------------------
65      !!-------------------------- OUT -------------------------------------
66      !!-------------------------- IN  -------------------------------------
67      INTEGER , DIMENSION(jpi,jpj), INTENT(in   ) :: ktop , kbot     ! top and bottom level of tbl
68      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pfrac, phtbl    ! fraction of bottom cell included in tbl, tbl thickness
69      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pfwf , pfwf_b   ! now/before fwf
70      REAL(wp),                     INTENT(in   ) :: pcoef           ! atfp * rdt * r1_rau0
71      !!----------------------------------------------------------------------
72      INTEGER :: ji,jj,jk
73      REAL(wp), DIMENSION(jpi,jpj) :: zfwfinc
74      !!----------------------------------------------------------------------
75      !
76      ! compute fwf conservation correction
77      zfwfinc(:,:) = pcoef * ( pfwf_b(:,:) - pfwf(:,:) ) / phtbl(:,:) * r1_rau0
78      !
79      ! add the increment in the tbl
80      DO jk = 1, jpkm1
81         DO jj = 1, jpj
82            DO ji = 1, jpi
83               IF( ktop(ji,jj) <= jk .AND. jk < kbot(ji,jj)  ) THEN
84                  e3t_b(ji,jj,jk) = e3t_b(ji,jj,jk) - zfwfinc(ji,jj) * e3t_n(ji,jj,jk)
85               ELSEIF ( jk == kbot(ji,jj) ) THEN
86                  e3t_b(ji,jj,jk) = e3t_b(ji,jj,jk) - zfwfinc(ji,jj) * e3t_n(ji,jj,jk) * pfrac(ji,jj)
87               ENDIF
88            END DO
89         END DO
90      END DO
91      !
92   END SUBROUTINE isf_dynnxt_mlt
93
94END MODULE isfnxt
Note: See TracBrowser for help on using the repository browser.