Back to home page

MITgcm
 
 

    

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

view on githubraw file Latest commit 5cf43646 on 2024-03-01 18:50:49 UTC
5cf4364659 Mart*0001 #include "CTRL_OPTIONS.h"
                0002 
                0003 CBOP
                0004 C     !ROUTINE: CTRL_INIT_FIXED
                0005 C     !INTERFACE:
                0006       SUBROUTINE CTRL_INIT_FIXED( myThid )
                0007 
                0008 C     !DESCRIPTION: \bv
                0009 C     *=================================================================
                0010 C     | SUBROUTINE CTRL_INIT_FIXED
                0011 C     | o Define the vector of control variables
                0012 C     *=================================================================
                0013 C     \ev
                0014 
                0015 C     !USES:
                0016       IMPLICIT NONE
                0017 
                0018 C     === Global variables ===
                0019 #include "EEPARAMS.h"
                0020 #include "SIZE.h"
                0021 #include "PARAMS.h"
                0022 #include "GRID.h"
                0023 #ifdef ALLOW_CTRL
                0024 # include "CTRL_SIZE.h"
                0025 # include "CTRL.h"
                0026 # include "CTRL_GENARR.h"
                0027 # include "CTRL_OBCS.h"
                0028 #endif
                0029 #ifdef ALLOW_CAL
                0030 # include "cal.h"
                0031 #endif
                0032 #ifdef ALLOW_DIC_CONTROL
                0033 # include "DIC_CTRL.h"
                0034 #endif
                0035 
                0036 C     !INPUT/OUTPUT PARAMETERS:
                0037 C     myThid     :: my Thread Id number
                0038       INTEGER myThid
                0039 
                0040 C     !FUNCTIONS:
                0041 #ifdef ALLOW_GENTIM2D_CONTROL
                0042       INTEGER  ILNBLNK
                0043       EXTERNAL ILNBLNK
                0044 #endif
                0045 #ifdef ALLOW_OBCS_CONTROL_MODES
                0046       INTEGER  MDS_RECLEN
                0047       EXTERNAL MDS_RECLEN
                0048 #endif
                0049 
                0050 C     !LOCAL VARIABLES:
                0051 C     msgBuf     :: Informational/error message buffer
                0052       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0053       INTEGER bi, bj
                0054       INTEGER i, j, k
                0055       INTEGER ivar, iarr
                0056       LOGICAL costfinal_exists
                0057       _RL dummy
                0058       _RL loctmp3d (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0059 
                0060 #if ( defined ALLOW_GENTIM2D_CONTROL || \
                0061       defined ALLOW_GENARR2D_CONTROL || \
                0062       defined ALLOW_GENARR3D_CONTROL )
                0063       CHARACTER*(1) ncvargrdtmp
                0064 #endif
                0065 #ifdef ALLOW_GENTIM2D_CONTROL
                0066       CHARACTER*(MAX_LEN_FNAM) fnamegen
                0067       INTEGER ilgen, k2, diffrecFull, endrecFull
                0068       INTEGER diffrec, startrec, endrec
                0069 #elif ( defined ALLOW_OBCS_CONTROL )
                0070       INTEGER diffrec, startrec, endrec
                0071 #endif
                0072 
                0073 #ifdef ALLOW_OBCS_CONTROL_MODES
                0074       INTEGER  length_of_rec, dUnit
                0075 #endif
                0076 CEOP
                0077 
                0078 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0079 
                0080 C--     Set default values.
                0081       DO ivar = 1,maxcvars
                0082        ncvarindex(ivar) = -1
                0083        ncvarrecs(ivar)  =  0
                0084        ncvarxmax(ivar)  =  0
                0085        ncvarymax(ivar)  =  0
                0086        ncvarnrmax(ivar) =  0
                0087        ncvargrd(ivar)   = '?'
                0088        ncvartype(ivar)  = '?'
                0089        ncvarfname(ivar) = ' '
                0090       ENDDO
                0091 
                0092 C     Set unit weight to 1
                0093       DO bj=1,nSy
                0094        DO bi=1,nSx
                0095         DO k=1,Nr
                0096           wunit(k,bi,bj) = 1. _d 0
                0097           DO j=1-OLy,sNy+OLy
                0098            DO i=1-OLx,sNx+OLx
                0099              loctmp3d(i,j,k,bi,bj) = 1. _d 0
                0100            ENDDO
                0101           ENDDO
                0102         ENDDO
                0103        ENDDO
                0104       ENDDO
                0105 
                0106 #ifdef ALLOW_AUTODIFF
                0107       CALL active_write_xyz( 'wunit', loctmp3d, 1, 0, myThid, dummy)
                0108 #else
                0109       CALL WRITE_REC_XYZ_RL( 'wunit', loctmp3d, 1, 1, myThid )
                0110 #endif
                0111 
                0112 #ifdef CTRL_DO_PACK_UNPACK_ONLY
                0113       costfinal_exists=.FALSE.
                0114 #else
                0115 c     _BEGIN_MASTER( myThid )
                0116       inquire( file='costfinal', exist=costfinal_exists )
                0117 c     _END_MASTER( myThid )
                0118 
                0119 C-- for DIVA, avoid forward-related output in adjoint part
                0120       IF ( costfinal_exists ) CALL TURNOFF_MODEL_IO( 1, myThid )
                0121 #endif
                0122 
                0123       _BARRIER
                0124 
                0125       ivar = 0
                0126 C--   ===========================
                0127 C--   Open boundary contributions.
                0128 C--   ===========================
                0129 
                0130 C----------------------------------------------------------------------
                0131 
                0132 #ifdef ALLOW_OBCSN_CONTROL
                0133 C--   Northern obc.
                0134       CALL ctrl_init_rec ( xx_obcsn_file,
                0135      I     xx_obcsnstartdate1, xx_obcsnstartdate2, xx_obcsnperiod, 4,
                0136      O     xx_obcsnstartdate, diffrec, startrec, endrec,
                0137      I     myThid )
                0138       ivar = ivar + 1
                0139       iarr = 1
                0140       CALL ctrl_init_ctrlvar (
                0141      I     xx_obcsn_file, ivar, iarr, diffrec, startrec, endrec,
                0142      I     sNx, 1, Nr, 'm', 'SecXZ', costfinal_exists, myThid )
                0143 #endif /* ALLOW_OBCSN_CONTROL */
                0144 
                0145 C----------------------------------------------------------------------
                0146 
                0147 #ifdef ALLOW_OBCSS_CONTROL
                0148 C--   Southern obc.
                0149       CALL ctrl_init_rec ( xx_obcss_file,
                0150      I     xx_obcssstartdate1, xx_obcssstartdate2, xx_obcssperiod, 4,
                0151      O     xx_obcssstartdate, diffrec, startrec, endrec,
                0152      I     myThid )
                0153       ivar = ivar+1
                0154       iarr = 2
                0155       CALL ctrl_init_ctrlvar (
                0156      I     xx_obcss_file, ivar, iarr, diffrec, startrec, endrec,
                0157      I     sNx, 1, Nr, 'm', 'SecXZ', costfinal_exists, myThid )
                0158 #endif /* ALLOW_OBCSS_CONTROL */
                0159 
                0160 C----------------------------------------------------------------------
                0161 
                0162 #ifdef ALLOW_OBCSW_CONTROL
                0163 C--   Western obc.
                0164       CALL ctrl_init_rec ( xx_obcsw_file,
                0165      I     xx_obcswstartdate1, xx_obcswstartdate2, xx_obcswperiod, 4,
                0166      O     xx_obcswstartdate, diffrec, startrec, endrec,
                0167      I     myThid )
                0168       ivar = ivar+1
                0169       iarr = 4
                0170       CALL ctrl_init_ctrlvar (
                0171      I     xx_obcsw_file, ivar, iarr, diffrec, startrec, endrec,
                0172      I     1, sNy, Nr, 'm', 'SecYZ', costfinal_exists, myThid )
                0173 #endif  /* ALLOW_OBCSW_CONTROL */
                0174 
                0175 C----------------------------------------------------------------------
                0176 
                0177 #ifdef ALLOW_OBCSE_CONTROL
                0178 C--   Eastern obc.
                0179       CALL ctrl_init_rec ( xx_obcse_file,
                0180      I     xx_obcsestartdate1, xx_obcsestartdate2, xx_obcseperiod, 4,
                0181      O     xx_obcsestartdate, diffrec, startrec, endrec,
                0182      I     myThid )
                0183       ivar = ivar+1
                0184       iarr = 3
                0185       CALL ctrl_init_ctrlvar (
                0186      I     xx_obcse_file, ivar, iarr, diffrec, startrec, endrec,
                0187      I     1, sNy, Nr, 'm', 'SecYZ', costfinal_exists, myThid )
                0188 #endif /* ALLOW_OBCSE_CONTROL */
                0189 
                0190 C----------------------------------------------------------------------
                0191 
                0192 #ifdef ALLOW_OBCS_CONTROL_MODES
                0193 Cih  Get matrices for reconstruction from barotropic-barclinic modes
                0194 CMM  To use modes now hardcoded with ECCO_CPPOPTION.  Would be good to have
                0195 C     run-time option and also define filename=baro_invmodes.bin
                0196         CALL MDSFINDUNIT( dUnit, myThid )
                0197         length_of_rec = MDS_RECLEN( 64, Nr*Nr, myThid )
                0198         OPEN( dUnit, FILE='baro_invmodes.bin', STATUS='old',
                0199      &         ACCESS='direct', RECL=length_of_rec )
                0200         DO j = 1,Nr
                0201            READ(dUnit,rec=j) ((modesv(k,i,j), k=1,Nr), i=1,Nr)
                0202         ENDDO
                0203         CLOSE( dUnit )
                0204 CMM  double precision modesv is size [NR,NR,NR]
                0205 C     dim one is z-space
                0206 C     dim two is mode space
                0207 C     dim three is the total depth for which this set of modes applies
                0208 C     so for example modesv(:,2,nr) will be the second mode
                0209 C     in z-space for the full model depth
                0210 C    The modes are to be orthogonal when weighted by dz.
                0211 C     i.e. if f_i(z) = mode i, sum_j(f_i(z_j)*f_j(z_j)*dz_j = delta_ij
                0212 C    first mode should also be constant in depth...barotropic
                0213 C    For a matlab code example how to construct the orthonormal modes,
                0214 C     which are ideally the solution of planetary vertical mode equation
                0215 C     using model mean dRho/dz, see
                0216 C     MITgcm/verification/obcs_ctrl/input/gendata.m
                0217 C    This code is compatible with partial cells
                0218 #endif
                0219 
                0220 C----------------------------------------------------------------------
                0221 
                0222 #ifdef ALLOW_GENARR2D_CONTROL
                0223       DO iarr = 1, maxCtrlArr2D
                0224        ncvargrdtmp='c'
                0225 # ifdef ALLOW_SHELFICE
                0226 C      Under iceshelf, use maskSHI for these
                0227        IF ((xx_genarr2d_file(iarr)(1:11).EQ.'xx_shicoeff').OR.
                0228      &     (xx_genarr2d_file(iarr)(1:11).EQ.'xx_shicdrag')) THEN
                0229          ncvargrdtmp='i'
                0230        ENDIF
                0231 # endif
                0232 
                0233 #ifndef ALLOW_OPENAD
                0234        IF (xx_genarr2d_weight(iarr).NE.' ') THEN
                0235 #endif
                0236         ivar = ivar+1
                0237         CALL ctrl_init_ctrlvar (
                0238      I       xx_genarr2d_file(iarr),
                0239      I       ivar, iarr, 1, 1, 1,
                0240      I       sNx, sNy, 1, ncvargrdtmp, 'Arr2D', costfinal_exists,
                0241      I       myThid )
                0242 #ifndef ALLOW_OPENAD
                0243        ENDIF
                0244 #endif
                0245       ENDDO
                0246 #endif /* ALLOW_GENARR2D_CONTROL */
                0247 
                0248 C----------------------------------------------------------------------
                0249 
                0250 #ifdef ALLOW_GENARR3D_CONTROL
                0251       DO iarr = 1, maxCtrlArr3D
                0252        ncvargrdtmp='c'
                0253 #ifndef ALLOW_OPENAD
                0254        IF (xx_genarr3d_weight(iarr).NE.' ') THEN
                0255 #endif
                0256         ivar = ivar+1
                0257         CALL ctrl_init_ctrlvar (
                0258      I       xx_genarr3d_file(iarr),
                0259      I       ivar, iarr, 1, 1, 1,
                0260      I       sNx, sNy, Nr, ncvargrdtmp, 'Arr3D', costfinal_exists,
                0261      I       myThid )
                0262 #ifndef ALLOW_OPENAD
                0263        ENDIF
                0264 #endif
                0265       ENDDO
                0266 #endif /* ALLOW_GENARR3D_CONTROL */
                0267 
                0268 C----------------------------------------------------------------------
                0269 
                0270 #ifdef ALLOW_GENTIM2D_CONTROL
                0271       DO iarr = 1, maxCtrlTim2D
                0272 
                0273 #ifdef ALLOW_CAL
                0274        IF (xx_gentim2d_startdate1(iarr).EQ.0) THEN
                0275           xx_gentim2d_startdate1(iarr)=startdate_1
                0276           xx_gentim2d_startdate2(iarr)=startdate_2
                0277        ENDIF
                0278 #endif
                0279        ncvargrdtmp='c'
                0280 # ifdef ALLOW_SHELFICE
                0281 C      Under iceshelf, use maskSHI for these
                0282        IF (xx_gentim2d_file(iarr)(1:11).EQ.'xx_shifwflx')
                0283      &       ncvargrdtmp='i'
                0284 # endif
                0285        IF (xx_gentim2d_file(iarr)(1:5).EQ.'xx_fu')
                0286      &       ncvargrdtmp='w'
                0287        IF (xx_gentim2d_file(iarr)(1:5).EQ.'xx_fv')
                0288      &       ncvargrdtmp='s'
                0289 
                0290        CALL ctrl_init_rec ( xx_gentim2d_file(iarr),
                0291      I       xx_gentim2d_startdate1(iarr),
                0292      I       xx_gentim2d_startdate2(iarr),
                0293      I       xx_gentim2d_period(iarr),
                0294      I       1,
                0295      O       xx_gentim2d_startdate(1,iarr),
                0296      O       diffrec, startrec, endrec,
                0297      I       myThid )
                0298 
                0299 #ifndef ALLOW_OPENAD
                0300        IF (xx_gentim2d_weight(iarr).NE.' ') THEN
                0301 #endif
                0302         DO k2 = 1, maxCtrlProc
                0303          IF (xx_gentim2d_preproc(k2,iarr).EQ.'replicate')
                0304      &    xx_gentim2d_preproc(k2,iarr)='docycle'
                0305          IF (xx_gentim2d_preproc(k2,iarr).EQ.'doglomean')
                0306      &    xx_gentim2d_glosum(iarr)     = .TRUE.
                0307          IF (xx_gentim2d_preproc(k2,iarr).EQ.'documul')
                0308      &    xx_gentim2d_cumsum(iarr)     = .TRUE.
                0309         ENDDO
                0310 
                0311         diffrecFull=diffrec
                0312         endrecFull=endrec
                0313         DO k2 = 1, maxCtrlProc
                0314           IF (xx_gentim2d_preproc(k2,iarr).EQ.'docycle') THEN
                0315            IF (xx_gentim2d_preproc_i(k2,iarr).NE.0) THEN
                0316             diffrec=min(diffrec,xx_gentim2d_preproc_i(k2,iarr))
                0317             endrec=min(endrec,xx_gentim2d_preproc_i(k2,iarr))
                0318            ENDIF
                0319           ENDIF
                0320         ENDDO
                0321 
                0322         ivar = ivar+1
                0323         ilgen = ILNBLNK( xx_gentim2d_file(iarr) )
                0324         WRITE(fnamegen,'(2a)')
                0325      &       xx_gentim2d_file(iarr)(1:ilgen),'.effective'
                0326         CALL ctrl_init_ctrlvar (
                0327      I       fnamegen,
                0328      I       0, iarr,
                0329      I       diffrecFull, startrec, endrecFull,
                0330      I       sNx, sNy, 1, ncvargrdtmp, 'Tim2D', costfinal_exists,
                0331      I       myThid )
                0332 
                0333         WRITE(fnamegen,'(2a)')
                0334      &       xx_gentim2d_file(iarr)(1:ilgen),'.tmp'
                0335         CALL ctrl_init_ctrlvar (
                0336      I       fnamegen,
                0337      I       0, iarr,
                0338      I       diffrecFull, startrec, endrecFull,
                0339      I       sNx, sNy, 1, ncvargrdtmp, 'Tim2D', costfinal_exists,
                0340      I       myThid )
                0341 
                0342 C     The length of adxx-files needs to be 1:endrec
                0343         CALL ctrl_init_ctrlvar (
                0344      I       xx_gentim2d_file(iarr),
                0345      I       ivar, iarr,
                0346      I       endrec, 1, endrec,
                0347      I       sNx, sNy, 1, ncvargrdtmp, 'Tim2D', costfinal_exists,
                0348      I       myThid )
                0349 
                0350 #ifndef ALLOW_OPENAD
                0351        ENDIF
                0352 #endif
                0353 
                0354       ENDDO
                0355 #endif /* ALLOW_GENTIM2D_CONTROL */
                0356 
                0357 C----------------------------------------------------------------------
                0358 
                0359 C--   short report before calling INIT_WET:
                0360       WRITE(msgBuf,'(2A,I4,A)') 'CTRL_INIT_FIXED: ',
                0361      &     'ivar=', ivar, ' = number of CTRL variables defined'
                0362       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0363      &                    SQUEEZE_RIGHT, myThid )
                0364       WRITE(msgBuf,'(A)') ' '
                0365       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0366      &                    SQUEEZE_RIGHT, myThid )
                0367 
                0368 C----------------------------------------------------------------------
                0369 
                0370       CALL CTRL_INIT_WET( myThid )
                0371 
                0372 #ifdef ALLOW_DIC_CONTROL
                0373       DO i = 1, dic_n_control
                0374        xx_dic(i) = 0. _d 0
                0375       ENDDO
                0376 #endif
                0377 
                0378 C----------------------------------------------------------------------
                0379 
                0380       _BARRIER
                0381 
                0382 C--   Summarize the CTRL package setup.
                0383       _BEGIN_MASTER( myThid )
                0384       CALL CTRL_SUMMARY( myThid )
                0385       _END_MASTER( myThid )
                0386 
                0387       RETURN
                0388       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!