pkg/ctrl/ctrl_get_gen.F

C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_get_gen.F,v 1.5 2004/03/04 19:49:47 heimbach Exp $
C $Name: checkpoint52l_post $

#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     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 (dont know why its here)
      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
c
cph since the above is ECCO specific, we undo it here:
      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)
     &                         + genfac            *xx_gen0(i,j,bi,bj)
     &                         + (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.6	C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_get_gen.F,v 1.5 2004/03/04 19:49:47 heimbach Exp $
2			C $Name: checkpoint52l_post $
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			_RL genfac
68	heimbach	1.6	logical doCtrlUpdate
69	heimbach	1.2	logical genfirst
70			logical genchanged
71			integer gencount0
72			integer gencount1
73
74			logical doglobalread
75			logical ladinit
76
77			character*(80) fnamegen
78
79			c == external functions ==
80
81			integer ilnblnk
82			external ilnblnk
83
84
85			c == end of interface ==
86
87			jtlo = mybylo(mythid)
88			jthi = mybyhi(mythid)
89			itlo = mybxlo(mythid)
90			ithi = mybxhi(mythid)
91			jmin = 1-oly
92			jmax = sny+oly
93			imin = 1-olx
94			imax = snx+olx
95
96			c-- Now, read the control vector.
97			doglobalread = .false.
98			ladinit = .false.
99
100			if (optimcycle .ge. 0) then
101			ilgen=ilnblnk( xx_gen_file )
102			write(fnamegen(1:80),'(2a,i10.10)')
103			& xx_gen_file(1:ilgen), '.', optimcycle
104			endif
105
106			c-- Get the counters, flags, and the interpolation factor.
107			call ctrl_get_gen_rec(
108			I xx_genstartdate, xx_genperiod,
109			O genfac, genfirst, genchanged,
110			O gencount0,gencount1,
111			I mytime, myiter, mythid )
112
113			if ( genfirst ) then
114	heimbach	1.3	call active_read_xy_loc( fnamegen, xx_gen1, gencount0,
115	heimbach	1.2	& doglobalread, ladinit, optimcycle,
116			& mythid, xx_gen_dummy )
117			#ifdef ALLOW_CTRL_SMOOTH
118	heimbach	1.5	if ( xx_gen_file .EQ. xx_tauu_file .OR.
119			& xx_gen_file .EQ. xx_tauv_file )
120			& call ctrl_smooth(xx_gen1,genmask)
121	heimbach	1.2	#endif
122			endif
123
124			if (( genfirst ) .or. ( genchanged )) then
125			call exf_SwapFFields( xx_gen0, xx_gen1, mythid )
126
127	heimbach	1.3	call active_read_xy_loc( fnamegen, xx_gen1 , gencount1,
128	heimbach	1.2	& doglobalread, ladinit, optimcycle,
129			& mythid, xx_gen_dummy )
130			#ifdef ALLOW_CTRL_SMOOTH
131	heimbach	1.5	if ( xx_gen_file .EQ. xx_tauu_file .OR.
132			& xx_gen_file .EQ. xx_tauv_file )
133			& call ctrl_smooth(xx_gen1,genmask)
134	heimbach	1.2	#endif
135			endif
136
137			c-- Add control to model variable.
138	heimbach	1.5	cph(
139			cph this flag ported from the SIO code (dont know why its here)
140	heimbach	1.6	if ( gencount0 .LE. 2 .AND.
141	heimbach	1.5	& ( xx_gen_file .EQ. xx_tauu_file .OR.
142			& xx_gen_file .EQ. xx_tauv_file ) ) then
143	heimbach	1.6	doCtrlUpdate = .FALSE.
144			else
145			doCtrlUpdate = .TRUE.
146			endif
147			c
148			cph since the above is ECCO specific, we undo it here:
149			doCtrlUpdate = .TRUE.
150			c
151			if ( doCtrlUpdate ) then
152	heimbach	1.5	cph)
153	heimbach	1.2	do bj = jtlo,jthi
154			do bi = itlo,ithi
155			c-- Calculate mask for tracer cells (0 => land, 1 => water).
156			k = 1
157			do j = 1,sny
158			do i = 1,snx
159			genfld(i,j,bi,bj) = genfld (i,j,bi,bj)
160			& + genfac *xx_gen0(i,j,bi,bj)
161			& + (1. _d 0 - genfac)*xx_gen1(i,j,bi,bj)
162			genfld(i,j,bi,bj) = genfld(i,j,bi,bj)*genmask(i,j,k,bi,bj)
163			enddo
164			enddo
165			enddo
166			enddo
167	heimbach	1.5	cph(
168			endif
169			cph)
170	heimbach	1.2
171	edhill	1.4	#endif /* ALLOW_EXF */
172	heimbach	1.2
173			end
174