pkg/ocn_compon_interf/ocn_store_my_data.F

071fa694ec Jean*0001 #include "OCN_CPL_OPTIONS.h"
e596558d31 Jean*0002
44ff40f0ae Jean*0003 C     !ROUTINE: OCN_STORE_MY_DATA
                0004 C     !INTERFACE:
e596558d31 Jean*0005       SUBROUTINE OCN_STORE_MY_DATA(
e38fd6e708 Jean*0006      I                     myTime, myIter, myThid )
44ff40f0ae Jean*0007
                0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
e596558d31 Jean*0010 C     | SUBROUTINE OCN_STORE_MY_DATA                             |
                0011 C     | o Routine for controlling storage of coupling data to    |
                0012 C     |   to the coupling layer.                                 |
44ff40f0ae Jean*0013 C     *==========================================================*
e596558d31 Jean*0014 C     | This version talks to the MIT Coupler. It uses the MIT   |
                0015 C     | Coupler "checkpoint1" library calls.                     |
44ff40f0ae Jean*0016 C     *==========================================================*
                0017 C     \ev
                0018
                0019 C     !USES:
e596558d31 Jean*0020       IMPLICIT NONE
                0021
                0022 C     == Global variables ==
                0023 #include "SIZE.h"
                0024 #include "EEPARAMS.h"
                0025 #include "PARAMS.h"
                0026 #include "CPL_PARAMS.h"
                0027 #include "GRID.h"
                0028 #include "SURFACE.h"
                0029 #include "DYNVARS.h"
                0030 #include "OCNCPL.h"
5de259dd7a Jean*0031 #ifdef ALLOW_THSICE
                0032 # include "THSICE_VARS.h"
                0033 #endif
44ff40f0ae Jean*0034 c#ifdef ALLOW_DIC
                0035 c# include "DIC_VARS.h"
                0036 c#endif
e596558d31 Jean*0037
44ff40f0ae Jean*0038 C     !INPUT/OUTPUT PARAMETERS:
                0039 C     == Routine Arguments ==
                0040 C     myTime     :: Current time in simulation
                0041 C     myIter     :: Current timestep number
                0042 C     myThid     :: my Thread Id. number
e596558d31 Jean*0043       _RL     myTime
                0044       INTEGER myIter
                0045       INTEGER myThid
44ff40f0ae Jean*0046 CEOP
e596558d31 Jean*0047
44ff40f0ae Jean*0048 C     !FUNCTIONS:
                0049 c     INTEGER ILNBLNK
e596558d31 Jean*0050
44ff40f0ae Jean*0051 C     !LOCAL VARIABLES:
e596558d31 Jean*0052 C     == Local variables ==
e38fd6e708 Jean*0053 C     bi,bj      :: Current tile indices
                0054 C     i, j       :: Loop indices
                0055       INTEGER bi,bj
                0056       INTEGER i, j
e596558d31 Jean*0057
e38fd6e708 Jean*0058       DO bj = myByLo(myThid), myByHi(myThid)
                0059        DO bi = myBxLo(myThid), myBxHi(myThid)
                0060 C--   bi,bj loop over my tiles
                0061
                0062          DO j=1,sNy
                0063           DO i=1,sNx
                0064             SSTocn2cpl(i,j,bi,bj) = theta(i,j,1,bi,bj)
                0065             SSSocn2cpl(i,j,bi,bj) = salt (i,j,1,bi,bj)
                0066           ENDDO
e596558d31 Jean*0067          ENDDO
e38fd6e708 Jean*0068 #ifdef NONLIN_FRSURF
                0069         IF ( nonlinFreeSurf.GT.0 .AND. staggerTimeStep ) THEN
                0070          IF ( select_rStar.GT.0 ) THEN
                0071           DO j=1,sNy
                0072            DO i=1,sNx
                0073             ocMxlD2cpl(i,j,bi,bj) =
                0074      &           h0FacC(i,j,1,bi,bj)*rStarFacC(i,j,bi,bj)*drF(1)
                0075            ENDDO
                0076           ENDDO
                0077          ELSE
                0078           DO j=1,sNy
                0079            DO i=1,sNx
                0080             ocMxlD2cpl(i,j,bi,bj) = hFac_surfC(i,j,bi,bj)*drF(1)
                0081            ENDDO
                0082           ENDDO
                0083          ENDIF
                0084         ELSE
e596558d31 Jean*0085 #else /* NONLIN_FRSURF */
e38fd6e708 Jean*0086         IF (.TRUE.) THEN
e596558d31 Jean*0087 #endif /* NONLIN_FRSURF */
e38fd6e708 Jean*0088          DO j=1,sNy
                0089           DO i=1,sNx
                0090             ocMxlD2cpl(i,j,bi,bj) = hFacC(i,j,1,bi,bj)*drF(1)
                0091           ENDDO
                0092          ENDDO
                0093         ENDIF
e596558d31 Jean*0094
e38fd6e708 Jean*0095          DO j=1,sNy
                0096           DO i=1,sNx
                0097             vSqocn2cpl(i,j,bi,bj) =
e596558d31 Jean*0098      &              ( uVel(i , j,1,bi,bj)*uVel(i , j,1,bi,bj)
                0099      &              + uVel(i+1,j,1,bi,bj)*uVel(i+1,j,1,bi,bj)
                0100      &              + vVel(i,j+1,1,bi,bj)*vVel(i,j+1,1,bi,bj)
                0101      &              + vVel(i,j , 1,bi,bj)*vVel(i,j , 1,bi,bj)
                0102      &              )*0.5 _d 0
e38fd6e708 Jean*0103           ENDDO
                0104          ENDDO
e596558d31 Jean*0105
5de259dd7a Jean*0106 #ifdef ALLOW_THSICE
                0107         IF ( useThSIce .AND. ocn_cplExch2W_sIce  ) THEN
                0108          DO j=1,sNy
                0109           DO i=1,sNx
                0110             sIceFrac_cpl (i,j,bi,bj) = iceMask(i,j,bi,bj)
                0111             sIceThick_cpl(i,j,bi,bj) = iceHeight(i,j,bi,bj)
                0112             sIceSnowH_cpl(i,j,bi,bj) = snowHeight(i,j,bi,bj)
                0113             sIceQ1_cpl   (i,j,bi,bj) = Qice1(i,j,bi,bj)
                0114             sIceQ2_cpl   (i,j,bi,bj) = Qice2(i,j,bi,bj)
                0115           ENDDO
                0116          ENDDO
                0117         ENDIF
                0118 #endif /* ALLOW_THSICE */
                0119
7f76a37b3a Davi*0120 c#ifdef ALLOW_DIC
071fa694ec Jean*0121 c       IF ( ocn_cplExch_DIC ) THEN
7f76a37b3a Davi*0122 c        DO j=1,sNy
                0123 c         DO i=1,sNx
e38fd6e708 Jean*0124 c           fluxCO2cpl(i,j,bi,bj) = fluxCO2(i,j,bi,bj)
7f76a37b3a Davi*0125 c         ENDDO
                0126 c        ENDDO
e38fd6e708 Jean*0127 c       ENDIF
7f76a37b3a Davi*0128 c#endif
e7c6a47db7 Jeff*0129
e38fd6e708 Jean*0130 C--   end bi,bj loops
                0131        ENDDO
                0132       ENDDO
                0133
e596558d31 Jean*0134       RETURN
                0135       END