ROMS
Loading...
Searching...
No Matches
ice_enthalpy.F
Go to the documentation of this file.
1#include "cppdefs.h"
3
4#ifdef ICE_MODEL
5!
6!git $Id$
7!=======================================================================
8! Copyright (c) 2002-2025 The ROMS Group !
9! Licensed under a MIT/X style license W. Paul Budgell !
10! See License_ROMS.md Katherine Hedstrom !
11!================================================== Hernan G. Arango ===
12! !
13! This routine computes the ice enthalpy (ti*hi) prior to advection. !
14! !
15!=======================================================================
16!
17 USE mod_param
18 USE mod_ice
19 USE mod_scalars
20!
22#ifdef DISTRIBUTE
24#endif
25!
26 implicit none
27!
28 PRIVATE
29 PUBLIC ice_enthalpy
30!
31 CONTAINS
32!
33!***********************************************************************
34 SUBROUTINE ice_enthalpy (ng, tile, model)
35!***********************************************************************
36!
37 USE mod_stepping
38!
39! Imported variable declarations.
40!
41 integer, intent(in) :: ng, tile, model
42!
43! Local variable declarations.
44!
45 character (len=*), parameter :: MyFile = &
46 & __FILE__
47!
48#include "tile.h"
49!
50# ifdef PROFILE
51 CALL wclock_on (ng, model, 42, __line__, myfile)
52# endif
53 CALL ice_enthalpy_tile (ng, tile, model, &
54 & lbi, ubi, lbj, ubj, &
55 & imins, imaxs, jmins, jmaxs, &
56 & liold(ng), linew(ng), &
57 & ice(ng)%Si)
58# ifdef PROFILE
59 CALL wclock_off (ng, model, 42, __line__, myfile)
60# endif
61!
62 RETURN
63 END SUBROUTINE ice_enthalpy
64!
65!***********************************************************************
66 SUBROUTINE ice_enthalpy_tile (ng, tile, model, &
67 & LBi, UBi, LBj, UBj, &
68 & IminS, ImaxS, JminS, JmaxS, &
69 & liold, linew, &
70 & Si)
71!***********************************************************************
72!
73! Imported variable declarations.
74!
75 integer, intent(in) :: ng, tile, model
76 integer, intent(in) :: LBi, UBi, LBj, UBj
77 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
78 integer, intent(in) :: liold, linew
79!
80#ifdef ASSUMED_SHAPE
81 real(r8), intent(inout) :: Si(LBi:,LBj:,:,:)
82#else
83 real(r8), intent(inout) :: Si(LBi:UBi,LBj:UBj,2,nIceS)
84#endif
85!
86! Local variables
87!
88 integer :: i, j
89
90#include "set_bounds.h"
91!
92!-----------------------------------------------------------------------
93! Computes the ice enthalpy.
94!-----------------------------------------------------------------------
95!
96 DO j=jstrt,jendt
97 DO i=istrt,iendt
98 si(i,j,liold,isenth)=si(i,j,liold,ishice)* &
99 & si(i,j,liold,istice)
100 si(i,j,linew,isenth)=si(i,j,linew,ishice)* &
101 & si(i,j,linew,istice)
102 IF(si(i,j,liold,ishice).le.min_hi(ng)) THEN
103 si(i,j,liold,isenth)=0.0_r8
104 END IF
105 END DO
106 END DO
107!
108! Exchange boundary data.
109!
110 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
111 CALL exchange_r2d_tile (ng, tile, &
112 & lbi, ubi, lbj, ubj, &
113 & si(:,:,liold,isenth))
114
115 CALL exchange_r2d_tile (ng, tile, &
116 & lbi, ubi, lbj, ubj, &
117 & si(:,:,linew,isenth))
118 END IF
119
120# ifdef DISTRIBUTE
121!
122 CALL mp_exchange2d (ng, tile, model, 2, &
123 & lbi, ubi, lbj, ubj, &
124 & nghostpoints, ewperiodic(ng), nsperiodic(ng), &
125 & si(:,:,liold,isenth), &
126 & si(:,:,linew,isenth))
127# endif
128!
129 RETURN
130 END SUBROUTINE ice_enthalpy_tile
131#endif
132 END MODULE ice_enthalpy_mod
subroutine exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
real(r8), dimension(:), allocatable min_hi
Definition ice_mod.h:246
integer, parameter isenth
Definition ice_mod.h:148
type(t_ice), dimension(:), allocatable ice
Definition ice_mod.h:283
integer, parameter istice
Definition ice_mod.h:145
integer, parameter ishice
Definition ice_mod.h:138
integer nghostpoints
Definition mod_param.F:710
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
recursive subroutine wclock_off(ng, model, region, line, routine)
Definition timers.F:148
recursive subroutine wclock_on(ng, model, region, line, routine)
Definition timers.F:3