** Warning **

Issuing rollback() due to DESTROY without explicit disconnect() of DBD::mysql::db handle dbname=MITgcm at /usr/local/share/lxr/lib/LXR/Common.pm line 1224.

Last-Modified: Wed, 18 Feb 2025 06:11:59 GMT Content-Type: text/html; charset=utf-8 MITgcm/MITgcm/pkg/exf/exf_set_obcs.F
Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:40:00 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
6d54cf9ca1 Ed H*0001 #include "EXF_OPTIONS.h"
7f861c1808 Patr*0002 
66208f8733 Jean*0003 C--  File exf_set_obcs.F:
                0004 C--   Contents
                0005 C--   o EXF_SET_OBCS_XZ
                0006 C--   o EXF_SET_OBCS_YZ
f694f549b7 Jean*0007 C--   o EXF_SET_OBCS_X   <- no longer maintained ; use SET_OBCS_XZ with nNz=1
                0008 C--   o EXF_SET_OBCS_Y   <- no longer maintained ; use SET_OBCS_YZ with nNz=1
66208f8733 Jean*0009 
                0010 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0011 
                0012       SUBROUTINE EXF_SET_OBCS_XZ (
                0013      U       obcs_fld_xz, obcs_xz_0, obcs_xz_1,
f694f549b7 Jean*0014      I       obcs_file, obcsmask, nNz,
66208f8733 Jean*0015      I       fac, first, changed, useYearlyFields, obcs_period,
                0016      I       count0, count1, year0, year1,
                0017      I       myTime, myIter, myThid )
7f861c1808 Patr*0018 
f694f549b7 Jean*0019 C     ==================================================================
                0020 C     SUBROUTINE EXF_SET_OBCS_XZ
                0021 C     ==================================================================
                0022 C
                0023 C     o set open boundary conditions
                0024 C
                0025 C     started: heimbach@mit.edu 01-May-2001
                0026 C     mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
7f861c1808 Patr*0027 
f694f549b7 Jean*0028 C     ==================================================================
                0029 C     SUBROUTINE EXF_SET_OBCS_XZ
                0030 C     ==================================================================
7f861c1808 Patr*0031 
66208f8733 Jean*0032       IMPLICIT NONE
7f861c1808 Patr*0033 
f694f549b7 Jean*0034 C     == global variables ==
7f861c1808 Patr*0035 #include "EEPARAMS.h"
                0036 #include "SIZE.h"
                0037 #include "GRID.h"
082e18c36c Jean*0038 #include "EXF_PARAM.h"
                0039 #include "EXF_CONSTANTS.h"
7f861c1808 Patr*0040 
f694f549b7 Jean*0041 C     == routine arguments ==
                0042 C     nNz   :: number of levels to process
                0043       INTEGER nNz
                0044       _RL obcs_fld_xz(1-OLx:sNx+OLx,nNz,nSx,nSy)
                0045       _RL obcs_xz_0(1-OLx:sNx+OLx,nNz,nSx,nSy)
                0046       _RL obcs_xz_1(1-OLx:sNx+OLx,nNz,nSx,nSy)
3a075b3d72 Dimi*0047 
66208f8733 Jean*0048       CHARACTER*(128) obcs_file
                0049       CHARACTER*1 obcsmask
                0050       LOGICAL first, changed
                0051       LOGICAL useYearlyFields
6b9fc2ad14 Mart*0052       _RL     obcs_period
66208f8733 Jean*0053       INTEGER count0, count1, year0, year1
7f861c1808 Patr*0054       _RL     fac
66208f8733 Jean*0055       _RL     myTime
                0056       INTEGER myIter
                0057       INTEGER myThid
7f861c1808 Patr*0058 
                0059 #ifdef ALLOW_OBCS
                0060 
f694f549b7 Jean*0061 C     == local variables ==
7f861c1808 Patr*0062 
66208f8733 Jean*0063       CHARACTER*(128) obcs_file0, obcs_file1
                0064       INTEGER bi, bj
                0065       INTEGER i, k
6b9fc2ad14 Mart*0066 
f694f549b7 Jean*0067 C     == end of interface ==
7f861c1808 Patr*0068 
66208f8733 Jean*0069       IF ( obcs_file .NE. ' ' ) THEN
6060ec2938 Dimi*0070 
66208f8733 Jean*0071          IF ( first ) THEN
6b9fc2ad14 Mart*0072 
66208f8733 Jean*0073             CALL exf_GetYearlyFieldName(
510778fc01 Mart*0074      I         useYearlyFields, twoDigitYear, obcs_period, year0,
                0075      I         obcs_file,
                0076      O         obcs_file0,
66208f8733 Jean*0077      I         myTime, myIter, myThid )
6b9fc2ad14 Mart*0078 
f694f549b7 Jean*0079             _BARRIER
                0080             CALL READ_REC_XZ_RL( obcs_file0, exf_iprec_obcs, nNz,
66208f8733 Jean*0081      &                           obcs_xz_1, count0, myIter, myThid )
f694f549b7 Jean*0082             _BARRIER
66208f8733 Jean*0083          ENDIF
6060ec2938 Dimi*0084 
f694f549b7 Jean*0085          IF ( first .OR. changed ) THEN
                0086             CALL exf_swapffields_xz( obcs_xz_0, obcs_xz_1, nNz,myThid )
6060ec2938 Dimi*0087 
66208f8733 Jean*0088             CALL exf_GetYearlyFieldName(
                0089      I         useYearlyFields, twoDigitYear, obcs_period, year1,
510778fc01 Mart*0090      I         obcs_file,
                0091      O         obcs_file1,
66208f8733 Jean*0092      I         myTime, myIter, myThid )
                0093 
f694f549b7 Jean*0094             _BARRIER
                0095             CALL READ_REC_XZ_RL( obcs_file1, exf_iprec_obcs, nNz,
66208f8733 Jean*0096      &                           obcs_xz_1, count1, myIter, myThid )
f694f549b7 Jean*0097             _BARRIER
66208f8733 Jean*0098          ENDIF
                0099 
                0100          DO bj = myByLo(myThid),myByHi(myThid)
                0101             DO bi = myBxLo(myThid),myBxHi(myThid)
f694f549b7 Jean*0102                DO k = 1,nNz
66208f8733 Jean*0103                   DO i = 1,sNx
                0104                      obcs_fld_xz(i,k,bi,bj) =
3a075b3d72 Dimi*0105      &                    fac * obcs_xz_0(i,k,bi,bj) +
6060ec2938 Dimi*0106      &                    (exf_one - fac) * obcs_xz_1(i,k,bi,bj)
66208f8733 Jean*0107                   ENDDO
                0108                ENDDO
                0109             ENDDO
                0110          ENDDO
7f861c1808 Patr*0111 
66208f8733 Jean*0112       ENDIF
7f861c1808 Patr*0113 
fe50289ca9 Dimi*0114 #endif /* ALLOW_OBCS */
7f861c1808 Patr*0115 
66208f8733 Jean*0116       RETURN
                0117       END
                0118 
                0119 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7f861c1808 Patr*0120 
66208f8733 Jean*0121       SUBROUTINE EXF_SET_OBCS_YZ (
                0122      U       obcs_fld_yz, obcs_yz_0, obcs_yz_1,
f694f549b7 Jean*0123      I       obcs_file, obcsmask, nNz,
66208f8733 Jean*0124      I       fac, first, changed, useYearlyFields, obcs_period,
                0125      I       count0, count1, year0, year1,
                0126      I       myTime, myIter, myThid)
7f861c1808 Patr*0127 
f694f549b7 Jean*0128 C     ==================================================================
                0129 C     SUBROUTINE EXF_SET_OBCS_YZ
                0130 C     ==================================================================
                0131 C
                0132 C     o set open boundary conditions
                0133 C
                0134 C     started: heimbach@mit.edu 01-May-2001
7f861c1808 Patr*0135 
f694f549b7 Jean*0136 C     ==================================================================
                0137 C     SUBROUTINE EXF_SET_OBCS_YZ
                0138 C     ==================================================================
7f861c1808 Patr*0139 
66208f8733 Jean*0140       IMPLICIT NONE
7f861c1808 Patr*0141 
f694f549b7 Jean*0142 C     == global variables ==
7f861c1808 Patr*0143 #include "EEPARAMS.h"
                0144 #include "SIZE.h"
                0145 #include "GRID.h"
082e18c36c Jean*0146 #include "EXF_PARAM.h"
                0147 #include "EXF_CONSTANTS.h"
7f861c1808 Patr*0148 
f694f549b7 Jean*0149 C     == routine arguments ==
                0150 C     nNz   :: number of levels to process
                0151       INTEGER nNz
                0152       _RL obcs_fld_yz(1-OLy:sNy+OLy,nNz,nSx,nSy)
                0153       _RL obcs_yz_0(1-OLy:sNy+OLy,nNz,nSx,nSy)
                0154       _RL obcs_yz_1(1-OLy:sNy+OLy,nNz,nSx,nSy)
66208f8733 Jean*0155       CHARACTER*(MAX_LEN_FNAM) obcs_file
                0156       CHARACTER*1 obcsmask
                0157       LOGICAL first, changed
                0158       LOGICAL useYearlyFields
6b9fc2ad14 Mart*0159       _RL     obcs_period
66208f8733 Jean*0160       INTEGER count0, count1, year0, year1
7f861c1808 Patr*0161       _RL     fac
66208f8733 Jean*0162       _RL     myTime
                0163       INTEGER myIter
                0164       INTEGER myThid
7f861c1808 Patr*0165 
                0166 #ifdef ALLOW_OBCS
                0167 
f694f549b7 Jean*0168 C     == local variables ==
7f861c1808 Patr*0169 
66208f8733 Jean*0170       CHARACTER*(128) obcs_file0, obcs_file1
                0171       INTEGER bi, bj
                0172       INTEGER j, k
de416ebcde Patr*0173 
f694f549b7 Jean*0174 C     == end of interface ==
7f861c1808 Patr*0175 
66208f8733 Jean*0176       IF ( obcs_file .NE. ' ' ) THEN
7f861c1808 Patr*0177 
66208f8733 Jean*0178          IF ( first ) THEN
6b9fc2ad14 Mart*0179 
66208f8733 Jean*0180             CALL exf_GetYearlyFieldName(
                0181      I         useYearlyFields, twoDigitYear, obcs_period, year0,
510778fc01 Mart*0182      I         obcs_file,
                0183      O         obcs_file0,
66208f8733 Jean*0184      I         myTime, myIter, myThid )
6b9fc2ad14 Mart*0185 
f694f549b7 Jean*0186             _BARRIER
                0187             CALL READ_REC_YZ_RL( obcs_file0, exf_iprec_obcs, nNz,
66208f8733 Jean*0188      &                           obcs_yz_1, count0, myIter, myThid )
f694f549b7 Jean*0189             _BARRIER
66208f8733 Jean*0190          ENDIF
7f861c1808 Patr*0191 
f694f549b7 Jean*0192          IF ( first .OR. changed ) THEN
                0193             CALL exf_swapffields_yz( obcs_yz_0, obcs_yz_1, nNz,myThid )
7109a141b2 Patr*0194 
66208f8733 Jean*0195             CALL exf_GetYearlyFieldName(
                0196      I         useYearlyFields, twoDigitYear, obcs_period, year1,
510778fc01 Mart*0197      I         obcs_file,
                0198      O         obcs_file1,
66208f8733 Jean*0199      I         myTime, myIter, myThid )
                0200 
f694f549b7 Jean*0201             _BARRIER
                0202             CALL READ_REC_YZ_RL( obcs_file1, exf_iprec_obcs, nNz,
66208f8733 Jean*0203      &                           obcs_yz_1, count1, myIter, myThid )
f694f549b7 Jean*0204             _BARRIER
66208f8733 Jean*0205          ENDIF
                0206 
                0207          DO bj = myByLo(myThid),myByHi(myThid)
                0208             DO bi = myBxLo(myThid),myBxHi(myThid)
f694f549b7 Jean*0209                DO k = 1,nNz
66208f8733 Jean*0210                   DO j = 1,sNy
                0211                      obcs_fld_yz(j,k,bi,bj) =
3a075b3d72 Dimi*0212      &                    fac             *obcs_yz_0(j,k,bi,bj) +
                0213      &                    (exf_one - fac) *obcs_yz_1(j,k,bi,bj)
66208f8733 Jean*0214                   ENDDO
                0215                ENDDO
                0216             ENDDO
                0217          ENDDO
7109a141b2 Patr*0218 
66208f8733 Jean*0219       ENDIF
7f861c1808 Patr*0220 
fe50289ca9 Dimi*0221 #endif /* ALLOW_OBCS */
                0222 
66208f8733 Jean*0223       RETURN
                0224       END
                0225 
                0226 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
fe50289ca9 Dimi*0227 
66208f8733 Jean*0228       SUBROUTINE EXF_SET_OBCS_X (
                0229      U       obcs_fld_x, obcs_x_0, obcs_x_1,
                0230      I       obcs_file, obcsmask,
                0231      I       fac, first, changed, useYearlyFields, obcs_period,
                0232      I       count0, count1, year0, year1,
                0233      I       myTime, myIter, myThid )
fe50289ca9 Dimi*0234 
f694f549b7 Jean*0235 C     ==================================================================
                0236 C     SUBROUTINE EXF_SET_OBCS_X
                0237 C     ==================================================================
                0238 C
                0239 C     o set open boundary conditions
                0240 C       same as EXF_SET_OBCS_XZ but for Nr=1
                0241 C
                0242 C     ==================================================================
                0243 C     SUBROUTINE EXF_SET_OBCS_X
                0244 C     ==================================================================
fe50289ca9 Dimi*0245 
66208f8733 Jean*0246       IMPLICIT NONE
fe50289ca9 Dimi*0247 
f694f549b7 Jean*0248 C     == global variables ==
fe50289ca9 Dimi*0249 
                0250 #include "EEPARAMS.h"
                0251 #include "SIZE.h"
                0252 #include "GRID.h"
                0253 #include "EXF_PARAM.h"
                0254 #include "EXF_CONSTANTS.h"
                0255 
f694f549b7 Jean*0256 C     == routine arguments ==
fe50289ca9 Dimi*0257 
66208f8733 Jean*0258       _RL obcs_fld_x(1-OLx:sNx+OLx,nSx,nSy)
                0259       _RL obcs_x_0(1-OLx:sNx+OLx,nSx,nSy)
                0260       _RL obcs_x_1(1-OLx:sNx+OLx,nSx,nSy)
3a075b3d72 Dimi*0261 
66208f8733 Jean*0262       CHARACTER*(128) obcs_file
                0263       CHARACTER*1 obcsmask
                0264       LOGICAL first, changed
                0265       LOGICAL useYearlyFields
6b9fc2ad14 Mart*0266       _RL     obcs_period
66208f8733 Jean*0267       INTEGER count0, count1, year0, year1
fe50289ca9 Dimi*0268       _RL     fac
66208f8733 Jean*0269       _RL     myTime
                0270       INTEGER myIter
                0271       INTEGER myThid
fe50289ca9 Dimi*0272 
                0273 #ifdef ALLOW_OBCS
                0274 
f694f549b7 Jean*0275 C     == local variables ==
fe50289ca9 Dimi*0276 
66208f8733 Jean*0277       CHARACTER*(128) obcs_file0, obcs_file1
                0278       INTEGER bi, bj, i
6b9fc2ad14 Mart*0279 
f694f549b7 Jean*0280 C     == end of interface ==
                0281 
                0282       STOP 'S/R EXF_SET_OBCS_X no longer maintained'
fe50289ca9 Dimi*0283 
66208f8733 Jean*0284       IF ( obcs_file .NE. ' ' ) THEN
fe50289ca9 Dimi*0285 
66208f8733 Jean*0286          IF ( first ) THEN
6b9fc2ad14 Mart*0287 
66208f8733 Jean*0288             CALL exf_GetYearlyFieldName(
                0289      I         useYearlyFields, twoDigitYear, obcs_period, year0,
510778fc01 Mart*0290      I         obcs_file,
                0291      O         obcs_file0,
66208f8733 Jean*0292      I         myTime, myIter, myThid )
6b9fc2ad14 Mart*0293 
66208f8733 Jean*0294             CALL READ_REC_XZ_RL( obcs_file0, exf_iprec_obcs, 1,
                0295      &                           obcs_x_1, count0, myIter, myThid )
                0296          ENDIF
fe50289ca9 Dimi*0297 
66208f8733 Jean*0298          IF (( first ) .OR. ( changed )) THEN
f694f549b7 Jean*0299             CALL exf_swapffields_xz( obcs_x_0, obcs_x_1, 1,myThid )
fe50289ca9 Dimi*0300 
66208f8733 Jean*0301             CALL exf_GetYearlyFieldName(
                0302      I         useYearlyFields, twoDigitYear, obcs_period, year1,
510778fc01 Mart*0303      I         obcs_file,
                0304      O         obcs_file1,
66208f8733 Jean*0305      I         myTime, myIter, myThid )
6b9fc2ad14 Mart*0306 
66208f8733 Jean*0307             CALL READ_REC_XZ_RL( obcs_file1, exf_iprec_obcs, 1,
                0308      &                           obcs_x_1, count1, myIter, myThid )
                0309          ENDIF
fe50289ca9 Dimi*0310 
66208f8733 Jean*0311          DO bj = myByLo(myThid),myByHi(myThid)
                0312             DO bi = myBxLo(myThid),myBxHi(myThid)
                0313                DO i = 1,sNx
                0314                   obcs_fld_x(i,bi,bj) =
3a075b3d72 Dimi*0315      &                 fac * obcs_x_0(i,bi,bj) +
fe50289ca9 Dimi*0316      &                 (exf_one - fac) * obcs_x_1(i,bi,bj)
66208f8733 Jean*0317                ENDDO
                0318             ENDDO
                0319          ENDDO
fe50289ca9 Dimi*0320 
66208f8733 Jean*0321       ENDIF
fe50289ca9 Dimi*0322 
                0323 #endif /* ALLOW_OBCS */
                0324 
66208f8733 Jean*0325       RETURN
                0326       END
fe50289ca9 Dimi*0327 
66208f8733 Jean*0328 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0329 
                0330       SUBROUTINE EXF_SET_OBCS_Y (
                0331      U       obcs_fld_y, obcs_y_0, obcs_y_1,
                0332      I       obcs_file, obcsmask,
                0333      I       fac, first, changed, useYearlyFields, obcs_period,
                0334      I       count0, count1, year0, year1,
                0335      I       myTime, myIter, myThid )
fe50289ca9 Dimi*0336 
f694f549b7 Jean*0337 C     ==================================================================
                0338 C     SUBROUTINE EXF_SET_OBCS_Y
                0339 C     ==================================================================
                0340 C
                0341 C     o set open boundary conditions
                0342 C       same as EXF_SET_OBCS_YZ but for Nr=1
                0343 C
                0344 C     ==================================================================
                0345 C     SUBROUTINE EXF_SET_OBCS_Y
                0346 C     ==================================================================
fe50289ca9 Dimi*0347 
66208f8733 Jean*0348       IMPLICIT NONE
fe50289ca9 Dimi*0349 
f694f549b7 Jean*0350 C     == global variables ==
fe50289ca9 Dimi*0351 
                0352 #include "EEPARAMS.h"
                0353 #include "SIZE.h"
                0354 #include "GRID.h"
                0355 #include "EXF_PARAM.h"
                0356 #include "EXF_CONSTANTS.h"
                0357 
f694f549b7 Jean*0358 C     == routine arguments ==
fe50289ca9 Dimi*0359 
66208f8733 Jean*0360       _RL obcs_fld_y(1-OLy:sNy+OLy,nSx,nSy)
                0361       _RL obcs_y_0(1-OLy:sNy+OLy,nSx,nSy)
                0362       _RL obcs_y_1(1-OLy:sNy+OLy,nSx,nSy)
                0363       CHARACTER*(MAX_LEN_FNAM) obcs_file
                0364       CHARACTER*1 obcsmask
                0365       LOGICAL first, changed
                0366       LOGICAL useYearlyFields
6b9fc2ad14 Mart*0367       _RL     obcs_period
66208f8733 Jean*0368       INTEGER count0, count1, year0, year1
fe50289ca9 Dimi*0369       _RL     fac
66208f8733 Jean*0370       _RL     myTime
                0371       INTEGER myIter
                0372       INTEGER myThid
fe50289ca9 Dimi*0373 
                0374 #ifdef ALLOW_OBCS
                0375 
f694f549b7 Jean*0376 C     == local variables ==
fe50289ca9 Dimi*0377 
66208f8733 Jean*0378       CHARACTER*(128) obcs_file0, obcs_file1
                0379       INTEGER bi, bj, j
6b9fc2ad14 Mart*0380 
f694f549b7 Jean*0381 C     == end of interface ==
                0382 
                0383       STOP 'S/R EXF_SET_OBCS_X no longer maintained'
fe50289ca9 Dimi*0384 
66208f8733 Jean*0385       IF ( obcs_file .NE. ' ' ) THEN
fe50289ca9 Dimi*0386 
66208f8733 Jean*0387          IF ( first ) THEN
6b9fc2ad14 Mart*0388 
66208f8733 Jean*0389             CALL exf_GetYearlyFieldName(
                0390      I         useYearlyFields, twoDigitYear, obcs_period, year0,
510778fc01 Mart*0391      I         obcs_file,
                0392      O         obcs_file0,
66208f8733 Jean*0393      I         myTime, myIter, myThid )
6b9fc2ad14 Mart*0394 
66208f8733 Jean*0395             CALL READ_REC_YZ_RL( obcs_file0, exf_iprec_obcs, 1,
                0396      &                           obcs_y_1, count0, myIter, myThid )
                0397          ENDIF
fe50289ca9 Dimi*0398 
66208f8733 Jean*0399          IF (( first ) .OR. ( changed )) THEN
f694f549b7 Jean*0400             CALL exf_swapffields_yz( obcs_y_0, obcs_y_1, 1,myThid )
fe50289ca9 Dimi*0401 
66208f8733 Jean*0402             CALL exf_GetYearlyFieldName(
                0403      I         useYearlyFields, twoDigitYear, obcs_period, year1,
510778fc01 Mart*0404      I         obcs_file,
                0405      O         obcs_file1,
66208f8733 Jean*0406      I         myTime, myIter, myThid )
6b9fc2ad14 Mart*0407 
66208f8733 Jean*0408             CALL READ_REC_YZ_RL( obcs_file1, exf_iprec_obcs, 1,
                0409      &                           obcs_y_1, count1, myIter, myThid )
                0410          ENDIF
fe50289ca9 Dimi*0411 
66208f8733 Jean*0412          DO bj = myByLo(myThid),myByHi(myThid)
                0413             DO bi = myBxLo(myThid),myBxHi(myThid)
                0414                DO j = 1,sNy
                0415                   obcs_fld_y(j,bi,bj) =
3a075b3d72 Dimi*0416      &                 fac             *obcs_y_0(j,bi,bj) +
                0417      &                 (exf_one - fac) *obcs_y_1(j,bi,bj)
66208f8733 Jean*0418                ENDDO
                0419             ENDDO
                0420          ENDDO
fe50289ca9 Dimi*0421 
66208f8733 Jean*0422       ENDIF
fe50289ca9 Dimi*0423 
                0424 #endif /* ALLOW_OBCS */
7f861c1808 Patr*0425 
66208f8733 Jean*0426       RETURN
                0427       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!