/[MITgcm]/MITgcm/pkg/ctrl/adctrl_bound.F
ViewVC logotype

Annotation of /MITgcm/pkg/ctrl/adctrl_bound.F

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

Revision 1.7 - (hide annotations) (download)
Tue Apr 7 14:43:20 2009 UTC (15 years, 2 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint62, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62i, checkpoint62h, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.6: +3 -3 lines 
remove comma before parenthesis
1 jmc 1.7 C $Header: /u/gcmpack/MITgcm/pkg/ctrl/adctrl_bound.F,v 1.6 2009/04/06 23:30:42 heimbach Exp $
2 jmc 1.2 C $Name: $
3 gforget 1.1
4     #include "CPP_OPTIONS.h"
5    
6     C !ROUTINE: ADCTRL_BOUND_3D
7     C !INTERFACE:
8     SUBROUTINE ADCTRL_BOUND_3D(
9 heimbach 1.6 I fieldCur, adjFieldCur,
10     I maskFld3d, boundsVec, myThid
11     I )
12 gforget 1.1 C !DESCRIPTION: \bv
13     C *==========================================================*
14 gforget 1.4 C | started: Gael Forget gforget@mit.edu 20-Aug-2007
15     C |
16     C | o in forward mode: impose bounds on ctrl vector values
17     C | o in adjoint mode: do nothing ... or emulate local minimum
18 gforget 1.1 C *==========================================================*
19    
20     #include "SIZE.h"
21     #include "EEPARAMS.h"
22     #include "PARAMS.h"
23    
24     integer myThid,bi,bj,i,j,k
25 gforget 1.4 integer itlo,ithi,jtlo,jthi
26     _RL fieldCur(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nsx,nsy)
27     _RL maskFld3d(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nsx,nsy)
28     _RL adjFieldCur(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nsx,nsy)
29     _RL boundsVec(5)
30     _RL x0,x0p5,l0p5,x1,x2,x2p5,l2p5,x3
31 jmc 1.7 _RL tmpCur,xCur,adxCur
32 gforget 1.4
33     jtlo = mybylo(mythid)
34     jthi = mybyhi(mythid)
35     itlo = mybxlo(mythid)
36     ithi = mybxhi(mythid)
37    
38    
39     #ifdef ALLOW_ADCTRLBOUND
40    
41     x0=boundsVec(1)
42     x1=boundsVec(2)
43 gforget 1.5 x0p5=(x0+x1)/2.0
44     l0p5=(x1-x0)/2.0
45 gforget 1.4 x2=boundsVec(3)
46     x3=boundsVec(4)
47 gforget 1.5 x2p5=(x2+x3)/2.0
48     l2p5=(x3-x2)/2.0
49 gforget 1.4
50     C x0<x1<x2<x3 => ctrl_bound and adctrl_bound act on xx/adxx
51     C x0=x3 => ctrl_bound and adctrl_bound do nothing
52     C otherwise => error
53    
54     if ( x0.LT.x3 ) then
55     if ( (x0.LT.x1).AND.(x1.LT.x2).AND.(x2.LT.x3) ) then
56    
57     do bj = jtlo,jthi
58     do bi = itlo,ithi
59     do k = 1,nr
60     do j = 1,sny
61     do i = 1,snx
62     IF (maskFld3d(i,j,k,bi,bj).NE.0.) then
63     xCur=fieldCur(i,j,k,bi,bj)
64     adxCur=adjFieldCur(i,j,k,bi,bj)
65     IF ( (xCur.gt.x2).AND.(adxCur.LT.0) ) then
66 gforget 1.5 tmpCur=1.0
67     adjFieldCur(i,j,k,bi,bj)=abs(adxCur)*
68     & min((xCur-x2p5)/l2p5,tmpCur)
69 gforget 1.4 ENDIF
70     IF ( (xCur.lt.x1).AND.(adxCur.GT.0) ) then
71 gforget 1.5 tmpCur=-1.0
72     adjFieldCur(i,j,k,bi,bj)=abs(adxCur)*
73     & max((xCur-x0p5)/l0p5,tmpCur)
74 gforget 1.4 ENDIF
75     ENDIF
76     enddo
77     enddo
78     enddo
79     enddo
80     enddo
81    
82     else
83     print*,"boundsVec is not self-consistent"
84     stop
85     endif
86     endif
87    
88     #endif
89 gforget 1.1
90     end
91    
92     C !ROUTINE: ADCTRL_BOUND_2D
93     C !INTERFACE:
94     SUBROUTINE ADCTRL_BOUND_2D(
95 heimbach 1.6 I fieldCur,adjFieldCur,
96 jmc 1.7 I maskFld3d,boundsVec,myThid
97 heimbach 1.6 I )
98 gforget 1.1 C !DESCRIPTION: \bv
99     C *==========================================================*
100 gforget 1.4 C | started: Gael Forget gforget@mit.edu 20-Aug-2007
101     C |
102     C | o in forward mode: impose bounds on ctrl vector values
103     C | o in adjoint mode: do nothing ... or emulate local minimum
104 gforget 1.1 C *==========================================================*
105    
106     #include "SIZE.h"
107     #include "EEPARAMS.h"
108     #include "PARAMS.h"
109    
110     integer myThid,bi,bj,i,j,k
111 gforget 1.4 integer itlo,ithi,jtlo,jthi
112     _RL fieldCur(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nsx,nsy)
113     _RL maskFld3d(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nsx,nsy)
114     _RL adjFieldCur(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nsx,nsy)
115     _RL boundsVec(5)
116 gforget 1.5 _RL x0,x0p5,l0p5,x1,x2,x2p5,l2p5,x3
117     _RL tmpCur,xCur,adxCur
118 gforget 1.4
119     jtlo = mybylo(mythid)
120     jthi = mybyhi(mythid)
121     itlo = mybxlo(mythid)
122     ithi = mybxhi(mythid)
123    
124    
125     #ifdef ALLOW_ADCTRLBOUND
126    
127     x0=boundsVec(1)
128     x1=boundsVec(2)
129 gforget 1.5 x0p5=(x0+x1)/2.0
130     l0p5=(x1-x0)/2.0
131 gforget 1.4 x2=boundsVec(3)
132     x3=boundsVec(4)
133 gforget 1.5 x2p5=(x2+x3)/2.0
134     l2p5=(x3-x2)/2.0
135 gforget 1.4
136     C x0<x1<x2<x3 => ctrl_bound and adctrl_bound act on xx/adxx
137     C x0=x3 => ctrl_bound and adctrl_bound do nothing
138     C otherwise => error
139    
140     if ( x0.LT.x3 ) then
141     if ( (x0.LT.x1).AND.(x1.LT.x2).AND.(x2.LT.x3) ) then
142    
143     do bj = jtlo,jthi
144     do bi = itlo,ithi
145     do j = 1,sny
146     do i = 1,snx
147     IF (maskFld3d(i,j,1,bi,bj).NE.0.) then
148     xCur=fieldCur(i,j,bi,bj)
149     adxCur=adjFieldCur(i,j,bi,bj)
150     IF ( (xCur.gt.x2).AND.(adxCur.LT.0) ) then
151 gforget 1.5 tmpCur=1.0
152     adjFieldCur(i,j,bi,bj)=abs(adxCur)*
153     & min((xCur-x2p5)/l2p5,tmpCur)
154 gforget 1.4 ENDIF
155     IF ( (xCur.lt.x1).AND.(adxCur.GT.0) ) then
156 gforget 1.5 tmpCur=-1.0
157     adjFieldCur(i,j,bi,bj)=abs(adxCur)*
158     & max((xCur-x0p5)/l0p5,tmpCur)
159 gforget 1.4 ENDIF
160     ENDIF
161     enddo
162     enddo
163     enddo
164     enddo
165    
166     else
167     print*,"boundsVec is not self-consistent"
168     stop
169     endif
170     endif
171    
172     #endif
173 gforget 1.1
174     end
175    
  ViewVC Help
Powered by ViewVC 1.1.22