/[MITgcm]/MITgcm/pkg/obcs/obcs_apply_ts.F
ViewVC logotype

Contents of /MITgcm/pkg/obcs/obcs_apply_ts.F

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

Revision 1.11 - (show annotations) (download)
Thu Nov 15 15:55:42 2012 UTC (11 years, 6 months ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint65, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65o, checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, HEAD
Changes since 1.10: +1 -3 lines 
adding tidal velocity forcing capability to obcs
 Modified Files:
  model/src/dynamics.F forward_step.F the_main_loop.F
  pkg/obcs/OBCS_FIELDS.h OBCS_OPTIONS.h OBCS_PARAMS.h
  OBCS_SEAICE.h obcs_apply_eta.F obcs_apply_r_star.F
  obcs_apply_surf_dr.F obcs_apply_ts.F obcs_apply_w.F
  obcs_calc.F obcs_check.F obcs_init_variables.F obcs_readparms.F
  verification/seaice_obcs/code/OBCS_OPTIONS.h
 Added Files:
  pkg/obcs/obcs_add_tides.F
  verification/seaice_obcs/input.tides/*
  verification/seaice_obcs/results/output.tides.txt
1 C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_apply_ts.F,v 1.10 2012/09/18 20:09:17 jmc Exp $
2 C $Name: $
3
4 #include "OBCS_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: OBCS_APPLY_TS
8 C !INTERFACE:
9
10 SUBROUTINE OBCS_APPLY_TS( bi, bj, kArg,
11 U tFld, sFld,
12 I myThid )
13
14 C !DESCRIPTION:
15 C *==========================================================*
16 C | S/R OBCS_APPLY_TS
17 C | Apply OB values to corresponding field array
18 C *==========================================================*
19
20 C !USES:
21 IMPLICIT NONE
22 C == Global variables ==
23 #include "SIZE.h"
24 #include "EEPARAMS.h"
25 #include "PARAMS.h"
26 #include "OBCS_PARAMS.h"
27 #include "OBCS_GRID.h"
28 #include "OBCS_FIELDS.h"
29
30 C !INPUT/OUTPUT PARAMETERS:
31 C == Routine Arguments ==
32 C bi, bj :: indices of current tile
33 C kArg :: index of current level which OBC apply to
34 C or if zeros, apply to all levels
35 C tFld :: temperature field
36 C sFld :: salinity field
37 C myThid :: my Thread Id number
38 c INTEGER biArg, bjArg
39 INTEGER bi, bj
40 INTEGER kArg
41 _RL tFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
42 _RL sFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
43 INTEGER myThid
44 CEOP
45
46 C !LOCAL VARIABLES:
47 C == Local variables ==
48 c INTEGER bi, bj, itLo, itHi, jtLo, jtHi
49 INTEGER k, kLo, kHi
50 INTEGER i, j
51 INTEGER Iobc, Jobc
52
53 c IF ( biArg.EQ.0 .OR. bjArg.EQ.0 ) THEN
54 c itLo = myBxLo(myThid)
55 c itHi = myBxHi(myThid)
56 c jtLo = myByLo(myThid)
57 c jtHi = myByHi(myThid)
58 c ELSE
59 c itLo = biArg
60 c itHi = biArg
61 c jtLo = bjArg
62 c jtHi = bjArg
63 c ENDIF
64 IF ( kArg.EQ.0 ) THEN
65 kLo = 1
66 kHi = Nr
67 ELSE
68 kLo = kArg
69 kHi = kArg
70 ENDIF
71
72 c DO bj = jtLo,jtHi
73 c DO bi = itLo,itHi
74
75 C Set model variables to OB values on North/South Boundaries
76 #ifdef ALLOW_OBCS_NORTH
77 IF ( tileHasOBN(bi,bj) ) THEN
78 C Northern boundary
79 # ifdef ALLOW_OBCS_STEVENS
80 IF ( useStevensNorth ) THEN
81 DO i=1-OLx,sNx+OLx
82 C add tendency term instead of overwriting field with boundary value
83 Jobc = OB_Jn(i,bi,bj)
84 IF ( Jobc.NE.OB_indexNone ) THEN
85 DO k = kLo,kHi
86 tFld(i,Jobc,k,bi,bj) = tFld(i,Jobc,k,bi,bj)
87 & + dTtracerLev(k)*OBNt(i,k,bi,bj)
88 sFld(i,Jobc,k,bi,bj) = sFld(i,Jobc,k,bi,bj)
89 & + dTtracerLev(k)*OBNs(i,k,bi,bj)
90 ENDDO
91 ENDIF
92 ENDDO
93 ELSE
94 # else
95 IF ( .TRUE. ) THEN
96 # endif /* ALLOW_OBCS_STEVENS */
97 DO i=1-OLx,sNx+OLx
98 Jobc = OB_Jn(i,bi,bj)
99 IF ( Jobc.NE.OB_indexNone ) THEN
100 DO k = kLo,kHi
101 tFld(i,Jobc,k,bi,bj) = OBNt(i,k,bi,bj)
102 sFld(i,Jobc,k,bi,bj) = OBNs(i,k,bi,bj)
103 ENDDO
104 ENDIF
105 ENDDO
106 ENDIF
107 ENDIF
108 #endif /* ALLOW_OBCS_NORTH */
109
110 #ifdef ALLOW_OBCS_SOUTH
111 IF ( tileHasOBS(bi,bj) ) THEN
112 C Southern boundary
113 # ifdef ALLOW_OBCS_STEVENS
114 IF ( useStevensSouth ) THEN
115 C add tendency term instead of overwriting field with boundary value
116 DO i=1-OLx,sNx+OLx
117 Jobc = OB_Js(i,bi,bj)
118 IF ( Jobc.NE.OB_indexNone ) THEN
119 DO k = kLo,kHi
120 tFld(i,Jobc,k,bi,bj) = tFld(i,Jobc,k,bi,bj)
121 & + dTtracerLev(k)*OBSt(i,k,bi,bj)
122 sFld(i,Jobc,k,bi,bj) = sFld(i,Jobc,k,bi,bj)
123 & + dTtracerLev(k)*OBSs(i,k,bi,bj)
124 ENDDO
125 ENDIF
126 ENDDO
127 ELSE
128 # else
129 IF ( .TRUE. ) THEN
130 # endif /* ALLOW_OBCS_STEVENS */
131 DO i=1-OLx,sNx+OLx
132 Jobc = OB_Js(i,bi,bj)
133 IF ( Jobc.NE.OB_indexNone ) THEN
134 DO k = kLo,kHi
135 tFld(i,Jobc,k,bi,bj) = OBSt(i,k,bi,bj)
136 sFld(i,Jobc,k,bi,bj) = OBSs(i,k,bi,bj)
137 ENDDO
138 ENDIF
139 ENDDO
140 ENDIF
141 ENDIF
142 #endif /* ALLOW_OBCS_SOUTH */
143
144 C Set model variables to OB values on East/West Boundaries
145 #ifdef ALLOW_OBCS_EAST
146 IF ( tileHasOBE(bi,bj) ) THEN
147 C Eastern boundary
148 # ifdef ALLOW_OBCS_STEVENS
149 IF ( useStevensEast ) THEN
150 C add tendency term instead of overwriting field with boundary value
151 DO j=1-OLy,sNy+OLy
152 Iobc = OB_Ie(j,bi,bj)
153 IF ( Iobc.NE.OB_indexNone ) THEN
154 DO k = kLo,kHi
155 tFld(Iobc,j,k,bi,bj) = tFld(Iobc,j,k,bi,bj)
156 & + dTtracerLev(k)*OBEt(j,k,bi,bj)
157 sFld(Iobc,j,k,bi,bj) = sFld(Iobc,j,k,bi,bj)
158 & + dTtracerLev(k)*OBEs(j,k,bi,bj)
159 ENDDO
160 ENDIF
161 ENDDO
162 ELSE
163 # else
164 IF ( .TRUE. ) THEN
165 # endif /* ALLOW_OBCS_STEVENS */
166 DO j=1-OLy,sNy+OLy
167 Iobc = OB_Ie(j,bi,bj)
168 IF ( Iobc.NE.OB_indexNone ) THEN
169 DO k = kLo,kHi
170 tFld(Iobc,j,k,bi,bj) = OBEt(j,k,bi,bj)
171 sFld(Iobc,j,k,bi,bj) = OBEs(j,k,bi,bj)
172 ENDDO
173 ENDIF
174 ENDDO
175 ENDIF
176 ENDIF
177 #endif /* ALLOW_OBCS_EAST */
178
179 #ifdef ALLOW_OBCS_WEST
180 IF ( tileHasOBW(bi,bj) ) THEN
181 C Western boundary
182 # ifdef ALLOW_OBCS_STEVENS
183 IF ( useStevensWest ) THEN
184 C add tendency term instead of overwriting field with boundary value
185 DO j=1-OLy,sNy+OLy
186 Iobc = OB_Iw(j,bi,bj)
187 IF ( Iobc.NE.OB_indexNone ) THEN
188 DO k = kLo,kHi
189 tFld(Iobc,j,k,bi,bj) = tFld(Iobc,j,k,bi,bj)
190 & + dTtracerLev(k)*OBWt(j,k,bi,bj)
191 sFld(Iobc,j,k,bi,bj) = sFld(Iobc,j,k,bi,bj)
192 & + dTtracerLev(k)*OBWs(j,k,bi,bj)
193 ENDDO
194 ENDIF
195 ENDDO
196 ELSE
197 # else
198 IF ( .TRUE. ) THEN
199 # endif /* ALLOW_OBCS_STEVENS */
200 DO j=1-OLy,sNy+OLy
201 Iobc = OB_Iw(j,bi,bj)
202 IF ( Iobc.NE.OB_indexNone ) THEN
203 DO k = kLo,kHi
204 tFld(Iobc,j,k,bi,bj) = OBWt(j,k,bi,bj)
205 sFld(Iobc,j,k,bi,bj) = OBWs(j,k,bi,bj)
206 ENDDO
207 ENDIF
208 ENDDO
209 ENDIF
210 ENDIF
211 #endif /* ALLOW_OBCS_WEST */
212
213 c ENDDO
214 c ENDDO
215
216 RETURN
217 END
  ViewVC Help
Powered by ViewVC 1.1.22