pkg/diagnostics/diagnostics_read_pickup.F

987bbc7d38 Ed H*0001 #include "DIAG_OPTIONS.h"
                0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
e129400813 Jean*0005 C     !ROUTINE: DIAGNOSTICS_READ_PICKUP
987bbc7d38 Ed H*0006 C     !INTERFACE:
                0007       SUBROUTINE DIAGNOSTICS_READ_PICKUP(
                0008      I     myThid )
                0009
                0010 C     !DESCRIPTION:
                0011 C     Reads previously saved state for the diagnostics package.
                0012
                0013 C     !USES:
                0014       IMPLICIT NONE
                0015
                0016 C     == Global variables ===
                0017 #include "SIZE.h"
                0018 #include "EEPARAMS.h"
                0019 #include "PARAMS.h"
                0020 #include "DIAGNOSTICS_SIZE.h"
                0021 #include "DIAGNOSTICS.h"
                0022
                0023 C     !INPUT/OUTPUT PARAMETERS:
                0024 C     myThid  :: Number of this instance
                0025       INTEGER myThid
                0026
                0027 #ifdef DIAGNOSTICS_HAS_PICKUP
                0028
                0029 C     !LOCAL VARIABLES:
                0030 C     fn      :: character buffer for creating filename
                0031 C     prec    :: precision of pickup files
                0032 c     INTEGER prec, iChar, lChar, k
9f24b0ff20 Jean*0033       INTEGER bi,bj
                0034       INTEGER prec, sn
987bbc7d38 Ed H*0035       CHARACTER*(MAX_LEN_FNAM) fn
                0036
                0037       INTEGER  ILNBLNK
                0038       EXTERNAL ILNBLNK
                0039
b38beaf3c1 Jean*0040       INTEGER dUnit, ndId, n, m
987bbc7d38 Ed H*0041
                0042 #ifdef ALLOW_MNC
9f24b0ff20 Jean*0043       INTEGER i, ii
987bbc7d38 Ed H*0044       CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
                0045       INTEGER CW_DIMS, NLEN
                0046       PARAMETER ( CW_DIMS = 10 )
                0047       PARAMETER ( NLEN    = 80 )
                0048       INTEGER dim(CW_DIMS), ib(CW_DIMS), ie(CW_DIMS)
                0049       CHARACTER*(NLEN) dn(CW_DIMS)
                0050       CHARACTER*(NLEN) d_cw_name
                0051       CHARACTER*(NLEN) dn_blnk
                0052 #endif /*  ALLOW_MNC  */
                0053
                0054 C     Add pickup capability
                0055       IF (diag_pickup_read) THEN
                0056
                0057 #ifdef ALLOW_MNC
                0058         IF (diag_pickup_read_mnc) THEN
                0059           DO i = 1,NLEN
                0060             dn_blnk(i:i) = ' '
                0061           ENDDO
                0062           DO i = 1,MAX_LEN_FNAM
                0063             diag_mnc_bn(i:i) = ' '
                0064           ENDDO
                0065           WRITE(diag_mnc_bn,'(A)') 'pickup_diagnostics'
                0066
                0067 C         Update the record dimension by writing the iteration number
                0068           CALL MNC_FILE_CLOSE_ALL_MATCHING(diag_mnc_bn, myThid)
                0069           CALL MNC_CW_SET_UDIM(diag_mnc_bn, 1, myThid)
e129400813 Jean*0070
987bbc7d38 Ed H*0071 C         Read the qdiag() array
                0072           d_cw_name(1:NLEN) = dn_blnk(1:NLEN)
                0073           DO ii = 1,CW_DIMS
                0074             dn(ii)(1:NLEN) = dn_blnk(1:NLEN)
                0075           ENDDO
                0076           d_cw_name(1:10) = 'diag_state'
                0077           dn(1)(1:3) = 'Xp1'
                0078           dim(1)     = sNx + 2*OLx
                0079           ib(1)      = OLx + 1
                0080           ie(1)      = OLx + sNx + 1
                0081           dn(2)(1:3) = 'Yp1'
                0082           dim(2)     = sNy + 2*OLy
                0083           ib(2)      = OLy + 1
                0084           ie(2)      = OLy + sNy + 1
                0085           dn(3)(1:2) = 'Zd'
e129400813 Jean*0086           dim(3)     = numDiags
987bbc7d38 Ed H*0087           ib(3)      = 1
e129400813 Jean*0088           ie(3)      = numDiags
987bbc7d38 Ed H*0089           dn(4)(1:1) = 'T'
                0090           dim(4)     = -1
                0091           ib(4)      = 1
                0092           ie(4)      = 1
e129400813 Jean*0093           CALL MNC_CW_ADD_GNAME(d_cw_name, 4,
987bbc7d38 Ed H*0094      &         dim, dn, ib, ie, myThid)
e129400813 Jean*0095           CALL MNC_CW_ADD_VNAME(d_cw_name, d_cw_name,
987bbc7d38 Ed H*0096      &         4,5, myThid)
                0097           CALL MNC_CW_RL_R('D',diag_mnc_bn,0,0,
                0098      &         d_cw_name, qdiag, myThid)
                0099           CALL MNC_CW_DEL_VNAME(d_cw_name, myThid)
                0100           CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)
e129400813 Jean*0101
987bbc7d38 Ed H*0102 C         Read the ndiag() array
                0103           d_cw_name(1:NLEN) = dn_blnk(1:NLEN)
                0104           DO ii = 1,CW_DIMS
                0105             dn(ii)(1:NLEN) = dn_blnk(1:NLEN)
                0106           ENDDO
                0107           d_cw_name(1:10) = 'diag_count'
                0108           dn(1)(1:2) = 'Nd'
e129400813 Jean*0109           dim(1)     = numDiags
987bbc7d38 Ed H*0110           ib(1)      = 1
e129400813 Jean*0111           ie(1)      = numDiags
987bbc7d38 Ed H*0112           dn(2)(1:1) = 'T'
                0113           dim(2)     = -1
                0114           ib(2)      = 1
                0115           ie(2)      = 1
e129400813 Jean*0116           CALL MNC_CW_ADD_GNAME(d_cw_name, 2,
987bbc7d38 Ed H*0117      &         dim, dn, ib, ie, myThid)
e129400813 Jean*0118           CALL MNC_CW_ADD_VNAME(d_cw_name, d_cw_name,
987bbc7d38 Ed H*0119      &         4,5, myThid)
                0120           CALL MNC_CW_ADD_VATTR_TEXT(d_cw_name,'description',
                0121      &         'diagnostics state',myThid)
e8b99b7223 Jean*0122 C- jmc: get warnings when I compile this S/R because something is not right
e129400813 Jean*0123 C       in the type or one or more arguments. commented out for now
e8b99b7223 Jean*0124 c         CALL MNC_CW_RL_R('I',diag_mnc_bn,0,0,
                0125 c    &         d_cw_name, ndiag, myThid)
987bbc7d38 Ed H*0126           CALL MNC_CW_DEL_VNAME(d_cw_name, myThid)
                0127           CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)
                0128
                0129         ENDIF
                0130 #endif /* ALLOW_MNC */
e129400813 Jean*0131
987bbc7d38 Ed H*0132         IF (diag_pickup_read_mdsio) THEN
                0133
                0134 C         Read qdiag()
9f24b0ff20 Jean*0135           prec = precFloat64
                0136           WRITE(fn,'(A,I10.10)') 'pickup_qdiag.', nIter0
                0137           CALL READ_REC_3D_RL( fn, prec,
                0138      &                         numDiags, qdiag, nIter0, myThid )
987bbc7d38 Ed H*0139
                0140 C         Read ndiag()
9f24b0ff20 Jean*0141           _BARRIER
                0142           _BEGIN_MASTER(myThid)
                0143
                0144 C--    jmc: should really write 1 file per tile
987bbc7d38 Ed H*0145           WRITE(fn,'(A,I10.10)') 'pickup_ndiag.', nIter0
9f24b0ff20 Jean*0146           CALL MDSFINDUNIT( dUnit, myThid )
987bbc7d38 Ed H*0147           OPEN( dUnit, file=fn )
e1f996bd9e Jean*0148           DO n = 1,nlists
cd2f74c826 Ed H*0149             DO m = 1,nfields(n)
b38beaf3c1 Jean*0150               ndId = ABS(jdiag(m,n))
                0151               READ(dUnit,'(I10)') ndiag(ndId,1,1)
cd2f74c826 Ed H*0152             ENDDO
987bbc7d38 Ed H*0153           ENDDO
                0154           CLOSE( dUnit )
9f24b0ff20 Jean*0155 C-        Need to fill-in ndiag for other tiles
                0156           DO bj=1,nSy
                0157            DO bi=1,nSx
                0158             DO n=1,ndiagt
                0159              ndiag(n,bi,bj) = ndiag(n,1,1)
                0160             ENDDO
                0161            ENDDO
                0162           ENDDO
987bbc7d38 Ed H*0163           _END_MASTER(myThid)
9f24b0ff20 Jean*0164           _BARRIER
987bbc7d38 Ed H*0165         ENDIF
                0166
                0167       ENDIF
                0168
                0169 #endif /* DIAGNOSTICS_HAS_PICKUP */
                0170
                0171       RETURN
                0172       END