pkg/ctrl/ctrl_convert_header.F

5cf4364659 Mart*0001 #include "CTRL_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: CTRL_CONVERT_HEADER
                0005 C     !INTERFACE:
                0006       SUBROUTINE CTRL_CONVERT_HEADER(
                0007      I              maxLocal, numVar, errMsgUnit,
                0008      U              varIndex, varRecs,
                0009      U              varNxMax, varNyMax, varNrMax,
                0010      U              varGrid, varType,
                0011      I              myThid )
                0012
                0013 C     !DESCRIPTION: \bv
                0014 C     *=================================================================
                0015 C     | SUBROUTINE CTRL_CONVERT_HEADER
                0016 C     | o Convert header of old ctrl-pack file to current one
                0017 C     *=================================================================
                0018 C     \ev
                0019
                0020 C     !USES:
                0021       IMPLICIT NONE
                0022
                0023 C     == Global variables ==
                0024 #include "EEPARAMS.h"
                0025 c#include "SIZE.h"
                0026 #include "CTRL_SIZE.h"
                0027 c#include "PARAMS.h"
                0028
                0029 C     !INPUT/OUTPUT PARAMETERS:
                0030 C     myThid     :: my Thread Id number
                0031       INTEGER maxLocal, numVar, errMsgUnit
                0032       INTEGER varIndex(maxLocal)
                0033       INTEGER varRecs (maxLocal)
                0034       INTEGER varNxMax(maxLocal)
                0035       INTEGER varNyMax(maxLocal)
                0036       INTEGER varNrMax(maxLocal)
                0037       CHARACTER*(1) varGrid(maxLocal)
                0038       CHARACTER*(5) varType(maxLocal)
                0039       INTEGER myThid
                0040
                0041 #ifdef READ_OLD_CTRL_PACK_FILE
                0042 C     !LOCAL VARIABLES:
                0043 C     msgBuf     :: Informational/error message buffer
                0044       INTEGER i, j, k
                0045       INTEGER iarr, jarr
                0046       CHARACTER*(5) allType(5)
                0047       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0048       INTEGER errCount
                0049 CEOP
                0050
                0051 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0052
                0053       errCount = 0
                0054       allType(1) = 'SecXZ'
                0055       allType(2) = 'SecYZ'
                0056       allType(3) = 'Arr2D'
                0057       allType(4) = 'Arr3D'
                0058       allType(5) = 'Tim2D'
                0059
                0060       j = 0
                0061       DO i=1,maxLocal
                0062         iarr = varIndex(i)
                0063         IF ( iarr.NE. -1 ) THEN
                0064           IF ( ( iarr.GE.111 .AND. iarr.LE.114 ).OR.
                0065      &         ( iarr.GE.201 .AND. iarr.LE.200+maxCtrlArr2D ) .OR.
                0066      &         ( iarr.GE.301 .AND. iarr.LE.300+maxCtrlArr3D ) .OR.
                0067      &         ( iarr.GE.401 .AND. iarr.LE.400+maxCtrlTim2D ) ) THEN
                0068             j = j + 1
                0069             k = ( iarr - 1 ) / 100 + 1
                0070             IF ( k.LE.2 ) THEN
                0071               jarr = iarr - 110
                0072               IF ( iarr.LE.112 ) THEN
                0073                 k = 1
                0074               ELSE
                0075 C             switch 3 <-> 4 ( obE was 114 now #3 ; obW was 113 now #4 )
                0076                 jarr = 7 - jarr
                0077               ENDIF
                0078             ELSE
                0079               jarr = MOD( iarr, 100 )
                0080             ENDIF
                0081 C- copy i -> j :
                0082             varIndex(j) = jarr
                0083             varRecs(j)  = varRecs(i)
                0084             varNxMax(j) = varNxMax(i)
                0085             varNyMax(j) = varNyMax(i)
                0086             varNrMax(j) = varNrMax(i)
                0087             varGrid(j)  = varGrid(i)
                0088 c           varType(j)  = varType(i)
                0089             varType(j)  = allType(k)
                0090           ELSE
                0091             WRITE(msgBuf,'(A,2(A,I4))') '*** ERROR *** ',
                0092      &      'CTRL_CONVERT_HEADER: invalid varIndex(i=', i, ')=', iarr
                0093             WRITE(errMsgUnit,'(A)') msgBuf
                0094 c           CALL PRINT_ERROR( msgBuf, myThid )
                0095             errCount = errCount + 1
                0096           ENDIF
                0097         ENDIF
                0098       ENDDO
                0099
                0100       IF ( errCount.GE.1 ) THEN
                0101         WRITE(msgBuf,'(2A,I3,A)') '*** ERROR *** ',
                0102      &      'CTRL_CONVERT_HEADER: detected', errCount,' fatal error(s)'
                0103         WRITE(errMsgUnit,'(A)') msgBuf
                0104 c       CALL PRINT_ERROR( msgBuf, myThid )
                0105 c       CALL ALL_PROC_DIE( 0 )
                0106         STOP 'ABNORMAL END: S/R CTRL_CONVERT_HEADER'
                0107       ENDIF
                0108       IF ( j .NE. numVar ) THEN
                0109         WRITE(msgBuf,'(2A,I4)') '*** ERROR *** ',
                0110      &      'CTRL_CONVERT_HEADER: number of ctrl-vars counted =', j
                0111         WRITE(errMsgUnit,'(A)') msgBuf
                0112         WRITE(msgBuf,'(2A,I4)') '*** ERROR *** ',
                0113      &      'CTRL_CONVERT_HEADER: inconsitent with numVar=', numVar
                0114         WRITE(errMsgUnit,'(A)') msgBuf
                0115         STOP 'ABNORMAL END: S/R CTRL_CONVERT_HEADER'
                0116       ENDIF
                0117
                0118 #endif /* READ_OLD_CTRL_PACK_FILE */
                0119       RETURN
                0120       END