pkg/ctrl/ctrl_get_gen.F

C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_get_gen.F,v 1.7 2004/11/11 06:28:33 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          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     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

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 )

      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 ) ) 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) = genfld(i,j,bi,bj)*genmask(i,j,k,bi,bj)
            enddo
          enddo
        enddo
      enddo
cph(
      endif
cph)

#endif /* ALLOW_EXF */

      end

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