/[MITgcm]/MITgcm/pkg/ctrl/ctrl_map_ini_gentim2d.F
ViewVC logotype

Annotation of /MITgcm/pkg/ctrl/ctrl_map_ini_gentim2d.F

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


Revision 1.1 - (hide annotations) (download)
Tue Dec 2 12:34:03 2014 UTC (10 years, 7 months ago) by gforget
Branch: MAIN
- move gentim2d part of ctrl_map_ini_genarr.F to
  new separate routine : ctrl_map_ini_gentim2d.F

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

  ViewVC Help
Powered by ViewVC 1.1.22