pkg/ecco/cost_gencal.F

ac486aa51f Gael*0001 #include "ECCO_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C     !ROUTINE: cost_gencal
                0006 C     !INTERFACE:
                0007       subroutine cost_gencal(
                0008      I     localbarfile, localobsfile,
                0009      I     irec, localstartdate, localperiod,
                0010      O     fname1, fname2, localrec, obsrec, exst,
                0011      I     mythid )
                0012
                0013 C     !DESCRIPTION: \bv
                0014 C     ==================================================================
                0015 C     SUBROUTINE cost_gencal
                0016 C     ==================================================================
                0017 C     reads and pre-processes bar file records
                0018 C     ==================================================================
                0019 C     SUBROUTINE cost_gencal
                0020 C     ==================================================================
                0021 C     \ev
                0022
                0023 C     !USES:
                0024       IMPLICIT NONE
                0025
                0026 C     == global variables ==
                0027 #include "EEPARAMS.h"
                0028 #include "SIZE.h"
e7d9258ace Gael*0029 #include "PARAMS.h"
ac486aa51f Gael*0030 #ifdef ALLOW_CAL
                0031 # include "cal.h"
                0032 #endif
                0033 #ifdef ALLOW_ECCO
13d362b8c1 Ou W*0034 # include "ECCO_SIZE.h"
                0035 # include "ECCO.h"
ac486aa51f Gael*0036 #endif
                0037
                0038 c     == routine arguments ==
                0039       character*(MAX_LEN_FNAM) localbarfile
                0040       character*(MAX_LEN_FNAM) localobsfile
9f5240b52a Jean*0041       integer irec, localstartdate(4)
                0042       _RL localperiod
ac486aa51f Gael*0043       character*(128) fname1, fname2
                0044       integer localrec, obsrec
9f5240b52a Jean*0045       logical exst
                0046       integer mythid
ac486aa51f Gael*0047
                0048 #ifdef ALLOW_ECCO
9f5240b52a Jean*0049 c     == external functions ==
                0050       integer  ilnblnk
                0051       external ilnblnk
ac486aa51f Gael*0052
                0053 c     == local variables ==
                0054 c      CHARACTER*(MAX_LEN_MBUF) msgBuf
                0055       integer k, il
                0056       _RL daytime
                0057       _RL diffsecs
                0058       integer dayiter
                0059       integer daydate(4)
                0060       integer difftime(4)
                0061       integer tempDate_1
                0062       integer middate(4)
                0063       integer yday, ymod
                0064       integer md, dd, sd, ld, wd
                0065       integer mody, modm
                0066
                0067 c     == end of interface ==
                0068 CEOP
                0069
                0070       il=ilnblnk( localbarfile )
de57a2ec4b Mart*0071       write(fname1,'(2a,i10.10)')
ac486aa51f Gael*0072      &     localbarfile(1:il),'.',eccoiter
                0073
e7d9258ace Gael*0074         if ( localperiod.EQ.dTtracerLev(1) ) then
                0075            localrec = irec
                0076            obsrec = irec
38fe590bed Gael*0077            yday = 0
e7d9258ace Gael*0078         elseif ( localperiod .EQ. 86400. ) then
ac486aa51f Gael*0079 c-- assume daily fields
                0080            obsrec = irec
                0081            daytime = FLOAT(secondsperday*(irec-1)) + modelstart
                0082            dayiter = hoursperday*(irec-1) + modeliter0
                0083            call cal_getdate( dayiter, daytime, daydate, mythid )
                0084            call cal_convdate( daydate,yday,md,dd,sd,ld,wd,mythid )
aa7751ee3b Gael*0085            ymod = modelstartdate(1)/10000
ac486aa51f Gael*0086            do k=1,4
                0087               middate(k)=0
                0088            enddo
                0089            tempDate_1 = yday*10000+100+1
                0090            if ( ymod .GE. yday ) then
aa7751ee3b Gael*0091               call cal_FullDate( modelstartdate(1), 0, middate, mythid)
ac486aa51f Gael*0092            else
                0093               call cal_FullDate( tempDate_1, 0, middate, mythid)
                0094            endif
                0095            call cal_TimePassed( middate, daydate, difftime, mythid )
                0096            call cal_ToSeconds( difftime, diffsecs, mythid )
                0097 c           localrec = floor(diffsecs/localperiod) + 1
                0098            localrec = int(diffsecs/localperiod) + 1
                0099         else
                0100 c-- assume monthly fields
aa7751ee3b Gael*0101            obsrec = irec
ac486aa51f Gael*0102            mody   = modelstartdate(1)/10000
                0103            modm   = modelstartdate(1)/100 - mody*100
                0104            yday   = mody + INT((modm-1+irec-1)/12)
                0105            localrec = 1 + MOD(modm-1+irec-1,12)
                0106         endif
                0107
                0108         il=ilnblnk(localobsfile)
de57a2ec4b Mart*0109         write(fname2,'(2a,i4)')
ac486aa51f Gael*0110      &       localobsfile(1:il), '_', yday
                0111         inquire( file=fname2, exist=exst )
aa7751ee3b Gael*0112         if (.NOT. exst) then
                0113 c          assume that the data set is cyclic
de57a2ec4b Mart*0114            write(fname2,'(a)') localobsfile(1:il)
ac486aa51f Gael*0115            inquire( file=fname2, exist=exst )
                0116         endif
                0117
                0118 #endif /* ALLOW_ECCO */
                0119
                0120       RETURN
                0121       END