C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_get_gen.F,v 1.38 2017/09/18 15:16:52 gforget Exp $
C $Name: $
#include "CTRL_OPTIONS.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 genweight,
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_SIZE.h"
#include "ctrl.h"
#include "ctrl_dummy.h"
#include "optim.h"
#ifdef ALLOW_EXF
# include "EXF_FIELDS.h"
#endif
#ifndef ECCO_CTRL_DEPRECATED
character*(MAX_LEN_FNAM) xx_tauu_file
character*(MAX_LEN_FNAM) xx_tauv_file
#endif
c == routine arguments ==
character*(80) fnamegeneric
character*(MAX_LEN_FNAM) xx_gen_file
integer xx_genstartdate(4)
_RL xx_genperiod
_RS 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 genweight(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
_RL mytime
integer myiter
integer mythid
c == local variables ==
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
#ifdef ALLOW_SMOOTH
#ifdef ALLOW_SMOOTH_CTRL2D
_RS dummyRS(1)
#endif
#endif
c == external functions ==
integer ilnblnk
external
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).AND.(.NOT.ctrlUseGen) ) then
ilgen=ilnblnk( xx_gen_file )
write(fnamegen(1:80),'(2a,i10.10)')
& xx_gen_file(1:ilgen), '.', optimcycle
endif
if ( (optimcycle .ge. 0).AND.ctrlUseGen ) then
ilgen=ilnblnk( xx_gen_file )
write(fnamegen(1:80),'(2a,i10.10)')
& xx_gen_file(1:ilgen),'.effective.',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
cc#ifdef ALLOW_OPENAD
cc call oad_active_read_xy( fnamegen, xx_gen1, gencount0,
cc & doglobalread, ladinit, optimcycle,
cc & mythid, xx_gen_dummy )
cc#else
#ifdef ALLOW_AUTODIFF
call ACTIVE_READ_XY( fnamegen, xx_gen1, gencount0,
& doglobalread, ladinit, optimcycle,
& mythid, xx_gen_dummy )
if (.false.) then
call ACTIVE_READ_XY( fnamegen, xx_gen0, gencount0,
& doglobalread, ladinit, optimcycle,
& mythid, xx_gen_dummy )
endif
#else
CALL READ_REC_XY_RL( fnamegen, xx_gen1, gencount0, 1, myThid )
#endif
cc#endif /* ALLOW_OPENAD */
#ifdef ECCO_CTRL_DEPRECATED
#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,myThid)
#endif
#endif
#ifdef ALLOW_SMOOTH
#ifdef ALLOW_SMOOTH_CTRL2D
if (useSMOOTH) call SMOOTH2D(xx_gen1,genmask,1,mythid)
write(fnamegeneric(1:80),'(2a,i10.10)')
& xx_gen_file(1:ilgen),'.smooth.',optimcycle
CALL MDS_WRITE_FIELD(fnamegeneric,ctrlprec,.FALSE.,.FALSE.,
& 'RL',1,1,1,xx_gen1,dummyRS,gencount1,optimcycle,mythid)
#endif /* ALLOW_SMOOTH_CTRL2D */
#endif /* ALLOW_SMOOTH */
endif
if (( genfirst ) .or. ( genchanged )) then
call CTRL_SWAPFFIELDS( xx_gen0, xx_gen1, mythid )
cc#ifdef ALLOW_OPENAD
cc call oad_active_read_xy( fnamegen, xx_gen1 , gencount1,
cc & doglobalread, ladinit, optimcycle,
cc & mythid, xx_gen_dummy )
cc#else
#ifdef ALLOW_AUTODIFF
call ACTIVE_READ_XY( fnamegen, xx_gen1 , gencount1,
& doglobalread, ladinit, optimcycle,
& mythid, xx_gen_dummy )
#else
CALL READ_REC_XY_RL( fnamegen, xx_gen1, gencount1, 1, myThid )
#endif
cc#endif /* ALLOW_OPENAD */
#ifdef ECCO_CTRL_DEPRECATED
#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,myThid)
#endif
#endif
#ifdef ALLOW_SMOOTH
#ifdef ALLOW_SMOOTH_CTRL2D
if (useSMOOTH) call SMOOTH2D(xx_gen1,genmask,1,mythid)
write(fnamegeneric(1:80),'(2a,i10.10)')
& xx_gen_file(1:ilgen),'.smooth.',optimcycle
CALL MDS_WRITE_FIELD(fnamegeneric,ctrlprec,.FALSE.,.FALSE.,
& 'RL',1,1,1,xx_gen1,dummyRS,gencount0,optimcycle,mythid)
#endif /* ALLOW_SMOOTH_CTRL2D */
#endif /* ALLOW_SMOOTH */
endif
c-- Add control to model variable.
cph(
cph this flag ported from the SIO code
cph Initial wind stress adjustments are too vigorous.
#ifndef ECCO_CTRL_DEPRECATED
xx_tauu_file = 'xx_tauu'
xx_tauv_file = 'xx_tauv'
#endif
if ( gencount0 .LE. 2 .AND.
& ( xx_gen_file(1:7) .EQ. xx_tauu_file .OR.
& xx_gen_file(1:7) .EQ. xx_tauv_file ) .AND.
& ( xx_genperiod .NE. 0 ) ) then
doCtrlUpdate = .FALSE.
else
doCtrlUpdate = .TRUE.
endif
if ( xx_gen_file(1:7) .EQ. xx_tauu_file .OR.
& xx_gen_file(1:7) .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)
CMLCML(
CMLCML hack until if find something better for the masks
CML if ( xx_gen_file(1:11) .eq. 'xx_shifwflx' ) then
CML do bj = jtlo,jthi
CML do bi = itlo,ithi
CMLc-- Calculate mask for tracer cells (0 => land, 1 => water).
CML do j = 1,sny
CML do i = 1,snx
CML genfld(i,j,bi,bj) = genfld (i,j,bi,bj)
CML & + gensign*genfac *xx_gen0(i,j,bi,bj)
CML & + gensign*(1. _d 0 - genfac)*xx_gen1(i,j,bi,bj)
CML if ( ksurfc(i,j,bi,bj) .ne. nr+1 ) then
CML genfld(i,j,bi,bj) =
CML & ( genfld (i,j,bi,bj) -
CML & ( xx_gen_remo_intercept +
CML & xx_gen_remo_slope*(mytime-starttime) ) )
CML else
CML genfld(i,j,bi,bj) = 0. _d 0
CML endif
CML enddo
CML enddo
CML enddo
CML enddo
CML else
CMLCML)
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
CMLCML)
CML endif
CMLCML)
cph(
endif
cph)
RETURN
END