Back to home page

MITgcm
 
 

    

File indexing completed on 2024-03-02 06:10:37 UTC

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