pkg/ctrl/ctrl_cost_driver.F

8717a37129 Gael*0001 #include "CTRL_OPTIONS.h"
                0002
84f053a743 Gael*0003       subroutine ctrl_cost_driver( myThid )
8717a37129 Gael*0004
                0005 c     ==================================================================
                0006 c     SUBROUTINE ctrl_cost_driver
                0007 c     ==================================================================
                0008
                0009       implicit none
                0010
                0011 c     == global variables ==
                0012
                0013 #include "EEPARAMS.h"
                0014 #include "SIZE.h"
                0015 #include "PARAMS.h"
                0016 #include "GRID.h"
                0017
                0018 #ifdef ALLOW_CTRL
                0019 # include "CTRL_SIZE.h"
4d72283393 Mart*0020 # include "CTRL.h"
edcd27be69 Mart*0021 # include "CTRL_DUMMY.h"
8717a37129 Gael*0022 # include "CTRL_GENARR.h"
                0023 #endif
                0024
                0025 c     == routine arguments ==
                0026
84f053a743 Gael*0027       integer myThid
8717a37129 Gael*0028
                0029 c     == local variables ==
                0030
84f053a743 Gael*0031 #ifdef ALLOW_CTRL
                0032
5cf4364659 Mart*0033       integer ivar
84f053a743 Gael*0034 #ifdef ALLOW_GENTIM2D_CONTROL
8717a37129 Gael*0035       integer startrec
                0036       integer endrec
09ce3bf350 Gael*0037 #endif
                0038
5cf4364659 Mart*0039 #if ( defined ALLOW_GENTIM2D_CONTROL \
                0040    || defined ALLOW_GENARR2D_CONTROL \
                0041    || defined ALLOW_GENARR3D_CONTROL )
8717a37129 Gael*0042       integer iarr
f127287d37 Gael*0043       logical dodimensionalcost
                0044       integer k2
9f5240b52a Jean*0045 #endif
5cf4364659 Mart*0046 #if ( defined ALLOW_GENTIM2D_CONTROL \
                0047    || defined ALLOW_GENARR2D_CONTROL )
9f5240b52a Jean*0048       _RS mask2D(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0049 #endif
                0050 #ifdef ALLOW_GENARR3D_CONTROL
                0051       _RS mask3D(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
8717a37129 Gael*0052 #endif
                0053
                0054 c     == end of interface ==
                0055
                0056 c--   Evaluate the individual cost function contributions.
                0057
5cf4364659 Mart*0058       do ivar = 1, maxcvars
8717a37129 Gael*0059 #ifdef ALLOW_GENTIM2D_CONTROL
5cf4364659 Mart*0060        if ( ncvartype(ivar) .EQ. 'Tim2D' ) then
                0061         iarr = ncvarindex(ivar)
8717a37129 Gael*0062
5cf4364659 Mart*0063         dodimensionalcost=.FALSE.
                0064         do k2 = 1, maxCtrlProc
                0065          if (xx_gentim2d_preproc(k2,iarr).EQ.'noscaling') then
                0066           dodimensionalcost=.TRUE.
e342a54299 Gael*0067          endif
5cf4364659 Mart*0068         enddo
                0069
                0070         if (xx_gentim2d_weight(iarr).NE.' ') then
                0071          startrec = ncvarrecstart(ivar)
                0072          endrec   = ncvarrecsend(ivar)
                0073          do k2 = 1, maxCtrlProc
                0074           if (xx_gentim2d_preproc(k2,iarr).EQ.'replicate') then
                0075            if (xx_gentim2d_preproc_i(k2,iarr).NE.0) then
                0076             endrec=min(endrec,xx_gentim2d_preproc_i(k2,iarr))
                0077            endif
                0078           endif
                0079          enddo
7b8b86ab99 Timo*0080
                0081 C --- Get appropriate mask for field
5cf4364659 Mart*0082          call ctrl_get_mask2D(xx_gentim2d_file(iarr),mask2D,myThid)
7b8b86ab99 Timo*0083
5cf4364659 Mart*0084          call ctrl_cost_gen2d (
84f053a743 Gael*0085      &     startrec, endrec,
ea1c7c7217 Gael*0086      &     xx_gentim2d_file(iarr),xx_gentim2d_dummy(iarr),
                0087      &     xx_gentim2d_period(iarr),
9f5240b52a Jean*0088      &     wgentim2d(1-OLx,1-OLy,1,1,iarr),
f127287d37 Gael*0089      &     dodimensionalcost,
989cdae9b6 Gael*0090      &     num_gentim2d(1,1,iarr),
                0091      &     objf_gentim2d(1,1,iarr),
7b8b86ab99 Timo*0092      &     mask2D, myThid )
5cf4364659 Mart*0093         endif
8717a37129 Gael*0094
5cf4364659 Mart*0095        endif
8717a37129 Gael*0096 #endif
84f053a743 Gael*0097
173641b4e3 Gael*0098 #ifdef ALLOW_GENARR2D_CONTROL
5cf4364659 Mart*0099        if ( ncvartype(ivar) .EQ. 'Arr2D' ) then
                0100         iarr = ncvarindex(ivar)
173641b4e3 Gael*0101
5cf4364659 Mart*0102         dodimensionalcost=.FALSE.
                0103         do k2 = 1, maxCtrlProc
                0104          if (xx_genarr2d_preproc(k2,iarr).EQ.'noscaling') then
                0105           dodimensionalcost=.TRUE.
                0106          endif
                0107         enddo
f127287d37 Gael*0108
7b8b86ab99 Timo*0109 C --- Get appropriate mask for field
5cf4364659 Mart*0110         call ctrl_get_mask2D(xx_genarr2d_file(iarr),mask2D,myThid)
7b8b86ab99 Timo*0111
5cf4364659 Mart*0112         if (xx_genarr2d_weight(iarr).NE.' ') then
                0113          call ctrl_cost_gen2d (
173641b4e3 Gael*0114      &     1,1,
                0115      &     xx_genarr2d_file(iarr),xx_genarr2d_dummy(iarr),
9f5240b52a Jean*0116      &     zeroRL, wgenarr2d(1-OLx,1-OLy,1,1,iarr),
f127287d37 Gael*0117      &     dodimensionalcost,
173641b4e3 Gael*0118      &     num_genarr2d(1,1,iarr), objf_genarr2d(1,1,iarr),
7b8b86ab99 Timo*0119      &     mask2D, myThid )
5cf4364659 Mart*0120         endif
7b8b86ab99 Timo*0121
5cf4364659 Mart*0122        endif
173641b4e3 Gael*0123 #endif
                0124
09ce3bf350 Gael*0125 #ifdef ALLOW_GENARR3D_CONTROL
5cf4364659 Mart*0126        if ( ncvartype(ivar) .EQ. 'Arr3D' ) then
                0127         iarr = ncvarindex(ivar)
09ce3bf350 Gael*0128
5cf4364659 Mart*0129         dodimensionalcost=.FALSE.
                0130         do k2 = 1, maxCtrlProc
                0131          if (xx_genarr3d_preproc(k2,iarr).EQ.'noscaling') then
                0132           dodimensionalcost=.TRUE.
                0133          endif
                0134         enddo
f127287d37 Gael*0135
7b8b86ab99 Timo*0136 C --- Get appropriate mask for field
5cf4364659 Mart*0137         call ctrl_get_mask3D(xx_genarr3d_file(iarr),mask3D,myThid)
7b8b86ab99 Timo*0138
5cf4364659 Mart*0139         if (xx_genarr3d_weight(iarr).NE.' ') then
                0140          call ctrl_cost_gen3d (
09ce3bf350 Gael*0141      &     xx_genarr3d_file(iarr),xx_genarr3d_dummy(iarr),
9f5240b52a Jean*0142      &     wgenarr3d(1-OLx,1-OLy,1,1,1,iarr),
f127287d37 Gael*0143      &     dodimensionalcost,
09ce3bf350 Gael*0144      &     num_genarr3d(1,1,iarr), objf_genarr3d(1,1,iarr),
7b8b86ab99 Timo*0145      &     mask3D, myThid )
5cf4364659 Mart*0146         endif
09ce3bf350 Gael*0147
5cf4364659 Mart*0148        endif
8717a37129 Gael*0149 #endif
5cf4364659 Mart*0150       enddo
                0151 #endif /* ALLOW_CTRL */
8717a37129 Gael*0152
7b8b86ab99 Timo*0153       return
8717a37129 Gael*0154       end