source: NEMO/branches/2019/ENHANCE-02_ISF_nemo/src/OCE/ISF/isfhdiv.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: 3.9 KB
Line 
1MODULE isfhdiv
2
3   USE dom_oce
4   USE isf
5   USE phycst
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 :   
21      !!
22      !! ** Method  :   
23      !!
24      !! ** Action  :   phdiv   decreased by the fwf inflow (isf melt in this case)
25      !!----------------------------------------------------------------------
26      REAL(wp), DIMENSION(:,:,:), INTENT( inout ) ::   phdiv   ! horizontal divergence
27      !!----------------------------------------------------------------------
28      INTEGER, INTENT(in) :: kt
29      !
30      ! ice shelf cavity contribution
31      IF ( ln_isfcav_mlt ) CALL isf_hdiv_mlt(misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav, fwfisf_cav, fwfisf_cav_b, phdiv)
32      !
33      ! ice shelf parametrisation contribution
34      IF ( ln_isfpar_mlt ) CALL isf_hdiv_mlt(misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, fwfisf_par, fwfisf_par_b, phdiv)
35      !
36      ! ice sheet coupling contribution (if conservation needed)
37      IF ( ll_isfcpl ) THEN
38         !
39         ! correct divergence only for the first time step
40         IF ( kt == nit000 ) CALL isf_hdiv_cpl(risfcpl_vol, phdiv)
41         !
42         ! correct divergence every time step to remove any trend due to coupling
43         IF ( ll_isfcpl_cons ) CALL isf_hdiv_cpl(risfcpl_cons_vol, phdiv)
44         !
45      END IF
46      !
47   END SUBROUTINE isf_hdiv
48
49   SUBROUTINE isf_hdiv_mlt(ktop, kbot, phtbl, pfrac, pfwf, pfwf_b, phdiv)
50      !!----------------------------------------------------------------------
51      !!                  ***  SUBROUTINE sbc_isf_div  ***
52      !!       
53      !! ** Purpose :   update the horizontal divergence with the runoff inflow
54      !!
55      !! ** Method  :   
56      !!                CAUTION : risf_tsc(:,:,jp_sal) is negative (outflow) increase the
57      !!                          divergence and expressed in m/s
58      !!
59      !! ** Action  :   phdivn   decreased by the runoff inflow
60      !!----------------------------------------------------------------------
61      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phdiv
62      !!----------------------------------------------------------------------
63      INTEGER , DIMENSION(jpi,jpj), INTENT(in   ) :: ktop , kbot
64      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pfrac, phtbl
65      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pfwf , pfwf_b
66      !!----------------------------------------------------------------------
67      INTEGER  ::   ji, jj, jk   ! dummy loop indices
68      INTEGER  ::   ikt, ikb 
69      REAL(wp), DIMENSION(jpi,jpj) :: zqvol,ztmp
70      !!----------------------------------------------------------------------
71      !
72      !==   fwf distributed over several levels   ==!
73      !
74      ! compute integrated divergence correction
75      zqvol(:,:) = 0.5_wp * ( pfwf(:,:) + pfwf_b(:,:) ) * r1_rau0 / phtbl(:,:)
76      !
77      ! update divergence at each level affected by ice shelf top boundary layer
78      DO jj = 1,jpj
79         DO ji = 1,jpi
80               ikt = ktop(ji,jj)
81               ikb = kbot(ji,jj)
82               ! level fully include in the ice shelf boundary layer
83               DO jk = ikt, ikb - 1
84                  phdiv(ji,jj,jk) = phdiv(ji,jj,jk) + zqvol(ji,jj)
85               END DO
86               ! level partially include in ice shelf boundary layer
87               phdiv(ji,jj,ikb) = phdiv(ji,jj,ikb) + zqvol(ji,jj) * pfrac(ji,jj)
88         END DO
89      END DO
90      !
91   END SUBROUTINE isf_hdiv_mlt
92
93   SUBROUTINE isf_hdiv_cpl(pqvol, phdiv)
94      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phdiv
95      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pqvol
96   
97   INTEGER :: jk
98     
99      DO jk=1,jpk 
100         phdiv(:,:,jk) =  phdiv(:,:,jk) + pqvol(:,:,jk) * r1_e1e2t(:,:) / e3t_n(:,:,jk)
101      END DO
102
103   END SUBROUTINE
104
105END MODULE isfhdiv
Note: See TracBrowser for help on using the repository browser.