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.
isfload.F90 in NEMO/trunk/src/OCE/ISF – NEMO

source: NEMO/trunk/src/OCE/ISF/isfload.F90 @ 13295

Last change on this file since 13295 was 13295, checked in by acc, 4 years ago

Replace do-loop macros in the trunk with alternative forms with greater flexibility for extra halo applications. This alters a lot of routines but does not change any behaviour or results. do_loop_substitute.h90 is greatly simplified by this change. SETTE results are identical to those with the previous revision

File size: 5.5 KB
RevLine 
[11403]1MODULE isfload
2   !!======================================================================
3   !!                       ***  MODULE  isfload  ***
4   !! isfload module :  compute ice shelf load (needed for the hpg)
5   !!======================================================================
6   !! History :  4.1  !  2019-09  (P. Mathiot) original code
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   isfload      : compute ice shelf load
11   !!----------------------------------------------------------------------
12
[12077]13   USE isf_oce, ONLY: cn_isfload, rn_isfload_T, rn_isfload_S ! ice shelf variables
[11852]14
[13237]15   USE dom_oce                                      ! vertical scale factor
[11852]16   USE eosbn2 , ONLY: eos                           ! eos routine
17
[12077]18   USE lib_mpp, ONLY: ctl_stop                               ! ctl_stop routine
19   USE in_out_manager                                        !
[11403]20
21   IMPLICIT NONE
22
23   PRIVATE
24
25   PUBLIC isf_load
[12340]26   !! * Substitutions
27#  include "do_loop_substitute.h90"
[13237]28#  include "domzgr_substitute.h90"
[11403]29
30CONTAINS
31
[12068]32   SUBROUTINE isf_load ( Kmm, pisfload )
[11403]33      !!--------------------------------------------------------------------
34      !!                  ***  SUBROUTINE isf_load  ***
35      !!
36      !! ** Purpose : compute the ice shelf load
37      !!
38      !!--------------------------------------------------------------------
39      !!-------------------------- OUT -------------------------------------
40      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pisfload
41      !!-------------------------- IN  -------------------------------------
[12068]42      INTEGER,                      INTENT(in)    :: Kmm           ! ocean time level index
[11403]43      !!----------------------------------------------------------------------
44      !
45      ! quality test: ice shelf in a stratify/uniform ocean should not drive any flow.
46      !               the smaller the residual flow is, the better it is.
47      !
48      ! ice shelf cavity
49      SELECT CASE ( cn_isfload )
[12077]50      CASE ( 'uniform' )
51         CALL isf_load_uniform ( Kmm, pisfload )
[11403]52      CASE DEFAULT
53         CALL ctl_stop('STOP','method cn_isfload to compute ice shelf load does not exist (isomip), check your namelist')
54      END SELECT
55      !
56   END SUBROUTINE isf_load
57
[12077]58   SUBROUTINE isf_load_uniform( Kmm, pisfload )
[11403]59      !!--------------------------------------------------------------------
60      !!                  ***  SUBROUTINE isf_load  ***
61      !!
62      !! ** Purpose : compute the ice shelf load
63      !!
64      !! ** Method  : The ice shelf is assumed to be in hydro static equilibrium
65      !!              in water at -1.9 C and 34.4 PSU. Weight of the ice shelf is
66      !!              integrated from top to bottom.
67      !!
68      !!--------------------------------------------------------------------
69      !!-------------------------- OUT -------------------------------------
70      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: pisfload
71      !!-------------------------- IN  -------------------------------------
[12068]72      INTEGER,                      INTENT(in)    :: Kmm           ! ocean time level index
[11403]73      !!--------------------------------------------------------------------
74      INTEGER  :: ji, jj, jk
75      INTEGER  :: ikt
76      REAL(wp)                          :: znad        !
77      REAL(wp), DIMENSION(jpi,jpj)      :: zrhdtop_isf ! water density    displaced by the ice shelf (at the interface)
78      REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts_top     ! water properties displaced by the ice shelf   
79      REAL(wp), DIMENSION(jpi,jpj,jpk)  :: zrhd        ! water density    displaced by the ice shelf
80      !!----------------------------------------------------------------------
81      !
82      znad = 1._wp                     !- To use density and not density anomaly
83      !
[12077]84      !                                !- assume water displaced by the ice shelf is at T=rn_isfload_T and S=rn_isfload_S (rude)
85      zts_top(:,:,jp_tem) = rn_isfload_T   ;   zts_top(:,:,jp_sal) = rn_isfload_S
[11403]86      !
87      DO jk = 1, jpk                   !- compute density of the water displaced by the ice shelf
[12068]88         CALL eos( zts_top(:,:,:), gdept(:,:,jk,Kmm), zrhd(:,:,jk) )
[11403]89      END DO
90      !
91      !                                !- compute rhd at the ice/oce interface (ice shelf side)
92      CALL eos( zts_top , risfdep, zrhdtop_isf )
93      !
94      !                                !- Surface value + ice shelf gradient
[11852]95      pisfload(:,:) = 0._wp                       ! compute pressure due to ice shelf load
[13295]96      DO_2D( 1, 1, 1, 1 )
[12340]97         ikt = mikt(ji,jj)
98         !
99         IF ( ikt > 1 ) THEN
[11403]100            !
[12340]101            ! top layer of the ice shelf
[13237]102            pisfload(ji,jj) = pisfload(ji,jj) + (znad + zrhd(ji,jj,1) )   &
103               &                                * e3w(ji,jj,1,Kmm)
[12340]104            !
105            ! core layers of the ice shelf
106            DO jk = 2, ikt-1
[13237]107               pisfload(ji,jj) = pisfload(ji,jj) + (2._wp * znad + zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk))   &
108                  &                                * e3w(ji,jj,jk,Kmm)
[12340]109            END DO
110            !
111            ! deepest part of the ice shelf (between deepest T point and ice/ocean interface
112            pisfload(ji,jj) = pisfload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + zrhd(ji,jj,ikt-1)) &
113               &                                              * ( risfdep(ji,jj) - gdept(ji,jj,ikt-1,Kmm) )
114            !
115         END IF
116      END_2D
[11403]117      !
[12077]118   END SUBROUTINE isf_load_uniform
[11403]119
120END MODULE isfload
Note: See TracBrowser for help on using the repository browser.