/[MITgcm]/MITgcm_contrib/ksnow/press_release/code/ini_nlfs_vars.F
ViewVC logotype

Annotation of /MITgcm_contrib/ksnow/press_release/code/ini_nlfs_vars.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.1 - (hide annotations) (download)
Tue Jul 11 13:42:34 2017 UTC (8 years, 5 months ago) by dgoldberg
Branch: MAIN
CVS Tags: HEAD 
prevent digging with grounded ice
1 dgoldberg 1.1 C $Header: /u/gcmpack/MITgcm/model/src/ini_nlfs_vars.F,v 1.10 2014/04/29 21:07:39 jmc Exp $
2     C $Name: $
3    
4     #include "PACKAGES_CONFIG.h"
5     #include "CPP_OPTIONS.h"
6     #ifdef ALLOW_SHELFICE
7     # include "SHELFICE_OPTIONS.h"
8     #endif
9    
10    
11     CBOP
12     C !ROUTINE: INI_NLFS_VARS
13     C !INTERFACE:
14     SUBROUTINE INI_NLFS_VARS( myThid )
15     C !DESCRIPTION: \bv
16     C *==========================================================*
17     C | SUBROUTINE INI_NLFS_VARS
18     C | o Initialise variables for Non-Linear Free-Surface
19     C | formulations (formerly INI_SURF_DR & INI_R_STAR)
20     C *==========================================================*
21     C \ev
22    
23     C !USES:
24     IMPLICIT NONE
25     C == Global variables
26     #include "SIZE.h"
27     #include "EEPARAMS.h"
28     #include "PARAMS.h"
29     #include "GRID.h"
30     #include "SURFACE.h"
31    
32     C !INPUT/OUTPUT PARAMETERS:
33     C == Routine arguments ==
34     C myThid :: my Thread Id. number
35     INTEGER myThid
36    
37     C !LOCAL VARIABLES:
38     C Local variables
39     C i,j,k,bi,bj :: loop counter
40     INTEGER bi,bj
41     #ifdef NONLIN_FRSURF
42     INTEGER i, j
43     INTEGER k, ks
44     _RL hFacInfMOM, Rmin_tmp
45     #else /* NONLIN_FRSURF */
46     # ifdef EXACT_CONSERV
47     INTEGER i, j
48     # endif
49     #endif /* NONLIN_FRSURF */
50     CEOP
51    
52     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
53    
54     #ifdef ALLOW_DEBUG
55     IF (debugMode) CALL DEBUG_ENTER('INI_NLFS_VARS',myThid)
56     #endif
57    
58     DO bj=myByLo(myThid), myByHi(myThid)
59     DO bi=myBxLo(myThid), myBxHi(myThid)
60     C- 1rst bi,bj loop :
61    
62     #ifdef EXACT_CONSERV
63     C-- Initialise arrays (defined within ifdef EXACT_CONSERV):
64     C note: should be done elsewhere, outside ifdef NONLIN_FRSURF bloc
65     DO j=1-OLy,sNy+OLy
66     DO i=1-OLx,sNx+OLx
67     etaHnm1(i,j,bi,bj) = 0.
68     dEtaHdt(i,j,bi,bj) = 0.
69     PmEpR (i,j,bi,bj) = 0.
70     ENDDO
71     ENDDO
72     #endif /* EXACT_CONSERV */
73    
74     #ifdef NONLIN_FRSURF
75     C-- Initialise arrays (NLFS using r-coordinate):
76     DO j=1-OLy,sNy+OLy
77     DO i=1-OLx,sNx+OLx
78     hFac_surfC(i,j,bi,bj) = 0.
79     hFac_surfW(i,j,bi,bj) = 0.
80     hFac_surfS(i,j,bi,bj) = 0.
81     hFac_surfNm1C(i,j,bi,bj) = 0.
82     hFac_surfNm1W(i,j,bi,bj) = 0.
83     hFac_surfNm1S(i,j,bi,bj) = 0.
84     Rmin_surf(i,j,bi,bj) = Ro_surf(i,j,bi,bj)
85     ENDDO
86     ENDDO
87    
88     C-- Initialise arrays (NLFS using r* coordinate):
89     DO j=1-OLy,sNy+OLy
90     DO i=1-OLx,sNx+OLx
91     rStarFacC(i,j,bi,bj) = 1.
92     rStarFacW(i,j,bi,bj) = 1.
93     rStarFacS(i,j,bi,bj) = 1.
94     pStarFacK(i,j,bi,bj) = 1.
95     rStarFacNm1C(i,j,bi,bj) = 1.
96     rStarFacNm1W(i,j,bi,bj) = 1.
97     rStarFacNm1S(i,j,bi,bj) = 1.
98     rStarExpC(i,j,bi,bj) = 1.
99     rStarExpW(i,j,bi,bj) = 1.
100     rStarExpS(i,j,bi,bj) = 1.
101     rStarDhCDt(i,j,bi,bj) = 0.
102     rStarDhWDt(i,j,bi,bj) = 0.
103     rStarDhSDt(i,j,bi,bj) = 0.
104     ENDDO
105     ENDDO
106    
107     C-- Initialise arrays (NLFS using hybrid sigma-coordinate):
108     DO j=1-OLy,sNy+OLy
109     DO i=1-OLx,sNx+OLx
110     etaHw (i,j,bi,bj) = 0.
111     etaHs (i,j,bi,bj) = 0.
112     dEtaWdt(i,j,bi,bj) = 0.
113     dEtaSdt(i,j,bi,bj) = 0.
114     ENDDO
115     ENDDO
116    
117     C-- to make TAF happy: reset hFac to h0Fac (copied from hFac in ini_linear_phisurf)
118     DO k=1,Nr
119     DO j=1-OLy,sNy+OLy
120     DO i=1-OLx,sNx+OLx
121     hFacC(i,j,k,bi,bj) = h0FacC(i,j,k,bi,bj)
122     hFacW(i,j,k,bi,bj) = h0FacW(i,j,k,bi,bj)
123     hFacS(i,j,k,bi,bj) = h0FacS(i,j,k,bi,bj)
124     ENDDO
125     ENDDO
126     ENDDO
127     #endif /* NONLIN_FRSURF */
128    
129     C- end 1rst bi,bj loop.
130     ENDDO
131     ENDDO
132    
133     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
134     #ifdef NONLIN_FRSURF
135    
136     hFacInfMOM = hFacInf
137    
138     DO bj=myByLo(myThid), myByHi(myThid)
139     DO bi=myBxLo(myThid), myBxHi(myThid)
140    
141     C-- Compute the mimimum value of r_surf (used for computing hFac_surfC)
142     DO j=1,sNy
143     DO i=1,sNx
144     ks = kSurfC(i,j,bi,bj)
145     IF (ks.LE.Nr) THEN
146     Rmin_tmp = rF(ks+1)
147     IF ( ks.EQ.kSurfW(i,j,bi,bj))
148     & Rmin_tmp = MAX(Rmin_tmp, R_low(i-1,j,bi,bj))
149     IF ( ks.EQ.kSurfW(i+1,j,bi,bj))
150     & Rmin_tmp = MAX(Rmin_tmp, R_low(i+1,j,bi,bj))
151     IF ( ks.EQ.kSurfS(i,j,bi,bj))
152     & Rmin_tmp = MAX(Rmin_tmp, R_low(i,j-1,bi,bj))
153     IF ( ks.EQ.kSurfS(i,j+1,bi,bj))
154     & Rmin_tmp = MAX(Rmin_tmp, R_low(i,j+1,bi,bj))
155    
156     #if defined(ALLOW_SHELFICE) && defined(ALLOW_SHELFICE_GROUNDED_ICE)
157     Rmin_surf(i,j,bi,bj) =
158     & MAX(rF(ks+1),R_low(i,j,bi,bj)) + hFacInf*drF(ks)
159     #else
160     Rmin_surf(i,j,bi,bj) =
161     & MAX( MAX(rF(ks+1),R_low(i,j,bi,bj)) + hFacInf*drF(ks),
162     & Rmin_tmp + hFacInfMOM*drF(ks)
163     & )
164     #endif
165     ENDIF
166     ENDDO
167     ENDDO
168    
169     C- end bi,bj loop.
170     ENDDO
171     ENDDO
172    
173     CALL EXCH_XY_RL( Rmin_surf, myThid )
174    
175     #endif /* NONLIN_FRSURF */
176     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
177    
178     #ifdef ALLOW_DEBUG
179     IF (debugMode) CALL DEBUG_LEAVE('INI_NLFS_VARS',myThid)
180     #endif
181    
182     RETURN
183     END
  ViewVC Help
Powered by ViewVC 1.1.22