/[MITgcm]/MITgcm/pkg/rw/read_mflds.F
ViewVC logotype

Diff of /MITgcm/pkg/rw/read_mflds.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.3 by jmc, Tue Nov 13 19:41:05 2007 UTC revision 1.4 by jmc, Sun Nov 25 21:34:01 2007 UTC
# Line 8  C--   Contents Line 8  C--   Contents
8  C--   o READ_MFLDS_INIT  C--   o READ_MFLDS_INIT
9  C--   o READ_MFLDS_SET  C--   o READ_MFLDS_SET
10  C--   o READ_MFLDS_3D_RL  C--   o READ_MFLDS_3D_RL
11    C--   o READ_MFLDS_LEV_RL
12  C--   o READ_MFLDS_CHECK  C--   o READ_MFLDS_CHECK
13    
14  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
# Line 354  C--   read in array "field" Line 355  C--   read in array "field"
355    
356  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
357  CBOP  CBOP
358    C     !ROUTINE: READ_MFLDS_LEV_RL
359    C     !INTERFACE:
360          SUBROUTINE READ_MFLDS_LEV_RL(
361         I                fldName,
362         O                field,
363         U                nj,
364         I                fPrec, kSiz, kLo, kHi, myIter, myThid )
365    
366    C     !DESCRIPTION:
367    C     Read, from a Multi-Fields binary file, field "fldName", a set of
368    C     consecutive levels (from kLo to kHi) into 3D array "field" (size: kSiz)
369    C     record Nb "nj" is search through the field-list (from meta-file) which
370    C     has been set before (calling READ_MFLDS_SET).
371    C     In case nFlds is <=0 , by-pass the search and directly read record number "nj"
372    
373    C     !USES:
374          IMPLICIT NONE
375    #include "SIZE.h"
376    #include "EEPARAMS.h"
377    #include "PARAMS.h"
378    #include "RW_MFLDS.h"
379    
380    C     !INPUT/OUTPUT PARAMETERS:
381    C     fldName :: Name of the field to read
382    C     field   :: Output array to read in
383    C     nj (in) :: number of the record (in file) just before the one to read
384    C     nj (out):: number of the record (from current file) which was read in
385    C     fPrec   :: File precision (number of bits per word, = 32 or 64)
386    C     kSiz    :: size of third dimension of array "field" to read-in
387    C     kLo     :: 1rst vertical level (of array "field") to read-in
388    C     kHi     :: last vertical level (of array "field") to read-in
389    C     myIter  :: Iteration number
390    C     myThid  :: My Thread Id number
391          CHARACTER*(8) fldName
392          _RL     field(*)
393          INTEGER nj
394          INTEGER fPrec
395          INTEGER kSiz, kLo, kHi
396          INTEGER myIter
397          INTEGER myThid
398    CEOP
399    
400    C     !FUNCTIONS
401          INTEGER  ILNBLNK
402          EXTERNAL ILNBLNK
403    
404    C     !LOCAL VARIABLES:
405          INTEGER j, iL, ioUnit
406          LOGICAL useCurrentDir
407          CHARACTER*(2) fType
408          CHARACTER*(MAX_LEN_FNAM) fName
409          CHARACTER*(MAX_LEN_MBUF) msgBuf
410    
411    C-----
412    
413          iL = ILNBLNK(mFldsFile)
414    #ifdef RW_SAFE_MFLDS
415          IF ( iL.EQ.0 ) THEN
416            WRITE(msgBuf,'(2A,I4)') 'READ_MFLDS_LEV_RL: ',
417         &    'empty MFLDS file-name'
418            CALL PRINT_ERROR( msgBuf, myThid )
419            STOP 'ABNORMAL END: S/R READ_MFLDS_LEV_RL (fileName)'
420          ENDIF
421    #endif /* RW_SAFE_MFLDS */
422    
423          ioUnit = standardMessageUnit
424          IF ( nFlds.GE.1 ) THEN
425    C--   Search for "fldName" in list of field-names:
426            nj = 0
427            DO j=1,nFlds
428              IF ( fldName.EQ.fldList(j) .AND. nj.EQ.0 ) nj = j
429            ENDDO
430            IF ( nj.EQ.0 ) THEN
431    C-      record unsuccessful search:
432              _BEGIN_MASTER( myThid )
433              nMissFld = nMissFld + 1
434              j = MIN(nMissFld,sizFldList)
435              fldMiss(j) = fldName
436              _END_MASTER( myThid )
437              IF ( debugLevel.GE.debLevA ) THEN
438                iL = ILNBLNK(mFldsFile)
439                iL = MIN(iL,MAX_LEN_MBUF-54-20)
440                WRITE(msgBuf,'(5A)') 'READ_MFLDS_LEV_RL: ',
441         &       'field: "',fldName,'" missing in file: ',mFldsFile(1:iL)
442                CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
443              ENDIF
444            ELSE
445    C-      convert from field Number to record number (if mix of 3D & 2D flds)
446              j = nj
447              IF ( nj.GT.nFl3D ) nj = nj + nFl3D*(thirdDim-1)
448              IF ( debugLevel.GE.debLevA ) THEN
449                WRITE(msgBuf,'(3A,2(A,I4))') 'READ_MFLDS_LEV_RL: ',
450         &       'read field: "',fldName,'", #',j,' in fldList, rec=',nj
451                CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
452              ENDIF
453            ENDIF
454          ELSEIF ( nj.GE.0 ) THEN
455    C-      increment record number
456            nj = nj + 1
457            IF ( debugLevel.GE.debLevA ) THEN
458                WRITE(msgBuf,'(3A,2(A,I4))') 'READ_MFLDS_LEV_RL: ',
459         &       'no fldList, try to read field "',fldName, '", rec=',nj
460                CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
461            ENDIF
462          ENDIF
463    
464          IF ( nj.GE.1 ) THEN
465    C--   read in array "field"
466            fName = mFldsFile
467            useCurrentDir = .FALSE.
468            fType = 'RL'
469    #ifdef ALLOW_MDSIO
470            CALL MDS_READ_FIELD(
471         I                       fName, fPrec, useCurrentDir,
472         I                       fType, kSiz, kLo, kHi,
473         O                       field,
474         I                       nj, myThid )
475    
476    #endif
477          ENDIF
478    
479          RETURN
480          END
481    
482    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
483    CBOP
484  C     !ROUTINE: READ_MFLDS_CHECK  C     !ROUTINE: READ_MFLDS_CHECK
485  C     !INTERFACE:  C     !INTERFACE:
486        SUBROUTINE READ_MFLDS_CHECK(        SUBROUTINE READ_MFLDS_CHECK(
# Line 409  C----- Line 536  C-----
536        ENDIF        ENDIF
537  #endif /* RW_SAFE_MFLDS */  #endif /* RW_SAFE_MFLDS */
538    
539    
540  C--   Initialise output arguments  C--   Initialise output arguments
541        DO j=1,nbErr        DO j=1,nbErr
542         errList(j) = ' '         errList(j) = ' '
543        ENDDO        ENDDO
544    
545    C--   every one waits for master thread to finish the update of
546    C       missing fields number & list.
547          _BARRIER
548    
549        IF ( nMissFld.GE.1 ) THEN        IF ( nMissFld.GE.1 ) THEN
550  C--   Attempted to read some fields that were not in the current MFLDS file  C--   Attempted to read some fields that were not in the current MFLDS file
551  C     => report by printing Error Msg:  C     => report by printing Error Msg:
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22