pkg/ctrl/ctrl_init_ctrlvar.F

7bfe6112e8 Jean*0001 #include "CTRL_OPTIONS.h"
57c22ecc45 Jean*0002 #include "AD_CONFIG.h"
4c6316f049 Patr*0003
5cf4364659 Mart*0004 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0005 CBOP
                0006 C     !ROUTINE: CTRL_INIT_CTRLVAR
                0007
                0008 C     !INTERFACE: ======================================================
4d72283393 Mart*0009       SUBROUTINE CTRL_INIT_CTRLVAR(
5cf4364659 Mart*0010      I       xx_fname,
                0011      I       ivar,
                0012      I       varIndex,
                0013      I       varRecs,
                0014      I       varStartRec,
                0015      I       varEndRec,
                0016      I       varNxMax,
                0017      I       varNyMax,
                0018      I       varNrMax,
                0019      I       varGrid,
                0020      I       varType,
                0021      I       costfinal_exists,
                0022      I       myThid )
                0023
                0024 C     !DESCRIPTION:
                0025 C
                0026 C     Generic routine to initialize control variable xx_fname and store
                0027 C     specifier in global arrays for later reference.
                0028 C
                0029 C     Called from S/R CTRL_INIT_FIXED, this is where the crucial
                0030 C     information for a given control variable is set.
                0031 C
                0032 C     started: heimbach@mit.edu 28-Oct-2003
                0033
                0034 C     !USES: ===========================================================
                0035       IMPLICIT NONE
                0036 C     == Global variables ===
4c6316f049 Patr*0037 #include "EEPARAMS.h"
                0038 #include "SIZE.h"
                0039 #include "PARAMS.h"
                0040 #include "GRID.h"
5cf4364659 Mart*0041 #include "CTRL_SIZE.h"
4d72283393 Mart*0042 #include "CTRL.h"
65754df434 Mart*0043 #include "OPTIMCYCLE.h"
4c6316f049 Patr*0044
5cf4364659 Mart*0045 C     !INPUT PARAMETERS: ===============================================
                0046 C     ivar   :: if > 0, index in ctrl-var list to store ctrl-var settings
                0047 C               if == 0, skip storing of ctrl-var settings
                0048 C     myThid ::  my Thread Id number
                0049       CHARACTER*(MAX_LEN_FNAM) xx_fname
                0050       INTEGER ivar
                0051       INTEGER varIndex
                0052       INTEGER varRecs
                0053       INTEGER varStartRec
                0054       INTEGER varEndRec
                0055       INTEGER varNxMax
                0056       INTEGER varNyMax
                0057       INTEGER varNrMax
                0058       CHARACTER*(1) varGrid
                0059       CHARACTER*(5) varType
                0060       LOGICAL costfinal_exists
                0061       INTEGER myThid
                0062
                0063 C     !OUTPUT PARAMETERS: ==============================================
                0064 C     none
                0065
                0066 C     === Functions ====
                0067       INTEGER  ILNBLNK
                0068       EXTERNAL ILNBLNK
                0069
                0070 C     !LOCAL VARIABLES:
                0071       INTEGER il,ilDir
                0072       CHARACTER*(MAX_LEN_FNAM) fname(3), gfname
                0073       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0074       LOGICAL g_exst
                0075 CEOP
4c6316f049 Patr*0076
4d72283393 Mart*0077 c     _BEGIN_MASTER( myThid )
5cf4364659 Mart*0078 C     First check if the control variable index is within the allowed range.
                0079       IF ( ivar .LT. 0 .OR. ivar .GT. maxcvars ) THEN
                0080         WRITE(msgBuf,'(A,I4,A)') 'S/R CTRL_INIT_CTRLVAR: ivar = ',
                0081      &       ivar, ' is not valid.'
                0082         CALL PRINT_ERROR( msgBuf, myThid )
                0083         WRITE(msgBuf,'(2A,I4)')
                0084      &       'S/R CTRL_INIT_CTRLVAR: allowed values: ',
                0085      &       '0 < ivar <= maxcvars = ', maxcvars
                0086         CALL PRINT_ERROR( msgBuf, myThid )
                0087         STOP 'ABNORMAL END: S/R CTRL_INIT_CTRLVAR'
                0088       ELSEIF ( ivar .NE. 0 ) THEN
                0089 C     Save this ctrl-var setting in ctrl-var list:
                0090         ncvarindex(ivar)    = varIndex
                0091         ncvarrecs (ivar)    = varRecs
                0092         ncvarrecstart(ivar) = varStartRec
                0093         ncvarrecsend(ivar)  = varEndRec
                0094         ncvarxmax (ivar)    = varNxMax
                0095         ncvarymax (ivar)    = varNyMax
                0096         ncvarnrmax(ivar)    = varNrMax
                0097         ncvargrd  (ivar)    = varGrid
                0098         ncvartype (ivar)    = varType
                0099         ncvarfname(ivar)    = xx_fname
                0100       ENDIF
4d72283393 Mart*0101 c     _END_MASTER( myThid )
4c6316f049 Patr*0102
352a245c08 Patr*0103 cph add following flag to make pack/unpack only less error-prone
                0104 #ifndef CTRL_DO_PACK_UNPACK_ONLY
                0105
5cf4364659 Mart*0106       ilDir = ILNBLNK( ctrlDir )
                0107       CALL CTRL_SET_FNAME( ctrlDir(1:ilDir)//xx_fname, fname, myThid )
2a878d427b Jean*0108
c8767af0b6 Timo*0109 C     In an adjoint run, adxx_ files should always be initialized with zeros
                0110 C     For TLM, all zeros means zero sensitivity, so check
                0111 C     for existing perturbation file g_xx_, otherwise
                0112 C     initialize to zero and warn user
5cf4364659 Mart*0113       IF (yadprefix.EQ.'g_') THEN
c8767af0b6 Timo*0114         il = ILNBLNK(fname(2))
5cf4364659 Mart*0115         WRITE(gfname(1:il+5),'(2a)') fname(2)(1:il),'.data'
                0116         INQUIRE(file=gfname,exist=g_exst)
                0117         IF (.NOT. g_exst) THEN
                0118             WRITE(msgBuf,'(3A)')'** WARNING ** CTRL_INIT_CTRLVAR: ',
c8767af0b6 Timo*0119      &          'could not find ', gfname(1:il+5)
                0120             CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0121      &                          SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0122             WRITE(msgBuf,'(3A)')'** WARNING ** ',
c8767af0b6 Timo*0123      &          'for TLM perturbation ',
                0124      &          'so will initialize this file with all zeros'
                0125             CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0126      &                          SQUEEZE_RIGHT, myThid )
5cf4364659 Mart*0127         ENDIF
                0128       ELSE
c8767af0b6 Timo*0129         g_exst = .FALSE.
5cf4364659 Mart*0130       ENDIF
c8767af0b6 Timo*0131
5cf4364659 Mart*0132       IF ( .NOT. costfinal_exists ) THEN
b8c0a52acd Patr*0133
5cf4364659 Mart*0134         IF ( varType .EQ. 'Arr3D' ) THEN
270c61eb81 Patr*0135 #if (defined (ALLOW_ADJOINT_RUN) || defined (ALLOW_TANGENTLINEAR_RUN))
5cf4364659 Mart*0136           IF ( yadprefix.EQ.'ad' .OR. .NOT.(g_exst .OR. doAdmTlm) )
                0137      &      CALL CTRL_SET_GLOBFLD_XYZ( fname(2),
                0138      &                                 varRecs, ctrlprec, myThid )
51c7f9a83e Gael*0139 #endif
5cf4364659 Mart*0140           IF ( ( doInitXX .AND. optimcycle.EQ.0 ) .OR. doAdmTlm )
                0141      &      CALL CTRL_SET_GLOBFLD_XYZ( fname(1),
                0142      &                                 varRecs, ctrlprec, myThid )
                0143         ELSEIF ( varType(4:5) .EQ. '2D' ) THEN
270c61eb81 Patr*0144 #if (defined (ALLOW_ADJOINT_RUN) || defined (ALLOW_TANGENTLINEAR_RUN))
5cf4364659 Mart*0145           IF ( yadprefix.EQ.'ad' .OR. .NOT.(g_exst .OR. doAdmTlm) )
                0146      &      CALL CTRL_SET_GLOBFLD_XY( fname(2),
                0147      &                                 varRecs, ctrlprec, myThid )
51c7f9a83e Gael*0148 #endif
5cf4364659 Mart*0149           IF ( ( doInitXX .AND. optimcycle.EQ.0 ) .OR. doAdmTlm )
                0150      &      CALL CTRL_SET_GLOBFLD_XY( fname(1),
                0151      &                                 varRecs, ctrlprec, myThid )
                0152         ELSEIF ( varType .EQ. 'SecXZ' ) THEN
270c61eb81 Patr*0153 #if (defined (ALLOW_ADJOINT_RUN) || defined (ALLOW_TANGENTLINEAR_RUN))
5cf4364659 Mart*0154           IF ( yadprefix.EQ.'ad' .OR. .NOT.(g_exst .OR. doAdmTlm) )
                0155      &      CALL CTRL_SET_GLOBFLD_XZ( fname(2),
                0156      &                                 varRecs, ctrlprec, myThid )
51c7f9a83e Gael*0157 #endif
5cf4364659 Mart*0158           IF ( ( doInitXX .AND. optimcycle.EQ.0 ) .OR. doAdmTlm )
                0159      &      CALL CTRL_SET_GLOBFLD_XZ( fname(1),
                0160      &                                 varRecs, ctrlprec, myThid )
                0161         ELSEIF ( varType .EQ. 'SecYZ' ) THEN
270c61eb81 Patr*0162 #if (defined (ALLOW_ADJOINT_RUN) || defined (ALLOW_TANGENTLINEAR_RUN))
5cf4364659 Mart*0163           IF ( yadprefix.EQ.'ad' .OR. .NOT.(g_exst .OR. doAdmTlm) )
                0164      &      CALL CTRL_SET_GLOBFLD_YZ( fname(2),
                0165      &                                 varRecs, ctrlprec, myThid )
51c7f9a83e Gael*0166 #endif
5cf4364659 Mart*0167           IF ( ( doInitXX .AND. optimcycle.EQ.0 ) .OR. doAdmTlm )
                0168      &      CALL CTRL_SET_GLOBFLD_YZ( fname(1),
                0169      &                                 varRecs, ctrlprec, myThid )
                0170         ELSE
                0171           STOP 'CTRL_INIT_CTRLVAR: varType option not implemented'
                0172         ENDIF
011115f9ba Patr*0173
b8c0a52acd Patr*0174       ENDIF
4c6316f049 Patr*0175
352a245c08 Patr*0176 #endif /* CTRL_DO_PACK_UNPACK_ONLY */
                0177
4d72283393 Mart*0178       RETURN
                0179       END