pkg/thsice/thsice_cost_test.F

6c747cb1b2 Patr*0001 #include "THSICE_OPTIONS.h"
6b47d550f4 Mart*0002 c#ifdef ALLOW_AUTODIFF
                0003 c# include "AUTODIFF_OPTIONS.h"
                0004 c#endif
                0005 #ifdef ALLOW_COST
                0006 # include "COST_OPTIONS.h"
                0007 #endif
6c747cb1b2 Patr*0008
6b47d550f4 Mart*0009       SUBROUTINE THSICE_COST_TEST( myTime, myIter, myThid )
6c747cb1b2 Patr*0010
                0011 c     ==================================================================
                0012 c     SUBROUTINE thsice_cost_test
                0013 c     ==================================================================
                0014 c
                0015 c     o Compute sea-ice cost function.  The following options can be
                0016 c       selected with data.thsice (THSICE_PARM02) variable thsice_cost_ice_flag
                0017 c
                0018 c     thsice_cost_ice_flag = 1
                0019 c     - compute mean sea-ice volume
6b47d550f4 Mart*0020 c       costIceStart < myTime < costIceEnd
6c747cb1b2 Patr*0021 c
                0022 c     thsice_cost_ice_flag = 2
                0023 c     - compute mean sea-ice area
6b47d550f4 Mart*0024 c       costIceStart < myTime < costIceEnd
6c747cb1b2 Patr*0025 c
                0026 c     thsice_cost_ice_flag = 3
                0027 c     - heat content of top level plus latent heat of sea-ice
6b47d550f4 Mart*0028 c       costIceStart < myTime < costIceEnd
6c747cb1b2 Patr*0029 c
                0030 c     thsice_cost_ice_flag = 4
                0031 c     - heat content of top level
6b47d550f4 Mart*0032 c       costIceStart < myTime < costIceEnd
6c747cb1b2 Patr*0033 c
                0034 c     thsice_cost_ice_flag = 5
                0035 c     - heat content of top level plus sea-ice plus latent heat of snow
6b47d550f4 Mart*0036 c       costIceStart < myTime < costIceEnd
6c747cb1b2 Patr*0037 c
                0038 c     thsice_cost_ice_flag = 6
                0039 c     - quadratic cost function measuring difference between pkg/thsice
                0040 c       AREA variable and simulated sea-ice measurements at every time
                0041 c       step.
                0042 c
                0043 c     ==================================================================
                0044 c     SUBROUTINE thsice_cost_test
                0045 c     ==================================================================
                0046
6b47d550f4 Mart*0047       IMPLICIT NONE
6c747cb1b2 Patr*0048
                0049 c     == global variables ==
                0050 #ifdef ALLOW_THSICE_COST_TEST
                0051 #include "EEPARAMS.h"
                0052 #include "SIZE.h"
                0053 #include "GRID.h"
                0054 #include "PARAMS.h"
                0055 #include "THSICE_SIZE.h"
                0056 #include "THSICE_COST.h"
                0057 #include "THSICE_VARS.h"
6b47d550f4 Mart*0058 c#include "DYNVARS.h"
6c747cb1b2 Patr*0059 #include "cost.h"
                0060 #endif /* ALLOW_THSICE_COST_TEST */
                0061
                0062 c     == routine arguments ==
6b47d550f4 Mart*0063       _RL     myTime
                0064       INTEGER myIter
                0065       INTEGER myThid
6c747cb1b2 Patr*0066
                0067 #ifdef ALLOW_THSICE_COST_TEST
6b47d550f4 Mart*0068 c     == external functions ==
                0069 c     INTEGER  ILNBLNK
                0070 c     EXTERNAL ILNBLNK
6c747cb1b2 Patr*0071
                0072 c     == local variables ==
6b47d550f4 Mart*0073 c     msgBuf     :: Informational/error message buffer
6c747cb1b2 Patr*0074       CHARACTER*(MAX_LEN_MBUF) msgBuf
6b47d550f4 Mart*0075       INTEGER bi, bj, i, j
6c747cb1b2 Patr*0076       _RL tempVar
                0077
                0078 c     == end of interface ==
                0079
6b47d550f4 Mart*0080       IF ( myTime .GT. (endTime - lastinterval) ) THEN
6c747cb1b2 Patr*0081          tempVar = 1. _d 0/
6b47d550f4 Mart*0082      &             ( ( 1. _d 0 + MIN(endTime-startTime,lastinterval) )
6c747cb1b2 Patr*0083      &             / deltaTClock )
                0084
6b47d550f4 Mart*0085          IF ( thsice_cost_ice_flag .EQ. 1 ) THEN
6c747cb1b2 Patr*0086 c     sea-ice volume
6b47d550f4 Mart*0087             DO bj=myByLo(myThid),myByHi(myThid)
                0088                DO bi=myBxLo(myThid),myBxHi(myThid)
                0089                   DO j = 1,sNy
                0090                      DO i =  1,sNx
6c747cb1b2 Patr*0091                         objf_thsice(bi,bj) = objf_thsice(bi,bj) +
                0092      &                       tempVar*rA(i,j,bi,bj)*iceHeight(i,j,bi,bj)
6b47d550f4 Mart*0093                      ENDDO
                0094                   ENDDO
                0095                ENDDO
                0096             ENDDO
6c747cb1b2 Patr*0097
6b47d550f4 Mart*0098          ELSEIF ( thsice_cost_ice_flag .EQ. 2 ) THEN
6c747cb1b2 Patr*0099 c     sea-ice area
6b47d550f4 Mart*0100             DO bj=myByLo(myThid),myByHi(myThid)
                0101                DO bi=myBxLo(myThid),myBxHi(myThid)
                0102                   DO j = 1,sNy
                0103                      DO i =  1,sNx
6c747cb1b2 Patr*0104                         objf_thsice(bi,bj) = objf_thsice(bi,bj) +
                0105      &                       tempVar*rA(i,j,bi,bj)*iceMask(i,j,bi,bj)
6b47d550f4 Mart*0106                      ENDDO
                0107                   ENDDO
                0108                ENDDO
                0109             ENDDO
6c747cb1b2 Patr*0110
6b47d550f4 Mart*0111          ELSE
6c747cb1b2 Patr*0112             WRITE(msgBuf,'(A)')
                0113      &           'THSICE_COST_TEST: invalid thsice_cost_ice_flag'
6b47d550f4 Mart*0114             CALL PRINT_ERROR( msgBuf, myThid )
6c747cb1b2 Patr*0115             STOP 'ABNORMAL END: S/R THSICE_COST_TEST'
6b47d550f4 Mart*0116          ENDIF
                0117       ENDIF
6c747cb1b2 Patr*0118
                0119 #endif /* ALLOW_THSICE_COST_TEST */
                0120
6b47d550f4 Mart*0121       RETURN
                0122       END