/[MITgcm]/MITgcm/model/src/update_etah.F
ViewVC logotype

Contents of /MITgcm/model/src/update_etah.F

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


Revision 1.11 - (show annotations) (download)
Wed Apr 27 22:20:22 2011 UTC (13 years, 1 month ago) by jmc
Branch: MAIN
CVS Tags: checkpoint62x
Changes since 1.10: +2 -2 lines
switch type of array PmEpR from _RS to _RL (but line is commented out)

1 C $Header: /u/gcmpack/MITgcm/model/src/update_etah.F,v 1.10 2010/09/11 21:27:13 jmc Exp $
2 C $Name: $
3
4 #include "PACKAGES_CONFIG.h"
5 #include "CPP_OPTIONS.h"
6
7 CBOP
8 C !ROUTINE: UPDATE_ETAH
9 C !INTERFACE:
10 SUBROUTINE UPDATE_ETAH( myTime, myIter, myThid )
11 C !DESCRIPTION: \bv
12 C *==========================================================*
13 C | SUBROUTINE UPDATE_ETAH
14 C | o Update etaH at the begining of the time step.
15 C | (required with NLFS to derive surface layer thickness)
16 C *==========================================================*
17 C \ev
18
19 C !USES:
20 IMPLICIT NONE
21 C == Global variables
22 #include "SIZE.h"
23 #include "EEPARAMS.h"
24 #include "PARAMS.h"
25 #include "DYNVARS.h"
26 #include "GRID.h"
27 #include "SURFACE.h"
28 #include "FFIELDS.h"
29
30 C !INPUT/OUTPUT PARAMETERS:
31 C == Routine arguments ==
32 C myTime :: Current time in simulation
33 C myIter :: Current iteration number in simulation
34 C myThid :: Thread number for this instance of the routine.
35 _RL myTime
36 INTEGER myIter
37 INTEGER myThid
38
39 C !LOCAL VARIABLES:
40 #ifdef EXACT_CONSERV
41 C Local variables in common block
42
43 C Local variables
44 C i,j,bi,bj :: Loop counters
45 INTEGER i,j,bi,bj
46 CEOP
47
48
49 DO bj=myByLo(myThid),myByHi(myThid)
50 DO bi=myBxLo(myThid),myBxHi(myThid)
51
52 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
53
54 C-- before updating etaH, save current etaH field in etaHnm1
55 DO j=1-Oly,sNy+Oly
56 DO i=1-Olx,sNx+Olx
57 etaHnm1(i,j,bi,bj) = etaH(i,j,bi,bj)
58 ENDDO
59 ENDDO
60
61 C-- Update etaH at the end of the time step :
62 C Incorporate the Explicit part of -Divergence(Barotropic_Flow)
63
64 IF (implicDiv2Dflow.EQ. 1. _d 0) THEN
65 DO j=1-Oly,sNy+Oly
66 DO i=1-Olx,sNx+Olx
67 etaH(i,j,bi,bj) = etaN(i,j,bi,bj)
68 ENDDO
69 ENDDO
70
71 ELSE
72 DO j=1,sNy
73 DO i=1,sNx
74 etaH(i,j,bi,bj) = etaN(i,j,bi,bj)
75 & + (1. - implicDiv2Dflow)*dEtaHdt(i,j,bi,bj)
76 & *deltaTfreesurf
77 ENDDO
78 ENDDO
79 ENDIF
80
81 #ifdef ALLOW_OBCS
82 C- note (with Non-Lin Free-Surface):
83 C 1) needs to apply OBC to etaH since viscous terms depend on hFacZ.
84 C that is not only function of boundaries hFac values.
85 C 2) has to be done before calc_surf_dr; but since obcs_calc is
86 C called later, hFacZ will lag 1 time step behind OBC update.
87 C 3) avoid also unrealistic value of etaH in OB regions that
88 C might produce many "WARNING" message from calc_surf_dr.
89 C-------
90 C-- Apply OBC to etaH if NonLin-FreeSurf, reset to zero otherwise:
91 IF ( useOBCS ) CALL OBCS_APPLY_ETA( bi, bj, etaH, myThid )
92 #endif /* ALLOW_OBCS */
93
94 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
95
96 C- end bi,bj loop.
97 ENDDO
98 ENDDO
99
100 IF (implicDiv2Dflow .NE. 1. _d 0 .OR. useOBCS )
101 & CALL EXCH_XY_RL( etaH, myThid )
102
103 c IF (useRealFreshWaterFlux .AND. myTime.EQ.startTime)
104 c & _EXCH_XY_RL( PmEpR, myThid )
105
106 #ifdef NONLIN_FRSURF
107 # ifndef DISABLE_SIGMA_CODE
108 IF ( nonlinFreeSurf.GT.0 .AND. selectSigmaCoord.NE.0 ) THEN
109
110 DO bj=myByLo(myThid),myByHi(myThid)
111 DO bi=myBxLo(myThid),myBxHi(myThid)
112 C- 2nd bi,bj loop :
113
114 C-- copy etaHX -> dEtaXdt
115 DO j=1-Oly,sNy+Oly
116 DO i=1-Olx,sNx+Olx
117 dEtaWdt(i,j,bi,bj) = etaHw(i,j,bi,bj)
118 dEtaSdt(i,j,bi,bj) = etaHs(i,j,bi,bj)
119 ENDDO
120 ENDDO
121
122 DO j=1,sNy+1
123 DO i=1,sNx+1
124 etaHw(i,j,bi,bj) = ( etaH (i-1,j,bi,bj)
125 & + etaH ( i ,j,bi,bj) )*0.5 _d 0
126 etaHs(i,j,bi,bj) = ( etaH (i,j-1,bi,bj)
127 & + etaH (i, j ,bi,bj) )*0.5 _d 0
128 c etaHw(i,j,bi,bj) = 0.5 _d 0
129 c & *( etaH (i-1,j,bi,bj)*rA(i-1,j,bi,bj)
130 c & + etaH ( i ,j,bi,bj)*rA( i ,j,bi,bj)
131 c & )*recip_rAw(i,j,bi,bj)
132 c etaHs(i,j,bi,bj) = 0.5 _d 0
133 c & *( etaH (i,j-1,bi,bj)*rA(i,j-1,bi,bj)
134 c & + etaH (i, j ,bi,bj)*rA(i, j ,bi,bj)
135 c & )*recip_rAs(i,j,bi,bj)
136 ENDDO
137 ENDDO
138
139 C- end 2nd bi,bj loop.
140 ENDDO
141 ENDDO
142
143 CALL EXCH_UV_XY_RL( etaHw, etaHs, .FALSE., myThid )
144 CALL EXCH_XY_RL( dEtaHdt, myThid )
145
146 DO bj=myByLo(myThid),myByHi(myThid)
147 DO bi=myBxLo(myThid),myBxHi(myThid)
148 C- 3rd bi,bj loop :
149
150 DO j=1-Oly,sNy+Oly
151 DO i=1-Olx,sNx+Olx
152 dEtaWdt(i,j,bi,bj) = ( etaHw(i,j,bi,bj)
153 & - dEtaWdt(i,j,bi,bj) )/deltaTfreesurf
154 dEtaSdt(i,j,bi,bj) = ( etaHs(i,j,bi,bj)
155 & - dEtaSdt(i,j,bi,bj) )/deltaTfreesurf
156 ENDDO
157 ENDDO
158
159 C- end 3rd bi,bj loop.
160 ENDDO
161 ENDDO
162
163 ENDIF
164 # endif /* DISABLE_SIGMA_CODE */
165 #endif /* NONLIN_FRSURF */
166
167 #endif /* EXACT_CONSERV */
168
169 RETURN
170 END

  ViewVC Help
Powered by ViewVC 1.1.22