pkg/ecco/cost_gencost_all.F

8f7d13d0c9 Jean*0001 #include "ECCO_OPTIONS.h"
df3aa3e753 Gael*0002
                0003       subroutine cost_gencost_all( myiter, mytime, mythid )
                0004
                0005 c     ==================================================================
                0006 c     SUBROUTINE cost_gencost_all
                0007 c     ==================================================================
                0008 c
                0009 c     o Evaluate user defined penalty terms
                0010 c
                0011 c     ==================================================================
                0012 c     SUBROUTINE cost_gencost_all
                0013 c     ==================================================================
                0014
                0015       implicit none
                0016
                0017 c     == global variables ==
                0018
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
                0022 #include "GRID.h"
f09238ab8f Gael*0023 #ifdef ALLOW_ECCO
13d362b8c1 Ou W*0024 # include "ECCO_SIZE.h"
                0025 # include "ECCO.h"
f09238ab8f Gael*0026 #endif
df3aa3e753 Gael*0027
                0028 c     == routine arguments ==
                0029
                0030       integer mythid
                0031       integer myiter
                0032       _RL     mytime
                0033
8c157ed454 Patr*0034 #ifdef ALLOW_GENCOST_CONTRIBUTION
df3aa3e753 Gael*0035 c     == local variables ==
                0036
69f8f4c84c Patr*0037       character*(max_len_mbuf) msgbuf
                0038       integer nnzbar
                0039       integer nnzobs
4d032ba730 Gael*0040       integer k
9eaee0f935 Gael*0041       integer nrecloc, nrecperiodloc
8c157ed454 Patr*0042
                0043 c     == external functions ==
                0044
df3aa3e753 Gael*0045 c     == end of interface ==
                0046
8c157ed454 Patr*0047       do k = 1, NGENCOST
                0048
df462307fb Timo*0049          if ( (using_gencost(k)).AND.( gencost_flag(k).EQ.1 )
6b2230d510 Ou W*0050      &   .AND.( .NOT.gencost_is1d(k) ) ) then
                0051
5cce2b5d76 Gael*0052 #ifdef ALLOW_DEBUG
4d032ba730 Gael*0053          IF ( debugLevel .GE. debLevD ) THEN
                0054            write(msgbuf,'(a,x,i2.2)') 'gencost #', k
                0055            call print_message( msgbuf, standardmessageunit,
8c157ed454 Patr*0056      &        SQUEEZE_RIGHT , mythid)
4d032ba730 Gael*0057          ENDIF
5cce2b5d76 Gael*0058 #endif
                0059
4d032ba730 Gael*0060          if ( .NOT.gencost_is3d(k) ) then
                0061            nnzbar = 1
                0062            nnzobs = 1
                0063          else
                0064            nnzbar = nr
                0065            nnzobs = nr
                0066          endif
5cce2b5d76 Gael*0067
9eaee0f935 Gael*0068          nrecloc= gencost_nrec(k)
b8fab26f74 Gael*0069          nrecperiodloc= gencost_nrec(k)
4d032ba730 Gael*0070
5cce2b5d76 Gael*0071          call cost_generic(
4d032ba730 Gael*0072      &     nnzbar, gencost_barfile(k), gencost_dummy(k),
dfd90b6b5c Gael*0073      &     nnzobs, gencost_datafile(k), gencost_errfile(k),
                0074      &     mult_gencost(k), nrecloc, nrecperiodloc,
47d80787ea Gael*0075      &     gencost_startdate(1,k), gencost_period(k), 'c',
3bd7a4549f Gael*0076      &     gencost_spmin(k), gencost_spmax(k), gencost_spzero(k),
                0077      &     gencost_preproc(1,k), gencost_preproc_c(1,k),
                0078      &     gencost_preproc_i(1,k), gencost_preproc_r(1,k),
df462307fb Timo*0079      &     gencost_posproc(1,k), gencost_posproc_c(1,k),
3bd7a4549f Gael*0080      &     gencost_posproc_i(1,k), gencost_posproc_r(1,k),
9eaee0f935 Gael*0081      &     gencost_outputlevel(k), gencost_name(k),
5cce2b5d76 Gael*0082      &     objf_gencost(1,1,k), num_gencost(1,1,k),
                0083      &     myiter, mytime, mythid )
                0084
4d032ba730 Gael*0085          endif ! if ( (using_gencost(k)).AND.( gencost_flag(k).EQ.1 ) ) then
f1e8c1d7ee Gael*0086
8c157ed454 Patr*0087       end do
                0088
6b2230d510 Ou W*0089       call cost_gencost_glbmean( mythid )
a7c06059b4 Gael*0090       call cost_gencost_boxmean( mythid )
f09238ab8f Gael*0091       call cost_gencost_bpv4( mythid )
df462307fb Timo*0092       call cost_gencost_moc( mythid )
f1e0eff8fe An T*0093       IF (using_cost_transp) call cost_gencost_transp( mythid )
f09238ab8f Gael*0094       IF (using_cost_altim) call cost_gencost_sshv4( mythid )
                0095       IF (using_cost_sst) call cost_gencost_sstv4( mythid )
                0096       IF (using_cost_seaice) call cost_gencost_seaicev4( mythid )
2ac072a19d Gael*0097
8c157ed454 Patr*0098 #endif /* ALLOW_GENCOST_CONTRIBUTION */
df3aa3e753 Gael*0099
df462307fb Timo*0100       return
df3aa3e753 Gael*0101       end