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

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

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

Revision 1.10 - (show annotations) (download)
Fri May 20 01:11:59 2011 UTC (13 years 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.9: +23 -72 lines 
move call to OBCS_APPLY_SURF_DR from update_surf_dr.F to calc_surf_dr.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_surf_dr.F,v 1.9 2011/01/14 23:23:54 gforget Exp $
2 C $Name: $
3
4 #include "CPP_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: UPDATE_SURF_DR
8 C !INTERFACE:
9 SUBROUTINE UPDATE_SURF_DR( useLatest, myTime, myIter, myThid )
10
11 C !DESCRIPTION: \bv
12 C *==========================================================*
13 C | SUBROUTINE UPDATE_SURF_DR
14 C | o Update the surface-level thickness fraction (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 hFac_surfC, else use hFac_surfNm1C
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,bi,bj - loop counter
43 INTEGER i,j,k,bi,bj
44 INTEGER ks
45 CEOP
46
47 DO bj=myByLo(myThid), myByHi(myThid)
48 DO bi=myBxLo(myThid), myBxHi(myThid)
49
50 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
51
52 IF (useLatest.AND.(nonlinFreeSurf.GT.0)) then
53
54 C-- Update the fractional thickness "hFacC" of the surface level kSurfC :
55 DO j=1-Oly,sNy+Oly
56 DO i=1-Olx,sNx+Olx
57 ks = kSurfC(i,j,bi,bj)
58 IF (ks.LE.Nr) THEN
59 hFacC(i,j,ks,bi,bj) = hFac_surfC(i,j,bi,bj)
60 recip_hFacC(i,j,ks,bi,bj)= 1. _d 0 / hFac_surfC(i,j,bi,bj)
61 ENDIF
62 ENDDO
63 ENDDO
64
65 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
66 C-- Update fractional thickness "hFacW" & "hFacS" (at U and V points)
67
68 DO j=1-Oly,sNy+Oly
69 DO i=2-Olx,sNx+Olx
70 ks = kSurfW(i,j,bi,bj)
71 IF (ks.LE.Nr) THEN
72 hFacW(i,j,ks,bi,bj) = hFac_surfW(i,j,bi,bj)
73 recip_hFacW(i,j,ks,bi,bj)= 1. _d 0 / hFac_surfW(i,j,bi,bj)
74 ENDIF
75 ENDDO
76 ENDDO
77 DO j=2-Oly,sNy+Oly
78 DO i=1-Olx,sNx+Olx
79 ks = kSurfS(i,j,bi,bj)
80 IF (ks.LE.Nr) THEN
81 hFacS(i,j,ks,bi,bj) = hFac_surfS(i,j,bi,bj)
82 recip_hFacS(i,j,ks,bi,bj)= 1. _d 0 / hFac_surfS(i,j,bi,bj)
83 ENDIF
84 ENDDO
85 ENDDO
86
87 ELSEIF (nonlinFreeSurf.GT.0) THEN
88
89 C-- Update the fractional thickness "hFacC" of the surface level kSurfC
90 C:
91 DO j=1-Oly,sNy+Oly
92 DO i=1-Olx,sNx+Olx
93 ks = kSurfC(i,j,bi,bj)
94 IF (ks.LE.Nr) THEN
95 hFacC(i,j,ks,bi,bj) = hFac_surfNm1C(i,j,bi,bj)
96 recip_hFacC(i,j,ks,bi,bj)= 1. _d 0 / hFac_surfNm1C(i,j,bi,bj)
97 ENDIF
98 ENDDO
99 ENDDO
100
101 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
102 C-- Update fractional thickness "hFacW" & "hFacS" (at U and V points)
103
104 DO j=1-Oly,sNy+Oly
105 DO i=2-Olx,sNx+Olx
106 ks = kSurfW(i,j,bi,bj)
107 IF (ks.LE.Nr) THEN
108 hFacW(i,j,ks,bi,bj) = hFac_surfNm1W(i,j,bi,bj)
109 recip_hFacW(i,j,ks,bi,bj)= 1. _d 0 / hFac_surfNm1W(i,j,bi,bj)
110 ENDIF
111 ENDDO
112 ENDDO
113 DO j=2-Oly,sNy+Oly
114 DO i=1-Olx,sNx+Olx
115 ks = kSurfS(i,j,bi,bj)
116 IF (ks.LE.Nr) THEN
117 hFacS(i,j,ks,bi,bj) = hFac_surfNm1S(i,j,bi,bj)
118 recip_hFacS(i,j,ks,bi,bj)= 1. _d 0 / hFac_surfNm1S(i,j,bi,bj)
119 ENDIF
120 ENDDO
121 ENDDO
122
123 ELSE
124
125 DO k=1,Nr
126 DO j=1-Oly,sNy+Oly
127 DO i=1-Olx,sNx+Olx
128 hFacC(i,j,k,bi,bj)=h0FacC(i,j,k,bi,bj)
129 IF (h0FacC(i,j,k,bi,bj) .NE. 0. ) THEN
130 recip_hFacC(i,j,k,bi,bj) = 1. _d 0 / h0FacC(i,j,k,bi,bj)
131 ELSE
132 recip_hFacC(i,j,k,bi,bj) = 0.
133 ENDIF
134 ENDDO
135 ENDDO
136 ENDDO
137
138 ENDIF
139
140 C- end bi,bj loop
141 ENDDO
142 ENDDO
143
144 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
145 #endif /* NONLIN_FRSURF */
146
147 RETURN
148 END
  ViewVC Help
Powered by ViewVC 1.1.22