pkg/autodiff/autodiff_store.F

0d7eb15592 Jean*0001 #include "AUTODIFF_OPTIONS.h"
bead363026 Jean*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
5728d4a98b Patr*0005 #ifdef ALLOW_OBCS
                0006 # include "OBCS_OPTIONS.h"
                0007 #endif
                0008 #ifdef ALLOW_SEAICE
                0009 # include "SEAICE_OPTIONS.h"
                0010 #endif
bf759c6109 Gael*0011 #ifdef ALLOW_EXF
                0012 # include "EXF_OPTIONS.h"
                0013 #endif
5728d4a98b Patr*0014
6fe4379e6f Jean*0015       SUBROUTINE AUTODIFF_STORE( myThid )
5728d4a98b Patr*0016
cda1c18f72 Jean*0017 C     ==================================================================
                0018 C     SUBROUTINE autodiff_store
                0019 C     ==================================================================
                0020 C
                0021 C     packing for checkpoint storage
                0022 C
                0023 C     started: Matt Mazloff mmazloff@mit.edu 03-May-2007
                0024 C
                0025 C     ==================================================================
                0026 C     SUBROUTINE autodiff_store
                0027 C     ==================================================================
5728d4a98b Patr*0028
6fe4379e6f Jean*0029       IMPLICIT NONE
5728d4a98b Patr*0030
cda1c18f72 Jean*0031 C     == global variables ==
5728d4a98b Patr*0032
                0033 #include "SIZE.h"
                0034 #include "EEPARAMS.h"
                0035 #include "PARAMS.h"
cda1c18f72 Jean*0036 C**************************************
                0037 C These includes are needed for
                0038 C AD-checkpointing.
                0039 C They provide the fields to be stored.
5728d4a98b Patr*0040
e28d7f2731 Gael*0041 #include "GRID.h"
                0042 #include "DYNVARS.h"
                0043 #include "FFIELDS.h"
                0044 #include "SURFACE.h"
5728d4a98b Patr*0045
e28d7f2731 Gael*0046 #ifdef ALLOW_OBCS
                0047 # include "OBCS_FIELDS.h"
                0048 # include "OBCS_SEAICE.h"
                0049 #endif
                0050 #ifdef ALLOW_EXF
                0051 # include "EXF_FIELDS.h"
                0052 # ifdef ALLOW_BULKFORMULAE
                0053 #  include "EXF_CONSTANTS.h"
5728d4a98b Patr*0054 # endif
e28d7f2731 Gael*0055 #endif /* ALLOW_EXF */
                0056 #ifdef ALLOW_SEAICE
                0057 # include "SEAICE_SIZE.h"
                0058 # include "SEAICE.h"
                0059 #endif
                0060 #ifdef ALLOW_CTRL
5cf4364659 Mart*0061 # include "CTRL_SIZE.h"
4d72283393 Mart*0062 # include "CTRL.h"
e28d7f2731 Gael*0063 # include "CTRL_OBCS.h"
                0064 #endif
cda1c18f72 Jean*0065 C     it is important that this file is included after SEAICE_SIZE.h
56a89d1ef6 Mart*0066 #include "AUTODIFF_STORE.h"
5728d4a98b Patr*0067
cda1c18f72 Jean*0068 C     == routine arguments ==
                0069 C     myThid   :: my Thread Id number
6fe4379e6f Jean*0070       INTEGER myThid
5728d4a98b Patr*0071
a47c7bbdd2 Mart*0072 #ifdef ALLOW_AUTODIFF_TAMC
cda1c18f72 Jean*0073 C     == local variables ==
                0074 #if ( defined AUTODIFF_USE_STORE_RESTORE || \
                0075      ( defined ALLOW_OBCS && defined AUTODIFF_USE_STORE_RESTORE_OBCS ))
                0076       INTEGER bi, bj
                0077       INTEGER I, J, K
                0078 #endif
0d7eb15592 Jean*0079
cda1c18f72 Jean*0080 C--   == end of interface ==
5728d4a98b Patr*0081
3e55964de2 Patr*0082 #ifdef ALLOW_DEBUG
862d160a2f Jean*0083       IF ( debugMode ) CALL DEBUG_ENTER('AUTODIFF_STORE',myThid)
5728d4a98b Patr*0084 #endif
0d7eb15592 Jean*0085
3c775cbf98 Mart*0086 #ifdef AUTODIFF_USE_STORE_RESTORE
5728d4a98b Patr*0087 C--   Over all tiles
                0088       DO bj = myByLo(myThid), myByHi(myThid)
                0089        DO bi = myBxLo(myThid), myBxHi(myThid)
                0090 C-      2D arrays
e4f1c09db9 Jean*0091         DO J=1-OLy,sNy+OLy
                0092          DO I=1-OLx,sNx+OLx
                0093           StoreDynVars2D(I,J,bi,bj,1) = etaN(I,J,bi,bj)
f255f6c083 Jean*0094           StoreDynVars2D(I,J,bi,bj,2) = taux0(I,J,bi,bj)
                0095           StoreDynVars2D(I,J,bi,bj,3) = taux1(I,J,bi,bj)
                0096           StoreDynVars2D(I,J,bi,bj,4) = tauy0(I,J,bi,bj)
                0097           StoreDynVars2D(I,J,bi,bj,5) = tauy1(I,J,bi,bj)
                0098           StoreDynVars2D(I,J,bi,bj,6) = qnet0(I,J,bi,bj)
                0099           StoreDynVars2D(I,J,bi,bj,7) = qnet1(I,J,bi,bj)
                0100           StoreDynVars2D(I,J,bi,bj,8)  = empmr0(I,J,bi,bj)
                0101           StoreDynVars2D(I,J,bi,bj,9) = empmr1(I,J,bi,bj)
                0102           StoreDynVars2D(I,J,bi,bj,10) = sst0(I,J,bi,bj)
                0103           StoreDynVars2D(I,J,bi,bj,11) = sst1(I,J,bi,bj)
                0104           StoreDynVars2D(I,J,bi,bj,12) = sss0(I,J,bi,bj)
                0105           StoreDynVars2D(I,J,bi,bj,13) = sss1(I,J,bi,bj)
                0106           StoreDynVars2D(I,J,bi,bj,14) = saltflux0(I,J,bi,bj)
                0107           StoreDynVars2D(I,J,bi,bj,15) = saltflux1(I,J,bi,bj)
5728d4a98b Patr*0108 #ifdef SHORTWAVE_HEATING
f255f6c083 Jean*0109           StoreDynVars2D(I,J,bi,bj,16) = qsw0(I,J,bi,bj)
                0110           StoreDynVars2D(I,J,bi,bj,17) = qsw1(I,J,bi,bj)
5728d4a98b Patr*0111 #else
f255f6c083 Jean*0112           StoreDynVars2D(I,J,bi,bj,16) = 0.
5728d4a98b Patr*0113           StoreDynVars2D(I,J,bi,bj,17) = 0.
                0114 #endif
                0115 #ifdef ATMOSPHERIC_LOADING
f255f6c083 Jean*0116           StoreDynVars2D(I,J,bi,bj,18) = pload0(I,J,bi,bj)
                0117           StoreDynVars2D(I,J,bi,bj,19) = pload1(I,J,bi,bj)
5728d4a98b Patr*0118 #else
f255f6c083 Jean*0119           StoreDynVars2D(I,J,bi,bj,18) = 0.
5728d4a98b Patr*0120           StoreDynVars2D(I,J,bi,bj,19) = 0.
                0121 #endif
                0122 #ifdef EXACT_CONSERV
f255f6c083 Jean*0123           StoreDynVars2D(I,J,bi,bj,20) = etaH(I,J,bi,bj)
                0124           StoreDynVars2D(I,J,bi,bj,21) = dEtaHdt(I,J,bi,bj)
                0125           StoreDynVars2D(I,J,bi,bj,22) = PmEpR(I,J,bi,bj)
5728d4a98b Patr*0126 #else
f255f6c083 Jean*0127           StoreDynVars2D(I,J,bi,bj,20) = 0.
5728d4a98b Patr*0128           StoreDynVars2D(I,J,bi,bj,21) = 0.
                0129           StoreDynVars2D(I,J,bi,bj,22) = 0.
                0130 #endif
                0131          ENDDO
                0132         ENDDO
3c775cbf98 Mart*0133        ENDDO
                0134       ENDDO
c5c9d716eb Patr*0135
3c775cbf98 Mart*0136 C--   Over all tiles
                0137       DO bj = myByLo(myThid), myByHi(myThid)
                0138        DO bi = myBxLo(myThid), myBxHi(myThid)
5728d4a98b Patr*0139 C-      3D arrays
                0140         DO K=1,Nr
e4f1c09db9 Jean*0141          DO J=1-OLy,sNy+OLy
                0142           DO I=1-OLx,sNx+OLx
507fbacc22 Gael*0143 #ifdef ALLOW_ADAMSBASHFORTH_3
e4f1c09db9 Jean*0144            StoreDynVars3D(I,J,K,bi,bj,1)  = gtNm(I,J,K,bi,bj,1)
                0145            StoreDynVars3D(I,J,K,bi,bj,2)  = gsNm(I,J,K,bi,bj,1)
                0146            StoreDynVars3D(I,J,K,bi,bj,3)  = guNm(I,J,K,bi,bj,1)
                0147            StoreDynVars3D(I,J,K,bi,bj,4)  = gvNm(I,J,K,bi,bj,1)
507fbacc22 Gael*0148 #else
e4f1c09db9 Jean*0149            StoreDynVars3D(I,J,K,bi,bj,1)  = gtNm1(I,J,K,bi,bj)
                0150            StoreDynVars3D(I,J,K,bi,bj,2)  = gsNm1(I,J,K,bi,bj)
                0151            StoreDynVars3D(I,J,K,bi,bj,3)  = guNm1(I,J,K,bi,bj)
                0152            StoreDynVars3D(I,J,K,bi,bj,4)  = gvNm1(I,J,K,bi,bj)
507fbacc22 Gael*0153 #endif
e4f1c09db9 Jean*0154            StoreDynVars3D(I,J,K,bi,bj,5)  = theta(I,J,K,bi,bj)
                0155            StoreDynVars3D(I,J,K,bi,bj,6)  = salt(I,J,K,bi,bj)
                0156            StoreDynVars3D(I,J,K,bi,bj,7)  = uVel(I,J,K,bi,bj)
                0157            StoreDynVars3D(I,J,K,bi,bj,8)  = vVel(I,J,K,bi,bj)
                0158            StoreDynVars3D(I,J,K,bi,bj,9)  = wVel(I,J,K,bi,bj)
                0159            StoreDynVars3D(I,J,K,bi,bj,10) = totPhiHyd(I,J,K,bi,bj)
507fbacc22 Gael*0160 #ifdef ALLOW_ADAMSBASHFORTH_3
e4f1c09db9 Jean*0161            StoreDynVars3D(I,J,K,bi,bj,11) = gtNm(I,J,K,bi,bj,2)
                0162            StoreDynVars3D(I,J,K,bi,bj,12) = gsNm(I,J,K,bi,bj,2)
                0163            StoreDynVars3D(I,J,K,bi,bj,13) = guNm(I,J,K,bi,bj,2)
                0164            StoreDynVars3D(I,J,K,bi,bj,14) = gvNm(I,J,K,bi,bj,2)
507fbacc22 Gael*0165 #endif
5728d4a98b Patr*0166           ENDDO
                0167          ENDDO
                0168         ENDDO
                0169        ENDDO
                0170       ENDDO
0d7eb15592 Jean*0171
5728d4a98b Patr*0172 #ifdef ALLOW_EXF
                0173 C--   Over all tiles
                0174       DO bj = myByLo(myThid), myByHi(myThid)
                0175        DO bi = myBxLo(myThid), myBxHi(myThid)
                0176 C-      2D arrays
e4f1c09db9 Jean*0177         DO J=1-OLy,sNy+OLy
                0178          DO I=1-OLx,sNx+OLx
0e8df33a35 Jean*0179           StoreEXF1(I,J,bi,bj,1)  = hflux0(I,J,bi,bj)
                0180           StoreEXF1(I,J,bi,bj,2)  = hflux1(I,J,bi,bj)
                0181           StoreEXF1(I,J,bi,bj,3)  = sflux0(I,J,bi,bj)
                0182           StoreEXF1(I,J,bi,bj,4)  = sflux1(I,J,bi,bj)
                0183           StoreEXF1(I,J,bi,bj,5)  = ustress0(I,J,bi,bj)
                0184           StoreEXF1(I,J,bi,bj,6)  = ustress1(I,J,bi,bj)
                0185           StoreEXF1(I,J,bi,bj,7)  = vstress0(I,J,bi,bj)
                0186           StoreEXF1(I,J,bi,bj,8)  = vstress1(I,J,bi,bj)
                0187           StoreEXF1(I,J,bi,bj,9)  = wspeed0(I,J,bi,bj)
fc77a29eb0 Patr*0188           StoreEXF1(I,J,bi,bj,10) = wspeed1(I,J,bi,bj)
                0189 # ifdef SHORTWAVE_HEATING
                0190           StoreEXF1(I,J,bi,bj,11) = swflux0(I,J,bi,bj)
                0191           StoreEXF1(I,J,bi,bj,12) = swflux1(I,J,bi,bj)
                0192 # else
                0193           StoreEXF1(I,J,bi,bj,11) = 0.0
                0194           StoreEXF1(I,J,bi,bj,12) = 0.0
                0195 # endif
                0196 # ifdef ALLOW_RUNOFF
                0197           StoreEXF1(I,J,bi,bj,13) = runoff0(I,J,bi,bj)
                0198           StoreEXF1(I,J,bi,bj,14) = runoff1(I,J,bi,bj)
                0199 # else
5728d4a98b Patr*0200           StoreEXF1(I,J,bi,bj,13) = 0.0
                0201           StoreEXF1(I,J,bi,bj,14) = 0.0
fc77a29eb0 Patr*0202 # endif
                0203 # ifdef ATMOSPHERIC_LOADING
                0204           StoreEXF1(I,J,bi,bj,15) = apressure0(I,J,bi,bj)
                0205           StoreEXF1(I,J,bi,bj,16) = apressure1(I,J,bi,bj)
                0206           StoreEXF1(I,J,bi,bj,17) = siceload(I,J,bi,bj)
                0207 # else
5728d4a98b Patr*0208           StoreEXF1(I,J,bi,bj,15) = 0.0
                0209           StoreEXF1(I,J,bi,bj,16) = 0.0
fc77a29eb0 Patr*0210           StoreEXF1(I,J,bi,bj,17) = 0.0
                0211 # endif
                0212 # ifdef ALLOW_CLIMSSS_RELAXATION
                0213           StoreEXF1(I,J,bi,bj,18) = climsss0(I,J,bi,bj)
                0214           StoreEXF1(I,J,bi,bj,19) = climsss1(I,J,bi,bj)
                0215 # else
                0216           StoreEXF1(I,J,bi,bj,18) = 0.0
                0217           StoreEXF1(I,J,bi,bj,19) = 0.0
                0218 # endif
                0219 # ifdef ALLOW_CLIMSST_RELAXATION
                0220           StoreEXF1(I,J,bi,bj,20) = climsst0(I,J,bi,bj)
                0221           StoreEXF1(I,J,bi,bj,21) = climsst1(I,J,bi,bj)
                0222 # else
                0223           StoreEXF1(I,J,bi,bj,20) = 0.0
                0224           StoreEXF1(I,J,bi,bj,21) = 0.0
                0225 # endif
d217f7c14d Gael*0226 # ifdef ALLOW_SALTFLX
                0227           StoreEXF1(I,J,bi,bj,22) = saltflx0(I,J,bi,bj)
                0228           StoreEXF1(I,J,bi,bj,23) = saltflx1(I,J,bi,bj)
                0229 # else
                0230           StoreEXF1(I,J,bi,bj,22) = 0.0
                0231           StoreEXF1(I,J,bi,bj,23) = 0.0
                0232 # endif
634ecb5dc5 Jean*0233          ENDDO
                0234         ENDDO
                0235        ENDDO
                0236       ENDDO
0d7eb15592 Jean*0237
5728d4a98b Patr*0238 C--   Over all tiles
                0239       DO bj = myByLo(myThid), myByHi(myThid)
                0240        DO bi = myBxLo(myThid), myBxHi(myThid)
                0241 C-      2D arrays
e4f1c09db9 Jean*0242         DO J=1-OLy,sNy+OLy
                0243          DO I=1-OLx,sNx+OLx
6fe4379e6f Jean*0244 # ifdef ALLOW_ATM_TEMP
5728d4a98b Patr*0245           StoreEXF2(I,J,bi,bj,1) = aqh0(I,J,bi,bj)
                0246           StoreEXF2(I,J,bi,bj,2) = aqh1(I,J,bi,bj)
                0247           StoreEXF2(I,J,bi,bj,3) = atemp0(I,J,bi,bj)
                0248           StoreEXF2(I,J,bi,bj,4) = atemp1(I,J,bi,bj)
                0249           StoreEXF2(I,J,bi,bj,5) = precip0(I,J,bi,bj)
                0250           StoreEXF2(I,J,bi,bj,6) = precip1(I,J,bi,bj)
                0251           StoreEXF2(I,J,bi,bj,7) = lwflux0(I,J,bi,bj)
                0252           StoreEXF2(I,J,bi,bj,8) = lwflux1(I,J,bi,bj)
fead278c20 Patr*0253           StoreEXF2(I,J,bi,bj,9)  = snowprecip0(I,J,bi,bj)
                0254           StoreEXF2(I,J,bi,bj,10) = snowprecip1(I,J,bi,bj)
0e8df33a35 Jean*0255 #  ifdef ALLOW_READ_TURBFLUXES
                0256           StoreEXF2(I,J,bi,bj,11) = hs0(I,J,bi,bj)
                0257           StoreEXF2(I,J,bi,bj,12) = hs1(I,J,bi,bj)
                0258           StoreEXF2(I,J,bi,bj,13) = hl0(I,J,bi,bj)
                0259           StoreEXF2(I,J,bi,bj,14) = hl1(I,J,bi,bj)
6fe4379e6f Jean*0260 #  else
0e8df33a35 Jean*0261           StoreEXF2(I,J,bi,bj,11) = 0.0
fead278c20 Patr*0262           StoreEXF2(I,J,bi,bj,12) = 0.0
5728d4a98b Patr*0263           StoreEXF2(I,J,bi,bj,13) = 0.0
                0264           StoreEXF2(I,J,bi,bj,14) = 0.0
0e8df33a35 Jean*0265 #  endif
                0266 #  ifdef EXF_READ_EVAP
                0267           StoreEXF2(I,J,bi,bj,15) = evap0(I,J,bi,bj)
                0268           StoreEXF2(I,J,bi,bj,16) = evap1(I,J,bi,bj)
                0269 #  else
                0270           StoreEXF2(I,J,bi,bj,15) = evap(I,J,bi,bj)
fead278c20 Patr*0271           StoreEXF2(I,J,bi,bj,16) = 0.0
0e8df33a35 Jean*0272 #  endif /* EXF_READ_EVAP */
                0273 #  ifdef ALLOW_DOWNWARD_RADIATION
                0274           StoreEXF2(I,J,bi,bj,17) = swdown0(I,J,bi,bj)
                0275           StoreEXF2(I,J,bi,bj,18) = swdown1(I,J,bi,bj)
                0276           StoreEXF2(I,J,bi,bj,19) = lwdown0(I,J,bi,bj)
                0277           StoreEXF2(I,J,bi,bj,20) = lwdown1(I,J,bi,bj)
                0278 #  else
                0279           StoreEXF2(I,J,bi,bj,17) = 0.0
                0280           StoreEXF2(I,J,bi,bj,18) = 0.0
                0281           StoreEXF2(I,J,bi,bj,19) = 0.0
                0282           StoreEXF2(I,J,bi,bj,20) = 0.0
6fe4379e6f Jean*0283 #  endif
                0284 # endif /* ALLOW_ATM_TEMP */
0e8df33a35 Jean*0285           StoreEXF2(I,J,bi,bj,21) = uwind0(I,J,bi,bj)
                0286           StoreEXF2(I,J,bi,bj,22) = uwind1(I,J,bi,bj)
                0287           StoreEXF2(I,J,bi,bj,23) = vwind0(I,J,bi,bj)
                0288           StoreEXF2(I,J,bi,bj,24) = vwind1(I,J,bi,bj)
634ecb5dc5 Jean*0289          ENDDO
                0290         ENDDO
                0291        ENDDO
                0292       ENDDO
5728d4a98b Patr*0293 #endif /* ALLOW_EXF */
                0294
3c775cbf98 Mart*0295 #ifdef ALLOW_SEAICE
                0296 C--   Over all tiles
                0297       DO bj = myByLo(myThid), myByHi(myThid)
                0298        DO bi = myBxLo(myThid), myBxHi(myThid)
                0299 C-      2D arrays
                0300         DO J=1-OLy,sNy+OLy
                0301          DO I=1-OLx,sNx+OLx
                0302           StoreSEAICE(I,J,bi,bj, 1) = AREA(I,J,bi,bj)
                0303           StoreSEAICE(I,J,bi,bj, 2) = HEFF(I,J,bi,bj)
                0304           StoreSEAICE(I,J,bi,bj, 3) = HSNOW(I,J,bi,bj)
                0305           StoreSEAICE(I,J,bi,bj, 4) = RUNOFF(I,J,bi,bj)
                0306           StoreSEAICE(I,J,bi,bj, 5) = UICE(I,J,bi,bj)
                0307           StoreSEAICE(I,J,bi,bj, 6) = VICE(I,J,bi,bj)
                0308           StoreSEAICE(I,J,bi,bj, 7) = ZETA(I,J,bi,bj)
                0309           StoreSEAICE(I,J,bi,bj, 8) = ETA(I,J,bi,bj)
                0310 # ifdef SEAICE_CGRID
                0311           StoreSEAICE(I,J,bi,bj, 9) = dwatn(I,J,bi,bj)
                0312 #  ifdef SEAICE_ALLOW_BOTTOMDRAG
                0313           StoreSEAICE(I,J,bi,bj,10) = cbotc(I,J,bi,bj)
                0314 #  else
                0315           StoreSEAICE(I,J,bi,bj,10) = 0.0
                0316 #  endif /* SEAICE_ALLOW_BOTTOMDRAG */
                0317           StoreSEAICE(I,J,bi,bj,11) = stressDivergenceX(I,J,bi,bj)
                0318           StoreSEAICE(I,J,bi,bj,12) = stressDivergenceY(I,J,bi,bj)
                0319 # else
                0320           StoreSEAICE(I,J,bi,bj, 9) = 0.0
                0321           StoreSEAICE(I,J,bi,bj,10) = 0.0
                0322           StoreSEAICE(I,J,bi,bj,11) = 0.0
                0323           StoreSEAICE(I,J,bi,bj,12) = 0.0
                0324 # endif /* SEAICE_CGRID */
                0325 # ifdef SEAICE_ALLOW_EVP
                0326           StoreSEAICE(I,J,bi,bj,13) = seaice_sigma1(I,J,bi,bj)
                0327           StoreSEAICE(I,J,bi,bj,14) = seaice_sigma2(I,J,bi,bj)
                0328           StoreSEAICE(I,J,bi,bj,15) = seaice_sigma12(I,J,bi,bj)
                0329 # else
                0330           StoreSEAICE(I,J,bi,bj,13) = 0.0
                0331           StoreSEAICE(I,J,bi,bj,14) = 0.0
                0332           StoreSEAICE(I,J,bi,bj,15) = 0.0
                0333 # endif /* SEAICE_ALLOW_EVP */
                0334 # ifdef SEAICE_VARIABLE_SALINITY
                0335           StoreSEAICE(I,J,bi,bj,16) = HSALT(I,J,bi,bj)
                0336 # else
                0337           StoreSEAICE(I,J,bi,bj,16) = 0.0
                0338 # endif
                0339          ENDDO
                0340         ENDDO
                0341 C--   this 3D array comes last because it has a variable size nITD
cda1c18f72 Jean*0342         DO K=1,nITD
3c775cbf98 Mart*0343          DO J=1-OLy,sNy+OLy
                0344           DO I=1-OLx,sNx+OLx
cda1c18f72 Jean*0345            StoreSEAICE(I,J,bi,bj,16+K) = TICES(I,J,K,bi,bj)
3c775cbf98 Mart*0346           ENDDO
                0347          ENDDO
                0348         ENDDO
                0349 C
                0350        ENDDO
                0351       ENDDO
                0352 #endif /* ALLOW_SEAICE */
                0353
                0354 #endif /* AUTODIFF_USE_STORE_RESTORE */
                0355
                0356 #if ( defined ALLOW_OBCS && defined AUTODIFF_USE_STORE_RESTORE_OBCS )
5728d4a98b Patr*0357 # ifdef ALLOW_OBCS_NORTH
                0358 C--   Over all tiles
                0359       DO bj = myByLo(myThid), myByHi(myThid)
                0360        DO bi = myBxLo(myThid), myBxHi(myThid)
                0361 C-      2D arrays
                0362         DO K=1,Nr
e4f1c09db9 Jean*0363          DO I=1-OLx,sNx+OLx
634ecb5dc5 Jean*0364           StoreOBCSN(I,K,bi,bj,1)  = OBNu(I,K,bi,bj)
                0365           StoreOBCSN(I,K,bi,bj,2)  = OBNv(I,K,bi,bj)
                0366           StoreOBCSN(I,K,bi,bj,3)  = OBNt(I,K,bi,bj)
                0367           StoreOBCSN(I,K,bi,bj,4)  = OBNs(I,K,bi,bj)
7b94249161 Jean*0368 #  ifdef ALLOW_OBCS_PRESCRIBE
634ecb5dc5 Jean*0369           StoreOBCSN(I,K,bi,bj,5)  = OBNu0(I,K,bi,bj)
                0370           StoreOBCSN(I,K,bi,bj,6)  = OBNv0(I,K,bi,bj)
                0371           StoreOBCSN(I,K,bi,bj,7)  = OBNt0(I,K,bi,bj)
                0372           StoreOBCSN(I,K,bi,bj,8)  = OBNs0(I,K,bi,bj)
                0373           StoreOBCSN(I,K,bi,bj,9)  = OBNu1(I,K,bi,bj)
                0374           StoreOBCSN(I,K,bi,bj,10) = OBNv1(I,K,bi,bj)
                0375           StoreOBCSN(I,K,bi,bj,11) = OBNt1(I,K,bi,bj)
                0376           StoreOBCSN(I,K,bi,bj,12) = OBNs1(I,K,bi,bj)
7b94249161 Jean*0377 #  endif
5728d4a98b Patr*0378 #  ifdef ALLOW_OBCSN_CONTROL
634ecb5dc5 Jean*0379           StoreOBCSN(I,K,bi,bj,13) = xx_obcsn0(I,K,bi,bj,1)
                0380           StoreOBCSN(I,K,bi,bj,14) = xx_obcsn0(I,K,bi,bj,2)
                0381           StoreOBCSN(I,K,bi,bj,15) = xx_obcsn0(I,K,bi,bj,3)
                0382           StoreOBCSN(I,K,bi,bj,16) = xx_obcsn0(I,K,bi,bj,4)
                0383           StoreOBCSN(I,K,bi,bj,17) = xx_obcsn1(I,K,bi,bj,1)
                0384           StoreOBCSN(I,K,bi,bj,18) = xx_obcsn1(I,K,bi,bj,2)
                0385           StoreOBCSN(I,K,bi,bj,19) = xx_obcsn1(I,K,bi,bj,3)
                0386           StoreOBCSN(I,K,bi,bj,20) = xx_obcsn1(I,K,bi,bj,4)
6fe4379e6f Jean*0387 #  else
60bf15049b Patr*0388           StoreOBCSN(I,K,bi,bj,13) = 0.0
                0389           StoreOBCSN(I,K,bi,bj,14) = 0.0
                0390           StoreOBCSN(I,K,bi,bj,15) = 0.0
                0391           StoreOBCSN(I,K,bi,bj,16) = 0.0
                0392           StoreOBCSN(I,K,bi,bj,17) = 0.0
                0393           StoreOBCSN(I,K,bi,bj,18) = 0.0
634ecb5dc5 Jean*0394           StoreOBCSN(I,K,bi,bj,19) = 0.0
                0395           StoreOBCSN(I,K,bi,bj,20) = 0.0
5728d4a98b Patr*0396 #  endif
634ecb5dc5 Jean*0397          ENDDO
                0398         ENDDO
                0399        ENDDO
                0400       ENDDO
0d7eb15592 Jean*0401 # endif /* ALLOW_OBCS_NORTH */
5728d4a98b Patr*0402
                0403 # ifdef ALLOW_OBCS_SOUTH
                0404 C--   Over all tiles
                0405       DO bj = myByLo(myThid), myByHi(myThid)
                0406        DO bi = myBxLo(myThid), myBxHi(myThid)
                0407 C-      2D arrays
                0408         DO K=1,Nr
e4f1c09db9 Jean*0409          DO I=1-OLx,sNx+OLx
634ecb5dc5 Jean*0410           StoreOBCSS(I,K,bi,bj,1)  = OBSu(I,K,bi,bj)
                0411           StoreOBCSS(I,K,bi,bj,2)  = OBSv(I,K,bi,bj)
                0412           StoreOBCSS(I,K,bi,bj,3)  = OBSt(I,K,bi,bj)
                0413           StoreOBCSS(I,K,bi,bj,4)  = OBSs(I,K,bi,bj)
7b94249161 Jean*0414 #  ifdef ALLOW_OBCS_PRESCRIBE
634ecb5dc5 Jean*0415           StoreOBCSS(I,K,bi,bj,5)  = OBSu0(I,K,bi,bj)
                0416           StoreOBCSS(I,K,bi,bj,6)  = OBSv0(I,K,bi,bj)
                0417           StoreOBCSS(I,K,bi,bj,7)  = OBSt0(I,K,bi,bj)
                0418           StoreOBCSS(I,K,bi,bj,8)  = OBSs0(I,K,bi,bj)
                0419           StoreOBCSS(I,K,bi,bj,9)  = OBSu1(I,K,bi,bj)
                0420           StoreOBCSS(I,K,bi,bj,10) = OBSv1(I,K,bi,bj)
                0421           StoreOBCSS(I,K,bi,bj,11) = OBSt1(I,K,bi,bj)
                0422           StoreOBCSS(I,K,bi,bj,12) = OBSs1(I,K,bi,bj)
7b94249161 Jean*0423 #  endif
5728d4a98b Patr*0424 #  ifdef ALLOW_OBCSS_CONTROL
634ecb5dc5 Jean*0425           StoreOBCSS(I,K,bi,bj,13) = xx_obcss0(I,K,bi,bj,1)
                0426           StoreOBCSS(I,K,bi,bj,14) = xx_obcss0(I,K,bi,bj,2)
                0427           StoreOBCSS(I,K,bi,bj,15) = xx_obcss0(I,K,bi,bj,3)
                0428           StoreOBCSS(I,K,bi,bj,16) = xx_obcss0(I,K,bi,bj,4)
                0429           StoreOBCSS(I,K,bi,bj,17) = xx_obcss1(I,K,bi,bj,1)
                0430           StoreOBCSS(I,K,bi,bj,18) = xx_obcss1(I,K,bi,bj,2)
                0431           StoreOBCSS(I,K,bi,bj,19) = xx_obcss1(I,K,bi,bj,3)
                0432           StoreOBCSS(I,K,bi,bj,20) = xx_obcss1(I,K,bi,bj,4)
6fe4379e6f Jean*0433 #  else
60bf15049b Patr*0434           StoreOBCSS(I,K,bi,bj,13) = 0.0
                0435           StoreOBCSS(I,K,bi,bj,14) = 0.0
                0436           StoreOBCSS(I,K,bi,bj,15) = 0.0
                0437           StoreOBCSS(I,K,bi,bj,16) = 0.0
                0438           StoreOBCSS(I,K,bi,bj,17) = 0.0
                0439           StoreOBCSS(I,K,bi,bj,18) = 0.0
634ecb5dc5 Jean*0440           StoreOBCSS(I,K,bi,bj,19) = 0.0
                0441           StoreOBCSS(I,K,bi,bj,20) = 0.0
5728d4a98b Patr*0442 #  endif
634ecb5dc5 Jean*0443          ENDDO
                0444         ENDDO
                0445        ENDDO
                0446       ENDDO
0d7eb15592 Jean*0447 # endif /* ALLOW_OBCS_SOUTH */
5728d4a98b Patr*0448
                0449 # ifdef ALLOW_OBCS_EAST
                0450 C--   Over all tiles
                0451       DO bj = myByLo(myThid), myByHi(myThid)
                0452        DO bi = myBxLo(myThid), myBxHi(myThid)
                0453 C-      2D arrays
                0454         DO K=1,Nr
e4f1c09db9 Jean*0455          DO J=1-OLy,sNy+OLy
634ecb5dc5 Jean*0456           StoreOBCSE(J,K,bi,bj,1)  = OBEu(J,K,bi,bj)
                0457           StoreOBCSE(J,K,bi,bj,2)  = OBEv(J,K,bi,bj)
                0458           StoreOBCSE(J,K,bi,bj,3)  = OBEt(J,K,bi,bj)
                0459           StoreOBCSE(J,K,bi,bj,4)  = OBEs(J,K,bi,bj)
7b94249161 Jean*0460 #  ifdef ALLOW_OBCS_PRESCRIBE
634ecb5dc5 Jean*0461           StoreOBCSE(J,K,bi,bj,5)  = OBEu0(J,K,bi,bj)
                0462           StoreOBCSE(J,K,bi,bj,6)  = OBEv0(J,K,bi,bj)
                0463           StoreOBCSE(J,K,bi,bj,7)  = OBEt0(J,K,bi,bj)
                0464           StoreOBCSE(J,K,bi,bj,8)  = OBEs0(J,K,bi,bj)
                0465           StoreOBCSE(J,K,bi,bj,9)  = OBEu1(J,K,bi,bj)
                0466           StoreOBCSE(J,K,bi,bj,10) = OBEv1(J,K,bi,bj)
                0467           StoreOBCSE(J,K,bi,bj,11) = OBEt1(J,K,bi,bj)
                0468           StoreOBCSE(J,K,bi,bj,12) = OBEs1(J,K,bi,bj)
7b94249161 Jean*0469 #  endif
5728d4a98b Patr*0470 #  ifdef ALLOW_OBCSE_CONTROL
634ecb5dc5 Jean*0471           StoreOBCSE(J,K,bi,bj,13) = xx_obcse0(J,K,bi,bj,1)
                0472           StoreOBCSE(J,K,bi,bj,14) = xx_obcse0(J,K,bi,bj,2)
                0473           StoreOBCSE(J,K,bi,bj,15) = xx_obcse0(J,K,bi,bj,3)
                0474           StoreOBCSE(J,K,bi,bj,16) = xx_obcse0(J,K,bi,bj,4)
                0475           StoreOBCSE(J,K,bi,bj,17) = xx_obcse1(J,K,bi,bj,1)
                0476           StoreOBCSE(J,K,bi,bj,18) = xx_obcse1(J,K,bi,bj,2)
                0477           StoreOBCSE(J,K,bi,bj,19) = xx_obcse1(J,K,bi,bj,3)
                0478           StoreOBCSE(J,K,bi,bj,20) = xx_obcse1(J,K,bi,bj,4)
6fe4379e6f Jean*0479 #  else
60bf15049b Patr*0480           StoreOBCSE(J,K,bi,bj,13) = 0.0
                0481           StoreOBCSE(J,K,bi,bj,14) = 0.0
                0482           StoreOBCSE(J,K,bi,bj,15) = 0.0
                0483           StoreOBCSE(J,K,bi,bj,16) = 0.0
                0484           StoreOBCSE(J,K,bi,bj,17) = 0.0
                0485           StoreOBCSE(J,K,bi,bj,18) = 0.0
634ecb5dc5 Jean*0486           StoreOBCSE(J,K,bi,bj,19) = 0.0
                0487           StoreOBCSE(J,K,bi,bj,20) = 0.0
5728d4a98b Patr*0488 #  endif
634ecb5dc5 Jean*0489          ENDDO
                0490         ENDDO
                0491        ENDDO
                0492       ENDDO
0d7eb15592 Jean*0493 # endif /* ALLOW_OBCS_EAST */
5728d4a98b Patr*0494
                0495 # ifdef ALLOW_OBCS_WEST
                0496 C--   Over all tiles
                0497       DO bj = myByLo(myThid), myByHi(myThid)
                0498        DO bi = myBxLo(myThid), myBxHi(myThid)
                0499 C-      2D arrays
                0500         DO K=1,Nr
e4f1c09db9 Jean*0501          DO J=1-OLy,sNy+OLy
634ecb5dc5 Jean*0502           StoreOBCSW(J,K,bi,bj,1)  = OBWu(J,K,bi,bj)
                0503           StoreOBCSW(J,K,bi,bj,2)  = OBWv(J,K,bi,bj)
                0504           StoreOBCSW(J,K,bi,bj,3)  = OBWt(J,K,bi,bj)
                0505           StoreOBCSW(J,K,bi,bj,4)  = OBWs(J,K,bi,bj)
7b94249161 Jean*0506 #  ifdef ALLOW_OBCS_PRESCRIBE
634ecb5dc5 Jean*0507           StoreOBCSW(J,K,bi,bj,5)  = OBWu0(J,K,bi,bj)
                0508           StoreOBCSW(J,K,bi,bj,6)  = OBWv0(J,K,bi,bj)
                0509           StoreOBCSW(J,K,bi,bj,7)  = OBWt0(J,K,bi,bj)
                0510           StoreOBCSW(J,K,bi,bj,8)  = OBWs0(J,K,bi,bj)
                0511           StoreOBCSW(J,K,bi,bj,9)  = OBWu1(J,K,bi,bj)
                0512           StoreOBCSW(J,K,bi,bj,10) = OBWv1(J,K,bi,bj)
                0513           StoreOBCSW(J,K,bi,bj,11) = OBWt1(J,K,bi,bj)
                0514           StoreOBCSW(J,K,bi,bj,12) = OBWs1(J,K,bi,bj)
7b94249161 Jean*0515 #  endif
5728d4a98b Patr*0516 #  ifdef ALLOW_OBCSW_CONTROL
634ecb5dc5 Jean*0517           StoreOBCSW(J,K,bi,bj,13) = xx_obcsw0(J,K,bi,bj,1)
                0518           StoreOBCSW(J,K,bi,bj,14) = xx_obcsw0(J,K,bi,bj,2)
                0519           StoreOBCSW(J,K,bi,bj,15) = xx_obcsw0(J,K,bi,bj,3)
                0520           StoreOBCSW(J,K,bi,bj,16) = xx_obcsw0(J,K,bi,bj,4)
                0521           StoreOBCSW(J,K,bi,bj,17) = xx_obcsw1(J,K,bi,bj,1)
                0522           StoreOBCSW(J,K,bi,bj,18) = xx_obcsw1(J,K,bi,bj,2)
                0523           StoreOBCSW(J,K,bi,bj,19) = xx_obcsw1(J,K,bi,bj,3)
                0524           StoreOBCSW(J,K,bi,bj,20) = xx_obcsw1(J,K,bi,bj,4)
6fe4379e6f Jean*0525 #  else
60bf15049b Patr*0526           StoreOBCSW(J,K,bi,bj,13) = 0.0
                0527           StoreOBCSW(J,K,bi,bj,14) = 0.0
                0528           StoreOBCSW(J,K,bi,bj,15) = 0.0
                0529           StoreOBCSW(J,K,bi,bj,16) = 0.0
                0530           StoreOBCSW(J,K,bi,bj,17) = 0.0
                0531           StoreOBCSW(J,K,bi,bj,18) = 0.0
634ecb5dc5 Jean*0532           StoreOBCSW(J,K,bi,bj,19) = 0.0
                0533           StoreOBCSW(J,K,bi,bj,20) = 0.0
5728d4a98b Patr*0534 #  endif
634ecb5dc5 Jean*0535          ENDDO
                0536         ENDDO
                0537        ENDDO
                0538       ENDDO
5728d4a98b Patr*0539 # endif /* ALLOW_OBCS_WEST */
cda1c18f72 Jean*0540 #endif /* ALLOW_OBCS & AUTODIFF_USE_STORE_RESTORE_OBCS */
5728d4a98b Patr*0541
b167b0379c Patr*0542 #ifdef ALLOW_DEBUG
862d160a2f Jean*0543       IF ( debugMode ) CALL DEBUG_LEAVE('AUTODIFF_STORE',myThid)
5728d4a98b Patr*0544 #endif
                0545
                0546 #endif /* ALLOW_AUTODIFF_TAMC */
cda1c18f72 Jean*0547 C**************************************
5728d4a98b Patr*0548
6fe4379e6f Jean*0549       RETURN
                0550       END