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

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

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

Revision 1.10 - (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.9: +2 -1 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_w.F,v 1.9 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_W
8 C !INTERFACE:
9 SUBROUTINE OBCS_APPLY_W( bi, bj, kArg,
10 U wFld,
11 I myThid )
12
13 C !DESCRIPTION:
14 C *==========================================================*
15 C | S/R OBCS_APPLY_W
16 C | Apply vertical velocity OB values
17 C | 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 "GRID.h"
27 #include "OBCS_PARAMS.h"
28 #include "OBCS_GRID.h"
29 #include "OBCS_FIELDS.h"
30
31 C !INPUT/OUTPUT PARAMETERS:
32 C == Routine Arguments ==
33 C bi, bj :: indices of current tile
34 C kArg :: index of current level which OBC apply to
35 C or if zero, apply to all levels
36 C wFld :: vertical velocity field
37 C myThid :: my Thread Id number
38 INTEGER bi, bj
39 INTEGER kArg
40 _RL wFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
41 INTEGER myThid
42 CEOP
43
44 #ifdef ALLOW_NONHYDROSTATIC
45 C !LOCAL VARIABLES:
46 C == Local variables ==
47 INTEGER kLo, kHi
48 INTEGER k, km1
49 INTEGER i, j
50 INTEGER Iobc, Jobc
51 _RL obc_mask
52
53 IF ( nonHydrostatic ) THEN
54
55 IF ( kArg.EQ.0 ) THEN
56 kLo = 1
57 kHi = Nr
58 ELSE
59 k = kArg
60 km1 = MAX( k-1, 1 )
61 ENDIF
62
63 C Set model variables to OB values on North/South Boundaries
64 #ifdef ALLOW_OBCS_NORTH
65 IF ( tileHasOBN(bi,bj) ) THEN
66 C Northern boundary
67 DO i=1-OLx,sNx+OLx
68 Jobc = OB_Jn(i,bi,bj)
69 IF ( Jobc.NE.OB_indexNone .AND. kArg.EQ.0 ) THEN
70 DO k = kLo,kHi
71 km1 = MAX( k-1, 1 )
72 obc_mask = maskC(i,Jobc,km1,bi,bj)*maskC(i,Jobc,k,bi,bj)
73 wFld(i,Jobc,k,bi,bj) = OBNw(i,k,bi,bj)*obc_mask
74 ENDDO
75 ELSEIF ( Jobc.NE.OB_indexNone ) THEN
76 obc_mask = maskC(i,Jobc,km1,bi,bj)*maskC(i,Jobc,k,bi,bj)
77 wFld(i,Jobc,k,bi,bj) = OBNw(i,k,bi,bj)*obc_mask
78 ENDIF
79 ENDDO
80 ENDIF
81 #endif /* ALLOW_OBCS_NORTH */
82
83 #ifdef ALLOW_OBCS_SOUTH
84 IF ( tileHasOBS(bi,bj) ) THEN
85 C Southern boundary
86 DO i=1-OLx,sNx+OLx
87 Jobc = OB_Js(i,bi,bj)
88 IF ( Jobc.NE.OB_indexNone .AND. kArg.EQ.0 ) THEN
89 DO k = kLo,kHi
90 km1 = MAX( k-1, 1 )
91 obc_mask = maskC(i,Jobc,km1,bi,bj)*maskC(i,Jobc,k,bi,bj)
92 wFld(i,Jobc,k,bi,bj) = OBSw(i,k,bi,bj)*obc_mask
93 ENDDO
94 ELSEIF ( Jobc.NE.OB_indexNone ) THEN
95 obc_mask = maskC(i,Jobc,km1,bi,bj)*maskC(i,Jobc,k,bi,bj)
96 wFld(i,Jobc,k,bi,bj) = OBSw(i,k,bi,bj)*obc_mask
97 ENDIF
98 ENDDO
99 ENDIF
100 #endif /* ALLOW_OBCS_SOUTH */
101
102 C Set model variables to OB values on East/West Boundaries
103 #ifdef ALLOW_OBCS_EAST
104 IF ( tileHasOBE(bi,bj) ) THEN
105 C Eastern boundary
106 DO j=1-OLy,sNy+OLy
107 Iobc = OB_Ie(j,bi,bj)
108 IF ( Iobc.NE.OB_indexNone .AND. kArg.EQ.0 ) THEN
109 DO k = kLo,kHi
110 km1 = MAX( k-1, 1 )
111 obc_mask = maskC(Iobc,j,km1,bi,bj)*maskC(Iobc,j,k,bi,bj)
112 wFld(Iobc,j,k,bi,bj) = OBEw(j,k,bi,bj)*obc_mask
113 ENDDO
114 ELSEIF ( Iobc.NE.OB_indexNone ) THEN
115 obc_mask = maskC(Iobc,j,km1,bi,bj)*maskC(Iobc,j,k,bi,bj)
116 wFld(Iobc,j,k,bi,bj) = OBEw(j,k,bi,bj)*obc_mask
117 ENDIF
118 ENDDO
119 ENDIF
120 #endif /* ALLOW_OBCS_EAST */
121
122 #ifdef ALLOW_OBCS_WEST
123 IF ( tileHasOBW(bi,bj) ) THEN
124 C Western boundary
125 DO j=1-OLy,sNy+OLy
126 Iobc = OB_Iw(j,bi,bj)
127 IF ( Iobc.NE.OB_indexNone .AND. kArg.EQ.0 ) THEN
128 DO k = kLo,kHi
129 km1 = MAX( k-1, 1 )
130 obc_mask = maskC(Iobc,j,km1,bi,bj)*maskC(Iobc,j,k,bi,bj)
131 wFld(Iobc,j,k,bi,bj) = OBWw(j,k,bi,bj)*obc_mask
132 ENDDO
133 ELSEIF ( Iobc.NE.OB_indexNone ) THEN
134 obc_mask = maskC(Iobc,j,km1,bi,bj)*maskC(Iobc,j,k,bi,bj)
135 wFld(Iobc,j,k,bi,bj) = OBWw(j,k,bi,bj)*obc_mask
136 ENDIF
137 ENDDO
138 ENDIF
139 #endif /* ALLOW_OBCS_WEST */
140
141 ENDIF
142 #endif /* ALLOW_NONHYDROSTATIC */
143
144 RETURN
145 END
  ViewVC Help
Powered by ViewVC 1.1.22