pkg/streamice/streamice_cost_surf_accum.F

578fad1ab3 Jean*0001 #include "STREAMICE_OPTIONS.h"
96b006450c dngo*0002 c#ifdef ALLOW_AUTODIFF
                0003 c# include "AUTODIFF_OPTIONS.h"
                0004 c#endif
5ca83cd8f7 Dani*0005 #ifdef ALLOW_COST
                0006 # include "COST_OPTIONS.h"
                0007 #endif
                0008
96b006450c dngo*0009       subroutine streamice_cost_surf_accum ( myIter, myThid )
578fad1ab3 Jean*0010 C     *==========================================================*
96b006450c dngo*0011 C     | subroutine streamice_cost_surf_accum                     |
                0012 C     | o this routine calculates the surface misfit contri-     |
                0013 C     |   bution to the per-timestep STREAMICE cost              |
578fad1ab3 Jean*0014 C     *==========================================================*
5ca83cd8f7 Dani*0015 C     |                                                          |
                0016 C     | Notes                                                    |
                0017 C     | =====                                                    |
578fad1ab3 Jean*0018 C     *==========================================================*
5ca83cd8f7 Dani*0019       IMPLICIT NONE
                0020
                0021 C     == Global variables ===
                0022 #include "SIZE.h"
96b006450c dngo*0023 #include "GRID.h"
5ca83cd8f7 Dani*0024 #include "EEPARAMS.h"
                0025 #include "PARAMS.h"
                0026 #include "DYNVARS.h"
                0027 #ifdef ALLOW_STREAMICE
                0028 # include "STREAMICE.h"
                0029 #endif
                0030
                0031 #ifdef ALLOW_COST
                0032 # include "cost.h"
578fad1ab3 Jean*0033 #endif
96b006450c dngo*0034 c#ifdef ALLOW_AUTODIFF_TAMC
                0035 c# include "tamc.h"
                0036 c#endif
5ca83cd8f7 Dani*0037
                0038 C     == Routine arguments ==
                0039 C     myThid - Thread number for this instance of the routine.
96b006450c dngo*0040       integer myIter, myThid
5ca83cd8f7 Dani*0041
96b006450c dngo*0042 #ifdef ALLOW_STREAMICE_TC_COST
5ca83cd8f7 Dani*0043 C     == Local variables
96b006450c dngo*0044       _RL HAF
5ca83cd8f7 Dani*0045       integer i, j, k, bi, bj
                0046       integer ig, jg
                0047       integer itlo,ithi
                0048       integer jtlo,jthi
7493c1d2cc Patr*0049       integer il
96b006450c dngo*0050       CHARACTER*(10) myIterStr
5ca83cd8f7 Dani*0051       INTEGER  ILNBLNK
                0052       EXTERNAL ILNBLNK
96b006450c dngo*0053       CHARACTER*(MAX_LEN_FNAM) surffilename, errsurffilename
                0054       _RL surfobs (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0055       _RL errsurfobs (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0056       _RL rhoi, rhow, r, i_r, i_numcells, surf_err, h, hf
                0057       WRITE(myIterStr,'(I10.10)') myIter
                0058       surffilename=STREAMICEsurfOptimTCBasename(1:
                0059      & ILNBLNK(STREAMICEsurfOptimTCBasename))//myIterStr//".bin"
                0060       errsurffilename=STREAMICEsurfOptimTCBasename(1:
                0061      & ILNBLNK(STREAMICEsurfOptimTCBasename))//myIterStr//"err.bin"
                0062       CALL READ_FLD_XY_RL( surffilename, ' ', surfobs,
                0063      &  0, myThid )
                0064       CALL READ_FLD_XY_RL( errsurffilename, ' ', errsurfobs,
                0065      &  0, myThid )
                0066
                0067 c#ifdef ALLOW_AUTODIFF_TAMC
                0068 cCADJ STORE surf_el_streamice  = comlev1, key = ikey_dynamics,
                0069 cCADJ &     kind = isbyte
                0070 cCADJ STORE H_streamice_prev  = comlev1, key = ikey_dynamics,
                0071 cCADJ &     kind = isbyte
                0072 cCADJ STORE H_streamice  = comlev1, key = ikey_dynamics,
                0073 cCADJ &     kind = isbyte
                0074 c#endif
                0075
                0076       rhoi = streamice_density
                0077       rhow = streamice_density_ocean_avg
                0078       r=rhoi/rhow
                0079       i_r = 1./r
                0080       i_numcells = 1.0/(Nx*Ny)
5ca83cd8f7 Dani*0081
                0082 C--   Calculate cost function on tile of this instance
96b006450c dngo*0083       DO bj=myByLo(myThid),myByHi(myThid)
                0084         DO bi=myBxLo(myThid),myBxHi(myThid)
5ca83cd8f7 Dani*0085           do j=1,sNy
                0086             do i=1,sNx
96b006450c dngo*0087              if (SURFOBS(i,j,bi,bj).ge.-999990. .and.
                0088      &           streamice_hmask(i,j,bi,bj).eq.1.0) THEN
                0089
                0090              h = H_streamice(i,j,bi,bj)
                0091              hf = -1.0 * i_r * R_low_si (i,j,bi,bj)
                0092
                0093               if (((h-hf) .gt. 5.) .OR.
                0094      &             STREAMICE_shelf_dhdt_ctrl) then
                0095
                0096                surf_err = streamice_wgt_surf * i_numcells *
                0097      &         (surf_el_streamice(i,j,bi,bj) -
                0098      &          surfobs(i,j,bi,bj))**2 /
                0099      &          (.001 + errSurfObs(i,j,bi,bj)**2)
                0100
                0101                cost_func1_streamice (bi,bj) =
                0102      &         cost_func1_streamice (bi,bj) +
                0103      &              surf_err
                0104                cost_surf_streamice (bi,bj) =
                0105      &         cost_surf_streamice (bi,bj) +
                0106      &              surf_err
                0107
                0108               endif
5ca83cd8f7 Dani*0109
                0110              endif
                0111
                0112             end do
                0113           end do
                0114         end do
                0115       end do
                0116
                0117 #endif
                0118
                0119       RETURN
                0120       END