/[MITgcm]/MITgcm/verification/halfpipe_streamice/code_ad/ctrl_map_ini_gentim2d.F
ViewVC logotype

Contents of /MITgcm/verification/halfpipe_streamice/code_ad/ctrl_map_ini_gentim2d.F

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


Revision 1.1 - (show annotations) (download)
Thu Feb 19 16:52:03 2015 UTC (9 years 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
Update verification, use time-dependent controls with active I/O

1 C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_map_ini_gentim2d.F,v 1.5 2015/02/17 13:54:21 heimbach Exp $
2 C $Name: $
3
4 #include "CTRL_OPTIONS.h"
5 #ifdef ALLOW_AUTODIFF
6 # include "AUTODIFF_OPTIONS.h"
7 #endif
8
9 CBOP
10 C !ROUTINE: CTRL_MAP_INI_GENTIM2D
11 C !INTERFACE:
12 SUBROUTINE CTRL_MAP_INI_GENTIM2D( myThid )
13
14 C !DESCRIPTION: \bv
15 C *=================================================================
16 C | SUBROUTINE CTRL_MAP_INI_GENTIM2D
17 C | Dimensionalize and preprocess time variable controls.
18 C *=================================================================
19 C \ev
20
21 C !USES:
22 IMPLICIT NONE
23
24 C == global variables ==
25 #include "SIZE.h"
26 #include "EEPARAMS.h"
27 #include "PARAMS.h"
28 #include "GRID.h"
29 #include "DYNVARS.h"
30 #include "FFIELDS.h"
31 #include "CTRL_SIZE.h"
32 #include "ctrl.h"
33 #include "optim.h"
34 #include "ctrl_dummy.h"
35 #include "CTRL_GENARR.h"
36 #ifdef ALLOW_PTRACERS
37 # include "PTRACERS_SIZE.h"
38 # include "PTRACERS_FIELDS.h"
39 #endif
40 #ifdef ALLOW_AUTODIFF
41 #include "tamc.h"
42 #endif
43
44 C !INPUT/OUTPUT PARAMETERS:
45 C == routine arguments ==
46 INTEGER myThid
47
48 #ifdef ALLOW_GENTIM2D_CONTROL
49 C !LOCAL VARIABLES:
50 C == local variables ==
51 integer iarr
52 integer smoothOpNb
53 character*(80) fnamegenIn
54 character*(80) fnamegenOut
55 character*(80) fnamebase
56 character*(80) fnamegeneric
57 integer startrec
58 integer endrec
59 integer diffrec
60 integer irec, jrec, krec
61 integer replicated_nrec
62 integer replicated_ntimes
63 logical doglobalread
64 logical ladinit
65 _RL xx_gen(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
66 integer bi,bj
67 integer i,j,k2
68 INTEGER ILNBLNK
69 EXTERNAL ILNBLNK
70 integer ilgen
71 CEOP
72
73 c-- Now, read the control vector.
74 doglobalread = .false.
75 ladinit = .false.
76
77 C-- generic 2D control variables
78 DO iarr = 1, maxCtrlTim2D
79
80 diffrec=0
81 startrec=0
82 endrec=0
83
84 cph if (xx_gentim2d_weight(iarr).NE.' ') then
85
86 fnamebase = xx_gentim2d_file(iarr)
87 call ctrl_init_rec ( fnamebase,
88 I xx_gentim2d_startdate1(iarr),
89 I xx_gentim2d_startdate2(iarr),
90 I xx_gentim2d_period(iarr),
91 I 1,
92 O xx_gentim2d_startdate(1,iarr),
93 O diffrec, startrec, endrec,
94 I myThid )
95
96 fnamebase = xx_gentim2d_file(iarr)
97 ilgen=ilnblnk( fnamebase )
98 write(fnamegenIn(1:80),'(2a,i10.10)')
99 & fnamebase(1:ilgen),'.',optimcycle
100 write(fnamegenOut(1:80),'(2a,i10.10)')
101 & fnamebase(1:ilgen),'.effective.',optimcycle
102
103 smoothOpNb=1
104 do k2 = 1, maxCtrlProc
105 if (xx_gentim2d_preproc(k2,iarr).EQ.'smooth') then
106 if (xx_gentim2d_preproc_i(k2,iarr).NE.0)
107 & smoothOpNb=xx_gentim2d_preproc_i(k2,iarr)
108 endif
109 enddo
110
111 replicated_nrec=endrec
112 replicated_ntimes=0
113 do k2 = 1, maxCtrlProc
114 if (xx_gentim2d_preproc(k2,iarr).EQ.'replicate') then
115 if (xx_gentim2d_preproc_i(k2,iarr).NE.0) then
116 replicated_nrec=min(endrec,xx_gentim2d_preproc_i(k2,iarr))
117 replicated_ntimes=
118 & int(float(endrec)/float(replicated_nrec))
119 if (replicated_ntimes*replicated_nrec.LT.endrec)
120 & replicated_ntimes=replicated_ntimes+1
121 if (replicated_ntimes*replicated_nrec.GT.endrec)
122 & replicated_ntimes=replicated_ntimes-1
123 endif
124 endif
125 enddo
126
127 DO irec = 1, replicated_nrec
128 #ifdef ALLOW_AUTODIFF
129 CADJ STORE xx_gentim2d_dummy = ctrltape, key = 1 , kind = isbyte
130 #endif
131
132 call active_read_xy( fnamegenIn, xx_gen, irec,
133 & doglobalread, ladinit, optimcycle,
134 & mythid, xx_gentim2d_dummy(iarr) )
135
136 do k2 = 1, maxCtrlProc
137 if (xx_gentim2d_preproc(k2,iarr).EQ.'variaweight')
138 & call mdsreadfield( xx_gentim2d_weight(iarr), ctrlprec, 'RL',
139 & 1, wgentim2d(1-Olx,1-Oly,1,1,iarr), irec, myThid )
140 enddo
141
142 #ifdef ALLOW_SMOOTH
143 IF ( ctrlSmoothCorrel2D ) THEN
144 IF ( useSMOOTH ) THEN
145 call smooth_correl2D(xx_gen,maskC,smoothOpNb,mythid)
146
147 DO bj=myByLo(myThid), myByHi(myThid)
148 DO bi=myBxLo(myThid), myBxHi(myThid)
149 DO j = 1,sNy
150 DO i = 1,sNx
151 if ((maskC(i,j,1,bi,bj).NE.0.).AND.
152 & (wgentim2d(i,j,bi,bj,iarr).GT.0.)) then
153 xx_gen(i,j,bi,bj)=xx_gen(i,j,bi,bj)
154 & /sqrt(wgentim2d(i,j,bi,bj,iarr))
155 else
156 xx_gen(i,j,bi,bj)=0. _d 0
157 endif
158 ENDDO
159 ENDDO
160 ENDDO
161 ENDDO
162
163 CALL EXCH_XY_RL ( xx_gen , myThid )
164 ENDIF
165 ENDIF
166 #endif /* ALLOW_SMOOTH */
167
168 call active_write_xy( fnamegenOut, xx_gen, irec, optimcycle,
169 & mythid, xx_gentim2d_dummy(iarr) )
170
171 c-- end irec loop
172 ENDDO
173
174 DO jrec = 1, replicated_ntimes
175 DO irec = 1, replicated_nrec
176 #ifdef ALLOW_AUTODIFF
177 CADJ STORE xx_gentim2d_dummy = ctrltape, key = 1 , kind = isbyte
178 #endif
179 krec=replicated_nrec*(jrec-1)+irec
180 IF (krec.LE.endrec) THEN
181 call active_read_xy( fnamegenOut, xx_gen, irec,
182 & doglobalread, ladinit, optimcycle,
183 & mythid, xx_gentim2d_dummy(iarr) )
184 call active_write_xy( fnamegenOut, xx_gen, krec, optimcycle,
185 & mythid, xx_gentim2d_dummy(iarr) )
186 ENDIF
187 ENDDO
188 ENDDO
189
190 cph endif
191
192 c-- end iarr loop
193 ENDDO
194
195 #endif /* ALLOW_GENTIM2D_CONTROL */
196
197 RETURN
198 END
199

  ViewVC Help
Powered by ViewVC 1.1.22