/[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.8 - (show annotations) (download)
Sat Apr 26 19:55:12 2014 UTC (10 years, 4 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64w, checkpoint65h, checkpoint65i, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint65
Changes since 1.7: +5 -4 lines 
move additional anomaly fields of control vars (related to options:
ALLOW_KAPGM_CONTROL, ALLOW_KAPREDI_CONTROL and ALLOW_BOTTOMDRAG_CONTROL)
from DYNVARS.h into new header file: CTRL_FIELDS.h
1 C $Header: /u/gcmpack/MITgcm/verification/hs94.1x64x5/code_ad/ctrl_map_ini_genarr.F,v 1.7 2014/04/05 21:44:33 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_FIELDS.h"
33 #include "CTRL_GENARR.h"
34 #include "ctrl_dummy.h"
35 #include "optim.h"
36 #ifdef ALLOW_PTRACERS
37 # include "PTRACERS_SIZE.h"
38 c#include "PTRACERS_PARAMS.h"
39 # include "PTRACERS_FIELDS.h"
40 #endif
41
42 C !INPUT/OUTPUT PARAMETERS:
43 C == routine arguments ==
44 INTEGER myThid
45
46 C !FUNCTIONS:
47 INTEGER ILNBLNk
48 EXTERNAL ILNBLNK
49
50 C !LOCAL VARIABLES:
51 C == local variables ==
52 integer bi,bj
53 integer i,j,k
54 integer jmin,jmax
55 integer imin,imax
56 integer il
57 integer iarr
58
59 logical doglobalread
60 logical ladinit
61 character*(MAX_LEN_FNAM) fnamebase
62 character*( 80) fnamegeneric
63 character*(MAX_LEN_MBUF) msgBuf
64 _RL fac
65 CEOP
66
67 jmin = 1
68 jmax = sNy
69 imin = 1
70 imax = sNx
71
72 doglobalread = .false.
73 ladinit = .false.
74 fac = 1. _d 0
75
76 #ifdef ALLOW_GENARR2D_CONTROL
77 C-- An example of connecting specific fields
78 C-- to 3 generic 2D control arrays
79 cc--->>>
80 cc--->>> COMPILE FAILURE IS DELIBERATE
81 cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
82 cc--->>>
83 C-- generic - user-defined control vars
84 DO iarr = 1, maxCtrlArr2D
85
86 fnamebase = xx_genarr2d_file(iarr)
87 il=ILNBLNK( fnamebase )
88 write(fnamegeneric(1:80),'(2a,i10.10)')
89 & fnamebase(1:il),'.',optimcycle
90 CALL ACTIVE_READ_XY ( fnamegeneric, tmpfld2d, 1,
91 & doglobalread, ladinit, optimcycle,
92 & myThid, xx_genarr2d_dummy(iarr) )
93 DO bj=myByLo(myThid), myByHi(myThid)
94 DO bi=myBxLo(myThid), myBxHi(myThid)
95 do j = jmin,jmax
96 do i = imin,imax
97 #ifndef ALLOW_OPENAD
98 if ( iarr .eq. 1 ) then
99 # ifdef ALLOW_BOTTOMDRAG_CONTROL
100 bottomDragFld(i,j,bi,bj) = bottomDragFld(i,j,bi,bj)
101 & + tmpfld2d(i,j,bi,bj)
102 # endif
103 elseif ( iarr .eq. 2 ) then
104 theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
105 & + tmpfld2d(i,j,bi,bj)
106 elseif ( iarr .eq. 3 ) then
107 salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
108 & + tmpfld2d(i,j,bi,bj)
109 endif
110 #else
111 if ( iarr .eq. 1 ) then
112 # ifdef ALLOW_BOTTOMDRAG_CONTROL
113 bottomDragFld(i,j,bi,bj) = bottomDragFld(i,j,bi,bj)
114 & + xx_genarr2d(i,j,bi,bj,iarr)
115 & + tmpfld2d(i,j,bi,bj)
116 # endif
117 elseif ( iarr .eq. 2 ) then
118 theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
119 & + xx_genarr2d(i,j,bi,bj,iarr)
120 & + tmpfld2d(i,j,bi,bj)
121 elseif ( iarr .eq. 3 ) then
122 salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
123 & + xx_genarr2d(i,j,bi,bj,iarr)
124 & + tmpfld2d(i,j,bi,bj)
125 endif
126 #endif /* ALLOW_OPENAD */
127 enddo
128 enddo
129 ENDDO
130 ENDDO
131 C-- end iarr loop
132 ENDDO
133 #ifdef ALLOW_BOTTOMDRAG_CONTROL
134 _EXCH_XY_RL( bottomDragFld, myThid )
135 #endif
136 _EXCH_XYZ_RL( theta, myThid )
137 _EXCH_XYZ_RL( salt, myThid )
138
139 #endif /* ALLOW_GENARR2D_CONTROL */
140
141 #ifdef ALLOW_GENARR3D_CONTROL
142 C-- An example of connecting specific fields
143 C-- to 3 generic 3D control arrays
144 cc--->>>
145 cc--->>> COMPILE FAILURE IS DELIBERATE
146 cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
147 cc--->>>
148 C-- generic - user-defined control vars
149 DO iarr = 1, maxCtrlArr3D
150
151 fnamebase = xx_genarr3d_file(iarr)
152 il=ILNBLNK( fnamebase )
153 write(fnamegeneric(1:80),'(2a,i10.10)')
154 & fnamebase(1:il),'.',optimcycle
155 CALL ACTIVE_READ_XYZ( fnamegeneric, tmpfld3d, 1,
156 & doglobalread, ladinit, optimcycle,
157 & myThid, xx_genarr3d_dummy(iarr) )
158 DO bj=myByLo(myThid), myByHi(myThid)
159 DO bi=myBxLo(myThid), myBxHi(myThid)
160 do k = 1,Nr
161 do j = jmin,jmax
162 do i = imin,imax
163 #ifndef ALLOW_OPENAD
164 if ( iarr .eq. 1 ) then
165 theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj)
166 & + fac*tmpfld3d(i,j,k,bi,bj)
167 elseif ( iarr .eq. 2 ) then
168 salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
169 & + fac*tmpfld3d(i,j,k,bi,bj)
170 endif
171 #else
172 if ( iarr .eq. 1 ) then
173 theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj)
174 & + fac*xx_genarr3d(i,j,k,bi,bj,iarr)
175 & + fac*tmpfld3d(i,j,k,bi,bj)
176 elseif ( iarr .eq. 2 ) then
177 salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
178 & + fac*xx_genarr3d(i,j,k,bi,bj,iarr)
179 & + fac*tmpfld3d(i,j,k,bi,bj)
180 endif
181 #endif /* ALLOW_OPENAD */
182 enddo
183 enddo
184 enddo
185 ENDDO
186 ENDDO
187 C-- end iarr loop
188 ENDDO
189 _EXCH_XYZ_RL( theta, myThid )
190 _EXCH_XYZ_RL( salt, myThid )
191
192 #endif /* ALLOW_GENARR3D_CONTROL */
193
194 RETURN
195 END
  ViewVC Help
Powered by ViewVC 1.1.22