Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:39:45 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
017b6b2289 Jean*0001 #include "CPP_EEOPTIONS.h"
                0002 #include "W2_OPTIONS.h"
                0003 
                0004 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0005 CBOP 0
                0006 C !ROUTINE: W2_READPARMS
                0007 
                0008 C !INTERFACE:
                0009       SUBROUTINE W2_READPARMS( myThid )
                0010 
                0011 C     !DESCRIPTION:
                0012 C     Initialize W2_EXCH2 variables and constants.
                0013 
                0014 C     !USES:
                0015       IMPLICIT NONE
                0016 #include "SIZE.h"
                0017 #include "EEPARAMS.h"
                0018 #include "W2_EXCH2_SIZE.h"
                0019 #include "W2_EXCH2_TOPOLOGY.h"
                0020 #include "W2_EXCH2_PARAMS.h"
                0021 
                0022 C     !INPUT PARAMETERS:
                0023 C     myThid  :: my Thread Id number
                0024 C               (Note: not relevant since threading has not yet started)
                0025       INTEGER myThid
                0026 CEOP
                0027 
                0028 C     !LOCAL VARIABLES:
                0029 C     === Local variables ===
c2931685c2 Jean*0030 C     msgBuf     :: Informational/error message buffer
017b6b2289 Jean*0031 C     iUnit      :: Work variable for IO unit number
                0032       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0033       LOGICAL fileExist, errFlag
                0034       INTEGER i, j, iUnit, stdUnit, errCnt
                0035 C--   Note: To avoid error in reading the namelist,
                0036 C     use larger local array to read-in lists dimsFacets & facetEdgeLink,
                0037 C     store only W2_maxNbFacets values, and stop if more values are found.
                0038       INTEGER namList_NbFacets
                0039       PARAMETER ( namList_NbFacets = W2_maxNbFacets*2 )
                0040       INTEGER dimsFacets( 2*namList_NbFacets )
                0041       Real*4  facetEdgeLink( 4, namList_NbFacets )
                0042 
                0043 C--   topology defined from processing "data.exch2" (selectTopol=0):
                0044 C     dimsFacets    :: facet pair of dimensions (n1x,n1y,n2x,n2y ...)
                0045 C     facetEdgeLink :: Face-Edge connectivity map:
                0046 C       facetEdgeLink(i,j)=XX.1 : face(j)-edge(i) (i=1,2,3,4 <==> N,S,E,W)
                0047 C       is connected to Northern edge of face "XX" ; similarly,
                0048 C       = XX.2 : to Southern.E, XX.3 = Eastern.E, XX.4 = Western.E of face "XX".
                0049 C--
                0050 C     edges order: N,S,E,W <==> 1,2,3,4
                0051 
                0052       NAMELIST /W2_EXCH2_PARM01/
                0053      &       preDefTopol,
                0054      &       dimsFacets, facetEdgeLink,
                0055      &       blankList,
                0056      &       W2_mapIO,
6fc6b32488 Jean*0057      &       W2_printMsg,
                0058      &       W2_useE2ioLayOut
017b6b2289 Jean*0059 
                0060       stdUnit  = standardMessageUnit
                0061 
                0062 C--   Default values for W2_EXCH2
                0063       W2_printMsg = -1
                0064       W2_mapIO = -1
6fc6b32488 Jean*0065       W2_useE2ioLayOut = .TRUE.
017b6b2289 Jean*0066       IF ( useCubedSphereExchange ) THEN
                0067         preDefTopol = 3
                0068       ELSE
                0069         preDefTopol = 1
                0070       ENDIF
                0071       DO i=1,W2_maxNbTiles
                0072         blankList(i) = 0
                0073       ENDDO
                0074 
                0075 C--   Initialise other params in namelist
                0076       DO j=1,W2_maxNbFacets*2
                0077         dimsFacets(2*j-1) = 0
                0078         dimsFacets( 2*j ) = 0
                0079         DO i=1,4
                0080           facetEdgeLink(i,j) = 0.
                0081         ENDDO
                0082       ENDDO
                0083 
                0084 C-    Initialise other parameters:
                0085       nFacets = 0
                0086       nBlankTiles = 0
                0087       DO j=1,W2_maxNbFacets
                0088         facet_dims(2*j-1) = 0
                0089         facet_dims( 2*j ) = 0
                0090         DO i=1,4
                0091           facet_link(i,j) = 0.
                0092         ENDDO
                0093       ENDDO
                0094 
0acd686861 Jean*0095 C     Set filling value for face-corner halo regions
                0096       e2FillValue_RL = 0. _d 0
                0097       e2FillValue_RS = 0. _d 0
                0098       e2FillValue_R4 = 0.e0
                0099       e2FillValue_R8 = 0.d0
                0100 C-    for testing only: put a large value (should not affects the results)
                0101 c     e2FillValue_RL = 1. _d+20
                0102 c     e2FillValue_RS = 1. _d+20
                0103 c     e2FillValue_R4 = 1.e+20
                0104 c     e2FillValue_R8 = 1.d+20
                0105 
017b6b2289 Jean*0106 C-    Check for file "data.ech2":
                0107       fileExist = .FALSE.
                0108       INQUIRE( FILE='data.exch2', EXIST=fileExist )
                0109 
                0110       IF ( fileExist ) THEN
                0111         WRITE(msgBuf,'(A)') 'W2_READPARMS: opening data.exch2'
                0112         CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid )
                0113         CALL OPEN_COPY_DATA_FILE(
                0114      I                      'data.exch2', 'W2_READPARMS',
                0115      O                      iUnit,
                0116      I                      myThid )
                0117 
                0118 C     Read parameters from open data file
                0119         READ(UNIT=iUnit,NML=W2_EXCH2_PARM01)
                0120         WRITE(msgBuf,'(A)')
                0121      &    'W2_READPARMS: finished reading data.exch2'
                0122         CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid )
                0123 C     Close the open data file
7a77863887 Mart*0124 #ifdef SINGLE_DISK_IO
017b6b2289 Jean*0125         CLOSE(iUnit)
7a77863887 Mart*0126 #else
                0127         CLOSE(iUnit,STATUS='DELETE')
                0128 #endif /* SINGLE_DISK_IO */
017b6b2289 Jean*0129       ELSE
                0130         WRITE(msgBuf,'(A)') 'W2_READPARMS: file data.exch2 not found'
                0131         CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid )
                0132         IF ( preDefTopol.EQ.1 ) THEN
                0133           WRITE(msgBuf,'(2A,I3)') '=> use W2_EXCH2 default:',
                0134      &      ' Single sub-domain (nFacets=1)'
                0135         ELSEIF ( preDefTopol .EQ. 3 ) THEN
                0136           WRITE(msgBuf,'(2A,I3)') '=> use W2_EXCH2 default:',
                0137      &      ' regular 6-facets Cube'
                0138         ELSE
                0139           WRITE(msgBuf,'(2A,I3)') '=> use W2_EXCH2 default:',
                0140      &      ' preDefTopol=', preDefTopol
                0141         ENDIF
                0142         CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid )
                0143       ENDIF
                0144 
                0145 C--   copy local arrays dimsFacets & facetEdgeLink to var in common block
                0146       DO j=1,2*W2_maxNbFacets
                0147 c       write(0,*) j, dimsFacets(j)
                0148         facet_dims(j) = dimsFacets(j)
                0149       ENDDO
                0150       DO j=1,W2_maxNbFacets
                0151        DO i=1,4
                0152         facet_link(i,j) = facetEdgeLink(i,j)
                0153        ENDDO
                0154       ENDDO
                0155 
                0156 C--   Check if too many values are specified in data.exch2:
                0157       errCnt = 0
                0158       DO j=W2_maxNbFacets+1,namList_NbFacets
                0159        errFlag = .FALSE.
                0160        DO i=1,4
                0161         IF ( facetEdgeLink(i,j).NE.0. ) errFlag = .TRUE.
                0162        ENDDO
                0163        IF ( errFlag ) errCnt = errCnt + 1
                0164       ENDDO
                0165       IF ( errCnt.GT.0 ) THEN
                0166         WRITE(msgBuf,'(2A)') ' W2_READPARMS:',
                0167      &    ' Number of "facetEdgeLink" list in "data.exch2"'
                0168         CALL PRINT_ERROR( msgBuf, myThid )
                0169         WRITE(msgBuf,'(A,2(A,I3))') ' W2_READPARMS:',
                0170      &    ' exceeds maxNbFacets(=',W2_maxNbFacets,') by', errCnt
                0171         CALL PRINT_ERROR( msgBuf, myThid )
                0172         errFlag = .TRUE.
                0173       ELSE
                0174         errFlag = .FALSE.
                0175       ENDIF
c2931685c2 Jean*0176 
017b6b2289 Jean*0177       errCnt = 0
                0178       DO j=2*W2_maxNbFacets+1,2*namList_NbFacets
                0179         IF ( dimsFacets(j).NE.0 ) errCnt = errCnt + 1
                0180       ENDDO
                0181       IF ( errCnt.GT.0 ) THEN
                0182         WRITE(msgBuf,'(2A)') ' W2_READPARMS:',
                0183      &    ' Number of "dimsFacets" in "data.exch2"'
                0184         CALL PRINT_ERROR( msgBuf, myThid )
                0185         WRITE(msgBuf,'(A,2(A,I3))') ' W2_READPARMS:',
                0186      &    ' exceeds 2*maxNbFacets(=',W2_maxNbFacets*2,') by', errCnt
                0187         CALL PRINT_ERROR( msgBuf, myThid )
                0188       ENDIF
                0189       IF ( errFlag .OR. errCnt.GT.0 ) THEN
                0190         STOP 'ABNORMAL END: S/R W2_READPARMS'
                0191       ENDIF
                0192 
c2931685c2 Jean*0193 C--   Print some Exch2 parameters:
                0194       WRITE(msgBuf,'(A,L5,A)') 'W2_useE2ioLayOut=', W2_useE2ioLayOut,
                0195      &  ' ;/* T: use Exch2 glob IO map; F: use model default */'
                0196       CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid )
                0197       WRITE(msgBuf,'(A,I4,A)') 'W2_mapIO        =', W2_mapIO,
                0198      & ' ; /* select option for Exch2 global-IO map */'
                0199       CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid )
                0200       WRITE(msgBuf,'(A,I4,A)') 'W2_printMsg     =', W2_printMsg,
                0201      & ' ; /* select option for printing information */'
                0202       CALL PRINT_MESSAGE( msgBuf, stdUnit, SQUEEZE_RIGHT , myThid )
                0203 
017b6b2289 Jean*0204       RETURN
                0205       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!