pkg/grdchk/grdchk_getadxx.F

9c7e07a4e1 Jean*0001 #include "GRDCHK_OPTIONS.h"
a7eff9e819 Jean*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
2091ce7ee7 Patr*0005
1052c30783 Jean*0006       SUBROUTINE GRDCHK_GETADXX(
2091ce7ee7 Patr*0007      I                       icvrec,
1052c30783 Jean*0008      I                       iGrdC, jGrdC, layer,
                0009      I                       bi_gc, bj_gc, procId_gc,
                0010      I                       varIndex_gc,
                0011      O                       xx_comp,
                0012      I                       myThid )
                0013
                0014 C     ==================================================================
                0015 C     SUBROUTINE grdchk_getadxx
                0016 C     ==================================================================
                0017 C
                0018 C     o Set component a component of the control vector; xx(loc)
                0019 C
                0020 C     started: Christian Eckert eckert@mit.edu 08-Mar-2000
                0021 C     continued: heimbach@mit.edu: 13-Jun-2001
                0022 C
                0023 C     ==================================================================
                0024 C     SUBROUTINE grdchk_getadxx
                0025 C     ==================================================================
                0026
                0027       IMPLICIT NONE
                0028
                0029 C     == global variables ==
2091ce7ee7 Patr*0030
                0031 #include "EEPARAMS.h"
                0032 #include "SIZE.h"
c04085ad02 Patr*0033 #include "CTRL_SIZE.h"
4d72283393 Mart*0034 #include "CTRL.h"
65754df434 Mart*0035 #include "OPTIMCYCLE.h"
1052c30783 Jean*0036
                0037 C     == routine arguments ==
                0038       INTEGER icvrec
                0039       INTEGER iGrdC, jGrdC, layer
                0040       INTEGER bi_gc, bj_gc
                0041       INTEGER procId_gc
                0042       INTEGER varIndex_gc
78a0e1cce7 Patr*0043       _RL     xx_comp
1052c30783 Jean*0044       INTEGER myThid
2091ce7ee7 Patr*0045
edd57506ae Patr*0046 #ifdef ALLOW_GRDCHK
1052c30783 Jean*0047 C--   == external ==
                0048       INTEGER  ILNBLNK
                0049       EXTERNAL ILNBLNK
                0050
                0051 C     == local variables ==
                0052       INTEGER il, ilDir
2091ce7ee7 Patr*0053       _RL     dummy
1052c30783 Jean*0054       LOGICAL doglobalread
                0055       LOGICAL ladinit
                0056       CHARACTER*(MAX_LEN_FNAM) ctrl_name
5cf4364659 Mart*0057       CHARACTER*(MAX_LEN_FNAM) fName
1052c30783 Jean*0058       _RL loctmp2d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0059 #ifdef ALLOW_GENARR3D_CONTROL
                0060       _RL loctmp3d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0061 #endif
7aa90384e1 Mart*0062 #if (defined ALLOW_OBCSN_CONTROL || defined ALLOW_OBCSS_CONTROL)
f9d7cbfb72 Ou W*0063       _RL tmpfldxz (1-OLx:sNx+OLx,Nr,nSx,nSy)
9c7e07a4e1 Jean*0064 #endif
7aa90384e1 Mart*0065 #if (defined ALLOW_OBCSE_CONTROL || defined ALLOW_OBCSW_CONTROL)
f9d7cbfb72 Ou W*0066       _RL tmpfldyz (1-OLy:sNy+OLy,Nr,nSx,nSy)
7aa90384e1 Mart*0067 #endif
1052c30783 Jean*0068 C--   == end of interface ==
174411e1dd Patr*0069
1052c30783 Jean*0070       xx_comp      = 0. _d 0
                0071
                0072       doglobalread = .FALSE.
                0073       ladinit      = .FALSE.
                0074 C     Find ctrlDir (w/o trailing blanks) length
                0075       ilDir = ILNBLNK(ctrlDir)
                0076
5cf4364659 Mart*0077       ctrl_name = ncvarfname(varIndex_gc)
1052c30783 Jean*0078       iL = ILNBLNK( ctrl_name )
b564382bca Gael*0079
1052c30783 Jean*0080       WRITE(fName,'(3A,I10.10)') ctrlDir(1:ilDir)//yadmark,
                0081      &           ctrl_name(1:iL), '.', optimcycle
                0082
                0083 #ifdef ALLOW_GENARR3D_CONTROL
5cf4364659 Mart*0084       IF ( ncvartype(varIndex_gc) .EQ. 'Arr3D' ) THEN
1052c30783 Jean*0085          CALL active_read_xyz( fName, loctmp3d, 1,
b564382bca Gael*0086      &                         doglobalread, ladinit, optimcycle,
1052c30783 Jean*0087      &                         myThid, dummy )
                0088          IF ( myProcId .EQ. procId_gc )
                0089      &   xx_comp = loctmp3d( iGrdC,jGrdC,layer,bi_gc,bj_gc )
                0090 #else
                0091       IF ( .FALSE. ) THEN
                0092 #endif
b564382bca Gael*0093
                0094 #if (defined ALLOW_OBCSN_CONTROL || defined ALLOW_OBCSS_CONTROL)
5cf4364659 Mart*0095       ELSEIF ( ncvartype(varIndex_gc) .EQ. 'SecXZ' ) THEN
1052c30783 Jean*0096          CALL active_read_xz( fName, tmpfldxz, icvrec,
b564382bca Gael*0097      &                        doglobalread, ladinit, optimcycle,
1052c30783 Jean*0098      &                        myThid, dummy)
                0099          IF ( myProcId .EQ. procId_gc )
                0100      &   xx_comp = tmpfldxz( iGrdC,layer,bi_gc,bj_gc )
b564382bca Gael*0101 #endif
                0102
                0103 #if (defined ALLOW_OBCSE_CONTROL || defined ALLOW_OBCSW_CONTROL)
5cf4364659 Mart*0104       ELSEIF ( ncvartype(varIndex_gc) .EQ. 'SecYZ' ) THEN
1052c30783 Jean*0105          CALL active_read_yz( fName, tmpfldyz, icvrec,
b564382bca Gael*0106      &                        doglobalread, ladinit, optimcycle,
1052c30783 Jean*0107      &                        myThid, dummy )
                0108          IF ( myProcId .EQ. procId_gc )
                0109      &   xx_comp = tmpfldyz( jGrdC,layer,bi_gc,bj_gc )
b564382bca Gael*0110 #endif
                0111
1052c30783 Jean*0112       ELSE
                0113          CALL active_read_xy( fName, loctmp2d, icvrec,
b564382bca Gael*0114      &                        doglobalread, ladinit, optimcycle,
1052c30783 Jean*0115      &                        myThid, dummy )
                0116          IF ( myProcId .EQ. procId_gc )
                0117      &   xx_comp = loctmp2d( iGrdC,jGrdC,bi_gc,bj_gc )
b564382bca Gael*0118
1052c30783 Jean*0119       ENDIF
b564382bca Gael*0120
edd57506ae Patr*0121 #endif /* ALLOW_GRDCHK */
2091ce7ee7 Patr*0122
1052c30783 Jean*0123       RETURN
                0124       END