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

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

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

ENHANCE-02_ISF_nemo : add comments, renaming file (AGRIF), add isfload module (ticket #2142)
File size: 11.7 KB
Line 
1MODULE isftbl
2   !!======================================================================
3   !!                       ***  MODULE  isftbl  ***
4   !! isftbl module :  compute properties of top boundary layer
5   !!======================================================================
6   !! History :  4.1  !  2019-09  (P. Mathiot) original code
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   isftbl       : routine to compute :
11   !!                  - geometry of the ice shelf tbl (isf_tbl_lvl, isftbl_ktop, isftbl_kbot)
12   !!                    (top and bottom level, thickness and fraction of deepest level affected)
13   !!                  - tbl averaged properties (isf_tbl, isf_tbl_avg)
14   !!----------------------------------------------------------------------
15
16   USE dom_oce ! vertical scale factor
17   USE lbclnk  ! lbc_lnk subroutine
18
19   IMPLICIT NONE
20
21   PRIVATE
22
23   PUBLIC isf_tbl, isf_tbl_avg, isf_tbl_lvl, isftbl_ktop, isftbl_kbot
24
25CONTAINS
26
27   SUBROUTINE isf_tbl( pvarin, pvarout, cd_ptin, ktop, kbot, phtbl, pfrac )
28      !!--------------------------------------------------------------------
29      !!                  ***  SUBROUTINE isf_tbl  ***
30      !!
31      !! ** Purpose : compute mean T/S/U/V in the boundary layer at T- point
32      !!
33      !!--------------------------------------------------------------------
34      !!-------------------------- OUT -------------------------------------
35      REAL(wp), DIMENSION(jpi,jpj)          , INTENT(  out) :: pvarout ! 2d average of pvarin
36      !!-------------------------- IN  -------------------------------------
37      CHARACTER(len=1)                      , INTENT(in   ) :: cd_ptin       ! point of variable in/out
38      REAL(wp), DIMENSION(jpi,jpj,jpk)      , INTENT(in   ) :: pvarin        ! 3d variable to average over the tbl
39      !!-------------------------- IN OPTIONAL -----------------------------
40      INTEGER,  DIMENSION(jpi,jpj), OPTIONAL, INTENT(in   ) :: ktop , kbot   ! top and bottom level
41      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in   ) :: phtbl, pfrac  ! tbl thickness and fraction of bottom cell affected
42      !!--------------------------------------------------------------------
43      INTEGER ::   ji, jj                   ! loop index
44      INTEGER , DIMENSION(jpi,jpj) :: iktbl ! bottom level of the tbl
45      REAL(wp), DIMENSION(jpi,jpj) :: zhtbl ! thickness of the tbl
46      REAL(wp), DIMENSION(jpi,jpj) :: zfrac ! thickness of the tbl
47      !!--------------------------------------------------------------------
48      !
49      SELECT CASE ( cd_ptin )
50      CASE ( 'U' )
51         !
52         ! compute tbl lvl/h
53         CALL isf_tbl_lvl( hu_n, e3u_n, miku, iktbl, zhtbl, zfrac )
54         !
55         ! compute tbl property at U point
56         CALL isf_tbl_avg( miku, iktbl, zhtbl, zfrac, e3u_n, pvarin, pvarout )
57         !
58         ! compute tbl property at T point
59         DO jj = 1, jpj
60            DO ji = 2, jpi
61               pvarout(ji,jj) = 0.5_wp * (pvarout(ji,jj) + pvarout(ji-1,jj))
62            END DO
63         END DO
64         !
65         ! check if needed (probably yes)
66         CALL lbc_lnk('sbcisf', pvarout,'T',-1.)
67         !
68      CASE ( 'V' )
69         !
70         ! compute tbl lvl/h
71         CALL isf_tbl_lvl( hv_n, e3v_n, mikv, iktbl, zhtbl, zfrac )
72         !
73         ! compute tbl property at V point
74         CALL isf_tbl_avg( mikv, iktbl, zhtbl, zfrac, e3v_n, pvarin, pvarout )
75         !
76         ! pvarout is an averaging of wet point
77         DO jj = 2, jpj
78            DO ji = 1, jpi
79               pvarout(ji,jj) = 0.5_wp * (pvarout(ji,jj) + pvarout(ji,jj-1))
80            END DO
81         END DO
82         !
83         ! check if needed (probably yes)
84         CALL lbc_lnk('sbcisf', pvarout,'T',-1.)
85         !
86      CASE ( 'T' )
87         !
88         ! compute tbl property at T point
89         CALL isf_tbl_avg( ktop, kbot, phtbl, pfrac, e3t_n, pvarin, pvarout )
90         !
91      END SELECT
92      !
93      ! mask mean tbl value
94      pvarout(:,:) = pvarout(:,:) * ssmask(:,:)
95      !
96   END SUBROUTINE isf_tbl
97
98   SUBROUTINE isf_tbl_avg( ktop, kbot, phtbl, pfrac, pe3, pvarin, pvarout )
99      !!--------------------------------------------------------------------
100      !!                  ***  ROUTINE isf_tbl_lvl  ***
101      !!
102      !! ** Purpose : compute mean property in the boundary layer
103      !!
104      !! ** Method  : Depth average is made between the top level ktop and the bottom level kbot
105      !!              over a thickness phtbl. The bottom level is partially counted (pfrac).
106      !!
107      !!--------------------------------------------------------------------
108      !!-------------------------- OUT -------------------------------------
109      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(  out) :: pvarout      ! tbl property averaged over phtbl between level ktop and kbot
110      !!-------------------------- IN  -------------------------------------
111      INTEGER,  DIMENSION(jpi,jpj)    , INTENT(in   ) :: ktop, kbot   ! top and bottom level of the top boundary layer
112      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   ) :: phtbl, pfrac ! fraction of bottom level to be affected by the tbl
113      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pe3          ! vertical scale factor
114      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pvarin       ! tbl property to average between ktop, kbot over phtbl
115      !!--------------------------------------------------------------------
116      INTEGER  :: ji,jj,jk                    ! loop indices
117      INTEGER  :: ikt, ikb                    ! top and bottom levels
118      !!--------------------------------------------------------------------
119      !
120      ! compute tbl top.bottom level and thickness
121      DO jj = 1,jpj
122         DO ji = 1,jpi
123            !
124            ! tbl top/bottom indices initialisation
125            ikt = ktop(ji,jj) ; ikb = kbot(ji,jj)
126            !
127            ! level fully include in the ice shelf boundary layer
128            pvarout(ji,jj) = SUM( pvarin(ji,jj,ikt:ikb-1) * pe3(ji,jj,ikt:ikb-1) ) / phtbl(ji,jj)
129            !
130            ! level partially include in ice shelf boundary layer
131            pvarout(ji,jj) = pvarout(ji,jj) + pvarin(ji,jj,ikb) * pe3(ji,jj,ikb) / phtbl(ji,jj) * pfrac(ji,jj)
132            !
133         END DO
134      END DO
135
136   END SUBROUTINE isf_tbl_avg
137
138   SUBROUTINE isf_tbl_lvl( phw, pe3, ktop, kbot, phtbl, pfrac )
139      !!--------------------------------------------------------------------
140      !!                  ***  ROUTINE isf_tbl_lvl  ***
141      !!
142      !! ** Purpose : - compute bottom level fully included in the top boundary layer
143      !!              - thickness of the top boundary layer
144      !!
145      !!--------------------------------------------------------------------
146      !!-------------------------- OUT -------------------------------------
147      INTEGER,  DIMENSION(jpi,jpj)    , INTENT(  out) :: kbot   ! bottom level of the top boundary layer
148      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(  out) :: phtbl  ! top boundary layer thickness
149      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(  out) :: pfrac  ! top boundary layer thickness
150      !!-------------------------- IN  -------------------------------------
151      INTEGER,  DIMENSION(jpi,jpj)    , INTENT(in   ) :: ktop   ! top level of the top boundary layer
152      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   ) :: phw    ! water column thickness
153      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pe3    ! vertical scale factor
154      !!---------------------------------------------------------------------
155      INTEGER :: ji,jj,jk
156      INTEGER :: ikt, ikb
157      !!---------------------------------------------------------------------
158      !
159      ! get htbl
160      DO jj = 1,jpj
161         DO ji = 1,jpi
162            !
163            ! tbl top/bottom indices initialisation
164            ikt = ktop(ji,jj)
165            !
166            ! limit the tbl to water thickness.
167            phtbl(ji,jj) = MIN( phtbl(ji,jj), phw(ji,jj) )
168            !
169            ! thickness of boundary layer must be at least the top level thickness
170            phtbl(ji,jj) = MAX( phtbl(ji,jj), pe3(ji,jj,ikt) )
171            !
172         END DO
173      END DO
174      !
175      ! get ktbl
176      CALL isftbl_kbot(ktop, phtbl, pe3, kbot)
177      !
178      ! get pfrac
179      DO jj = 1,jpj
180         DO ji = 1,jpi
181            !
182            ! tbl top/bottom indices initialisation
183            ikt = ktop(ji,jj) ; ikb = kbot(ji,jj)
184            !
185            ! proportion of the bottom cell included in ice shelf boundary layer
186            pfrac(ji,jj) = ( phtbl(ji,jj) - SUM( pe3(ji,jj,ikt:ikb-1) ) ) / pe3(ji,jj,ikb)
187            !
188         END DO
189      END DO
190      !
191   END SUBROUTINE isf_tbl_lvl
192   !
193   SUBROUTINE isftbl_kbot(ktop, phtbl, pe3, kbot)
194      !!--------------------------------------------------------------------
195      !!                  ***  ROUTINE isf_tbl_lvl  ***
196      !!
197      !! ** Purpose : compute bottom level of the isf top boundary layer
198      !!
199      !!--------------------------------------------------------------------
200      !!-------------------------- OUT -------------------------------------
201      INTEGER,  DIMENSION(jpi,jpj)    , INTENT(  out) :: kbot   ! bottom level of the top boundary layer
202      !!-------------------------- IN  -------------------------------------
203      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   ) :: phtbl  ! top boundary layer thickness
204      INTEGER,  DIMENSION(jpi,jpj)    , INTENT(in   ) :: ktop   ! top level of the top boundary layer
205      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pe3    ! vertical scale factor
206      !!--------------------------------------------------------------------
207      INTEGER :: ji, jj
208      INTEGER :: ikt, ikb
209      !!--------------------------------------------------------------------
210      !
211      ! phtbl need to be bounded by water column thickness before
212      ! test: if phtbl = water column thickness, should return mbathy
213      ! test: if phtbl = 0 should return ktop
214      !
215      ! get ktbl
216      DO jj = 1,jpj
217         DO ji = 1,jpi
218            !
219            ! determine the deepest level influenced by the boundary layer
220            ikt = ktop(ji,jj)
221            ikb = ikt
222            DO WHILE ( SUM(pe3(ji,jj,ikt:ikb-1)) < phtbl(ji,jj ) ) ;  ikb = ikb + 1 ;  END DO
223            kbot(ji,jj) = ikb - 1
224            !
225         END DO
226      END DO
227      !
228   END SUBROUTINE isftbl_kbot
229      !
230   SUBROUTINE isftbl_ktop(pdep, ktop)
231      !!--------------------------------------------------------------------
232      !!                  ***  ROUTINE isf_tbl_lvl  ***
233      !!
234      !! ** Purpose : compute top level of the isf top boundary layer in case of an ice shelf parametrisation
235      !!
236      !!--------------------------------------------------------------------
237      !!-------------------------- OUT -------------------------------------
238      INTEGER,  DIMENSION(jpi,jpj), INTENT(  out) :: ktop        ! top level affected by the ice shelf parametrisation
239      !!-------------------------- IN  -------------------------------------
240      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pdep        ! top depth of the parametrisation influence
241      !!--------------------------------------------------------------------
242      INTEGER :: ji,jj
243      INTEGER :: ikt
244      !!--------------------------------------------------------------------
245      !
246      ! compute top level (need to be recomputed each time (z*, z~)
247      ! be sure pdep is already correctly bounded
248      ! test: this routine run on isfdraft should return mikt
249      ! test: this routine run with pdep = 0 should return 1
250      !
251      DO ji = 1, jpi
252         DO jj = 1, jpj
253            ikt = 2
254            DO WHILE ( gdepw_n(ji,jj,ikt) <= pdep(ji,jj ) ) ;  ikt = ikt + 1 ;  END DO
255            ktop(ji,jj) = ikt - 1
256         END DO
257      END DO
258      !
259   END SUBROUTINE isftbl_ktop
260
261END MODULE isftbl
Note: See TracBrowser for help on using the repository browser.