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

Annotation of /MITgcm/pkg/obcs/obcs_check_depths.F

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

Revision 1.1 - (hide annotations) (download)
Fri Apr 24 01:52:12 2009 UTC (15 years, 1 month ago) by jmc
Branch: MAIN
CVS Tags: checkpoint62, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62x, checkpoint61n, checkpoint61o, checkpoint61m, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y 
take OBCS_CHECK_TOPOGRAPHY out of obcs_check.F and rename it
"OBCS_CHECK_DEPTHS"; motivation: 1) called from ini_depths ;
2) could be adapted for P-coord (isomorphism & ocean in P).
1 jmc 1.1 C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_check.F,v 1.12 2008/04/24 08:22:06 mlosch Exp $
2     C $Name: $
3    
4     #include "OBCS_OPTIONS.h"
5    
6     SUBROUTINE OBCS_CHECK_DEPTHS( myThid )
7     C *==========================================================*
8     C | SUBROUTINE OBCS_CHECK_DEPTHS |
9     C | o Check for non-zero normal gradient across open |
10     C | boundaries |
11     C | o fix them if required and print a message |
12     C *==========================================================*
13     C *==========================================================*
14     IMPLICIT NONE
15    
16     C === Global variables ===
17     #include "SIZE.h"
18     #include "EEPARAMS.h"
19     #include "PARAMS.h"
20     #include "GRID.h"
21     #include "OBCS.h"
22    
23     C === Routine arguments ===
24     C myThid - Number of this instances
25     INTEGER myThid
26    
27     #ifdef ALLOW_OBCS
28     C === Local variables ===
29     C msgBuf - Informational/error meesage buffer
30     CHARACTER*(MAX_LEN_MBUF) msgBuf
31     INTEGER bi, bj, I, J, K, ichanged
32    
33     IF ( OBCSfixTopo ) THEN
34     C-- Modify topography to ensure that outward d(topography)/dn >= 0,
35     C topography at open boundary points must be equal or shallower than
36     C topography one grid-point inward from open boundary
37     ichanged = 0
38     DO bj = myByLo(myThid), myByHi(myThid)
39     DO bi = myBxLo(myThid), myBxHi(myThid)
40    
41     DO K=1,Nr
42     #ifdef ALLOW_OBCS_NORTH
43     DO I=1,sNx
44     J=OB_Jn(I,bi,bj)
45     IF ( J .NE. 0 .AND.
46     & ( R_low(I,J,bi,bj) .LT. R_low(I,J-1,bi,bj) ) ) THEN
47     ichanged = ichanged + 1
48     R_low(I,J,bi,bj) = R_low(I,J-1,bi,bj)
49     WRITE(msgBuf,'(2A,(1X,4I6))')
50     & 'S/R OBCS_CHECK_DEPTHS: fixed topography at ',
51     & '(i,j,bi,bj) = ', I, J, bi, bj
52     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
53     & SQUEEZE_RIGHT, myThid)
54     ENDIF
55     ENDDO
56     #endif
57     #ifdef ALLOW_OBCS_SOUTH
58     DO I=1,sNx
59     J=OB_Js(I,bi,bj)
60     IF ( J .NE. 0 .AND.
61     & ( R_low(I,J,bi,bj) .LT. R_low(I,J+1,bi,bj) ) ) THEN
62     ichanged = ichanged + 1
63     R_low(I,J,bi,bj) = R_low(I,J+1,bi,bj)
64     WRITE(msgBuf,'(2A,(1X,4I6))')
65     & 'S/R OBCS_CHECK_DEPTHS: fixed topography at ',
66     & '(i,j,bi,bj) = ', I, J, bi, bj
67     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
68     & SQUEEZE_RIGHT, myThid)
69     ENDIF
70     ENDDO
71     #endif
72     #ifdef ALLOW_OBCS_EAST
73     DO J=1,sNy
74     I = OB_Ie(J,bi,bj)
75     IF ( I .NE. 0 .AND.
76     & ( R_low(I,J,bi,bj) .LT. R_low(I-1,J,bi,bj) ) ) THEN
77     ichanged = ichanged + 1
78     R_low(I,J,bi,bj) = R_low(I-1,J,bi,bj)
79     WRITE(msgBuf,'(2A,(1X,4I6))')
80     & 'S/R OBCS_CHECK_DEPTHS: fixed topography at ',
81     & '(i,j,bi,bj) = ', I, J, bi, bj
82     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
83     & SQUEEZE_RIGHT, myThid)
84     ENDIF
85     ENDDO
86     #endif
87     C Western boundary
88     #ifdef ALLOW_OBCS_WEST
89     DO J=1,sNy
90     I = OB_Iw(J,bi,bj)
91     IF ( I .NE. 0 .AND.
92     & ( R_low(I,J,bi,bj) .LT. R_low(I+1,J,bi,bj) ) ) THEN
93     ichanged = ichanged + 1
94     R_low(I,J,bi,bj) = R_low(I+1,J,bi,bj)
95     WRITE(msgBuf,'(2A,(1X,4I6))')
96     & 'S/R OBCS_CHECK_DEPTHS: fixed topography at ',
97     & '(i,j,bi,bj) = ', I, J, bi, bj
98     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
99     & SQUEEZE_RIGHT, myThid)
100     ENDIF
101     ENDDO
102     #endif
103     ENDDO
104    
105     ENDDO
106     ENDDO
107     C-- some diagnostics to stdout
108     IF ( ichanged .GT. 0 ) THEN
109     WRITE(msgBuf,'(A,I7,A,A)')
110     & 'OBCS message: corrected ', ichanged,
111     & ' instances of problematic topography gradients',
112     & ' normal to open boundaries'
113     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
114     & SQUEEZE_RIGHT, myThid)
115     ENDIF
116     C endif (OBCSfixTopo)
117     ENDIF
118     #endif /* ALLOW_OBCS */
119    
120     RETURN
121     END
  ViewVC Help
Powered by ViewVC 1.1.22