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

Annotation 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 - (hide annotations) (download)
Thu Feb 19 16:52:03 2015 UTC (9 years, 1 month 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 heimbach 1.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