Back to home page

MITgcm
 
 

    

File indexing completed on 2024-02-07 06:10:18 UTC

view on githubraw file Latest commit 35c4fdc7 on 2024-02-06 21:05:47 UTC
8f7d13d0c9 Jean*0001 #include "ECCO_OPTIONS.h"
93bee5c6a2 Jean*0002 #include "AD_CONFIG.h"
6b47d550f4 Mart*0003 #ifdef ALLOW_CTRL
                0004 # include "CTRL_OPTIONS.h"
                0005 #endif
5001c65f45 Patr*0006 
6b47d550f4 Mart*0007       subroutine ecco_cost_init_fixed( myThid )
5001c65f45 Patr*0008 
                0009 c     ==================================================================
                0010 c     SUBROUTINE ecco_cost_init_fixed
                0011 c     ==================================================================
                0012 c
                0013 c     o Set contributions to the cost function and the cost function
                0014 c       itself to zero. The cost function and the individual contribu-
                0015 c       tions are defined in the header file "ecco_cost.h".
                0016 c
                0017 c     started: Christian Eckert eckert@mit.edu 30-Jun-1999
                0018 c
                0019 c     changed: Christian Eckert eckert@mit.edu 25-Feb-2000
                0020 c
                0021 c              - Restructured the code in order to create a package
                0022 c                for the MITgcmUV.
                0023 c
                0024 c     changed: Ralf Giering 18-Jan-2001
                0025 c
                0026 c              - move namelist reading to cost_readparms.F
                0027 c
                0028 c     ==================================================================
                0029 c     SUBROUTINE ecco_cost_init_fixed
                0030 c     ==================================================================
                0031 
d4b64b229a Jean*0032       IMPLICIT NONE
5001c65f45 Patr*0033 
                0034 c     == global variables ==
                0035 
                0036 #include "EEPARAMS.h"
                0037 #include "SIZE.h"
                0038 #include "GRID.h"
                0039 #include "PARAMS.h"
                0040 
869864d4b6 Patr*0041 #ifdef ALLOW_CAL
35c4fdc74b Emma*0042 # include "cal.h"
49484c0542 Gael*0043 #endif
35c4fdc74b Emma*0044 #include "ECCO_SIZE.h"
                0045 #include "ECCO.h"
49484c0542 Gael*0046 #ifdef ALLOW_CTRL
65754df434 Mart*0047 # include "OPTIMCYCLE.h"
49484c0542 Gael*0048 #endif
5001c65f45 Patr*0049 
                0050 c     == routine arguments ==
                0051 
6b47d550f4 Mart*0052       integer myThid
5001c65f45 Patr*0053 
                0054 c     == local variables ==
                0055 
5cce2b5d76 Gael*0056       integer k
                0057       logical exst
7484238bfd Patr*0058       _RL     missingObsFlag
                0059       PARAMETER ( missingObsFlag = 1. _d 23 )
cf705a6c8e Mart*0060 #ifdef ALLOW_GENCOST_1D
d4b64b229a Jean*0061       CHARACTER*(MAX_LEN_MBUF) msgBuf
9f5240b52a Jean*0062       integer ilo, ihi, irec, gwunit
                0063 #endif
5cce2b5d76 Gael*0064 #ifdef ALLOW_GENCOST_CONTRIBUTION
9f5240b52a Jean*0065       integer k2
5cce2b5d76 Gael*0066 #endif
35c4fdc74b Emma*0067 #ifndef ECCO_VARIABLE_AREAVOLGLOB
                0068       INTEGER i, j, bi, bj
                0069 #endif
5001c65f45 Patr*0070 
                0071 c     == external functions ==
                0072 
706976e7e4 Patr*0073       integer  cal_IntYears
                0074       external cal_IntYears
5001c65f45 Patr*0075       integer  cal_IntMonths
                0076       external cal_IntMonths
                0077       integer  cal_IntDays
                0078       external cal_IntDays
7484238bfd Patr*0079       integer  ifnblnk
                0080       external ifnblnk
                0081       integer  ilnblnk
                0082       external ilnblnk
5001c65f45 Patr*0083 
                0084 c     == end of interface ==
                0085 
49484c0542 Gael*0086 #ifdef ALLOW_CTRL
                0087       eccoiter=optimcycle
                0088 #else
                0089       eccoiter=0
                0090 #endif
                0091 
35c4fdc74b Emma*0092 #ifndef ECCO_VARIABLE_AREAVOLGLOB
                0093       DO bj=myByLo(myThid),myByHi(myThid)
                0094         DO bi=myBxLo(myThid),myBxHi(myThid)
                0095           DO k = 1,Nr
                0096             DO j = 1-OLy,sNy+OLy
                0097               DO i = 1-OLx,sNx+OLx
                0098                 eccoVol_0(i,j,k,bi,bj)=
                0099      &          hFacC(i,j,k,bi,bj)*drF(k)*rA(i,j,bi,bj)
                0100               ENDDO
                0101             ENDDO
                0102           ENDDO
                0103         ENDDO
                0104       ENDDO
                0105 #endif
                0106 
5001c65f45 Patr*0107 #ifdef ALLOW_CAL
                0108 
                0109 c--   The number of monthly and daily averages generated by the
                0110 c--   current model integration.
6b47d550f4 Mart*0111       nyearsrec = cal_IntYears( myThid )
                0112       nmonsrec = cal_IntMonths( myThid )
                0113       ndaysrec = cal_IntDays( myThid )
5001c65f45 Patr*0114 
7acc326976 Gael*0115 #ifdef ALLOW_GENCOST_CONTRIBUTION
                0116       do k = 1, NGENCOST
49484c0542 Gael*0117 
6b47d550f4 Mart*0118 c--    skip averaging when several cost terms use the
9eaee0f935 Gael*0119 c      same barfile or when barfile is undefined
                0120        gencost_barskip(k)=.FALSE.
6b47d550f4 Mart*0121        if ( gencost_barfile(k).EQ.' ' )
9eaee0f935 Gael*0122      &      gencost_barskip(k)=.TRUE.
                0123        do k2 = 1,k-1
                0124          if ( gencost_barfile(k2).EQ.gencost_barfile(k) )
                0125      &      gencost_barskip(k)=.TRUE.
                0126        enddo
                0127 
5cce2b5d76 Gael*0128 c--    set time averaging parameters
49484c0542 Gael*0129        if ( (using_gencost(k)).AND.( (gencost_flag(k).GE.1).OR.
                0130      &         (gencost_avgperiod(k).NE.'     ') ) ) then
7acc326976 Gael*0131          if ( gencost_avgperiod(k) .EQ. 'day' .OR.
                0132      &        gencost_avgperiod(k) .EQ. 'DAY' ) then
                0133             gencost_nrec(k)   = ndaysrec
                0134             gencost_period(k) = 86400.
                0135          else if ( gencost_avgperiod(k) .EQ. 'month' .OR.
                0136      &        gencost_avgperiod(k) .EQ. 'MONTH' ) then
                0137             gencost_nrec(k)   =nmonsrec
                0138             gencost_period(k) = 0.
e7d9258ace Gael*0139          else if ( gencost_avgperiod(k) .EQ. 'step' .OR.
                0140      &        gencost_avgperiod(k) .EQ. 'STEP' ) then
                0141             gencost_nrec(k)   =nTimeSteps+1
                0142             gencost_period(k) = dTtracerLev(1)
985662a3b3 Gael*0143          else if ( gencost_avgperiod(k) .EQ. 'const' .OR.
                0144      &        gencost_avgperiod(k) .EQ. 'CONST' ) then
                0145             gencost_nrec(k)   =1
                0146             gencost_period(k) = dTtracerLev(1)
7acc326976 Gael*0147          else if ( gencost_avgperiod(k) .EQ. 'year' .OR.
                0148      &        gencost_avgperiod(k) .EQ. 'YEAR' ) then
f80d27073f Patr*0149            STOP
                0150      &      'ecco_cost_init_fixed: yearly data not yet implemented'
7acc326976 Gael*0151          else
8f7d13d0c9 Jean*0152            STOP
f80d27073f Patr*0153      &      'ecco_cost_init_fixed: gencost_avgperiod wrongly specified'
7acc326976 Gael*0154          endif
f80d27073f Patr*0155        endif
49484c0542 Gael*0156 
5cce2b5d76 Gael*0157 c--    set observation start/enddate
49484c0542 Gael*0158        if (gencost_startdate1(k).GT.0) then
                0159          call cal_FullDate(
                0160      &     gencost_startdate1(k), gencost_startdate2(k),
6b47d550f4 Mart*0161      &     gencost_startdate(1,k), myThid )
49484c0542 Gael*0162        else
                0163          call cal_CopyDate(modelStartDate,
6b47d550f4 Mart*0164      &     gencost_startdate(1,k),myThid)
94b7e5468a Gael*0165          gencost_startdate1(k)=startdate_1
                0166          gencost_startdate2(k)=startdate_2
49484c0542 Gael*0167        endif
                0168 
                0169        if (gencost_enddate1(k).GT.0) then
                0170          call cal_FullDate(
                0171      &     gencost_enddate1(k), gencost_enddate2(k),
6b47d550f4 Mart*0172      &     gencost_enddate(1,k), myThid )
49484c0542 Gael*0173        else
                0174          call cal_CopyDate(modelEndDate,
6b47d550f4 Mart*0175      &     gencost_enddate(1,k),myThid)
49484c0542 Gael*0176        endif
                0177 
6b2230d510 Ou W*0178 #ifdef ALLOW_GENCOST_1D
                0179       if ( (gencost_name(k).EQ.'gmbp') .OR.
                0180      &     (gencost_name(k).EQ.'gmsl')) then
                0181        if(gencost_nrec(k).GT.N1DDATA)then
                0182         WRITE(msgBuf,'(2A,2i8)') 'ecco_cost_init_fixed: ',
                0183      &   'Increase N1DDATA', N1DDATA, gencost_nrec(k)
                0184         CALL PRINT_ERROR( msgBuf, myThid)
                0185        endif
                0186 
                0187       do irec = 1, N1DDATA
                0188        gencost_1DDATA(irec,k) = 0. _d 0
                0189       enddo
                0190 
                0191       if(gencost_wei1d(k).NE.0. _d 0)then
                0192         gencost_wei1d(k) = 1. _d 0 / gencost_wei1d(k)
                0193      &      /gencost_wei1d(k)
                0194       endif
                0195 
                0196       if ( gencost_datafile(k) .NE. ' ' ) then
                0197       ilo = ifnblnk(gencost_datafile(k))
                0198       ihi = ilnblnk(gencost_datafile(k))
                0199 
                0200       CALL OPEN_COPY_DATA_FILE(
                0201      I                          gencost_datafile(k)(ilo:ihi),
                0202      I                          'ECCO_COST_INIT_FIXED: ',
                0203      O                          gwunit,
                0204      I                          myThid )
                0205       do irec = 1, gencost_nrec(k)
                0206          read(gwunit,*) gencost_1DDATA(irec,k)
                0207       enddo
                0208       close(gwunit)
                0209       endif
                0210 
                0211       endif
                0212 #endif /* ALLOW_GENCOST_1D */
                0213 
5cce2b5d76 Gael*0214       enddo !do k = 1, NGENCOST
7acc326976 Gael*0215 #endif /* ALLOW_GENCOST_CONTRIBUTION */
                0216 
5001c65f45 Patr*0217 #endif /* ALLOW_CAL */
                0218 
d4b64b229a Jean*0219 C-    ECCO_CHECK is now called from packages_check.F
                0220 c     call ecco_check( myThid )
cc9899cf30 Patr*0221 
5001c65f45 Patr*0222 c--   Get the weights that are to be used for the individual cost
                0223 c--   function contributions.
6b47d550f4 Mart*0224       call ecco_cost_weights( myThid )
5001c65f45 Patr*0225 
                0226 c--   Initialise adjoint of monthly mean files calculated
                0227 c--   in cost_averagesfields (and their ad...).
                0228 cph(
                0229 cph   The following init. shoud not be applied if in the middle
                0230 cph   of a divided adjoint run
                0231 cph)
                0232 #ifndef ALLOW_TANGENTLINEAR_RUN
                0233 cph!!! and I think it needs to be seen by TAF
                0234 cph!!! for repeated TLM runs
                0235 cph!!!
                0236       inquire( file='costfinal', exist=exst )
                0237       if ( .NOT. exst) then
6b47d550f4 Mart*0238          call ecco_cost_init_barfiles( myThid )
5001c65f45 Patr*0239       endif
                0240 #endif
                0241 
d4b64b229a Jean*0242 c--   Summarize the cost function setup. <-- now called at the end of ECCO_CHECK
                0243 c     call ecco_summary( myThid )
5001c65f45 Patr*0244 
                0245       _BARRIER
                0246 
6b47d550f4 Mart*0247       RETURN
                0248       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!