pkg/seaice/seaice_fake.F

eaed823920 Gael*0001 #include "SEAICE_OPTIONS.h"
                0002 #ifdef ALLOW_EXF
                0003 # include "EXF_OPTIONS.h"
                0004 #endif
                0005
                0006 C     StartOfInterface
                0007       SUBROUTINE SEAICE_FAKE( myTime, myIter, myThid )
2af26567a1 Jean*0008 C     *==========================================================*
eaed823920 Gael*0009 C     | SUBROUTINE seaice_fake (for adjoint purpose only)        |
2af26567a1 Jean*0010 C     *==========================================================*
eaed823920 Gael*0011       IMPLICIT NONE
                0012
                0013 C     === Global variables ===
                0014 #include "SIZE.h"
                0015 #include "EEPARAMS.h"
                0016 #include "PARAMS.h"
                0017 #include "DYNVARS.h"
                0018 #include "GRID.h"
                0019 #include "FFIELDS.h"
                0020 #include "SEAICE_SIZE.h"
                0021 #include "SEAICE_PARAMS.h"
                0022 #include "SEAICE.h"
                0023 #ifdef ALLOW_EXF
                0024 # include "EXF_FIELDS.h"
                0025 # include "EXF_PARAM.h"
                0026 #endif
                0027 C     === Routine arguments ===
                0028 C     myTime - Simulation time
                0029 C     myIter - Simulation timestep number
                0030 C     myThid - Thread no. that called this routine.
                0031       _RL myTime
                0032       INTEGER myIter, myThid
                0033 C     EndOfInterface(global-font-lock-mode 1)
                0034
                0035 C     === Local variables ===
                0036 C     i,j,bi,bj - Loop counters
                0037
3fb99b5c15 Gael*0038       INTEGER i, j, bi, bj
eaed823920 Gael*0039       _RL fac, tempFrz
3fb99b5c15 Gael*0040       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0041
                0042       WRITE(msgBuf,'(2A)') 'SEAICE_FAKE:',
                0043      &  ' forward code is not meant to be used (adj only)'
                0044       CALL PRINT_ERROR( msgBuf, myThid )
                0045       STOP 'ABNORMAL END: S/R SEAICE_FAKE'
eaed823920 Gael*0046
                0047       DO bj=myByLo(myThid),myByHi(myThid)
                0048        DO bi=myBxLo(myThid),myBxHi(myThid)
                0049         DO j=1,sNy
                0050          DO i=1,sNx
2af26567a1 Jean*0051 c shielding effect
eaed823920 Gael*0052             fac=MIN(1. _d 0, MAX(0. _d 0 , 1. _d 0 - area(i,j,bi,bj)))
                0053             fu(i,j,bi,bj) = fu(i,j,bi,bj) * fac
                0054             fv(i,j,bi,bj) = fv(i,j,bi,bj) * fac
                0055             qnet(i,j,bi,bj) = qnet(i,j,bi,bj) * fac
                0056             qsw(i,j,bi,bj) = qsw(i,j,bi,bj) * fac
                0057 #if (defined ALLOW_EXF) && (defined ALLOW_ATM_TEMP)
                0058 c the fresh water flux at the top of the ice
ec0d7df165 Mart*0059             EmPmR(i,j,bi,bj)  = HEFFM(i,j,bi,bj)*(
2af26567a1 Jean*0060      &         fac * EVAP(i,j,bi,bj)
                0061      &             - PRECIP(i,j,bi,bj)
                0062 #ifdef ALLOW_RUNOFF
                0063      &             - RUNOFF(i,j,bi,bj)
                0064 #endif /* ALLOW_RUNOFF */
eaed823920 Gael*0065      &         )*rhoConstFresh
                0066 #endif
                0067 c relaxation to freezing point
                0068             fac=MIN(1. _d 0, MAX(0. _d 0 , area(i,j,bi,bj)))
                0069             tempFrz = SEAICE_tempFrz0 +
2af26567a1 Jean*0070      &                SEAICE_dTempFrz_dS *salt(i,j,1,bi,bj)
3fb99b5c15 Gael*0071             theta(i,j,1,bi,bj)=theta(i,j,1,bi,bj) + fac *
                0072      &        ( tempFrz-theta(i,j,1,bi,bj) ) *
eaed823920 Gael*0073      &        SEAICE_mcPheePiston/drF(1)*SEAICE_deltaTtherm
                0074          ENDDO
                0075         ENDDO
                0076        ENDDO
                0077       ENDDO
                0078
                0079        CALL EXCH_UV_XY_RS(fu,fv,.TRUE.,myThid)
                0080        _EXCH_XY_RS( qnet,  myThid )
                0081        _EXCH_XY_RS( qsw,  myThid )
                0082        _EXCH_XY_RS( empmr,  myThid )
                0083
                0084       RETURN
                0085       END