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

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

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

Revision 1.8 - (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.7: +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_r_star.F,v 1.7 2012/09/18 20:09:17 jmc Exp $
2 C $Name: $
3
4 #include "OBCS_OPTIONS.h"
5
6 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7 CBOP
8 C !ROUTINE: OBCS_APPLY_R_STAR
9
10 C !INTERFACE:
11 SUBROUTINE OBCS_APPLY_R_STAR(
12 I bi, bj, etaFld,
13 U rStarFldC, rStarFldW, rStarFldS,
14 I myTime, myIter, myThid )
15
16 C !DESCRIPTION:
17 C *==========================================================*
18 C | S/R OBCS_APPLY_R_STAR
19 C *==========================================================*
20
21 C !USES:
22 IMPLICIT NONE
23 C == Global variables ==
24 #include "SIZE.h"
25 #include "EEPARAMS.h"
26 #include "PARAMS.h"
27 #include "GRID.h"
28 #include "OBCS_PARAMS.h"
29 #include "OBCS_GRID.h"
30 #include "OBCS_FIELDS.h"
31
32 C !INPUT/OUTPUT PARAMETERS:
33 C bi, bj :: tile indices
34 C etaFld :: current eta field used to update the hFactor
35 C rStarFldC :: r* thickness-factor (grid-cell center)
36 C hFac_FldW :: r* thickness-factor (grid-cell Western -Edge)
37 C hFac_FldS :: r* thickness-factor (grid-cell Southern-Edge)
38 C myTime :: current time in simlation
39 C myIter :: current time-step number
40 C myThid :: my Thread Id number
41 INTEGER bi, bj
42 _RL etaFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
43 _RL rStarFldC(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
44 _RL rStarFldW(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
45 _RL rStarFldS(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
46 _RL myTime
47 INTEGER myIter, myThid
48 CEOP
49
50 #ifdef NONLIN_FRSURF
51 #ifndef DISABLE_RSTAR_CODE
52
53 C !LOCAL VARIABLES:
54 INTEGER i,j
55 LOGICAL useOBeta
56
57 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
58
59 C-- Eta OB values corresponding to previous iteration are not available when
60 C calc_r_star is called for the 1rst time (myIter=-1) form initialise_varia.
61 C Use current "etaFld" values instead, only for this 1rst call (myIter=-1).
62 useOBeta = myIter.NE.-1
63
64 C- Set model rStar_Factor to OB values on North/South Boundaries
65 IF ( tileHasOBN(bi,bj) ) THEN
66 C Northern boundary
67 DO i=1-OLx,sNx+OLx
68 IF ( OB_Jn(i,bi,bj).NE.OB_indexNone ) THEN
69 j = OB_Jn(i,bi,bj)
70 IF (kSurfS(i,j,bi,bj).LE.Nr) THEN
71 IF ( useOBeta ) THEN
72 rStarFldS(i,j,bi,bj) = 1. _d 0
73 & + OBNeta( j,bi,bj) / (rSurfS(i,j,bi,bj)-rLowS(i,j,bi,bj))
74 ELSE
75 rStarFldS(i,j,bi,bj) = 1. _d 0
76 & + etaFld(i,j,bi,bj) / (rSurfS(i,j,bi,bj)-rLowS(i,j,bi,bj))
77 ENDIF
78 ENDIF
79 ENDIF
80 ENDDO
81 ENDIF
82 IF ( tileHasOBS(bi,bj) ) THEN
83 C Southern boundary
84 DO i=1-OLx,sNx+OLx
85 IF ( OB_Js(i,bi,bj).NE.OB_indexNone ) THEN
86 j = OB_Js(i,bi,bj)+1
87 IF (kSurfS(i,j,bi,bj).LE.Nr) THEN
88 IF ( useOBeta ) THEN
89 rStarFldS(i,j,bi,bj) = 1. _d 0
90 & + OBSeta( j,bi,bj) / (rSurfS(i,j,bi,bj)-rLowS(i,j,bi,bj))
91 ELSE
92 rStarFldS(i,j,bi,bj) = 1. _d 0
93 & + etaFld(i,j-1,bi,bj)/(rSurfS(i,j,bi,bj)-rLowS(i,j,bi,bj))
94 ENDIF
95 ENDIF
96 ENDIF
97 ENDDO
98 ENDIF
99
100 C- Set model rStar_Factor to OB values on East/West Boundaries
101 IF ( tileHasOBE(bi,bj) ) THEN
102 C Eastern boundary
103 DO j=1-OLy,sNy+OLy
104 IF ( OB_Ie(j,bi,bj).NE.OB_indexNone ) THEN
105 i = OB_Ie(j,bi,bj)
106 IF (kSurfW(i,j,bi,bj).LE.Nr) THEN
107 IF ( useOBeta ) THEN
108 rStarFldW(i,j,bi,bj) = 1. _d 0
109 & + OBEeta( j,bi,bj) / (rSurfW(i,j,bi,bj)-rLowW(i,j,bi,bj))
110 ELSE
111 rStarFldW(i,j,bi,bj) = 1. _d 0
112 & + etaFld(i,j,bi,bj) / (rSurfW(i,j,bi,bj)-rLowW(i,j,bi,bj))
113 ENDIF
114 ENDIF
115 ENDIF
116 ENDDO
117 ENDIF
118 IF ( tileHasOBW(bi,bj) ) THEN
119 C Western boundary
120 DO j=1-OLy,sNy+OLy
121 IF ( OB_Iw(j,bi,bj).NE.OB_indexNone ) THEN
122 i = OB_Iw(j,bi,bj)+1
123 IF (kSurfW(i,j,bi,bj).LE.Nr) THEN
124 IF ( useOBeta ) THEN
125 rStarFldW(i,j,bi,bj) = 1. _d 0
126 & + OBWeta( j,bi,bj) / (rSurfW(i,j,bi,bj)-rLowW(i,j,bi,bj))
127 ELSE
128 rStarFldW(i,j,bi,bj) = 1. _d 0
129 & + etaFld(i-1,j,bi,bj)/(rSurfW(i,j,bi,bj)-rLowW(i,j,bi,bj))
130 ENDIF
131 ENDIF
132 ENDIF
133 ENDDO
134 ENDIF
135
136 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
137
138 #endif /* DISABLE_RSTAR_CODE */
139 #endif /* NONLIN_FRSURF */
140
141 RETURN
142 END
  ViewVC Help
Powered by ViewVC 1.1.22