pkg/ctrl/ctrl_get_gen.F

C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_get_gen.F,v 1.9 2006/03/02 02:53:23 heimbach Exp $
C $Name:  $

#include "CTRL_CPPOPTIONS.h"


      subroutine ctrl_get_gen(
     I          xx_gen_file, xx_genstartdate, xx_genperiod,
     I          genmask, genfld, xx_gen0, xx_gen1, xx_gen_dummy, 
     I          xx_gen_remo_intercept, xx_gen_remo_slope,
     I          mytime, myiter, mythid
     &                     )

c     ==================================================================
c     SUBROUTINE ctrl_get_gen
c     ==================================================================
c
c     o new generic routine for reading time dependent control variables
c       heimbach@mit.edu 12-Jun-2003
c
c     ==================================================================
c     SUBROUTINE ctrl_get_gen
c     ==================================================================

      implicit none

c     == global variables ==

#include "EEPARAMS.h"
#include "SIZE.h"
#include "PARAMS.h"
#include "GRID.h"

#include "ctrl.h"
#include "ctrl_dummy.h"
#include "optim.h"
#ifdef ALLOW_EXF
# include "exf_fields.h"
#endif

c     == routine arguments ==

      character*(MAX_LEN_FNAM) xx_gen_file
      integer xx_genstartdate(4)
      _RL     xx_genperiod
      _RL     genmask(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)
      _RL     genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
      _RL     xx_gen0(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
      _RL     xx_gen1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
      _RL     xx_gen_dummy
      _RL     xx_gen_remo_intercept
      _RL     xx_gen_remo_slope

      _RL     mytime
      integer myiter
      integer mythid

c     == local variables ==

#ifdef ALLOW_EXF

      integer bi,bj
      integer i,j,k
      integer itlo,ithi
      integer jtlo,jthi
      integer jmin,jmax
      integer imin,imax
      integer ilgen

      _RL     gensign
      _RL     genfac
      logical doCtrlUpdate
      logical genfirst
      logical genchanged
      integer gencount0
      integer gencount1

      logical doglobalread
      logical ladinit

      character*(80) fnamegen

c     == external functions ==

      integer  ilnblnk
      external ilnblnk


c     == end of interface ==

      jtlo = mybylo(mythid)
      jthi = mybyhi(mythid)
      itlo = mybxlo(mythid)
      ithi = mybxhi(mythid)
      jmin = 1-oly
      jmax = sny+oly
      imin = 1-olx
      imax = snx+olx

c--   Now, read the control vector.
      doglobalread = .false.
      ladinit      = .false.

      if (optimcycle .ge. 0) then
        ilgen=ilnblnk( xx_gen_file )
        write(fnamegen(1:80),'(2a,i10.10)') 
     &       xx_gen_file(1:ilgen), '.', optimcycle
      endif

# ifdef ALLOW_CAL
         if ( xx_genperiod .EQ. 0 ) then
c     record numbers are assumed 1 to 12 corresponding to
c     Jan. through Dec.
            call cal_GetMonthsRec(
     O           genfac, genfirst, genchanged,
     O           gencount0, gencount1,
     I           mytime, myiter, mythid
     &           )
         else
c--   Get the counters, flags, and the interpolation factor.
      call ctrl_get_gen_rec(
     I                   xx_genstartdate, xx_genperiod,
     O                   genfac, genfirst, genchanged,
     O                   gencount0,gencount1,
     I                   mytime, myiter, mythid )
        endif
# else
c--   Get the counters, flags, and the interpolation factor.
      call ctrl_get_gen_rec(
     I                   xx_genstartdate, xx_genperiod,
     O                   genfac, genfirst, genchanged,
     O                   gencount0,gencount1,
     I                   mytime, myiter, mythid )
# endif

      if ( genfirst ) then
        call active_read_xy_loc( fnamegen, xx_gen1, gencount0,
     &                       doglobalread, ladinit, optimcycle,
     &                       mythid, xx_gen_dummy )
#ifdef ALLOW_CTRL_SMOOTH
        if ( xx_gen_file .EQ. xx_tauu_file .OR.
     &       xx_gen_file .EQ. xx_tauv_file )
     &     call ctrl_smooth(xx_gen1,genmask)
#endif
      endif

      if (( genfirst ) .or. ( genchanged )) then
        call exf_SwapFFields( xx_gen0, xx_gen1, mythid )

        call active_read_xy_loc( fnamegen, xx_gen1 , gencount1,
     &                       doglobalread, ladinit, optimcycle,
     &                       mythid, xx_gen_dummy )
#ifdef ALLOW_CTRL_SMOOTH
        if ( xx_gen_file .EQ. xx_tauu_file .OR.
     &       xx_gen_file .EQ. xx_tauv_file )
     &     call ctrl_smooth(xx_gen1,genmask)
#endif
      endif

c--   Add control to model variable.
cph(
cph this flag ported from the SIO code
cph Initial wind stress adjustments are too vigorous.
      if ( gencount0 .LE. 2 .AND. 
     &     ( xx_gen_file .EQ. xx_tauu_file .OR.
     &       xx_gen_file .EQ. xx_tauv_file ) .AND.
     &     ( xx_genperiod .NE. 0 ) ) then
         doCtrlUpdate = .FALSE.
      else
         doCtrlUpdate = .TRUE.
      endif
      if ( xx_gen_file .EQ. xx_tauu_file .OR.
     &     xx_gen_file .EQ. xx_tauv_file ) then
         gensign = -1.
      else
         gensign = 1.
      endif
c
cph since the above is ECCO specific, we undo it here:
cph      doCtrlUpdate = .TRUE.
c
      if ( doCtrlUpdate ) then
cph)
      do bj = jtlo,jthi
        do bi = itlo,ithi
c--       Calculate mask for tracer cells (0 => land, 1 => water).
          k = 1
          do j = 1,sny
            do i = 1,snx
              genfld(i,j,bi,bj) = genfld (i,j,bi,bj)
     &              + gensign*genfac            *xx_gen0(i,j,bi,bj)
     &              + gensign*(1. _d 0 - genfac)*xx_gen1(i,j,bi,bj)
              genfld(i,j,bi,bj) = 
     &             genmask(i,j,k,bi,bj)*( genfld (i,j,bi,bj) -
     &             ( xx_gen_remo_intercept +
     &               xx_gen_remo_slope*(mytime-starttime) ) )
            enddo
          enddo
        enddo
      enddo
cph(
      endif
cph)

#endif /* ALLOW_EXF */

      end

1	gforget	1.10	C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_get_gen.F,v 1.9 2006/03/02 02:53:23 heimbach Exp $
2	heimbach	1.7	C $Name: $
3	heimbach	1.2
4			#include "CTRL_CPPOPTIONS.h"
5
6
7			subroutine ctrl_get_gen(
8			I xx_gen_file, xx_genstartdate, xx_genperiod,
9			I genmask, genfld, xx_gen0, xx_gen1, xx_gen_dummy,
10	heimbach	1.9	I xx_gen_remo_intercept, xx_gen_remo_slope,
11	heimbach	1.2	I mytime, myiter, mythid
12			& )
13
14			c ==================================================================
15			c SUBROUTINE ctrl_get_gen
16			c ==================================================================
17			c
18			c o new generic routine for reading time dependent control variables
19			c heimbach@mit.edu 12-Jun-2003
20			c
21			c ==================================================================
22			c SUBROUTINE ctrl_get_gen
23			c ==================================================================
24
25			implicit none
26
27			c == global variables ==
28
29			#include "EEPARAMS.h"
30			#include "SIZE.h"
31			#include "PARAMS.h"
32			#include "GRID.h"
33
34			#include "ctrl.h"
35			#include "ctrl_dummy.h"
36			#include "optim.h"
37	edhill	1.4	#ifdef ALLOW_EXF
38	heimbach	1.2	# include "exf_fields.h"
39			#endif
40
41			c == routine arguments ==
42
43			character*(MAX_LEN_FNAM) xx_gen_file
44			integer xx_genstartdate(4)
45			_RL xx_genperiod
46			_RL genmask(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)
47			_RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
48			_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)
50			_RL xx_gen_dummy
51	heimbach	1.9	_RL xx_gen_remo_intercept
52			_RL xx_gen_remo_slope
53	heimbach	1.2
54			_RL mytime
55			integer myiter
56			integer mythid
57
58			c == local variables ==
59
60	edhill	1.4	#ifdef ALLOW_EXF
61	heimbach	1.2
62			integer bi,bj
63			integer i,j,k
64			integer itlo,ithi
65			integer jtlo,jthi
66			integer jmin,jmax
67			integer imin,imax
68			integer ilgen
69
70	heimbach	1.7	_RL gensign
71	heimbach	1.2	_RL genfac
72	heimbach	1.6	logical doCtrlUpdate
73	heimbach	1.2	logical genfirst
74			logical genchanged
75			integer gencount0
76			integer gencount1
77
78			logical doglobalread
79			logical ladinit
80
81			character*(80) fnamegen
82
83			c == external functions ==
84
85			integer ilnblnk
86			external ilnblnk
87
88
89			c == end of interface ==
90
91			jtlo = mybylo(mythid)
92			jthi = mybyhi(mythid)
93			itlo = mybxlo(mythid)
94			ithi = mybxhi(mythid)
95			jmin = 1-oly
96			jmax = sny+oly
97			imin = 1-olx
98			imax = snx+olx
99
100			c-- Now, read the control vector.
101			doglobalread = .false.
102			ladinit = .false.
103
104			if (optimcycle .ge. 0) then
105			ilgen=ilnblnk( xx_gen_file )
106			write(fnamegen(1:80),'(2a,i10.10)')
107			& xx_gen_file(1:ilgen), '.', optimcycle
108			endif
109
110	gforget	1.10	# 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	heimbach	1.2	c-- Get the counters, flags, and the interpolation factor.
121			call ctrl_get_gen_rec(
122			I xx_genstartdate, xx_genperiod,
123			O genfac, genfirst, genchanged,
124			O gencount0,gencount1,
125			I mytime, myiter, mythid )
126	gforget	1.10	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	heimbach	1.2
136			if ( genfirst ) then
137	heimbach	1.3	call active_read_xy_loc( fnamegen, xx_gen1, gencount0,
138	heimbach	1.2	& doglobalread, ladinit, optimcycle,
139			& mythid, xx_gen_dummy )
140			#ifdef ALLOW_CTRL_SMOOTH
141	heimbach	1.5	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	heimbach	1.2	#endif
145			endif
146
147			if (( genfirst ) .or. ( genchanged )) then
148			call exf_SwapFFields( xx_gen0, xx_gen1, mythid )
149
150	heimbach	1.3	call active_read_xy_loc( fnamegen, xx_gen1 , gencount1,
151	heimbach	1.2	& doglobalread, ladinit, optimcycle,
152			& mythid, xx_gen_dummy )
153			#ifdef ALLOW_CTRL_SMOOTH
154	heimbach	1.5	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	heimbach	1.2	#endif
158			endif
159
160			c-- Add control to model variable.
161	heimbach	1.5	cph(
162	heimbach	1.8	cph this flag ported from the SIO code
163			cph Initial wind stress adjustments are too vigorous.
164	heimbach	1.6	if ( gencount0 .LE. 2 .AND.
165	heimbach	1.5	& ( xx_gen_file .EQ. xx_tauu_file .OR.
166	gforget	1.10	& xx_gen_file .EQ. xx_tauv_file ) .AND.
167			& ( xx_genperiod .NE. 0 ) ) then
168	heimbach	1.6	doCtrlUpdate = .FALSE.
169			else
170			doCtrlUpdate = .TRUE.
171			endif
172	heimbach	1.7	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	heimbach	1.6	c
179			cph since the above is ECCO specific, we undo it here:
180	heimbach	1.7	cph doCtrlUpdate = .TRUE.
181	heimbach	1.6	c
182			if ( doCtrlUpdate ) then
183	heimbach	1.5	cph)
184	heimbach	1.2	do bj = jtlo,jthi
185			do bi = itlo,ithi
186			c-- Calculate mask for tracer cells (0 => land, 1 => water).
187			k = 1
188			do j = 1,sny
189			do i = 1,snx
190			genfld(i,j,bi,bj) = genfld (i,j,bi,bj)
191	heimbach	1.7	& + gensigngenfac xx_gen0(i,j,bi,bj)
192			& + gensign(1. _d 0 - genfac)xx_gen1(i,j,bi,bj)
193	heimbach	1.9	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	heimbach	1.2	enddo
198			enddo
199			enddo
200			enddo
201	heimbach	1.5	cph(
202			endif
203			cph)
204	heimbach	1.2
205	edhill	1.4	#endif /* ALLOW_EXF */
206	heimbach	1.2
207			end
208