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

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

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

Revision 1.8 - (hide annotations) (download)
Fri Jan 14 01:28:31 2011 UTC (13 years, 4 months ago) by gforget
Branch: MAIN
Changes since 1.7: +60 -5 lines 
o model/src, pkg/autodiff, pkg/ecco, pkg/seaice:
  alleviate the need for additional 3D tapes when using
  the non-inear free surface in the adjoint. This is done
  by adding an 'update' of hfacc etc. to their current
  value at the beginning of forward_step.F.
1 gforget 1.8 C $Header: /u/gcmpack/MITgcm/model/src/update_surf_dr.F,v 1.7 2008/08/12 22:42:33 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4 edhill 1.4 #include "PACKAGES_CONFIG.h"
5 jmc 1.1 #include "CPP_OPTIONS.h"
6    
7 cnh 1.2 CBOP
8     C !ROUTINE: UPDATE_SURF_DR
9     C !INTERFACE:
10 gforget 1.8 SUBROUTINE UPDATE_SURF_DR( useLatest, myTime, myIter, myThid )
11 cnh 1.2 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 jmc 1.1 IMPLICIT NONE
21     C == Global variables
22     #include "SIZE.h"
23     #include "EEPARAMS.h"
24     #include "PARAMS.h"
25     c #include "DYNVARS.h"
26     #include "GRID.h"
27     #include "SURFACE.h"
28 heimbach 1.6 #ifdef ALLOW_AUTODIFF_TAMC
29     # include "tamc.h"
30     # include "tamc_keys.h"
31     #endif
32 jmc 1.1
33 cnh 1.2 C !INPUT/OUTPUT PARAMETERS:
34 jmc 1.1 C == Routine arguments ==
35 gforget 1.8 C useLatest - if true use hFac_surfC, else use hFac_surfNm1C
36 jmc 1.1 C myTime - Current time in simulation
37     C myIter - Current iteration number in simulation
38     C myThid - Thread number for this instance of the routine.
39 gforget 1.8 LOGICAL useLatest
40 jmc 1.1 _RL myTime
41     INTEGER myIter
42     INTEGER myThid
43    
44 cnh 1.2 C !LOCAL VARIABLES:
45 jmc 1.1 #ifdef NONLIN_FRSURF
46     C Local variables
47 jmc 1.5 C i,j,bi,bj - loop counter
48     INTEGER i,j,bi,bj
49 jmc 1.1 INTEGER ks
50 cnh 1.2 CEOP
51 jmc 1.1
52     DO bj=myByLo(myThid), myByHi(myThid)
53     DO bi=myBxLo(myThid), myBxHi(myThid)
54    
55 heimbach 1.6 #ifdef ALLOW_AUTODIFF_TAMC
56     act1 = bi - myBxLo(myThid)
57     max1 = myBxHi(myThid) - myBxLo(myThid) + 1
58     act2 = bj - myByLo(myThid)
59     max2 = myByHi(myThid) - myByLo(myThid) + 1
60     act3 = myThid - 1
61     max3 = nTx*nTy
62     act4 = ikey_dynamics - 1
63     idynkey = (act1 + 1) + act2*max1
64     & + act3*max1*max2
65     & + act4*max1*max2*max3
66     #endif /* ALLOW_AUTODIFF_TAMC */
67    
68 jmc 1.1 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
69 jmc 1.3
70     #ifdef ALLOW_OBCS
71 heimbach 1.6 # ifdef ALLOW_AUTODIFF_TAMC
72 gforget 1.8 CADJ STORE hFac_surfC(:,:,bi,bj) =
73 heimbach 1.6 CADJ & comlev1_bibj, key = idynkey, byte = isbyte
74 gforget 1.8 CADJ STORE hFac_surfS(:,:,bi,bj) =
75 heimbach 1.6 CADJ & comlev1_bibj, key = idynkey, byte = isbyte
76 gforget 1.8 CADJ STORE hFac_surfW(:,:,bi,bj) =
77     CADJ & comlev1_bibj, key = idynkey, byte = isbyte
78     CADJ STORE hFac_surfNm1C(:,:,bi,bj) =
79     CADJ & comlev1_bibj, key = idynkey, byte = isbyte
80     CADJ STORE hFac_surfNm1S(:,:,bi,bj) =
81     CADJ & comlev1_bibj, key = idynkey, byte = isbyte
82     CADJ STORE hFac_surfNm1W(:,:,bi,bj) =
83 heimbach 1.6 CADJ & comlev1_bibj, key = idynkey, byte = isbyte
84     # endif /* ALLOW_AUTODIFF_TAMC */
85 jmc 1.3 C-- Apply OBC to hFac_surfW,S before updating hFacW,S
86 heimbach 1.6 IF (useOBCS) THEN
87 gforget 1.8 IF (useLatest) then
88 heimbach 1.6 CALL OBCS_APPLY_SURF_DR(
89 jmc 1.7 I bi, bj,
90 jmc 1.3 U hFac_surfC, hFac_surfW, hFac_surfS,
91     I myThid )
92 gforget 1.8 ELSE
93     CALL OBCS_APPLY_SURF_DR(
94     I bi, bj,
95     U hFac_surfNm1C, hFac_surfNm1W, hFac_surfNm1S,
96     I myThid )
97     ENDIF
98 heimbach 1.6 ENDIF
99 jmc 1.3 #endif /* ALLOW_OBCS */
100    
101 gforget 1.8 IF (useLatest) then
102    
103 jmc 1.1 C-- Update the fractional thickness "hFacC" of the surface level ksurfC :
104     DO j=1-Oly,sNy+Oly
105     DO i=1-Olx,sNx+Olx
106     ks = ksurfC(i,j,bi,bj)
107     IF (ks.LE.Nr) THEN
108     hFacC(i,j,ks,bi,bj) = hFac_surfC(i,j,bi,bj)
109     recip_hFacC(i,j,ks,bi,bj)= 1. _d 0 / hFac_surfC(i,j,bi,bj)
110     ENDIF
111     ENDDO
112     ENDDO
113    
114     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
115     C-- Update fractional thickness "hFacW" & "hFacS" (at U and V points)
116    
117     DO j=1-Oly,sNy+Oly
118     DO i=2-Olx,sNx+Olx
119     ks = ksurfW(i,j,bi,bj)
120     IF (ks.LE.Nr) THEN
121     hFacW(i,j,ks,bi,bj) = hFac_surfW(i,j,bi,bj)
122     recip_hFacW(i,j,ks,bi,bj)= 1. _d 0 / hFac_surfW(i,j,bi,bj)
123     ENDIF
124     ENDDO
125     ENDDO
126     DO j=2-Oly,sNy+Oly
127     DO i=1-Olx,sNx+Olx
128     ks = ksurfS(i,j,bi,bj)
129     IF (ks.LE.Nr) THEN
130     hFacS(i,j,ks,bi,bj) = hFac_surfS(i,j,bi,bj)
131     recip_hFacS(i,j,ks,bi,bj)= 1. _d 0 / hFac_surfS(i,j,bi,bj)
132     ENDIF
133     ENDDO
134     ENDDO
135    
136 gforget 1.8 ELSE
137    
138     C-- Update the fractional thickness "hFacC" of the surface level ksurfC
139     C:
140     DO j=1-Oly,sNy+Oly
141     DO i=1-Olx,sNx+Olx
142     ks = ksurfC(i,j,bi,bj)
143     IF (ks.LE.Nr) THEN
144     hFacC(i,j,ks,bi,bj) = hFac_surfNm1C(i,j,bi,bj)
145     recip_hFacC(i,j,ks,bi,bj)= 1. _d 0 / hFac_surfNm1C(i,j,bi,bj)
146     ENDIF
147     ENDDO
148     ENDDO
149    
150     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
151     C-- Update fractional thickness "hFacW" & "hFacS" (at U and V points)
152    
153     DO j=1-Oly,sNy+Oly
154     DO i=2-Olx,sNx+Olx
155     ks = ksurfW(i,j,bi,bj)
156     IF (ks.LE.Nr) THEN
157     hFacW(i,j,ks,bi,bj) = hFac_surfNm1W(i,j,bi,bj)
158     recip_hFacW(i,j,ks,bi,bj)= 1. _d 0 / hFac_surfNm1W(i,j,bi,bj)
159     ENDIF
160     ENDDO
161     ENDDO
162     DO j=2-Oly,sNy+Oly
163     DO i=1-Olx,sNx+Olx
164     ks = ksurfS(i,j,bi,bj)
165     IF (ks.LE.Nr) THEN
166     hFacS(i,j,ks,bi,bj) = hFac_surfNm1S(i,j,bi,bj)
167     recip_hFacS(i,j,ks,bi,bj)= 1. _d 0 / hFac_surfNm1S(i,j,bi,bj)
168     ENDIF
169     ENDDO
170     ENDDO
171    
172     ENDIF
173    
174 jmc 1.1 C- end bi,bj loop
175     ENDDO
176     ENDDO
177    
178     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
179     #endif /* NONLIN_FRSURF */
180    
181     RETURN
182     END
  ViewVC Help
Powered by ViewVC 1.1.22