/[MITgcm]/MITgcm/pkg/dic/dic_write_pickup.F
ViewVC logotype

Diff of /MITgcm/pkg/dic/dic_write_pickup.F

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

revision 1.2 by dfer, Fri Apr 4 21:37:06 2008 UTC revision 1.3 by jmc, Sun Apr 6 03:26:01 2008 UTC
# Line 32  C     myThid  :: My Thread Id number Line 32  C     myThid  :: My Thread Id number
32  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
33  C     == Local variables ==  C     == Local variables ==
34        CHARACTER*(MAX_LEN_FNAM) fn        CHARACTER*(MAX_LEN_FNAM) fn
35        INTEGER prec        LOGICAL glf
36  c     CHARACTER*(MAX_LEN_MBUF) msgBuf        INTEGER prec, j, nj
37          INTEGER listDim, nWrFlds
38          PARAMETER( listDim = 2 )
39          CHARACTER*(8) wrFldList(listDim)
40          CHARACTER*(MAX_LEN_MBUF) msgBuf
41  CEOP  CEOP
42    
43        prec = precFloat64  c     IF ( DIC_pickup_write_mdsio ) THEN
44        WRITE(fn,'(A,A)') 'pickup_dic.',suff          prec = precFloat64
45            WRITE(fn,'(A,A)') 'pickup_dic.',suff
46            j = 0
47    
48        CALL WRITE_REC_3D_RL( fn, prec, 1, pH, 1, myIter, myThid )  C     Firstly, write 3-D fields as consecutive records,
49    
50    C-    switch to 2-D fields:
51            nj = -j*Nr
52    
53    C       record number < 0 : a hack not to write meta files now:
54            j = j + 1
55            nj = nj-1
56            CALL WRITE_REC_3D_RL( fn, prec, 1, pH, nj, myIter, myThid )
57            IF (j.LE.listDim) wrFldList(j) = 'DIC_pH2d'
58    
59    C--------------------------
60            nWrFlds = j
61            IF ( nWrFlds.GT.listDim ) THEN
62              WRITE(msgBuf,'(2A,I5,A)') 'DIC_WRITE_PICKUP: ',
63         &     'trying to write ',nWrFlds,' fields'
64              CALL PRINT_ERROR( msgBuf, myThid )
65              WRITE(msgBuf,'(2A,I5,A)') 'DIC_WRITE_PICKUP: ',
66         &     'field-list dimension (listDim=',listDim,') too small'
67              CALL PRINT_ERROR( msgBuf, myThid )
68              STOP 'ABNORMAL END: S/R DIC_WRITE_PICKUP (list-size Pb)'
69            ENDIF
70    
71    #ifdef ALLOW_MDSIO
72    C     uses this specific S/R to write (with more informations) only meta
73    C     files
74            j  = 1
75            nj = ABS(nj)
76            IF ( nWrFlds*Nr .EQ. nj ) THEN
77              j  = Nr
78              nj = nWrFlds
79            ENDIF
80            glf  = globalFiles
81            CALL MDS_WR_METAFILES( fn, prec, glf, .FALSE.,
82         &                         0, 0, j, ' ',
83         &                         nWrFlds, wrFldList,
84         &                         1, myTime,
85         &                         nj, myIter, myThid )
86    #endif /* ALLOW_MDSIO */
87    C--------------------------
88    
89    c     ENDIF /* DIC_pickup_write_mdsio */
90    
91  #endif /*  DIC_BIOTIC  */  #endif /*  DIC_BIOTIC  */
92  #endif /*  ALLOW_DIC  */  #endif /*  ALLOW_DIC  */
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22