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 @ 11521

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

ENHANCE-02_ISF: fix issue with ice sheet coupling and conservation + other minor changes (ticket #2142)

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