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

Diff of /MITgcm/pkg/ctrl/ctrl_get_gen.F

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

revision 1.4 by edhill, Sat Nov 1 04:50:02 2003 UTC revision 1.14 by jmc, Tue Aug 24 14:13:13 2010 UTC
# Line 6  C $Name$ Line 6  C $Name$
6    
7        subroutine ctrl_get_gen(        subroutine ctrl_get_gen(
8       I          xx_gen_file, xx_genstartdate, xx_genperiod,       I          xx_gen_file, xx_genstartdate, xx_genperiod,
9       I          genmask, genfld, xx_gen0, xx_gen1, xx_gen_dummy,       I          genmask, genfld, xx_gen0, xx_gen1, xx_gen_dummy,
10         I          xx_gen_remo_intercept, xx_gen_remo_slope,
11       I          mytime, myiter, mythid       I          mytime, myiter, mythid
12       &                     )       &                     )
13    
# Line 34  c     == global variables == Line 35  c     == global variables ==
35  #include "ctrl_dummy.h"  #include "ctrl_dummy.h"
36  #include "optim.h"  #include "optim.h"
37  #ifdef ALLOW_EXF  #ifdef ALLOW_EXF
38  # include "exf_fields.h"  # include "EXF_FIELDS.h"
39  #endif  #endif
40    
41  c     == routine arguments ==  c     == routine arguments ==
42    
43          character*(80) fnamegeneric
44        character*(MAX_LEN_FNAM) xx_gen_file        character*(MAX_LEN_FNAM) xx_gen_file
45        integer xx_genstartdate(4)        integer xx_genstartdate(4)
46        _RL     xx_genperiod        _RL     xx_genperiod
# Line 47  c     == routine arguments == Line 49  c     == routine arguments ==
49        _RL     xx_gen0(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL     xx_gen0(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
50        _RL     xx_gen1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)        _RL     xx_gen1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
51        _RL     xx_gen_dummy        _RL     xx_gen_dummy
52          _RL     xx_gen_remo_intercept
53          _RL     xx_gen_remo_slope
54    
55        _RL     mytime        _RL     mytime
56        integer myiter        integer myiter
# Line 64  c     == local variables == Line 68  c     == local variables ==
68        integer imin,imax        integer imin,imax
69        integer ilgen        integer ilgen
70    
71          _RL     gensign
72        _RL     genfac        _RL     genfac
73          logical doCtrlUpdate
74        logical genfirst        logical genfirst
75        logical genchanged        logical genchanged
76        integer gencount0        integer gencount0
# Line 98  c--   Now, read the control vector. Line 104  c--   Now, read the control vector.
104    
105        if (optimcycle .ge. 0) then        if (optimcycle .ge. 0) then
106          ilgen=ilnblnk( xx_gen_file )          ilgen=ilnblnk( xx_gen_file )
107          write(fnamegen(1:80),'(2a,i10.10)')          write(fnamegen(1:80),'(2a,i10.10)')
108       &       xx_gen_file(1:ilgen), '.', optimcycle       &       xx_gen_file(1:ilgen), '.', optimcycle
109        endif        endif
110    
111    # ifdef ALLOW_CAL
112             if ( xx_genperiod .EQ. 0 ) then
113    c     record numbers are assumed 1 to 12 corresponding to
114    c     Jan. through Dec.
115                call cal_GetMonthsRec(
116         O           genfac, genfirst, genchanged,
117         O           gencount0, gencount1,
118         I           mytime, myiter, mythid
119         &           )
120             else
121  c--   Get the counters, flags, and the interpolation factor.  c--   Get the counters, flags, and the interpolation factor.
122        call ctrl_get_gen_rec(        call ctrl_get_gen_rec(
123       I                   xx_genstartdate, xx_genperiod,       I                   xx_genstartdate, xx_genperiod,
124       O                   genfac, genfirst, genchanged,       O                   genfac, genfirst, genchanged,
125       O                   gencount0,gencount1,       O                   gencount0,gencount1,
126       I                   mytime, myiter, mythid )       I                   mytime, myiter, mythid )
127            endif
128    # else
129    c--   Get the counters, flags, and the interpolation factor.
130          call ctrl_get_gen_rec(
131         I                   xx_genstartdate, xx_genperiod,
132         O                   genfac, genfirst, genchanged,
133         O                   gencount0,gencount1,
134         I                   mytime, myiter, mythid )
135    # endif
136    
137        if ( genfirst ) then        if ( genfirst ) then
138          call active_read_xy_loc( fnamegen, xx_gen1, gencount0,          call active_read_xy( fnamegen, xx_gen1, gencount0,
139       &                       doglobalread, ladinit, optimcycle,       &                       doglobalread, ladinit, optimcycle,
140       &                       mythid, xx_gen_dummy )       &                       mythid, xx_gen_dummy )
141  #ifdef ALLOW_CTRL_SMOOTH  #ifdef ALLOW_CTRL_SMOOTH
142            call ctrl_smooth(xx_gen1,genmask)          if ( xx_gen_file .EQ. xx_tauu_file .OR.
143         &       xx_gen_file .EQ. xx_tauv_file )
144         &     call ctrl_smooth(xx_gen1,genmask)
145    #endif
146    #ifdef ALLOW_SMOOTH_CORREL2D
147          call smooth_correl2D(xx_gen1,genmask,1,mythid)
148          call smooth_correl2Dw(xx_gen1,genmask,xx_gen_file,mythid)
149          write(fnamegeneric(1:80),'(2a,i10.10)')
150         & xx_gen_file(1:ilgen),'.effective.',optimcycle
151          call mdswritefield(fnamegeneric,ctrlprec,.FALSE.,'RL',
152         & 1, xx_gen1, gencount0, optimcycle, mythid)
153  #endif  #endif
154        endif        endif
155    
156        if (( genfirst ) .or. ( genchanged )) then        if (( genfirst ) .or. ( genchanged )) then
157          call exf_SwapFFields( xx_gen0, xx_gen1, mythid )          call exf_SwapFFields( xx_gen0, xx_gen1, mythid )
158    
159          call active_read_xy_loc( fnamegen, xx_gen1 , gencount1,          call active_read_xy( fnamegen, xx_gen1 , gencount1,
160       &                       doglobalread, ladinit, optimcycle,       &                       doglobalread, ladinit, optimcycle,
161       &                       mythid, xx_gen_dummy )       &                       mythid, xx_gen_dummy )
162  #ifdef ALLOW_CTRL_SMOOTH  #ifdef ALLOW_CTRL_SMOOTH
163            call ctrl_smooth(xx_gen1,genmask)          if ( xx_gen_file .EQ. xx_tauu_file .OR.
164         &       xx_gen_file .EQ. xx_tauv_file )
165         &     call ctrl_smooth(xx_gen1,genmask)
166    #endif
167    #ifdef ALLOW_SMOOTH_CORREL2D
168          call smooth_correl2D(xx_gen1,genmask,1,mythid)
169          call smooth_correl2Dw(xx_gen1,genmask,xx_gen_file,mythid)
170          write(fnamegeneric(1:80),'(2a,i10.10)')
171         & xx_gen_file(1:ilgen),'.effective.',optimcycle
172          call mdswritefield(fnamegeneric,ctrlprec,.FALSE.,'RL',
173         & 1, xx_gen1, gencount1, optimcycle, mythid)
174  #endif  #endif
175        endif        endif
176    
177  c--   Add control to model variable.  c--   Add control to model variable.
178    cph(
179    cph this flag ported from the SIO code
180    cph Initial wind stress adjustments are too vigorous.
181          if ( gencount0 .LE. 2 .AND.
182         &     ( xx_gen_file .EQ. xx_tauu_file .OR.
183         &       xx_gen_file .EQ. xx_tauv_file ) .AND.
184         &     ( xx_genperiod .NE. 0 ) ) then
185             doCtrlUpdate = .FALSE.
186          else
187             doCtrlUpdate = .TRUE.
188          endif
189          if ( xx_gen_file .EQ. xx_tauu_file .OR.
190         &     xx_gen_file .EQ. xx_tauv_file ) then
191             gensign = -1.
192          else
193             gensign = 1.
194          endif
195    c
196    cph since the above is ECCO specific, we undo it here:
197    cph      doCtrlUpdate = .TRUE.
198    c
199          if ( doCtrlUpdate ) then
200    cph)
201        do bj = jtlo,jthi        do bj = jtlo,jthi
202          do bi = itlo,ithi          do bi = itlo,ithi
203  c--       Calculate mask for tracer cells (0 => land, 1 => water).  c--       Calculate mask for tracer cells (0 => land, 1 => water).
# Line 137  c--       Calculate mask for tracer cell Line 205  c--       Calculate mask for tracer cell
205            do j = 1,sny            do j = 1,sny
206              do i = 1,snx              do i = 1,snx
207                genfld(i,j,bi,bj) = genfld (i,j,bi,bj)                genfld(i,j,bi,bj) = genfld (i,j,bi,bj)
208       &                         + genfac            *xx_gen0(i,j,bi,bj)       &              + gensign*genfac            *xx_gen0(i,j,bi,bj)
209       &                         + (1. _d 0 - genfac)*xx_gen1(i,j,bi,bj)       &              + gensign*(1. _d 0 - genfac)*xx_gen1(i,j,bi,bj)
210                genfld(i,j,bi,bj) = genfld(i,j,bi,bj)*genmask(i,j,k,bi,bj)                genfld(i,j,bi,bj) =
211         &             genmask(i,j,k,bi,bj)*( genfld (i,j,bi,bj) -
212         &             ( xx_gen_remo_intercept +
213         &               xx_gen_remo_slope*(mytime-starttime) ) )
214              enddo              enddo
215            enddo            enddo
216          enddo          enddo
217        enddo        enddo
218    cph(
219          endif
220    cph)
221    
222  #endif /* ALLOW_EXF */  #endif /* ALLOW_EXF */
223    
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22