/[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.9 - (show annotations) (download)
Sun Feb 22 23:50:22 2015 UTC (9 years, 4 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, HEAD
Changes since 1.8: +14 -51 lines
Complete switch to active I/O for OpenAD verification exps.

1 C $Header: /u/gcmpack/MITgcm/verification/hs94.1x64x5/code_oad/ctrl_map_ini_genarr.F,v 1.4 2015/01/28 12:36:35 heimbach 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*( 80) 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 if ( iarr .eq. 1 ) then
97 theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
98 & + tmpfld2d(i,j,bi,bj)
99 elseif ( iarr .eq. 2 ) then
100 salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
101 & + tmpfld2d(i,j,bi,bj)
102 endif
103 enddo
104 enddo
105 ENDDO
106 ENDDO
107 C-- end iarr loop
108 ENDDO
109
110 _EXCH_XYZ_RL( theta, myThid )
111 _EXCH_XYZ_RL( salt, myThid )
112
113 #endif /* ALLOW_GENARR2D_CONTROL */
114
115 #ifdef ALLOW_GENARR3D_CONTROL
116 C-- An example of connecting specific fields
117 C-- to 3 generic 3D control arrays
118 cc--->>>
119 cc--->>> COMPILE FAILURE IS DELIBERATE
120 cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
121 cc--->>>
122 C-- generic - user-defined control vars
123 DO iarr = 1, maxCtrlArr3D
124
125 fnamebase = xx_genarr3d_file(iarr)
126 il=ILNBLNK( fnamebase )
127 write(fnamegeneric(1:80),'(2a,i10.10)')
128 & fnamebase(1:il),'.',optimcycle
129 CALL ACTIVE_READ_XYZ( fnamegeneric, tmpfld3d, 1,
130 & doglobalread, ladinit, optimcycle,
131 & myThid, xx_genarr3d_dummy(iarr) )
132 DO bj=myByLo(myThid), myByHi(myThid)
133 DO bi=myBxLo(myThid), myBxHi(myThid)
134 do k = 1,Nr
135 do j = jmin,jmax
136 do i = imin,imax
137 cc if ( iarr .eq. 1 ) then
138 cc theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj)
139 cc & + fac*tmpfld3d(i,j,k,bi,bj)
140 cc elseif ( iarr .eq. 2 ) then
141 cc salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
142 cc & + fac*tmpfld3d(i,j,k,bi,bj)
143 cc endif
144 enddo
145 enddo
146 enddo
147 ENDDO
148 ENDDO
149 C-- end iarr loop
150 ENDDO
151
152 cc _EXCH_XYZ_RL( theta, myThid )
153 cc _EXCH_XYZ_RL( salt, myThid )
154
155 #endif /* ALLOW_GENARR3D_CONTROL */
156
157 RETURN
158 END

  ViewVC Help
Powered by ViewVC 1.1.22