C $Header: /u/gcmpack/MITgcm/pkg/ecco/ecco_cost_init_fixed.F,v 1.47 2017/04/03 23:16:38 ou.wang Exp $
C $Name: $
#include "ECCO_OPTIONS.h"
#include "AD_CONFIG.h"
subroutine ECCO_COST_INIT_FIXED( mythid )
c ==================================================================
c SUBROUTINE ecco_cost_init_fixed
c ==================================================================
c
c o Set contributions to the cost function and the cost function
c itself to zero. The cost function and the individual contribu-
c tions are defined in the header file "ecco_cost.h".
c
c started: Christian Eckert eckert@mit.edu 30-Jun-1999
c
c changed: Christian Eckert eckert@mit.edu 25-Feb-2000
c
c - Restructured the code in order to create a package
c for the MITgcmUV.
c
c changed: Ralf Giering 18-Jan-2001
c
c - move namelist reading to cost_readparms.F
c
c ==================================================================
c SUBROUTINE ecco_cost_init_fixed
c ==================================================================
implicit none
c == global variables ==
#include "EEPARAMS.h"
#include "SIZE.h"
#include "GRID.h"
#include "PARAMS.h"
#ifdef ALLOW_CAL
#include "cal.h"
#endif
#ifdef ALLOW_ECCO
# ifdef ECCO_CTRL_DEPRECATED
# include "ecco_cost.h"
else
# include "ecco.h"
# endif
#endif
#ifdef ALLOW_CTRL
# include "optim.h"
#endif
c == routine arguments ==
integer mythid
c == local variables ==
integer k
logical exst
_RL dummy
integer tempDate1(4)
integer tempDate2(4)
integer gwunit
integer il, ilo,ihi
character*(max_len_mbuf) msgbuf
integer irec
_RL missingObsFlag
PARAMETER ( missingObsFlag = 1. _d 23 )
#ifdef ALLOW_GENCOST_CONTRIBUTION
integer bi,bj
integer i,j,kk,k2
#endif
c == external functions ==
integer cal_IntYears
external
integer cal_IntMonths
external
integer cal_IntDays
external
integer ifnblnk
external
integer ilnblnk
external
c == end of interface ==
#ifdef ALLOW_CTRL
eccoiter=optimcycle
#else
eccoiter=0
#endif
#ifdef ALLOW_CAL
c-- The number of monthly and daily averages generated by the
c-- current model integration.
nyearsrec = cal_IntYears( mythid )
nmonsrec = cal_IntMonths( mythid )
ndaysrec = cal_IntDays( mythid )
_BEGIN_MASTER( myThid )
#ifdef ECCO_CTRL_DEPRECATED
c-- Get the complete dates of the ...
c-- ... TMI data.
if ( tmidatfile .ne. ' ' )
& call CAL_FULLDATE( tmistartdate1, tmistartdate2,
& tmistartdate, mythid )
c-- ... SST data.
if ( sstdatfile .ne. ' ' )
& call CAL_FULLDATE( sststartdate1, sststartdate2,
& sststartdate, mythid )
c-- ... SSS data.
if ( sssdatfile .ne. ' ' )
& call CAL_FULLDATE( sssstartdate1, sssstartdate2,
& sssstartdate, mythid )
c-- ... BP data.
if ( bpdatfile .ne. ' ' )
& call CAL_FULLDATE( bpstartdate1, bpstartdate2,
& bpstartdate, mythid )
c-- ... IES data.
if ( iesdatfile .ne. ' ' )
& call CAL_FULLDATE( iesstartdate1, iesstartdate2,
& iesstartdate, mythid )
#ifdef ALLOW_SSH_MEAN_COST_CONTRIBUTION
c-- ... mdt data.
if ( mdtdatfile .ne. ' ' )
& call CAL_FULLDATE( mdtstartdate1, mdtstartdate2,
& mdtstartdate, mythid )
c-- ... mdt data.
if ( mdtdatfile .ne. ' ' )
& call CAL_FULLDATE( mdtenddate1, mdtenddate2,
& mdtenddate, mythid )
#endif /* ALLOW_SSH_MEAN_COST_CONTRIBUTION */
c-- ... T/P data.
if ( topexfile .ne. ' ' )
& call CAL_FULLDATE( topexstartdate1, topexstartdate2,
& topexstartdate, mythid )
c-- ... ERS data.
if ( ersfile .ne. ' ' )
& call CAL_FULLDATE( ersstartdate1, ersstartdate2,
& ersstartdate, mythid )
c-- ... GFO data.
if ( gfofile .ne. ' ' )
& call CAL_FULLDATE( gfostartdate1, gfostartdate2,
& gfostartdate, mythid )
c-- ... SCAT data.
if ( scatxdatfile .ne. ' ' )
& call CAL_FULLDATE( scatstartdate1, scatstartdate2,
& scatxstartdate, mythid )
if ( scatydatfile .ne. ' ' )
& call CAL_FULLDATE( scatstartdate1, scatstartdate2,
& scatystartdate, mythid )
c-- ... ARGO data.
if ( argotfile .ne. ' ' )
& call CAL_FULLDATE( argotstartdate1, argotstartdate2,
& argotstartdate, mythid )
if ( argosfile .ne. ' ' )
& call CAL_FULLDATE( argosstartdate1, argotstartdate2,
& argosstartdate, mythid )
#endif /* ECCO_CTRL_DEPRECATED */
#ifdef ALLOW_GENCOST_CONTRIBUTION
do k = 1, NGENCOST
c-- skip averaging when several cost terms use the
c same barfile or when barfile is undefined
gencost_barskip(k)=.FALSE.
if ( gencost_barfile(k).EQ.' ' )
& gencost_barskip(k)=.TRUE.
do k2 = 1,k-1
if ( gencost_barfile(k2).EQ.gencost_barfile(k) )
& gencost_barskip(k)=.TRUE.
enddo
c-- set time averaging parameters
if ( (using_gencost(k)).AND.( (gencost_flag(k).GE.1).OR.
& (gencost_avgperiod(k).NE.' ') ) ) then
if ( gencost_avgperiod(k) .EQ. 'day' .OR.
& gencost_avgperiod(k) .EQ. 'DAY' ) then
gencost_nrec(k) = ndaysrec
gencost_period(k) = 86400.
else if ( gencost_avgperiod(k) .EQ. 'month' .OR.
& gencost_avgperiod(k) .EQ. 'MONTH' ) then
gencost_nrec(k) =nmonsrec
gencost_period(k) = 0.
else if ( gencost_avgperiod(k) .EQ. 'step' .OR.
& gencost_avgperiod(k) .EQ. 'STEP' ) then
gencost_nrec(k) =nTimeSteps+1
gencost_period(k) = dTtracerLev(1)
else if ( gencost_avgperiod(k) .EQ. 'const' .OR.
& gencost_avgperiod(k) .EQ. 'CONST' ) then
gencost_nrec(k) =1
gencost_period(k) = dTtracerLev(1)
else if ( gencost_avgperiod(k) .EQ. 'year' .OR.
& gencost_avgperiod(k) .EQ. 'YEAR' ) then
STOP
& 'ecco_cost_init_fixed: yearly data not yet implemented'
else
STOP
& 'ecco_cost_init_fixed: gencost_avgperiod wrongly specified'
endif
endif
c-- set observation start/enddate
if (gencost_startdate1(k).GT.0) then
call CAL_FULLDATE(
& gencost_startdate1(k), gencost_startdate2(k),
& gencost_startdate(1,k), mythid )
else
call CAL_COPYDATE(modelStartDate,
& gencost_startdate(1,k),mythid)
gencost_startdate1(k)=startdate_1
gencost_startdate2(k)=startdate_2
endif
if (gencost_enddate1(k).GT.0) then
call CAL_FULLDATE(
& gencost_enddate1(k), gencost_enddate2(k),
& gencost_enddate(1,k), mythid )
else
call CAL_COPYDATE(modelEndDate,
& gencost_enddate(1,k),mythid)
endif
#ifdef ALLOW_GENCOST_1D
if ( (gencost_name(k).EQ.'gmbp') .OR.
& (gencost_name(k).EQ.'gmsl')) then
if(gencost_nrec(k).GT.N1DDATA)then
WRITE(msgBuf,'(2A,2i8)') 'ecco_cost_init_fixed: ',
& 'Increase N1DDATA', N1DDATA, gencost_nrec(k)
CALL PRINT_ERROR( msgBuf, myThid)
endif
do irec = 1, N1DDATA
gencost_1DDATA(irec,k) = 0. _d 0
enddo
if(gencost_wei1d(k).NE.0. _d 0)then
gencost_wei1d(k) = 1. _d 0 / gencost_wei1d(k)
& /gencost_wei1d(k)
endif
if ( gencost_datafile(k) .NE. ' ' ) then
ilo = ifnblnk(gencost_datafile(k))
ihi = ilnblnk(gencost_datafile(k))
CALL OPEN_COPY_DATA_FILE(
I gencost_datafile(k)(ilo:ihi),
I 'ECCO_COST_INIT_FIXED: ',
O gwunit,
I myThid )
do irec = 1, gencost_nrec(k)
read(gwunit,*) gencost_1DDATA(irec,k)
enddo
close(gwunit)
_BARRIER
endif
endif
#endif /* ALLOW_GENCOST_1D */
enddo !do k = 1, NGENCOST
#endif /* ALLOW_GENCOST_CONTRIBUTION */
_END_MASTER( mythid )
#endif /* ALLOW_CAL */
call ECCO_CHECK( myThid )
c-- Get the weights that are to be used for the individual cost
c-- function contributions.
call ECCO_COST_WEIGHTS( mythid )
c-- Initialise adjoint of monthly mean files calculated
c-- in cost_averagesfields (and their ad...).
cph(
cph The following init. shoud not be applied if in the middle
cph of a divided adjoint run
cph)
#ifndef ALLOW_TANGENTLINEAR_RUN
cph!!! and I think it needs to be seen by TAF
cph!!! for repeated TLM runs
cph!!!
inquire( file='costfinal', exist=exst )
if ( .NOT. exst) then
call ECCO_COST_INIT_BARFILES( mythid )
endif
#endif
#ifdef ECCO_CTRL_DEPRECATED
#ifdef ALLOW_TRANSPORT_COST_CONTRIBUTION
do irec = 1, ndaysrec
wtransp(irec) = 0. _d 0
transpobs(irec) = 0. _d 0
enddo
if ( costTranspDataFile .NE. ' ' ) then
_BEGIN_MASTER(myThid)
ilo = ifnblnk(costTranspDataFile)
ihi = ilnblnk(costTranspDataFile)
CALL OPEN_COPY_DATA_FILE(
I costTranspDataFile(ilo:ihi),
I 'ECCO_COST_INIT_FIXED',
O gwunit,
I myThid )
do irec = 1, ndaysrec
c-- read daily transport time series
c-- 1st: transport in m/s
c-- 2nd: date in YYYYMMDD
c-- 3rd: uncertainty in m/s
read(gwunit,*) transpobs(irec), dummy, wtransp(irec)
c-- convert std.dev. to weight
if ( wtransp(irec) .NE. 0. )
& wtransp(irec) =1.0/(wtransp(irec)*wtransp(irec))
c-- set weight to zero for missing values
if ( transpobs(irec) .EQ. missingObsFlag )
& wtransp(irec) = 0. _d 0
enddo
_END_MASTER(myThid)
_BARRIER
endif
#endif /* ALLOW_TRANSPORT_COST_CONTRIBUTION */
#ifdef ALLOW_NEW_SSH_COST
c-- Read flags for picking SSH time averages
do irec = 1, ndaysrec
tpTimeMask(irec) = 1. _d 0
ersTimeMask(irec) = 1. _d 0
gfoTimeMask(irec) = 1. _d 0
enddo
c
_BEGIN_MASTER(myThid)
c
#ifdef ALLOW_SSH_TPANOM_COST_CONTRIBUTION
if ( tpTimeMaskFile .NE. ' ' ) then
ilo = ifnblnk(tpTimeMaskFile)
ihi = ilnblnk(tpTimeMaskFile)
CALL OPEN_COPY_DATA_FILE(
I tpTimeMaskFile(ilo:ihi),
I 'cost_ssh tp',
O gwunit,
I myThid )
do irec = 1, ndaysrec
read(gwunit,*) tpTimeMask(irec)
enddo
endif
#endif
c
#ifdef ALLOW_SSH_ERSANOM_COST_CONTRIBUTION
if ( ersTimeMaskFile .NE. ' ' ) then
ilo = ifnblnk(ersTimeMaskFile)
ihi = ilnblnk(ersTimeMaskFile)
CALL OPEN_COPY_DATA_FILE(
I ersTimeMaskFile(ilo:ihi),
I 'cost_ssh ers',
O gwunit,
I myThid )
do irec = 1, ndaysrec
read(gwunit,*) ersTimeMask(irec)
enddo
endif
#endif
c
#ifdef ALLOW_SSH_GFOANOM_COST_CONTRIBUTION
if ( gfoTimeMaskFile .NE. ' ' ) then
ilo = ifnblnk(gfoTimeMaskFile)
ihi = ilnblnk(gfoTimeMaskFile)
CALL OPEN_COPY_DATA_FILE(
I gfoTimeMaskFile(ilo:ihi),
I 'cost_ssh gfo',
O gwunit,
I myThid )
do irec = 1, ndaysrec
read(gwunit,*) gfoTimeMask(irec)
enddo
endif
#endif
c
do irec = 1, ndaysrec
if (
& ( tpTimeMask(irec).NE.0. .AND. tpTimeMask(irec).NE.1. ) .OR.
& ( ersTimeMask(irec).NE.0. .AND. ersTimeMask(irec).NE.1. ) .OR.
& ( ersTimeMask(irec).NE.0. .AND. ersTimeMask(irec).NE.1. ) )
& then
WRITE(msgBuf,'(2A,I10)')
& 'ecco_cost_init_fixed: (SSH)TimeMask not 0. or 1. ',
& 'for irec (=day) ', irec
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT , myThid )
CALL PRINT_ERROR( msgBuf , myThid )
STOP 'ABNORMAL END: S/R ECCO_COST_INIT_FIXED'
endif
enddo
c
_END_MASTER(myThid)
_BARRIER
#endif /* ALLOW_NEW_SSH_COST */
#endif /* ECCO_CTRL_DEPRECATED */
c-- Summarize the cost function setup.
_BEGIN_MASTER( mythid )
call ECCO_SUMMARY( mythid )
call ECCO_COST_SUMMARY( mythid )
_END_MASTER( mythid )
_BARRIER
end