7 |
C !ROUTINE: INI_VERTICAL_GRID |
C !ROUTINE: INI_VERTICAL_GRID |
8 |
C !INTERFACE: |
C !INTERFACE: |
9 |
SUBROUTINE INI_VERTICAL_GRID( myThid ) |
SUBROUTINE INI_VERTICAL_GRID( myThid ) |
10 |
|
|
11 |
C !DESCRIPTION: \bv |
C !DESCRIPTION: \bv |
12 |
C *==========================================================* |
C *==========================================================* |
13 |
C | SUBROUTINE INI_VERTICAL_GRID |
C | SUBROUTINE INI_VERTICAL_GRID |
14 |
C | o Initialise vertical gridding arrays |
C | o Initialise vertical gridding arrays |
15 |
C *==========================================================* |
C *==========================================================* |
16 |
C \ev |
C \ev |
17 |
|
|
25 |
|
|
26 |
C !INPUT/OUTPUT PARAMETERS: |
C !INPUT/OUTPUT PARAMETERS: |
27 |
C == Routine arguments == |
C == Routine arguments == |
28 |
C myThid - Number of this instance of INI_DEPTHS |
C myThid :: my Thread Id number |
29 |
INTEGER myThid |
INTEGER myThid |
30 |
|
|
31 |
C !LOCAL VARIABLES: |
C !LOCAL VARIABLES: |
32 |
C == Local variables == |
C == Local variables == |
33 |
C K :: loop index |
C k :: loop index |
34 |
C msgBuf :: Informational/error meesage buffer |
C msgBuf :: Informational/error meesage buffer |
35 |
INTEGER K |
INTEGER k |
36 |
|
_RL tmpRatio, checkRatio1, checkRatio2 |
37 |
CHARACTER*(MAX_LEN_MBUF) msgBuf |
CHARACTER*(MAX_LEN_MBUF) msgBuf |
38 |
CEOP |
CEOP |
39 |
|
|
40 |
IF (setCenterDr) THEN |
_BEGIN_MASTER(myThid) |
41 |
C-- Interface at middle between 2 centers : |
|
42 |
|
WRITE(msgBuf,'(A,2(A,L5))') 'Enter INI_VERTICAL_GRID:', |
43 |
|
& ' setInterFDr=', setInterFDr, |
44 |
|
& ' ; setCenterDr=', setCenterDr |
45 |
|
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
46 |
|
& SQUEEZE_RIGHT, myThid ) |
47 |
|
|
48 |
|
C-- Set factors required for mixing pressure and meters as vertical coordinate. |
49 |
|
C rkSign is a "sign" parameter which is used where the orientation of the vertical |
50 |
|
C coordinate (pressure or meters) relative to the vertical index (k) is important. |
51 |
|
C rkSign = -1 applies when k and the coordinate are in the opposite sense. |
52 |
|
C rkSign = 1 applies when k and the coordinate are in the same sense. |
53 |
|
rkSign = -1. _d 0 |
54 |
|
gravitySign = -1. _d 0 |
55 |
|
IF ( usingPCoords ) THEN |
56 |
|
gravitySign = 1. _d 0 |
57 |
|
ENDIF |
58 |
|
|
59 |
|
IF ( .NOT.(setInterFDr.OR.setCenterDr) ) THEN |
60 |
|
WRITE(msgBuf,'(A)') |
61 |
|
& 'S/R INI_VERTICAL_GRID: neither delR nor delRc are defined' |
62 |
|
CALL PRINT_ERROR( msgBuf, myThid ) |
63 |
|
WRITE(msgBuf,'(A)') |
64 |
|
& 'S/R INI_VERTICAL_GRID: Need at least 1 of the 2 (delR,delRc)' |
65 |
|
CALL PRINT_ERROR( msgBuf, myThid ) |
66 |
|
STOP 'ABNORMAL END: S/R INI_VERTICAL_GRID' |
67 |
|
ENDIF |
68 |
|
|
69 |
|
C--- Set Level r-thickness (drF) and Center r-distances (drC) |
70 |
|
|
71 |
|
IF (setInterFDr) THEN |
72 |
|
C-- Interface r-distances are defined: |
73 |
|
DO k=1,Nr |
74 |
|
drF(k) = delR(k) |
75 |
|
ENDDO |
76 |
C- Check that all thickness are > 0 : |
C- Check that all thickness are > 0 : |
77 |
DO K=1,Nr+1 |
DO k=1,Nr |
78 |
IF (delRc(K).LE.0.) THEN |
IF (delR(k).LE.0.) THEN |
79 |
WRITE(msgBuf,'(A,I4,A,E16.8)') |
WRITE(msgBuf,'(A,I4,A,E16.8)') |
80 |
& 'S/R INI_VERTICAL_GRID: delRc(K=',K,' )=',delRc(K) |
& 'S/R INI_VERTICAL_GRID: delR(k=',k,' )=',delR(k) |
81 |
CALL PRINT_ERROR( msgBuf , 1) |
CALL PRINT_ERROR( msgBuf, myThid ) |
82 |
WRITE(msgBuf,'(A)') |
WRITE(msgBuf,'(A)') |
83 |
& 'S/R INI_VERTICAL_GRID: Vert. grid spacing MUST BE > 0' |
& 'S/R INI_VERTICAL_GRID: Vert. grid spacing MUST BE > 0' |
84 |
CALL PRINT_ERROR( msgBuf , 1) |
CALL PRINT_ERROR( msgBuf, myThid ) |
85 |
STOP 'ABNORMAL END: S/R INI_VERTICAL_GRID' |
STOP 'ABNORMAL END: S/R INI_VERTICAL_GRID' |
86 |
ENDIF |
ENDIF |
87 |
ENDDO |
ENDDO |
|
|
|
|
C- Calculate depths of centers and interfaces |
|
|
rF(1) = Ro_SeaLevel |
|
|
rC(1) = rF(1) + rkSign*delRc(1) |
|
|
drC(1) = delRc(1) |
|
|
drF(1) = delRc(1) |
|
|
DO K=2,Nr |
|
|
drC(K) = delRc(K) |
|
|
drF(K-1) = drF(K-1) + 0.5 _d 0*delRc(K) |
|
|
drF(K) = 0.5 _d 0*delRc(K) |
|
|
rC(K) = rC(K-1) + rkSign*drC(K) |
|
|
rF(K) = rF(K-1) + rkSign*drF(K-1) |
|
|
ENDDO |
|
|
drF(Nr) = drF(Nr) + delRc(Nr+1) |
|
|
rF(Nr+1) = rF(Nr) + rkSign*drF(Nr) |
|
|
|
|
88 |
ELSE |
ELSE |
89 |
C-- Center at middle between 2 interfaces : |
C-- Interface r-distances undefined: |
90 |
|
C assume Interface at middle between 2 Center |
91 |
|
drF(1) = delRc(1) |
92 |
|
DO k=2,Nr |
93 |
|
drF(k-1) = 0.5 _d 0 *delRc(k) + drF(k-1) |
94 |
|
drF( k ) = 0.5 _d 0 *delRc(k) |
95 |
|
ENDDO |
96 |
|
drF(Nr) = delRc(Nr+1) + drF(Nr) |
97 |
|
ENDIF |
98 |
|
|
99 |
|
IF (setCenterDr) THEN |
100 |
|
C-- Cell Center r-distances are defined: |
101 |
|
DO k=1,Nr |
102 |
|
drC(k) = delRc(k) |
103 |
|
ENDDO |
104 |
C- Check that all thickness are > 0 : |
C- Check that all thickness are > 0 : |
105 |
DO K=1,Nr |
DO k=1,Nr+1 |
106 |
IF (delR(K).LE.0.) THEN |
IF (delRc(k).LE.0.) THEN |
107 |
WRITE(msgBuf,'(A,I4,A,E16.8)') |
WRITE(msgBuf,'(A,I4,A,E16.8)') |
108 |
& 'S/R INI_VERTICAL_GRID: delR(K=',K,' )=',delR(K) |
& 'S/R INI_VERTICAL_GRID: delRc(k=',k,' )=',delRc(k) |
109 |
CALL PRINT_ERROR( msgBuf , 1) |
CALL PRINT_ERROR( msgBuf, myThid ) |
110 |
WRITE(msgBuf,'(A)') |
WRITE(msgBuf,'(A)') |
111 |
& 'S/R INI_VERTICAL_GRID: Vert. grid spacing MUST BE > 0' |
& 'S/R INI_VERTICAL_GRID: Vert. grid spacing MUST BE > 0' |
112 |
CALL PRINT_ERROR( msgBuf , 1) |
CALL PRINT_ERROR( msgBuf, myThid ) |
113 |
STOP 'ABNORMAL END: S/R INI_VERTICAL_GRID' |
STOP 'ABNORMAL END: S/R INI_VERTICAL_GRID' |
114 |
ENDIF |
ENDIF |
115 |
ENDDO |
ENDDO |
116 |
|
ELSE |
117 |
|
C-- Cell Center r-distances undefined: |
118 |
|
C assume Center at middle between 2 Interfaces |
119 |
|
drC(1) = 0.5 _d 0 *delR(1) |
120 |
|
DO k=2,Nr |
121 |
|
drC(k) = 0.5 _d 0 *(delR(k-1)+delR(k)) |
122 |
|
ENDDO |
123 |
|
ENDIF |
124 |
|
|
125 |
C- Calculate depths of interfaces and centers |
C--- Set r-position of interFace (rF) and cell-Center (rC): |
126 |
rF(1) = Ro_SeaLevel |
rF(1) = Ro_SeaLevel |
127 |
DO K=1,Nr |
DO k=1,Nr |
128 |
drF(K) = delR(K) |
rF(k+1) = rF(k) + rkSign*drF(k) |
|
rF(K+1) = rF(K) + rkSign*delR(K) |
|
129 |
ENDDO |
ENDDO |
130 |
drC(1) = delR(1) * 0.5 _d 0 |
rC(1) = rF(1) + rkSign*drC(1) |
131 |
rC(1) = rf(1) + rkSign*delR(1) * 0.5 _d 0 |
DO k=2,Nr |
132 |
DO K=2,Nr |
rC(k) = rC(k-1) + rkSign*drC(k) |
|
drC(K) = 0.5 _d 0 *(delR(K-1)+delR(K)) |
|
|
rC(K) = rC(K-1) + rkSign*drC(K) |
|
133 |
ENDDO |
ENDDO |
134 |
|
|
135 |
C-- |
C--- Check vertical discretization : |
136 |
ENDIF |
checkRatio2 = 100. |
137 |
|
checkRatio1 = 1. _d 0 / checkRatio2 |
138 |
|
DO k=1,Nr |
139 |
|
tmpRatio = 0. |
140 |
|
IF ( (rC(k)-rF(k+1)) .NE. 0. ) |
141 |
|
& tmpRatio = (rF(k)-rC(k)) / (rC(k)-rF(k+1)) |
142 |
|
IF ( tmpRatio.LT.checkRatio1 .OR. tmpRatio.GT.checkRatio2 ) THEN |
143 |
|
c write(0,*) 'drF=',drF |
144 |
|
c write(0,*) 'drC=',drC |
145 |
|
c write(0,*) 'rF=',rF |
146 |
|
c write(0,*) 'rC=',rC |
147 |
|
WRITE(msgBuf,'(A,I4,A,E16.8)') |
148 |
|
& 'S/R INI_VERTICAL_GRID: Invalid relative position, level k=', |
149 |
|
& k, ' :', tmpRatio |
150 |
|
CALL PRINT_ERROR( msgBuf, myThid ) |
151 |
|
WRITE(msgBuf,'(A,1PE14.6,A,2E14.6)') |
152 |
|
& 'S/R INI_VERTICAL_GRID: rC=', rC(k), |
153 |
|
& ' , rF(k,k+1)=',rF(k),rF(k+1) |
154 |
|
CALL PRINT_ERROR( msgBuf, myThid ) |
155 |
|
STOP 'ABNORMAL END: S/R INI_VERTICAL_GRID' |
156 |
|
ENDIF |
157 |
|
ENDDO |
158 |
|
|
159 |
C- Calculate reciprol vertical grid spacing : |
C- Calculate reciprol vertical grid spacing : |
160 |
DO K=1,Nr |
DO k=1,Nr |
161 |
saFac(K) = 1. _d 0 |
recip_drC(k) = 1. _d 0/drC(k) |
162 |
recip_drC(K) = 1. _d 0/drC(K) |
recip_drF(k) = 1. _d 0/drF(k) |
|
recip_drF(K) = 1. _d 0/drF(K) |
|
163 |
ENDDO |
ENDDO |
164 |
|
|
165 |
|
_END_MASTER(myThid) |
166 |
|
_BARRIER |
167 |
|
|
168 |
RETURN |
RETURN |
169 |
END |
END |