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

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

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

Revision 1.9 - (show annotations) (download)
Fri May 20 01:09:37 2011 UTC (12 years, 11 months ago) by jmc
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, checkpoint62z, checkpoint62y, checkpoint63g, checkpoint64, checkpoint65, checkpoint63, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63a, checkpoint63b, checkpoint63c, 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.8: +12 -61 lines 
move call to OBCS_APPLY_R_STAR from update_r_star.F to calc_r_star.F
 and add argument etaFld:
this fixes missing EXCH + get consistent eta OB value (+ fix restart)
1 C $Header: /u/gcmpack/MITgcm/model/src/update_r_star.F,v 1.8 2011/01/14 01:28:31 gforget Exp $
2 C $Name: $
3
4 #include "CPP_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: UPDATE_R_STAR
8 C !INTERFACE:
9 SUBROUTINE UPDATE_R_STAR( useLatest, myTime, myIter, myThid )
10
11 C !DESCRIPTION: \bv
12 C *==========================================================*
13 C | SUBROUTINE UPDATE_R_STAR
14 C | o Update the thickness fractions (hFacC,W,S)
15 C | according to the surface r-position = Non-Linear FrSurf
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 "GRID.h"
26 #include "SURFACE.h"
27
28 C !INPUT/OUTPUT PARAMETERS:
29 C == Routine arguments ==
30 C useLatest :: if true use rStarFacC, else use rStarFacNm1C
31 C myTime :: Current time in simulation
32 C myIter :: Current iteration number in simulation
33 C myThid :: Thread number for this instance of the routine.
34 LOGICAL useLatest
35 _RL myTime
36 INTEGER myIter
37 INTEGER myThid
38
39 C !LOCAL VARIABLES:
40 #ifdef NONLIN_FRSURF
41 C Local variables
42 C i,j,k,bi,bj :: loop counter
43 INTEGER i,j,k,bi,bj
44 CEOP
45
46 DO bj=myByLo(myThid), myByHi(myThid)
47 DO bi=myBxLo(myThid), myBxHi(myThid)
48
49 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
50
51 IF (useLatest) THEN
52
53 DO k=1,Nr
54 DO j=1-Oly,sNy+Oly
55 DO i=1-Olx,sNx+Olx
56 # ifndef DISABLE_RSTAR_CODE
57 C-- Update the fractional thickness hFacC , hFacW & hFacS (& "recip_hFac") :
58 hFacC(i,j,k,bi,bj) = h0FacC(i,j,k,bi,bj)
59 & *rStarFacC(i,j,bi,bj)
60 hFacW(i,j,k,bi,bj) = h0FacW(i,j,k,bi,bj)
61 & *rStarFacW(i,j,bi,bj)
62 hFacS(i,j,k,bi,bj) = h0FacS(i,j,k,bi,bj)
63 & *rStarFacS(i,j,bi,bj)
64 #endif
65 C
66 #ifdef USE_MASK_AND_NO_IF
67 recip_hFacC(i,j,k,bi,bj) = maskC(i,j,k,bi,bj)
68 & / ( _hFacC(i,j,k,bi,bj) + (1.-maskC(i,j,k,bi,bj)) )
69 recip_hFacW(i,j,k,bi,bj) = maskW(i,j,k,bi,bj)
70 & / ( _hFacW(i,j,k,bi,bj) + (1.-maskW(i,j,k,bi,bj)) )
71 recip_hFacS(i,j,k,bi,bj) = maskS(i,j,k,bi,bj)
72 & / ( _hFacS(i,j,k,bi,bj) + (1.-maskS(i,j,k,bi,bj)) )
73 #else
74 IF (maskC(i,j,k,bi,bj).NE.0.)
75 & recip_hFacC(i,j,k,bi,bj) = 1. _d 0 / _hFacC(i,j,k,bi,bj)
76 IF (maskW(i,j,k,bi,bj).NE.0.)
77 & recip_hFacW(i,j,k,bi,bj) = 1. _d 0 / _hFacW(i,j,k,bi,bj)
78 IF (maskS(i,j,k,bi,bj).NE.0.)
79 & recip_hFacS(i,j,k,bi,bj) = 1. _d 0 / _hFacS(i,j,k,bi,bj)
80 #endif
81 ENDDO
82 ENDDO
83 ENDDO
84
85 ELSE
86
87 DO k=1,Nr
88 DO j=1-Oly,sNy+Oly
89 DO i=1-Olx,sNx+Olx
90 # ifndef DISABLE_RSTAR_CODE
91 C-- Update the fractional thickness hFacC , hFacW & hFacS (&
92 C"recip_hFac") :
93 hFacC(i,j,k,bi,bj) = h0FacC(i,j,k,bi,bj)
94 & *rStarFacNm1C(i,j,bi,bj)
95 hFacW(i,j,k,bi,bj) = h0FacW(i,j,k,bi,bj)
96 & *rStarFacNm1W(i,j,bi,bj)
97 hFacS(i,j,k,bi,bj) = h0FacS(i,j,k,bi,bj)
98 & *rStarFacNm1S(i,j,bi,bj)
99 #endif
100 C
101 #ifdef USE_MASK_AND_NO_IF
102 recip_hFacC(i,j,k,bi,bj) = maskC(i,j,k,bi,bj)
103 & / ( _hFacC(i,j,k,bi,bj) + (1.-maskC(i,j,k,bi,bj)) )
104 recip_hFacW(i,j,k,bi,bj) = maskW(i,j,k,bi,bj)
105 & / ( _hFacW(i,j,k,bi,bj) + (1.-maskW(i,j,k,bi,bj)) )
106 recip_hFacS(i,j,k,bi,bj) = maskS(i,j,k,bi,bj)
107 & / ( _hFacS(i,j,k,bi,bj) + (1.-maskS(i,j,k,bi,bj)) )
108 #else
109 IF (maskC(i,j,k,bi,bj).NE.0.)
110 & recip_hFacC(i,j,k,bi,bj) = 1. _d 0 / _hFacC(i,j,k,bi,bj)
111 IF (maskW(i,j,k,bi,bj).NE.0.)
112 & recip_hFacW(i,j,k,bi,bj) = 1. _d 0 / _hFacW(i,j,k,bi,bj)
113 IF (maskS(i,j,k,bi,bj).NE.0.)
114 & recip_hFacS(i,j,k,bi,bj) = 1. _d 0 / _hFacS(i,j,k,bi,bj)
115 #endif
116 ENDDO
117 ENDDO
118 ENDDO
119
120 ENDIF
121
122 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
123
124 C- end bi,bj loop
125 ENDDO
126 ENDDO
127
128 c _EXCH_XYZ_RS( hFacC, myThid )
129 c _EXCH_XYZ_RS( recip_hFacC, myThid )
130 c CALL EXCH_UV_XYZ_RS(hFacW,hFacS,.FALSE.,myThid)
131 c CALL EXCH_UV_XYZ_RS(recip_hFacW,recip_hFacS,.FALSE.,myThid)
132
133 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
134 #endif /* NONLIN_FRSURF */
135
136 RETURN
137 END
  ViewVC Help
Powered by ViewVC 1.1.22