--- MITgcm/pkg/mnc/mnc_cwrapper.F 2004/02/04 05:45:09 1.4 +++ MITgcm/pkg/mnc/mnc_cwrapper.F 2004/03/20 23:51:23 1.10 @@ -1,4 +1,4 @@ -C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/mnc/mnc_cwrapper.F,v 1.4 2004/02/04 05:45:09 edhill Exp $ +C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/mnc/mnc_cwrapper.F,v 1.10 2004/03/20 23:51:23 edhill Exp $ C $Name: $ #include "MNC_OPTIONS.h" @@ -6,12 +6,12 @@ C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| SUBROUTINE MNC_CW_ADD_GNAME( - I myThid, I name, I ndim, I dlens, I dnames, - I inds_beg, inds_end ) + I inds_beg, inds_end, + I myThid ) implicit none #include "mnc_common.h" @@ -34,15 +34,15 @@ nnl = ILNBLNK(name) C Check that this name is not already defined - CALL MNC_GET_IND(myThid, MNC_MAX_ID, name, mnc_cw_gname, indg) + CALL MNC_GET_IND(MNC_MAX_ID, name, mnc_cw_gname, indg, myThid) IF (indg .GT. 0) THEN write(msgbuf,'(3a)') 'MNC_CW_ADD_GNAME ERROR: ''', name, & ''' is already defined' CALL print_error(msgbuf, mythid) stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME' ENDIF - CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_cw_gname, - & indg) + CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_gname, + & indg, myThid) mnc_cw_gname(indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR) mnc_cw_gname(indg)(1:(nnl-nnf+1)) = name(nnf:nnl) @@ -63,63 +63,111 @@ C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| - SUBROUTINE MNC_CW_DUMP() + SUBROUTINE MNC_CW_DUMP( myThid ) implicit none #include "mnc_common.h" +#include "SIZE.h" +#include "EEPARAMS.h" +#include "PARAMS.h" + +C Arguments + integer myThid C Local Variables integer i,j, ntot + integer NBLNK + parameter ( NBLNK = 150 ) + character s1*(NBLNK), blnk*(NBLNK) + - write(*,'(a)') 'The currently defined Grid Types are:' + _BEGIN_MASTER(myThid) + + DO i = 1,NBLNK + blnk(i:i) = ' ' + ENDDO + + s1(1:NBLNK) = blnk(1:NBLNK) + write(s1,'(a5,a)') 'MNC: ', + & 'The currently defined Grid Types are:' + CALL PRINT_MESSAGE( + & s1, standardMessageUnit, SQUEEZE_RIGHT, mythid) ntot = 0 DO j = 1,MNC_MAX_ID IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR) & .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN ntot = ntot + 1 - write(*,'(2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a4)') + s1(1:NBLNK) = blnk(1:NBLNK) + write(s1,'(a5,2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a4)') + & 'MNC: ', & j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j), & ' : ', (mnc_cw_dims(i,j), i=1,5), & ' | ', (mnc_cw_is(i,j), i=1,5), & ' | ', (mnc_cw_ie(i,j), i=1,5), & ' | ', (mnc_cw_dn(i,j)(1:4), i=1,5) - + CALL PRINT_MESSAGE( + & s1, standardMessageUnit, SQUEEZE_RIGHT, mythid) + ENDIF ENDDO - - write(*,'(a)') 'The currently defined Variable Types are:' + + s1(1:NBLNK) = blnk(1:NBLNK) + write(s1,'(a5,a)') 'MNC: ', + & 'The currently defined Variable Types are:' + CALL PRINT_MESSAGE( + & s1, standardMessageUnit, SQUEEZE_RIGHT, mythid) ntot = 0 DO j = 1,MNC_MAX_ID IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR) & .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN - + ntot = ntot + 1 - write(*,'(2i5,a3,a25,a3,i4)') j, ntot, ' : ', - & mnc_cw_vname(j)(1:20), ' : ', mnc_cw_vgind(j) - + s1(1:NBLNK) = blnk(1:NBLNK) + write(s1,'(a5,2i5,a3,a25,a3,i4)') 'MNC: ', + & j, ntot, ' | ', + & mnc_cw_vname(j)(1:20), ' | ', mnc_cw_vgind(j) + CALL PRINT_MESSAGE( + & s1, standardMessageUnit, SQUEEZE_RIGHT, mythid) + DO i = 1,mnc_cw_vnat(1,j) - write(*,'(a14,i4,a3,a25,a3,a25)') ' text_at:',i, + s1(1:NBLNK) = blnk(1:NBLNK) + write(s1,'(a5,a14,i4,a3,a25,a3,a55)') + & 'MNC: ',' text_at:',i, & ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ', - & mnc_cw_vtat(i,j)(1:25) + & mnc_cw_vtat(i,j)(1:55) + CALL PRINT_MESSAGE( + & s1, standardMessageUnit, SQUEEZE_RIGHT, mythid) ENDDO DO i = 1,mnc_cw_vnat(2,j) - write(*,'(a14,i4,a3,a25,a3,i20)') ' int__at:',i, + s1(1:NBLNK) = blnk(1:NBLNK) + write(s1,'(a5,a14,i4,a3,a25,a3,i20)') + & 'MNC: ',' int__at:',i, & ' : ', mnc_cw_vinm(i,j)(1:25), ' : ', & mnc_cw_viat(i,j) + CALL PRINT_MESSAGE( + & s1, standardMessageUnit, SQUEEZE_RIGHT, mythid) ENDDO DO i = 1,mnc_cw_vnat(3,j) - write(*,'(a14,i4,a3,a25,a3,f25.10)') ' dbl__at:',i, + s1(1:NBLNK) = blnk(1:NBLNK) + write(s1,'(a5,a14,i4,a3,a25,a3,f25.10)') + & 'MNC: ',' dbl__at:',i, & ' : ', mnc_cw_vdnm(i,j)(1:25), ' : ', & mnc_cw_vdat(i,j) - ENDDO - + CALL PRINT_MESSAGE( + & s1, standardMessageUnit, SQUEEZE_RIGHT, mythid) + ENDDO + ENDIF ENDDO IF (ntot .EQ. 0) THEN - write(*,'(a)') ' None defined!' + s1(1:NBLNK) = blnk(1:NBLNK) + write(s1,'(a)') 'MNC: None defined!' + CALL PRINT_MESSAGE( + & s1, standardMessageUnit, SQUEEZE_RIGHT, mythid) ENDIF - + + _END_MASTER(myThid) RETURN END @@ -127,8 +175,8 @@ C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| SUBROUTINE MNC_CW_INIT( - I myThid, - I sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr ) + I sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr, + I myThid ) implicit none #include "mnc_common.h" @@ -305,8 +353,8 @@ & ' | ', (dn(i)(1:4), i=1,5) #endif - CALL MNC_CW_ADD_GNAME(myThid, name, ndim, - & dim, dn, ib, ie) + CALL MNC_CW_ADD_GNAME(name, ndim, + & dim, dn, ib, ie, myThid) ENDIF ENDDO @@ -323,16 +371,17 @@ C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| SUBROUTINE MNC_CW_ADD_VNAME( - I myThid, I vname, - I gname ) + I gname, + I bi_dim, bj_dim, + I myThid ) implicit none #include "mnc_common.h" #include "EEPARAMS.h" C Arguments - integer myThid + integer myThid, bi_dim, bj_dim character*(*) vname, gname C Functions @@ -348,18 +397,18 @@ ngl = ILNBLNK(gname) C Check that this vname is not already defined - CALL MNC_GET_IND(myThid, MNC_MAX_ID, vname, mnc_cw_vname, indv) + CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid) IF (indv .GT. 0) THEN write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''', & vname(nvf:nvl), ''' is already defined' CALL print_error(msgbuf, mythid) stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME' ENDIF - CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_cw_vname, - & indv) + CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_vname, + & indv, myThid) C Check that gname exists - CALL MNC_GET_IND(myThid, MNC_MAX_ID, gname, mnc_cw_gname, indg) + CALL MNC_GET_IND(MNC_MAX_ID, gname, mnc_cw_gname, indg, myThid) IF (indg .LT. 1) THEN write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''', & gname(ngf:ngl), ''' is not defined' @@ -373,6 +422,10 @@ DO i = 1,3 mnc_cw_vnat(i,indv) = 0 ENDDO + mnc_cw_vbij(1,indv) = bi_dim + mnc_cw_vbij(2,indv) = bj_dim + + CALL MNC_CW_ADD_VATTR_TEXT(vname,1,'mitgcm_grid',gname, myThid) RETURN END @@ -380,11 +433,11 @@ C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| SUBROUTINE MNC_CW_ADD_VATTR_TEXT( - I myThid, I vname, I ntat, I tnames, - I tvals ) + I tvals, + I myThid ) implicit none @@ -392,10 +445,10 @@ integer myThid, ntat character*(*) vname, tnames(*), tvals(*) - CALL MNC_CW_ADD_VATTR_ANY(myThid, vname, + CALL MNC_CW_ADD_VATTR_ANY(vname, & ntat, 0, 0, & tnames, ' ', ' ', - & tvals, 0, 0.0D0 ) + & tvals, 0, 0.0D0, myThid ) RETURN END @@ -403,11 +456,11 @@ C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| SUBROUTINE MNC_CW_ADD_VATTR_INT( - I myThid, I vname, I niat, I inames, - I ivals ) + I ivals, + I myThid ) implicit none @@ -416,10 +469,10 @@ character*(*) vname, inames(*) integer ivals(*) - CALL MNC_CW_ADD_VATTR_ANY(myThid, vname, + CALL MNC_CW_ADD_VATTR_ANY(vname, & 0, niat, 0, & ' ', inames, ' ', - & ' ', ivals, 0.0D0 ) + & ' ', ivals, 0.0D0, myThid ) RETURN END @@ -427,11 +480,11 @@ C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| SUBROUTINE MNC_CW_ADD_VATTR_DBL( - I myThid, I vname, I ndat, I dnames, - I dvals ) + I dvals, + I myThid ) implicit none @@ -440,10 +493,10 @@ character*(*) vname, dnames(*) REAL*8 dvals(*) - CALL MNC_CW_ADD_VATTR_ANY(myThid, vname, + CALL MNC_CW_ADD_VATTR_ANY(vname, & 0, 0, ndat, & ' ', ' ', dnames, - & ' ', 0, dvals ) + & ' ', 0, dvals, myThid ) RETURN END @@ -451,11 +504,11 @@ C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| SUBROUTINE MNC_CW_ADD_VATTR_ANY( - I myThid, I vname, I ntat, niat, ndat, I tnames, inames, dnames, - I tvals, ivals, dvals ) + I tvals, ivals, dvals, + I myThid ) implicit none #include "mnc_common.h" @@ -480,7 +533,7 @@ nvl = ILNBLNK(vname) C Check that vname is defined - CALL MNC_GET_IND(myThid, MNC_MAX_ID, vname, mnc_cw_vname, indv) + CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid) IF (indv .LT. 1) THEN write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''', & vname(nvf:nvl), ''' is not defined' @@ -526,13 +579,17 @@ C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| SUBROUTINE MNC_CW_GET_TILE_NUM( - I myThid, I bi, bj, - O uniq_tnum ) + O uniq_tnum, + I myThid ) implicit none #include "EEPARAMS.h" #include "SIZE.h" +#ifdef ALLOW_EXCH2 +#include "W2_EXCH2_TOPOLOGY.h" +#include "W2_EXCH2_PARAMS.h" +#endif C Arguments integer myThid, bi,bj, uniq_tnum @@ -545,7 +602,6 @@ #ifdef ALLOW_EXCH2 -#include "W2_EXCH2_PARAMS.h" uniq_tnum = W2_myTileList(bi) #else @@ -566,9 +622,9 @@ C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| SUBROUTINE MNC_CW_FILE_AORC( - I myThid, I fname, - O indf ) + O indf, + I myThid ) implicit none #include "netcdf.inc" @@ -584,19 +640,19 @@ character*(MAX_LEN_MBUF) msgbuf C Check if the file is already open - CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf) + CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid) IF (indf .GT. 0) THEN RETURN ENDIF C Try to open an existing file - CALL MNC_FILE_TRY_READ(myThid, fname, ierr, indf) + CALL MNC_FILE_TRY_READ(fname, ierr, indf, myThid) IF (ierr .EQ. NF_NOERR) THEN RETURN ENDIF C Try to create a new one - CALL MNC_FILE_OPEN(myThid, fname, 0, indf) + CALL MNC_FILE_OPEN(fname, 0, indf, myThid) RETURN END