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

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

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

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

File size: 5.1 KB
Line 
1MODULE isfhdiv
2
3   USE isf                    ! ice shelf
4   USE dom_oce                ! time and space domain
5   USE phycst , ONLY: r1_rau0 ! physical constant
6   USE in_out_manager         !
7
8   IMPLICIT NONE
9
10   PRIVATE
11
12   PUBLIC isf_hdiv
13
14CONTAINS
15
16   SUBROUTINE isf_hdiv( kt, phdiv )
17      !!----------------------------------------------------------------------
18      !!                  ***  SUBROUTINE isf_hdiv  ***
19      !!       
20      !! ** Purpose :   update the horizontal divergence with the ice shelf contribution
21      !!                (parametrisation, explicit, ice sheet coupling conservation
22      !!                 increment)
23      !!
24      !!----------------------------------------------------------------------
25      REAL(wp), DIMENSION(:,:,:), INTENT( inout ) ::   phdiv   ! horizontal divergence
26      !!----------------------------------------------------------------------
27      INTEGER, INTENT(in) :: kt
28      !
29      IF ( ln_isf ) THEN
30         !
31         ! ice shelf cavity contribution
32         IF ( ln_isfcav_mlt ) CALL isf_hdiv_mlt(misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav, fwfisf_cav, fwfisf_cav_b, phdiv)
33         !
34         ! ice shelf parametrisation contribution
35         IF ( ln_isfpar_mlt ) CALL isf_hdiv_mlt(misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, fwfisf_par, fwfisf_par_b, phdiv)
36         !
37         !
38         ! ice sheet coupling contribution
39         IF ( ln_isfcpl .AND. kt /= 0 ) THEN
40            !
41            ! correct divergence only for the first time step
42            IF ( kt == nit000   ) CALL isf_hdiv_cpl(risfcpl_vol       , phdiv)
43            IF ( kt == nit000+1 ) CALL isf_hdiv_cpl(risfcpl_vol*0.5_wp, phdiv)
44            !
45            ! correct divergence every time step to remove any trend due to coupling
46            ! conservation option
47            IF ( ln_isfcpl_cons ) CALL isf_hdiv_cpl(risfcpl_cons_vol, phdiv)
48            !
49         END IF
50         !
51      END IF
52      !
53   END SUBROUTINE isf_hdiv
54
55   SUBROUTINE isf_hdiv_mlt(ktop, kbot, phtbl, pfrac, pfwf, pfwf_b, phdiv)
56      !!----------------------------------------------------------------------
57      !!                  ***  SUBROUTINE sbc_isf_div  ***
58      !!       
59      !! ** Purpose :   update the horizontal divergence with the ice shelf inflow
60      !!
61      !! ** Method  :   pfwf is positive (outflow) and expressed as kg/m2/s
62      !!                increase the divergence
63      !!
64      !! ** Action  :   phdivn   increased by the ice shelf outflow
65      !!----------------------------------------------------------------------
66      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phdiv
67      !!----------------------------------------------------------------------
68      INTEGER , DIMENSION(jpi,jpj), INTENT(in   ) :: ktop , kbot
69      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pfrac, phtbl
70      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pfwf , pfwf_b
71      !!----------------------------------------------------------------------
72      INTEGER  ::   ji, jj, jk   ! dummy loop indices
73      INTEGER  ::   ikt, ikb 
74      REAL(wp), DIMENSION(jpi,jpj) :: zhdiv
75      !!----------------------------------------------------------------------
76      !
77      !==   fwf distributed over several levels   ==!
78      !
79      ! compute integrated divergence correction
80      zhdiv(:,:) = 0.5_wp * ( pfwf(:,:) + pfwf_b(:,:) ) * r1_rau0 / phtbl(:,:)
81      !
82      ! update divergence at each level affected by ice shelf top boundary layer
83      DO jj = 1,jpj
84         DO ji = 1,jpi
85            ikt = ktop(ji,jj)
86            ikb = kbot(ji,jj)
87            ! level fully include in the ice shelf boundary layer
88            DO jk = ikt, ikb - 1
89               phdiv(ji,jj,jk) = phdiv(ji,jj,jk) + zhdiv(ji,jj)
90            END DO
91            ! level partially include in ice shelf boundary layer
92            phdiv(ji,jj,ikb) = phdiv(ji,jj,ikb) + zhdiv(ji,jj) * pfrac(ji,jj)
93         END DO
94      END DO
95      !
96   END SUBROUTINE isf_hdiv_mlt
97
98   SUBROUTINE isf_hdiv_cpl(pqvol, phdiv)
99      !!----------------------------------------------------------------------
100      !!                  ***  SUBROUTINE isf_hdiv_cpl  ***
101      !!       
102      !! ** Purpose :   update the horizontal divergence with the ice shelf
103      !!                coupling conservation increment
104      !!
105      !! ** Method  :   pqvol is positive (outflow) and expressed as m3/s
106      !!                increase the divergence
107      !!
108      !! ** Action  :   phdivn   increased by the ice shelf outflow
109      !!
110      !!----------------------------------------------------------------------
111      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phdiv
112      !!----------------------------------------------------------------------
113      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pqvol
114      !!----------------------------------------------------------------------
115      INTEGER :: jk
116      !!----------------------------------------------------------------------
117      !
118      DO jk=1,jpk 
119         phdiv(:,:,jk) =  phdiv(:,:,jk) + pqvol(:,:,jk) * r1_e1e2t(:,:) / e3t_n(:,:,jk)
120      END DO
121      !
122   END SUBROUTINE isf_hdiv_cpl
123
124END MODULE isfhdiv
Note: See TracBrowser for help on using the repository browser.