pkg/ctrl/ctrl_cost_driver.F

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