/[MITgcm]/MITgcm/verification/hs94.1x64x5/code_ad/ctrl_map_ini_genarr.F
ViewVC logotype

Contents of /MITgcm/verification/hs94.1x64x5/code_ad/ctrl_map_ini_genarr.F

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


Revision 1.6 - (show annotations) (download)
Fri Jun 21 16:24:39 2013 UTC (11 years, 1 month ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint64o, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64n, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l
Changes since 1.5: +40 -6 lines
OpenAD-compliant modifs

1 C $Header: /u/gcmpack/MITgcm/verification/hs94.1x64x5/code_ad/ctrl_map_ini_genarr.F,v 1.4 2012/08/12 19:59:03 jmc Exp $
2 C $Name: $
3
4 #include "CTRL_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: CTRL_MAP_INI_GENARR
8 C !INTERFACE:
9 SUBROUTINE CTRL_MAP_INI_GENARR( myThid )
10
11 C !DESCRIPTION: \bv
12 C *=================================================================
13 C | SUBROUTINE CTRL_MAP_INI_GENARR
14 C | Add the generic arrays of the
15 C | control vector to the model state and update the tile halos.
16 C | The control vector is defined in the header file "ctrl.h".
17 C *=================================================================
18 C \ev
19
20 C !USES:
21 IMPLICIT NONE
22
23 C == global variables ==
24 #include "SIZE.h"
25 #include "EEPARAMS.h"
26 #include "PARAMS.h"
27 #include "GRID.h"
28 #include "DYNVARS.h"
29 #include "FFIELDS.h"
30 #include "CTRL_SIZE.h"
31 #include "ctrl.h"
32 #include "CTRL_GENARR.h"
33 #include "ctrl_dummy.h"
34 #include "optim.h"
35 #ifdef ALLOW_PTRACERS
36 # include "PTRACERS_SIZE.h"
37 c#include "PTRACERS_PARAMS.h"
38 # include "PTRACERS_FIELDS.h"
39 #endif
40
41 C !INPUT/OUTPUT PARAMETERS:
42 C == routine arguments ==
43 INTEGER myThid
44
45 C !FUNCTIONS:
46 INTEGER ILNBLNk
47 EXTERNAL ILNBLNK
48
49 C !LOCAL VARIABLES:
50 C == local variables ==
51 integer bi,bj
52 integer i,j,k
53 integer jmin,jmax
54 integer imin,imax
55 integer il
56 integer iarr
57
58 logical doglobalread
59 logical ladinit
60 character*(MAX_LEN_FNAM) fnamebase
61 character*( 80) fnamegeneric
62 character*(MAX_LEN_MBUF) msgBuf
63 _RL fac
64 CEOP
65
66 jmin = 1
67 jmax = sNy
68 imin = 1
69 imax = sNx
70
71 doglobalread = .false.
72 ladinit = .false.
73 fac = 1. _d 0
74
75 #ifdef ALLOW_GENARR2D_CONTROL
76 C-- An example of connecting specific fields
77 C-- to 3 generic 2D control arrays
78 cc--->>>
79 cc--->>> COMPILE FAILURE IS DELIBERATE
80 cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
81 cc--->>>
82 C-- generic - user-defined control vars
83 DO iarr = 1, maxCtrlArr2D
84
85 fnamebase = xx_genarr2d_file(iarr)
86 il=ILNBLNK( fnamebase )
87 write(fnamegeneric(1:80),'(2a,i10.10)')
88 & fnamebase(1:il),'.',optimcycle
89 CALL ACTIVE_READ_XY ( fnamegeneric, tmpfld2d, 1,
90 & doglobalread, ladinit, optimcycle,
91 & myThid, xx_genarr2d_dummy(iarr) )
92 DO bj=myByLo(myThid), myByHi(myThid)
93 DO bi=myBxLo(myThid), myBxHi(myThid)
94 do j = jmin,jmax
95 do i = imin,imax
96 #ifndef ALLOW_AUTODIFF_OPENAD
97 if ( iarr .eq. 1 ) then
98 # ifdef ALLOW_BOTTOMDRAG_CONTROL
99 bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)
100 & + tmpfld2d(i,j,bi,bj)
101 # endif
102 elseif ( iarr .eq. 2 ) then
103 theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
104 & + tmpfld2d(i,j,bi,bj)
105 elseif ( iarr .eq. 3 ) then
106 salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
107 & + tmpfld2d(i,j,bi,bj)
108 endif
109 #else
110 if ( iarr .eq. 1 ) then
111 # ifdef ALLOW_BOTTOMDRAG_CONTROL
112 bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)
113 & + xx_genarr2d(i,j,bi,bj,iarr)
114 & + tmpfld2d(i,j,bi,bj)
115 # endif
116 elseif ( iarr .eq. 2 ) then
117 theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
118 & + xx_genarr2d(i,j,bi,bj,iarr)
119 & + tmpfld2d(i,j,bi,bj)
120 elseif ( iarr .eq. 3 ) then
121 salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
122 & + xx_genarr2d(i,j,bi,bj,iarr)
123 & + tmpfld2d(i,j,bi,bj)
124 endif
125 #endif /* ALLOW_AUTODIFF_OPENAD */
126 enddo
127 enddo
128 ENDDO
129 ENDDO
130 C-- end iarr loop
131 ENDDO
132 #ifdef ALLOW_BOTTOMDRAG_CONTROL
133 _EXCH_XY_RL( bottomdragfld, myThid )
134 #endif
135 _EXCH_XYZ_RL( theta, myThid )
136 _EXCH_XYZ_RL( salt, myThid )
137
138 #endif /* ALLOW_GENARR2D_CONTROL */
139
140 #ifdef ALLOW_GENARR3D_CONTROL
141 C-- An example of connecting specific fields
142 C-- to 3 generic 3D control arrays
143 cc--->>>
144 cc--->>> COMPILE FAILURE IS DELIBERATE
145 cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
146 cc--->>>
147 C-- generic - user-defined control vars
148 DO iarr = 1, maxCtrlArr3D
149
150 fnamebase = xx_genarr3d_file(iarr)
151 il=ILNBLNK( fnamebase )
152 write(fnamegeneric(1:80),'(2a,i10.10)')
153 & fnamebase(1:il),'.',optimcycle
154 CALL ACTIVE_READ_XYZ( fnamegeneric, tmpfld3d, 1,
155 & doglobalread, ladinit, optimcycle,
156 & myThid, xx_genarr3d_dummy(iarr) )
157 DO bj=myByLo(myThid), myByHi(myThid)
158 DO bi=myBxLo(myThid), myBxHi(myThid)
159 do k = 1,Nr
160 do j = jmin,jmax
161 do i = imin,imax
162 #ifndef ALLOW_AUTODIFF_OPENAD
163 if ( iarr .eq. 1 ) then
164 theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj)
165 & + fac*tmpfld3d(i,j,k,bi,bj)
166 elseif ( iarr .eq. 2 ) then
167 salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
168 & + fac*tmpfld3d(i,j,k,bi,bj)
169 endif
170 #else
171 if ( iarr .eq. 1 ) then
172 theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj)
173 & + fac*xx_genarr3d(i,j,k,bi,bj,iarr)
174 & + fac*tmpfld3d(i,j,k,bi,bj)
175 elseif ( iarr .eq. 2 ) then
176 salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
177 & + fac*xx_genarr3d(i,j,k,bi,bj,iarr)
178 & + fac*tmpfld3d(i,j,k,bi,bj)
179 endif
180 #endif /* ALLOW_AUTODIFF_OPENAD */
181 enddo
182 enddo
183 enddo
184 ENDDO
185 ENDDO
186 C-- end iarr loop
187 ENDDO
188 _EXCH_XYZ_RL( theta, myThid )
189 _EXCH_XYZ_RL( salt, myThid )
190
191 #endif /* ALLOW_GENARR3D_CONTROL */
192
193 RETURN
194 END

  ViewVC Help
Powered by ViewVC 1.1.22