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
7bfe6112e8 Jean*0001 #include "CTRL_OPTIONS.h"
57c22ecc45 Jean*0002 #include "AD_CONFIG.h"
4c6316f049 Patr*0003
5cf4364659 Mart*0004
0005
0006
0007
0008
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
0025
0026
0027
0028
0029
0030
0031
0032
0033
0034
0035 IMPLICIT NONE
0036
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
0046
0047
0048
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
0064
0065
0066
0067 INTEGER ILNBLNK
0068 EXTERNAL ILNBLNK
0069
0070
0071 INTEGER il,ilDir
0072 CHARACTER*(MAX_LEN_FNAM) fname(3), gfname
0073 CHARACTER*(MAX_LEN_MBUF) msgBuf
0074 LOGICAL g_exst
0075
4c6316f049 Patr*0076
4d72283393 Mart*0077
5cf4364659 Mart*0078
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
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
4c6316f049 Patr*0102
352a245c08 Patr*0103
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
0110
0111
0112
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