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

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

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


Revision 1.2 - (show annotations) (download)
Wed Feb 18 20:47:01 2015 UTC (9 years, 3 months ago) by heimbach
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +1 -1 lines
FILE REMOVED
Update verification.

1 C $Header: /u/gcmpack/MITgcm/verification/hs94.1x64x5/code_ad/ctrl_map_ini_gentim2d.F,v 1.1 2015/02/06 22:15:11 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 #ifndef ALLOW_OPENAD
26 #include "SIZE.h"
27 #include "EEPARAMS.h"
28 #include "PARAMS.h"
29 #include "GRID.h"
30 #include "DYNVARS.h"
31 #include "FFIELDS.h"
32 #include "CTRL_SIZE.h"
33 #include "ctrl.h"
34 #include "optim.h"
35 #include "ctrl_dummy.h"
36 #include "CTRL_GENARR.h"
37 #ifdef ALLOW_PTRACERS
38 # include "PTRACERS_SIZE.h"
39 # include "PTRACERS_FIELDS.h"
40 #endif
41 #ifdef ALLOW_AUTODIFF
42 #include "tamc.h"
43 #endif
44 #endif
45
46 C !INPUT/OUTPUT PARAMETERS:
47 C == routine arguments ==
48 INTEGER myThid
49
50 #ifndef ALLOW_OPENAD
51 #ifdef ALLOW_GENTIM2D_CONTROL
52 C !LOCAL VARIABLES:
53 C == local variables ==
54 integer iarr
55 integer smoothOpNb
56 character*(80) fnamegenIn
57 character*(80) fnamegenOut
58 integer startrec
59 integer endrec
60 integer diffrec
61 integer irec, jrec, krec
62 integer replicated_nrec
63 integer replicated_ntimes
64 logical doglobalread
65 logical ladinit
66 _RL xx_gen(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
67 integer bi,bj
68 integer i,j,k2
69 INTEGER ILNBLNK
70 EXTERNAL ILNBLNK
71 integer ilgen
72 CEOP
73
74 c-- Now, read the control vector.
75 doglobalread = .false.
76 ladinit = .false.
77
78 C-- generic 2D control variables
79 DO iarr = 1, maxCtrlTim2D
80
81 diffrec=0
82 startrec=0
83 endrec=0
84
85 cph if (xx_gentim2d_weight(iarr).NE.' ') then
86
87 call ctrl_init_rec ( xx_gentim2d_file(iarr)(1:MAX_LEN_FNAM),
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 ilgen=ilnblnk( xx_gentim2d_file(iarr) )
97 write(fnamegenIn(1:80),'(2a,i10.10)')
98 & xx_gentim2d_file(iarr)(1:ilgen), '.', optimcycle
99 write(fnamegenOut(1:80),'(2a,i10.10)')
100 & xx_gentim2d_file(iarr)(1:ilgen),'.effective.',optimcycle
101
102 replicated_nrec=endrec
103 replicated_ntimes=0
104 do k2 = 1, maxCtrlProc
105 if (xx_gentim2d_preproc(k2,iarr).EQ.'replicate') then
106 if (xx_gentim2d_preproc_i(k2,iarr).NE.0) then
107 replicated_nrec=min(endrec,xx_gentim2d_preproc_i(k2,iarr))
108 replicated_ntimes=
109 & int(float(endrec)/float(replicated_nrec))
110 if (replicated_ntimes*replicated_nrec.LT.endrec)
111 & replicated_ntimes=replicated_ntimes+1
112 if (replicated_ntimes*replicated_nrec.GT.endrec)
113 & replicated_ntimes=replicated_ntimes-1
114 endif
115 endif
116 enddo
117
118 DO irec = 1, replicated_nrec
119 #ifdef ALLOW_AUTODIFF
120 CADJ STORE xx_gentim2d_dummy = ctrltape, key = 1 , kind = isbyte
121 #endif
122
123 call active_read_xy( fnamegenIn, xx_gen, irec,
124 & doglobalread, ladinit, optimcycle,
125 & mythid, xx_gentim2d_dummy(iarr) )
126
127 call active_write_xy( fnamegenOut, xx_gen, irec, optimcycle,
128 & mythid, xx_gentim2d_dummy(iarr) )
129
130 c-- end irec loop
131 ENDDO
132
133 DO jrec = 1, replicated_ntimes
134 DO irec = 1, replicated_nrec
135 #ifdef ALLOW_AUTODIFF
136 CADJ STORE xx_gentim2d_dummy = ctrltape, key = 1 , kind = isbyte
137 #endif
138 krec=replicated_nrec*(jrec-1)+irec
139 IF (krec.LE.endrec) THEN
140 call active_read_xy( fnamegenOut, xx_gen, irec,
141 & doglobalread, ladinit, optimcycle,
142 & mythid, xx_gentim2d_dummy(iarr) )
143 call active_write_xy( fnamegenOut, xx_gen, krec, optimcycle,
144 & mythid, xx_gentim2d_dummy(iarr) )
145 ENDIF
146 ENDDO
147 ENDDO
148
149 cph endif
150
151 c-- end iarr loop
152 ENDDO
153
154 #endif /* ALLOW_GENTIM2D_CONTROL */
155 #endif /* ALLOW_OPENAD */
156
157 RETURN
158 END
159

  ViewVC Help
Powered by ViewVC 1.1.22