/[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.12 by heimbach, Mon May 14 22:02:33 2007 UTC
# Line 7  C $Name$ Line 7  C $Name$
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 ==
# Line 47  c     == routine arguments == Line 48  c     == routine arguments ==
48        _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)
49        _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)
50        _RL     xx_gen_dummy        _RL     xx_gen_dummy
51          _RL     xx_gen_remo_intercept
52          _RL     xx_gen_remo_slope
53    
54        _RL     mytime        _RL     mytime
55        integer myiter        integer myiter
# Line 64  c     == local variables == Line 67  c     == local variables ==
67        integer imin,imax        integer imin,imax
68        integer ilgen        integer ilgen
69    
70          _RL     gensign
71        _RL     genfac        _RL     genfac
72          logical doCtrlUpdate
73        logical genfirst        logical genfirst
74        logical genchanged        logical genchanged
75        integer gencount0        integer gencount0
# Line 102  c--   Now, read the control vector. Line 107  c--   Now, read the control vector.
107       &       xx_gen_file(1:ilgen), '.', optimcycle       &       xx_gen_file(1:ilgen), '.', optimcycle
108        endif        endif
109    
110    # ifdef ALLOW_CAL
111             if ( xx_genperiod .EQ. 0 ) then
112    c     record numbers are assumed 1 to 12 corresponding to
113    c     Jan. through Dec.
114                call cal_GetMonthsRec(
115         O           genfac, genfirst, genchanged,
116         O           gencount0, gencount1,
117         I           mytime, myiter, mythid
118         &           )
119             else
120  c--   Get the counters, flags, and the interpolation factor.  c--   Get the counters, flags, and the interpolation factor.
121        call ctrl_get_gen_rec(        call ctrl_get_gen_rec(
122       I                   xx_genstartdate, xx_genperiod,       I                   xx_genstartdate, xx_genperiod,
123       O                   genfac, genfirst, genchanged,       O                   genfac, genfirst, genchanged,
124       O                   gencount0,gencount1,       O                   gencount0,gencount1,
125       I                   mytime, myiter, mythid )       I                   mytime, myiter, mythid )
126            endif
127    # else
128    c--   Get the counters, flags, and the interpolation factor.
129          call ctrl_get_gen_rec(
130         I                   xx_genstartdate, xx_genperiod,
131         O                   genfac, genfirst, genchanged,
132         O                   gencount0,gencount1,
133         I                   mytime, myiter, mythid )
134    # endif
135    
136        if ( genfirst ) then        if ( genfirst ) then
137          call active_read_xy_loc( fnamegen, xx_gen1, gencount0,          call active_read_xy( fnamegen, xx_gen1, gencount0,
138       &                       doglobalread, ladinit, optimcycle,       &                       doglobalread, ladinit, optimcycle,
139       &                       mythid, xx_gen_dummy )       &                       mythid, xx_gen_dummy )
140  #ifdef ALLOW_CTRL_SMOOTH  #ifdef ALLOW_CTRL_SMOOTH
141            call ctrl_smooth(xx_gen1,genmask)          if ( xx_gen_file .EQ. xx_tauu_file .OR.
142         &       xx_gen_file .EQ. xx_tauv_file )
143         &     call ctrl_smooth(xx_gen1,genmask)
144  #endif  #endif
145        endif        endif
146    
147        if (( genfirst ) .or. ( genchanged )) then        if (( genfirst ) .or. ( genchanged )) then
148          call exf_SwapFFields( xx_gen0, xx_gen1, mythid )          call exf_SwapFFields( xx_gen0, xx_gen1, mythid )
149    
150          call active_read_xy_loc( fnamegen, xx_gen1 , gencount1,          call active_read_xy( fnamegen, xx_gen1 , gencount1,
151       &                       doglobalread, ladinit, optimcycle,       &                       doglobalread, ladinit, optimcycle,
152       &                       mythid, xx_gen_dummy )       &                       mythid, xx_gen_dummy )
153  #ifdef ALLOW_CTRL_SMOOTH  #ifdef ALLOW_CTRL_SMOOTH
154            call ctrl_smooth(xx_gen1,genmask)          if ( xx_gen_file .EQ. xx_tauu_file .OR.
155         &       xx_gen_file .EQ. xx_tauv_file )
156         &     call ctrl_smooth(xx_gen1,genmask)
157  #endif  #endif
158        endif        endif
159    
160  c--   Add control to model variable.  c--   Add control to model variable.
161    cph(
162    cph this flag ported from the SIO code
163    cph Initial wind stress adjustments are too vigorous.
164          if ( gencount0 .LE. 2 .AND.
165         &     ( xx_gen_file .EQ. xx_tauu_file .OR.
166         &       xx_gen_file .EQ. xx_tauv_file ) .AND.
167         &     ( xx_genperiod .NE. 0 ) ) then
168             doCtrlUpdate = .FALSE.
169          else
170             doCtrlUpdate = .TRUE.
171          endif
172          if ( xx_gen_file .EQ. xx_tauu_file .OR.
173         &     xx_gen_file .EQ. xx_tauv_file ) then
174             gensign = -1.
175          else
176             gensign = 1.
177          endif
178    c
179    cph since the above is ECCO specific, we undo it here:
180    cph      doCtrlUpdate = .TRUE.
181    c
182          if ( doCtrlUpdate ) then
183    cph)
184        do bj = jtlo,jthi        do bj = jtlo,jthi
185          do bi = itlo,ithi          do bi = itlo,ithi
186  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 188  c--       Calculate mask for tracer cell
188            do j = 1,sny            do j = 1,sny
189              do i = 1,snx              do i = 1,snx
190                genfld(i,j,bi,bj) = genfld (i,j,bi,bj)                genfld(i,j,bi,bj) = genfld (i,j,bi,bj)
191       &                         + genfac            *xx_gen0(i,j,bi,bj)       &              + gensign*genfac            *xx_gen0(i,j,bi,bj)
192       &                         + (1. _d 0 - genfac)*xx_gen1(i,j,bi,bj)       &              + gensign*(1. _d 0 - genfac)*xx_gen1(i,j,bi,bj)
193                genfld(i,j,bi,bj) = genfld(i,j,bi,bj)*genmask(i,j,k,bi,bj)                genfld(i,j,bi,bj) =
194         &             genmask(i,j,k,bi,bj)*( genfld (i,j,bi,bj) -
195         &             ( xx_gen_remo_intercept +
196         &               xx_gen_remo_slope*(mytime-starttime) ) )
197              enddo              enddo
198            enddo            enddo
199          enddo          enddo
200        enddo        enddo
201    cph(
202          endif
203    cph)
204    
205  #endif /* ALLOW_EXF */  #endif /* ALLOW_EXF */
206    
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22