pkg/grdchk/grdchk_setxx.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_SETXX(
2091ce7ee7 Patr*0007      I                       icvrec,
22f0d78f5f Patr*0008      I                       theSimulationMode,
1052c30783 Jean*0009      I                       iGrdC, jGrdC, layer,
                0010      I                       bi_gc, bj_gc, procId_gc,
                0011      I                       varIndex_gc,
2091ce7ee7 Patr*0012      I                       xx_comp_ref,
1052c30783 Jean*0013      I                       myThid )
                0014
                0015 C     ==================================================================
                0016 C     SUBROUTINE grdchk_setxx
                0017 C     ==================================================================
                0018 C
                0019 C     o Set component a component of the control vector; xx(loc)
                0020 C
                0021 C     started: Christian Eckert eckert@mit.edu 08-Mar-2000
                0022 C     continued: heimbach@mit.edu: 13-Jun-2001
2091ce7ee7 Patr*0023 c
1052c30783 Jean*0024 C     ==================================================================
                0025 C     SUBROUTINE grdchk_setxx
                0026 C     ==================================================================
2091ce7ee7 Patr*0027
1052c30783 Jean*0028       IMPLICIT NONE
2091ce7ee7 Patr*0029
1052c30783 Jean*0030 C     == global variables ==
2091ce7ee7 Patr*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"
2091ce7ee7 Patr*0036
1052c30783 Jean*0037 C     == routine arguments ==
                0038       INTEGER icvrec
                0039       INTEGER theSimulationMode
                0040       INTEGER iGrdC, jGrdC, layer
                0041       INTEGER bi_gc, bj_gc
                0042       INTEGER procId_gc
                0043       INTEGER varIndex_gc
2091ce7ee7 Patr*0044       _RL     xx_comp_ref
1052c30783 Jean*0045       INTEGER myThid
2091ce7ee7 Patr*0046
edd57506ae Patr*0047 #ifdef ALLOW_GRDCHK
1052c30783 Jean*0048 C--   == external ==
                0049       INTEGER  ILNBLNK
                0050       EXTERNAL ILNBLNK
2091ce7ee7 Patr*0051
1052c30783 Jean*0052 C     == local variables ==
                0053       INTEGER iL, ilDir
2091ce7ee7 Patr*0054       _RL     dummy
1052c30783 Jean*0055       LOGICAL doglobalread
                0056       LOGICAL ladinit
                0057       CHARACTER*(MAX_LEN_FNAM) ctrl_name
5cf4364659 Mart*0058       CHARACTER*(MAX_LEN_FNAM) fName
1052c30783 Jean*0059       _RL loctmp2d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0060 #ifdef ALLOW_GENARR3D_CONTROL
                0061       _RL loctmp3d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0062 #endif
7aa90384e1 Mart*0063 #if (defined ALLOW_OBCSN_CONTROL || defined ALLOW_OBCSS_CONTROL)
f9d7cbfb72 Ou W*0064       _RL tmpfldxz (1-OLx:sNx+OLx,Nr,nSx,nSy)
9c7e07a4e1 Jean*0065 #endif
7aa90384e1 Mart*0066 #if (defined ALLOW_OBCSE_CONTROL || defined ALLOW_OBCSW_CONTROL)
f9d7cbfb72 Ou W*0067       _RL tmpfldyz (1-OLy:sNy+OLy,Nr,nSx,nSy)
7aa90384e1 Mart*0068 #endif
1052c30783 Jean*0069 C--   == end of interface ==
                0070
                0071       doglobalread = .FALSE.
                0072       ladinit      = .FALSE.
                0073 C     Find ctrlDir (w/o trailing blanks) length
                0074       ilDir = ILNBLNK(ctrlDir)
                0075
5cf4364659 Mart*0076       ctrl_name = ncvarfname(varIndex_gc)
1052c30783 Jean*0077       iL = ILNBLNK( ctrl_name )
                0078
                0079       IF ( theSimulationMode .EQ. TANGENT_SIMULATION ) THEN
                0080         WRITE(fName,'(3A,I10.10)') ctrlDir(1:ilDir)//yadmark,
                0081      &           ctrl_name(1:iL), '.', optimcycle
                0082       ELSEIF ( theSimulationMode .EQ. FORWARD_SIMULATION ) THEN
                0083         WRITE(fName,'(3A,I10.10)') ctrlDir(1:ilDir),
                0084      &           ctrl_name(1:iL), '.', optimcycle
                0085       ELSE
                0086         WRITE(fName,'(A)') ' '
                0087       ENDIF
174411e1dd Patr*0088
                0089 #ifdef ALLOW_GENARR3D_CONTROL
5cf4364659 Mart*0090       IF ( ncvartype(varIndex_gc) .EQ. 'Arr3D' ) THEN
1052c30783 Jean*0091         CALL active_read_xyz( fName, loctmp3d, 1,
                0092      &                        doglobalread, ladinit, optimcycle,
                0093      &                        myThid, dummy )
                0094         IF ( myProcId .EQ. procId_gc )
                0095      &  loctmp3d( iGrdC,jGrdC,layer,bi_gc,bj_gc ) = xx_comp_ref
                0096         CALL active_write_xyz( fName, loctmp3d, 1,
                0097      &                         optimcycle,
                0098      &                         myThid, dummy )
                0099 #else
                0100       IF ( .FALSE. ) THEN
fa1c4e7ee9 Patr*0101 #endif
b564382bca Gael*0102
                0103 #if (defined ALLOW_OBCSN_CONTROL || defined ALLOW_OBCSS_CONTROL)
5cf4364659 Mart*0104       ELSEIF ( ncvartype(varIndex_gc) .EQ. 'SecXZ' ) THEN
1052c30783 Jean*0105         CALL active_read_xz( fName, tmpfldxz, icvrec,
                0106      &                       doglobalread, ladinit, optimcycle,
                0107      &                       myThid, dummy )
                0108         IF ( myProcId .EQ. procId_gc )
                0109      &  tmpfldxz( iGrdC,layer,bi_gc,bj_gc ) = xx_comp_ref
                0110         CALL active_write_xz( fName, tmpfldxz, icvrec,
                0111      &                        optimcycle,
                0112      &                        myThid, dummy )
b564382bca Gael*0113 #endif
                0114
                0115 #if (defined ALLOW_OBCSE_CONTROL || defined ALLOW_OBCSW_CONTROL)
5cf4364659 Mart*0116       ELSEIF ( ncvartype(varIndex_gc) .EQ. 'SecYZ' ) THEN
1052c30783 Jean*0117         CALL active_read_yz( fName, tmpfldyz, icvrec,
                0118      &                       doglobalread, ladinit, optimcycle,
                0119      &                       myThid, dummy )
                0120         IF ( myProcId .EQ. procId_gc )
                0121      &  tmpfldyz( jGrdC,layer,bi_gc,bj_gc ) = xx_comp_ref
                0122         CALL active_write_yz( fName, tmpfldyz, icvrec,
                0123      &                        optimcycle,
                0124      &                        myThid, dummy )
b564382bca Gael*0125 #endif
174411e1dd Patr*0126
1052c30783 Jean*0127       ELSE
b564382bca Gael*0128
1052c30783 Jean*0129         CALL active_read_xy( fName, loctmp2d, icvrec,
                0130      &                       doglobalread, ladinit, optimcycle,
                0131      &                       myThid, dummy )
                0132         IF ( myProcId .EQ. procId_gc )
                0133      &  loctmp2d( iGrdC,jGrdC,bi_gc,bj_gc ) = xx_comp_ref
                0134         CALL active_write_xy( fName, loctmp2d, icvrec,
                0135      &                        optimcycle,
                0136      &                        myThid, dummy )
b564382bca Gael*0137
1052c30783 Jean*0138       ENDIF
2091ce7ee7 Patr*0139
edd57506ae Patr*0140 #endif /* ALLOW_GRDCHK */
2091ce7ee7 Patr*0141
1052c30783 Jean*0142       RETURN
                0143       END