pkg/ctrl/ctrl_get_gen.F

C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_get_gen.F,v 1.13 2007/06/19 03:42:30 gforget 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*(80) fnamegeneric
      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( 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
#ifdef ALLOW_SMOOTH_CORREL2D
      call smooth_correl2D(xx_gen1,genmask,1,mythid)
      call smooth_correl2Dw(xx_gen1,genmask,xx_gen_file,mythid)
      write(fnamegeneric(1:80),'(2a,i10.10)')
     & xx_gen_file(1:ilgen),'.effective.',optimcycle
      call mdswritefield(fnamegeneric,ctrlprec,.FALSE.,'RL',
     & 1, xx_gen1, gencount0, optimcycle, mythid)
#endif
      endif

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

        call active_read_xy( 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
#ifdef ALLOW_SMOOTH_CORREL2D
      call smooth_correl2D(xx_gen1,genmask,1,mythid)
      call smooth_correl2Dw(xx_gen1,genmask,xx_gen_file,mythid)
      write(fnamegeneric(1:80),'(2a,i10.10)')
     & xx_gen_file(1:ilgen),'.effective.',optimcycle
      call mdswritefield(fnamegeneric,ctrlprec,.FALSE.,'RL',
     & 1, xx_gen1, gencount1, optimcycle, mythid)
#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	jmc	1.14	C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_get_gen.F,v 1.13 2007/06/19 03:42:30 gforget 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	jmc	1.14	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	jmc	1.11	# include "EXF_FIELDS.h"
39	heimbach	1.2	#endif
40
41			c == routine arguments ==
42
43	gforget	1.13	character*(80) fnamegeneric
44	heimbach	1.2	character*(MAX_LEN_FNAM) xx_gen_file
45			integer xx_genstartdate(4)
46			_RL xx_genperiod
47			_RL genmask(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)
48			_RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
49			_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)
51			_RL xx_gen_dummy
52	heimbach	1.9	_RL xx_gen_remo_intercept
53			_RL xx_gen_remo_slope
54	heimbach	1.2
55			_RL mytime
56			integer myiter
57			integer mythid
58
59			c == local variables ==
60
61	edhill	1.4	#ifdef ALLOW_EXF
62	heimbach	1.2
63			integer bi,bj
64			integer i,j,k
65			integer itlo,ithi
66			integer jtlo,jthi
67			integer jmin,jmax
68			integer imin,imax
69			integer ilgen
70
71	heimbach	1.7	_RL gensign
72	heimbach	1.2	_RL genfac
73	heimbach	1.6	logical doCtrlUpdate
74	heimbach	1.2	logical genfirst
75			logical genchanged
76			integer gencount0
77			integer gencount1
78
79			logical doglobalread
80			logical ladinit
81
82			character*(80) fnamegen
83
84			c == external functions ==
85
86			integer ilnblnk
87			external ilnblnk
88
89
90			c == end of interface ==
91
92			jtlo = mybylo(mythid)
93			jthi = mybyhi(mythid)
94			itlo = mybxlo(mythid)
95			ithi = mybxhi(mythid)
96			jmin = 1-oly
97			jmax = sny+oly
98			imin = 1-olx
99			imax = snx+olx
100
101			c-- Now, read the control vector.
102			doglobalread = .false.
103			ladinit = .false.
104
105			if (optimcycle .ge. 0) then
106			ilgen=ilnblnk( xx_gen_file )
107	jmc	1.14	write(fnamegen(1:80),'(2a,i10.10)')
108	heimbach	1.2	& xx_gen_file(1:ilgen), '.', optimcycle
109			endif
110
111	gforget	1.10	# 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	heimbach	1.2	c-- Get the counters, flags, and the interpolation factor.
122			call ctrl_get_gen_rec(
123			I xx_genstartdate, xx_genperiod,
124			O genfac, genfirst, genchanged,
125			O gencount0,gencount1,
126			I mytime, myiter, mythid )
127	gforget	1.10	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	heimbach	1.2
137			if ( genfirst ) then
138	heimbach	1.12	call active_read_xy( fnamegen, xx_gen1, gencount0,
139	heimbach	1.2	& doglobalread, ladinit, optimcycle,
140			& mythid, xx_gen_dummy )
141			#ifdef ALLOW_CTRL_SMOOTH
142	jmc	1.14	if ( xx_gen_file .EQ. xx_tauu_file .OR.
143	heimbach	1.5	& xx_gen_file .EQ. xx_tauv_file )
144			& call ctrl_smooth(xx_gen1,genmask)
145	heimbach	1.2	#endif
146	gforget	1.13	#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
154	heimbach	1.2	endif
155
156			if (( genfirst ) .or. ( genchanged )) then
157			call exf_SwapFFields( xx_gen0, xx_gen1, mythid )
158
159	heimbach	1.12	call active_read_xy( fnamegen, xx_gen1 , gencount1,
160	heimbach	1.2	& doglobalread, ladinit, optimcycle,
161			& mythid, xx_gen_dummy )
162			#ifdef ALLOW_CTRL_SMOOTH
163	jmc	1.14	if ( xx_gen_file .EQ. xx_tauu_file .OR.
164	heimbach	1.5	& xx_gen_file .EQ. xx_tauv_file )
165			& call ctrl_smooth(xx_gen1,genmask)
166	heimbach	1.2	#endif
167	gforget	1.13	#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
175	heimbach	1.2	endif
176
177			c-- Add control to model variable.
178	heimbach	1.5	cph(
179	heimbach	1.8	cph this flag ported from the SIO code
180			cph Initial wind stress adjustments are too vigorous.
181	jmc	1.14	if ( gencount0 .LE. 2 .AND.
182	heimbach	1.5	& ( xx_gen_file .EQ. xx_tauu_file .OR.
183	gforget	1.10	& xx_gen_file .EQ. xx_tauv_file ) .AND.
184			& ( xx_genperiod .NE. 0 ) ) then
185	heimbach	1.6	doCtrlUpdate = .FALSE.
186			else
187			doCtrlUpdate = .TRUE.
188			endif
189	heimbach	1.7	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	heimbach	1.6	c
196			cph since the above is ECCO specific, we undo it here:
197	heimbach	1.7	cph doCtrlUpdate = .TRUE.
198	heimbach	1.6	c
199			if ( doCtrlUpdate ) then
200	heimbach	1.5	cph)
201	heimbach	1.2	do bj = jtlo,jthi
202			do bi = itlo,ithi
203			c-- Calculate mask for tracer cells (0 => land, 1 => water).
204			k = 1
205			do j = 1,sny
206			do i = 1,snx
207			genfld(i,j,bi,bj) = genfld (i,j,bi,bj)
208	heimbach	1.7	& + gensigngenfac xx_gen0(i,j,bi,bj)
209			& + gensign(1. _d 0 - genfac)xx_gen1(i,j,bi,bj)
210	jmc	1.14	genfld(i,j,bi,bj) =
211	heimbach	1.9	& genmask(i,j,k,bi,bj)*( genfld (i,j,bi,bj) -
212			& ( xx_gen_remo_intercept +
213			& xx_gen_remo_slope*(mytime-starttime) ) )
214	heimbach	1.2	enddo
215			enddo
216			enddo
217			enddo
218	heimbach	1.5	cph(
219			endif
220			cph)
221	heimbach	1.2
222	edhill	1.4	#endif /* ALLOW_EXF */
223	heimbach	1.2
224			end
225