pkg/ocn_compon_interf/ocn_apply_import.F

071fa694ec Jean*0001 #include "OCN_CPL_OPTIONS.h"
2bd29ade83 Jean*0002
69e21e3ef0 Jean*0003 CBOP
                0004 C     !ROUTINE: OCN_APPLY_IMPORT
                0005 C     !INTERFACE:
2bd29ade83 Jean*0006       SUBROUTINE OCN_APPLY_IMPORT(
e596558d31 Jean*0007      I               apply2AllFields, myTime, myIter, myThid )
69e21e3ef0 Jean*0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
2bd29ade83 Jean*0010 C     | SUBROUTINE OCN_APPLY_IMPORT
69e21e3ef0 Jean*0011 C     | o Apply imported coupling data to forcing fields
                0012 C     *==========================================================*
                0013 C     *==========================================================*
                0014 C     \ev
                0015
                0016 C     !USES:
                0017       IMPLICIT NONE
                0018 C     === Global variables ===
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
                0022 #include "CPL_PARAMS.h"
9ffc618587 Jean*0023 #include "SURFACE.h"
                0024 #include "FFIELDS.h"
                0025 #include "OCNCPL.h"
                0026 #ifdef ALLOW_THSICE
                0027 # include "THSICE_VARS.h"
e7c6a47db7 Jeff*0028 #endif
2bd29ade83 Jean*0029
69e21e3ef0 Jean*0030 C     !INPUT/OUTPUT PARAMETERS:
                0031 C     === Routine arguments ===
e596558d31 Jean*0032 C     apply2AllFields - flag: T= apply import to all coupling fields
                0033 C                 F= only forcing fields relevant for eta variations
69e21e3ef0 Jean*0034 C     myTime - Simulation time
                0035 C     myIter - Simulation timestep number
                0036 C     myThid - Thread no. that called this routine.
e596558d31 Jean*0037       LOGICAL apply2AllFields
69e21e3ef0 Jean*0038       _RL     myTime
                0039       INTEGER myIter
                0040       INTEGER myThid
2bd29ade83 Jean*0041
69e21e3ef0 Jean*0042 C     !LOCAL VARIABLES:
                0043 C     === Local arrays ===
                0044       INTEGER bi,bj,i,j
                0045 CEOP
                0046
e596558d31 Jean*0047 C--  Use imported coupling data in place of input files data:
d4b28e407b Jean*0048       DO bj = myByLo(myThid), myByHi(myThid)
                0049        DO bi = myBxLo(myThid), myBxHi(myThid)
                0050
                0051 C--     Aplly import to all coupling fields (standard way)
                0052         IF ( apply2AllFields ) THEN
e596558d31 Jean*0053
                0054 C-   Dynamical forcing
d4b28e407b Jean*0055          IF ( useImportTau ) THEN
071fa694ec Jean*0056            DO j=1-OLy,sNy+OLy
                0057             DO i=1-OLx,sNx+OLx
e596558d31 Jean*0058               fu(i,j,bi,bj) = tauX(i,j,bi,bj)
                0059               fv(i,j,bi,bj) = tauY(i,j,bi,bj)
                0060             ENDDO
                0061            ENDDO
                0062          ENDIF
                0063          IF ( useImportSLP ) THEN
071fa694ec Jean*0064            DO j=1-OLy,sNy+OLy
                0065             DO i=1-OLx,sNx+OLx
e596558d31 Jean*0066               pLoad(i,j,bi,bj) = atmSLPr(i,j,bi,bj)
                0067             ENDDO
                0068            ENDDO
                0069          ENDIF
d4b28e407b Jean*0070          IF ( useImportSIce ) THEN
071fa694ec Jean*0071            DO j=1-OLy,sNy+OLy
                0072             DO i=1-OLx,sNx+OLx
d4b28e407b Jean*0073               sIceLoad(i,j,bi,bj) = seaIceMass(i,j,bi,bj)
e596558d31 Jean*0074             ENDDO
                0075            ENDDO
                0076          ENDIF
                0077
                0078 C-   Fresh-Water & Salinity forcing
                0079          IF ( useImportFW ) THEN
071fa694ec Jean*0080            DO j=1-OLy,sNy+OLy
                0081             DO i=1-OLx,sNx+OLx
e596558d31 Jean*0082               EmPmR(i,j,bi,bj) = FWFlux    (i,j,bi,bj)
                0083             ENDDO
                0084            ENDDO
                0085          ENDIF
d4b28e407b Jean*0086          IF ( useImportFW ) THEN
071fa694ec Jean*0087            DO j=1-OLy,sNy+OLy
                0088             DO i=1-OLx,sNx+OLx
e596558d31 Jean*0089               saltFlux(i,j,bi,bj)= iceSaltFlx(i,j,bi,bj)
                0090             ENDDO
                0091            ENDDO
                0092          ENDIF
                0093
                0094 C-   Heat Flux forcing
d4b28e407b Jean*0095          IF ( useImportHFlx ) THEN
071fa694ec Jean*0096            DO j=1-OLy,sNy+OLy
                0097             DO i=1-OLx,sNx+OLx
e596558d31 Jean*0098               Qnet(i,j,bi,bj)= HeatFlux  (i,j,bi,bj)
                0099             ENDDO
                0100            ENDDO
                0101 #ifdef SHORTWAVE_HEATING
071fa694ec Jean*0102            DO j=1-OLy,sNy+OLy
                0103             DO i=1-OLx,sNx+OLx
e596558d31 Jean*0104              Qsw(i,j,bi,bj) = qShortWave(i,j,bi,bj)
                0105             ENDDO
                0106            ENDDO
69e21e3ef0 Jean*0107 #endif
e596558d31 Jean*0108          ENDIF
                0109
9ffc618587 Jean*0110 #ifdef ALLOW_THSICE
                0111          IF ( useImportThSIce .AND. useThSIce ) THEN
                0112            DO j=1-OLy,sNy+OLy
                0113             DO i=1-OLx,sNx+OLx
                0114              iceMask   (i,j,bi,bj) = sIceFrac_cpl (i,j,bi,bj)
                0115              iceHeight (i,j,bi,bj) = sIceThick_cpl(i,j,bi,bj)
                0116              snowHeight(i,j,bi,bj) = sIceSnowH_cpl(i,j,bi,bj)
                0117              Qice1     (i,j,bi,bj) = sIceQ1_cpl   (i,j,bi,bj)
                0118              Qice2     (i,j,bi,bj) = sIceQ2_cpl   (i,j,bi,bj)
                0119             ENDDO
                0120            ENDDO
                0121          ENDIF
                0122 #endif /* ALLOW_THSICE */
                0123
d4b28e407b Jean*0124 C--     Apply only to forcings relevant for eta/surf.press variations
                0125         ELSE
                0126
                0127          IF ( useImportSIce .AND. useImportSLP ) THEN
071fa694ec Jean*0128            DO j=1-OLy,sNy+OLy
                0129             DO i=1-OLx,sNx+OLx
d4b28e407b Jean*0130               phi0surf(i,j,bi,bj) = atmSLPr(i,j,bi,bj)*recip_rhoConst
                0131      &                 + gravity*seaIceMass(i,j,bi,bj)*recip_rhoConst
                0132             ENDDO
                0133            ENDDO
                0134          ELSEIF ( useImportSIce ) THEN
071fa694ec Jean*0135            DO j=1-OLy,sNy+OLy
                0136             DO i=1-OLx,sNx+OLx
2bd29ade83 Jean*0137               phi0surf(i,j,bi,bj) = pLoad(i,j,bi,bj)*recip_rhoConst
d4b28e407b Jean*0138      &                 + gravity*seaIceMass(i,j,bi,bj)*recip_rhoConst
                0139             ENDDO
                0140            ENDDO
                0141          ELSEIF ( useImportSLP ) THEN
071fa694ec Jean*0142            DO j=1-OLy,sNy+OLy
                0143             DO i=1-OLx,sNx+OLx
d4b28e407b Jean*0144               phi0surf(i,j,bi,bj) = atmSLPr(i,j,bi,bj)*recip_rhoConst
                0145             ENDDO
                0146            ENDDO
                0147          ENDIF
                0148
                0149          IF ( useImportFW ) THEN
071fa694ec Jean*0150            DO j=1-OLy,sNy+OLy
                0151             DO i=1-OLx,sNx+OLx
d4b28e407b Jean*0152               EmPmR(i,j,bi,bj) = FWFlux    (i,j,bi,bj)
                0153             ENDDO
                0154            ENDDO
                0155          ENDIF
                0156
                0157 C--     end if apply2AllFields / else blocks
                0158         ENDIF
                0159
e596558d31 Jean*0160 C--  end bi,bj loop
69e21e3ef0 Jean*0161        ENDDO
d4b28e407b Jean*0162       ENDDO
69e21e3ef0 Jean*0163
e596558d31 Jean*0164 C--  Fill in Halo region with valid values
                0165
                0166 #ifdef ATMOSPHERIC_LOADING
071fa694ec Jean*0167       IF ( useImportSLP . AND.
                0168      &    ( ocn_cplExch_DIC .OR. apply2AllFields ) )
77358e65ba Jean*0169      &   _EXCH_XY_RS( pLoad,    myThid )
071fa694ec Jean*0170       IF ( apply2AllFields ) THEN
9ffc618587 Jean*0171         IF ( useImportSIce ) _EXCH_XY_RS( sIceLoad, myThid )
071fa694ec Jean*0172       ELSEIF ( useImportSLP .OR. useImportSIce ) THEN
77358e65ba Jean*0173          _EXCH_XY_RS( phi0surf, myThid )
071fa694ec Jean*0174       ENDIF
e7c6a47db7 Jeff*0175 #else
071fa694ec Jean*0176       IF ( useImportSLP . AND. ocn_cplExch_DIC )
9ffc618587 Jean*0177      &   _EXCH_XY_RS( pLoad,    myThid )
e596558d31 Jean*0178 #endif
e7c6a47db7 Jeff*0179
9ffc618587 Jean*0180       IF ( useImportFW  ) _EXCH_XY_RS( EmPmR, myThid )
071fa694ec Jean*0181       IF ( apply2AllFields ) THEN
9ffc618587 Jean*0182         IF ( useImportTau  ) CALL EXCH_UV_XY_RS(fu,fv,.TRUE.,myThid)
                0183         IF ( useImportFW   ) _EXCH_XY_RS( saltFlux, myThid )
                0184         IF ( useImportHFlx ) _EXCH_XY_RS( Qnet , myThid )
69e21e3ef0 Jean*0185 #ifdef SHORTWAVE_HEATING
9ffc618587 Jean*0186         IF ( useImportHFlx ) _EXCH_XY_RS( Qsw ,  myThid )
69e21e3ef0 Jean*0187 #endif
9ffc618587 Jean*0188 #ifdef ALLOW_THSICE
                0189         IF ( useImportThSIce .AND. useThSIce ) THEN
                0190           _EXCH_XY_RL( iceMask   , myThid )
                0191           _EXCH_XY_RL( iceHeight , myThid )
                0192           _EXCH_XY_RL( snowHeight, myThid )
                0193           _EXCH_XY_RL( Qice1     , myThid )
                0194           _EXCH_XY_RL( Qice2     , myThid )
                0195         ENDIF
                0196 #endif /* ALLOW_THSICE */
e7c6a47db7 Jeff*0197       ENDIF
69e21e3ef0 Jean*0198
                0199       RETURN
                0200       END