/[MITgcm]/MITgcm/pkg/obcs/obcs_readparms.F
ViewVC logotype

Diff of /MITgcm/pkg/obcs/obcs_readparms.F

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

revision 1.28 by mlosch, Thu Nov 11 09:42:54 2010 UTC revision 1.29 by jmc, Thu Nov 18 22:37:25 2010 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "OBCS_OPTIONS.h"  #include "OBCS_OPTIONS.h"
5    
6    CBOP
7    C     !ROUTINE: OBCS_READPARMS
8    C     !INTERFACE:
9        SUBROUTINE OBCS_READPARMS( myThid )        SUBROUTINE OBCS_READPARMS( myThid )
10    
11    C     !DESCRIPTION: \bv
12  C     *==========================================================*  C     *==========================================================*
13  C     | SUBROUTINE OBCS_READPARMS  C     | SUBROUTINE OBCS_READPARMS
14  C     | o Routine to initialize OBCS variables and constants.  C     | o Routine to initialize OBCS variables and constants.
15  C     *==========================================================*  C     *==========================================================*
16  C     *==========================================================*  C     \ev
       IMPLICIT NONE  
17    
18    C     !USES:
19          IMPLICIT NONE
20  C     === Global variables ===  C     === Global variables ===
21  #include "SIZE.h"  #include "SIZE.h"
22  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 29  C     === Global variables === Line 35  C     === Global variables ===
35  #include "W2_EXCH2_PARAMS.h"  #include "W2_EXCH2_PARAMS.h"
36  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
37    
38    C     !INPUT/OUTPUT PARAMETERS:
39  C     === Routine arguments ===  C     === Routine arguments ===
40        INTEGER myThid        INTEGER myThid
41    
42  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
43    
44    C     !LOCAL VARIABLES:
45  C     === Local variables ===  C     === Local variables ===
46  C     msgBuf      - Informational/error message buffer  C     msgBuf      :: Informational/error message buffer
47  C     iUnit       - Work variable for IO unit number  C     iUnit       :: Work variable for IO unit number
48        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
49        INTEGER iUnit        INTEGER iUnit
50        INTEGER I, J        INTEGER I, J
# Line 108  C     OBEW_Ny :: height of global domain Line 116  C     OBEW_Ny :: height of global domain
116  C     buf :: used to exchange OB_Jnorth, ...  C     buf :: used to exchange OB_Jnorth, ...
117        _RS buf(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy)        _RS buf(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy)
118  #endif  #endif
119    CEOP
120    
121        NAMELIST /OBCS_PARM01/        NAMELIST /OBCS_PARM01/
122       &          OB_Jnorth,OB_Jsouth,OB_Ieast,OB_Iwest,       &          OB_Jnorth,OB_Jsouth,OB_Ieast,OB_Iwest,
# Line 146  C     buf :: used to exchange OB_Jnorth, Line 155  C     buf :: used to exchange OB_Jnorth,
155        NAMELIST /OBCS_PARM04/        NAMELIST /OBCS_PARM04/
156       &          TrelaxStevens,SrelaxStevens,       &          TrelaxStevens,SrelaxStevens,
157       &          useStevensPhaseVel,useStevensAdvection       &          useStevensPhaseVel,useStevensAdvection
158  #endif ALLOW_OBCS_STEVENS  #endif /* ALLOW_OBCS_STEVENS */
159    
160        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
161    
# Line 162  C     buf :: used to exchange OB_Jnorth, Line 171  C     buf :: used to exchange OB_Jnorth,
171        OBEW_Ny = Ny        OBEW_Ny = Ny
172  #endif  #endif
173    
 C--   OBCS_READPARMS has been called so we know that  
 C     the package is active.  
 c     OBCSIsOn=.TRUE.  
   
       IF ( debugLevel .GE. debLevB ) THEN  
        WRITE(msgBuf,'(A)') ' OBCS_READPARMS: opening data.obcs'  
        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &      SQUEEZE_RIGHT , 1)  
       ENDIF  
   
       CALL OPEN_COPY_DATA_FILE(  
      I                          'data.obcs', 'OBCS_READPARMS',  
      O                          iUnit,  
      I                          myThid )  
   
174  C--   Default flags and values for OBCS  C--   Default flags and values for OBCS
175        DO I=1,OBNS_Nx        DO I=1,OBNS_Nx
176         OB_Jnorth(I)=0         OB_Jnorth(I)=0
# Line 260  C--   Default flags and values for OBCS Line 254  C--   Default flags and values for OBCS
254        ENDDO        ENDDO
255  #endif  #endif
256    
257    C     Open and read the data.obcs file
258          WRITE(msgBuf,'(A)') ' OBCS_READPARMS: opening data.obcs'
259          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
260         &                    SQUEEZE_RIGHT , myThid )
261          CALL OPEN_COPY_DATA_FILE(
262         I                          'data.obcs', 'OBCS_READPARMS',
263         O                          iUnit,
264         I                          myThid )
265    
266  C--   Read parameters from open data file  C--   Read parameters from open data file
267        READ(UNIT=iUnit,NML=OBCS_PARM01)        READ(UNIT=iUnit,NML=OBCS_PARM01)
268    
 C     Account for periodicity if negative indices were supplied  
       DO J=1,OBEW_Ny  
        IF (OB_Ieast(J).lt.0) OB_Ieast(J)=OB_Ieast(J)+OBEW_Nx+1  
       ENDDO  
       DO I=1,OBNS_Nx  
        IF (OB_Jnorth(I).lt.0) OB_Jnorth(I)=OB_Jnorth(I)+OBNS_Ny+1  
       ENDDO  
       IF ( debugLevel .GE. debLevB ) THEN  
        write(*,*) 'OB Jn =',OB_Jnorth  
        write(*,*) 'OB Js =',OB_Jsouth  
        write(*,*) 'OB Ie =',OB_Ieast  
        write(*,*) 'OB Iw =',OB_Iwest  
       ENDIF  
   
269  #ifdef ALLOW_ORLANSKI  #ifdef ALLOW_ORLANSKI
270  C     Default Orlanski radiation parameters  C     Default Orlanski radiation parameters
271        CMAX = 0.45 _d 0 /* maximum allowable phase speed-CFL for AB-II */        CMAX = 0.45 _d 0 /* maximum allowable phase speed-CFL for AB-II */
# Line 311  CML      Vrelaxobcsbound = 1. _d 0 Line 300  CML      Vrelaxobcsbound = 1. _d 0
300  #ifdef ALLOW_OBCS_STEVENS  #ifdef ALLOW_OBCS_STEVENS
301        TrelaxStevens   = 0. _d 0        TrelaxStevens   = 0. _d 0
302        SrelaxStevens   = 0. _d 0        SrelaxStevens   = 0. _d 0
303        IF (      useStevensNorth .OR. useStevensSouth        IF (      useStevensNorth .OR. useStevensSouth
304       &     .OR. useStevensEast  .OR. useStevensWest  )       &     .OR. useStevensEast  .OR. useStevensWest  )
305       & READ(UNIT=iUnit,NML=OBCS_PARM04)       & READ(UNIT=iUnit,NML=OBCS_PARM04)
306  #endif  #endif
307    
308        IF ( debugLevel .GE. debLevB ) THEN        WRITE(msgBuf,'(A)') ' OBCS_READPARMS: finished reading data.obcs'
309         WRITE(msgBuf,'(A)') ' OBCS_READPARMS: finished reading data.obcs'        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
310         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,       &                    SQUEEZE_RIGHT , myThid )
      &      SQUEEZE_RIGHT , 1)  
       ENDIF  
311    
312  C--   Close the open data file  C--   Close the open data file
313        CLOSE(iUnit)        CLOSE(iUnit)
       _END_MASTER(myThid)  
314    
315    C-    Account for periodicity if negative indices were supplied
316          DO J=1,OBEW_Ny
317           IF (OB_Ieast(J).LT.0) OB_Ieast(J)=OB_Ieast(J)+OBEW_Nx+1
318          ENDDO
319          DO I=1,OBNS_Nx
320           IF (OB_Jnorth(I).LT.0) OB_Jnorth(I)=OB_Jnorth(I)+OBNS_Ny+1
321          ENDDO
322          IF ( debugLevel.GE.debLevA ) THEN
323    c       write(*,*) 'OB Jn =',OB_Jnorth
324    c       write(*,*) 'OB Js =',OB_Jsouth
325    c       write(*,*) 'OB Ie =',OB_Ieast
326    c       write(*,*) 'OB Iw =',OB_Iwest
327            WRITE(msgBuf,'(A)') ' Northern OB global indices : OB_Jnorth ='
328            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
329         &                      SQUEEZE_RIGHT, myThid )
330            CALL PRINT_LIST_I( OB_Jnorth, 1, OBNS_Nx, INDEX_I,
331         &                    .FALSE., .TRUE., standardMessageUnit )
332            WRITE(msgBuf,'(A)') ' Southern OB global indices : OB_Jsouth ='
333            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
334         &                      SQUEEZE_RIGHT, myThid )
335            CALL PRINT_LIST_I( OB_Jsouth, 1, OBNS_Nx, INDEX_I,
336         &                    .FALSE., .TRUE., standardMessageUnit )
337            WRITE(msgBuf,'(A)') ' Eastern  OB global indices : OB_Ieast ='
338            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
339         &                      SQUEEZE_RIGHT, myThid )
340            CALL PRINT_LIST_I( OB_Ieast, 1, OBEW_Ny, INDEX_J,
341         &                    .FALSE., .TRUE., standardMessageUnit )
342            WRITE(msgBuf,'(A)') ' Western  OB global indices : OB_Iwest ='
343            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
344         &                      SQUEEZE_RIGHT, myThid )
345            CALL PRINT_LIST_I( OB_Iwest, 1, OBEW_Ny, INDEX_J,
346         &                    .FALSE., .TRUE., standardMessageUnit )
347            WRITE(msgBuf,'(A)') ' '
348            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
349         &                      SQUEEZE_RIGHT, myThid )
350          ENDIF
351    
352          _END_MASTER(myThid)
353  C--   Everyone else must wait for the parameters to be loaded  C--   Everyone else must wait for the parameters to be loaded
354        _BARRIER        _BARRIER
355    
# Line 333  C--   Calculate the tiled index arrays O Line 357  C--   Calculate the tiled index arrays O
357  C     global arrays OB_Jnorth/Jsouth/Ieast/Iwest.  C     global arrays OB_Jnorth/Jsouth/Ieast/Iwest.
358  C     Note: This part of the code has been moved from obcs_init_fixed to  C     Note: This part of the code has been moved from obcs_init_fixed to
359  C     routine routine because the OB_Jn/Js/Ie/Iw index arrays are  C     routine routine because the OB_Jn/Js/Ie/Iw index arrays are
360  C     required by ini_depth which is called befoer obcs_init_fixed  C     required by ini_depth which is called before obcs_init_fixed
361        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
362         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
363    
Legend:
Removed from v.1.28  
changed lines
  Added in v.1.29
  ViewVC Help
Powered by ViewVC 1.1.22