File indexing completed on 2018-03-02 18:41:58 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
d77e828db7 Ed H*0001 #include "MNC_OPTIONS.h"
0002
0003
0004
0005
c424ee7cc7 Jean*0006
d77e828db7 Ed H*0007
c424ee7cc7 Jean*0008 SUBROUTINE MNC_CW_WRITE_CVAR(
0009 I fname,
0010 I cvname,
0011 I fid,
0012 I did,
0013 I bi, bj,
d77e828db7 Ed H*0014 I myThid )
0015
0016
0017
0018
0019
0020 implicit none
07155994b8 Mart*0021 #include "MNC_COMMON.h"
d77e828db7 Ed H*0022 #include "SIZE.h"
0023 #include "EEPARAMS.h"
0024 #include "PARAMS.h"
0025 #include "GRID.h"
2f38f768b3 Ed H*0026 #ifdef ALLOW_EXCH2
f9f661930b Jean*0027 #include "W2_EXCH2_SIZE.h"
2f38f768b3 Ed H*0028 #include "W2_EXCH2_TOPOLOGY.h"
0029 #endif
853ee6565e Jean*0030 #include "netcdf.inc"
2f38f768b3 Ed H*0031
0032
0033 integer IFNBLNK, ILNBLNK
d77e828db7 Ed H*0034
0035
0036 character*(*) fname
0037 character*(*) cvname
0038 integer fid, did, bi,bj
0039 integer myThid
0040
0041
0042
8b4eff4f81 Mart*0043 integer i, vid, nnf, nnl, doit, err
2f38f768b3 Ed H*0044 integer nids, cv_did(1), xtmin,ytmin
d77e828db7 Ed H*0045 character*(MAX_LEN_MBUF) msgbuf
0046 integer cv_start(1), cv_count(1)
7437aa2da1 Ed H*0047 _RS rtmp(sNx + 2*OLx + sNy + 2*OLy + Nr)
93077dbe26 Mart*0048
0049 integer MAX_LEN_NAME, ia
0050 PARAMETER ( MAX_LEN_NAME = 128 )
0051 character*(MAX_LEN_NAME) units, long_name, positive
0052
0053 DO i=1,MAX_LEN_NAME
0054 units(i:i) = ' '
0055 long_name(i:i) = ' '
0056 positive(i:i) = ' '
0057 ENDDO
d77e828db7 Ed H*0058
0059 nnf = IFNBLNK(cvname)
0060 nnl = ILNBLNK(cvname)
0061
2f38f768b3 Ed H*0062 xtmin = 0
0063 ytmin = 0
0064 #ifdef ALLOW_EXCH2
c424ee7cc7 Jean*0065 xtmin = exch2_tbasex(W2_myTileList(bi,bj))
0066 ytmin = exch2_tbasey(W2_myTileList(bi,bj))
a32626876a Mart*0067 #else
0068 IF ( .NOT. useCubedSphereExchange ) THEN
0069
0070
0071
0072
0073 xtmin = sNx * ( bi+(myXGlobalLo-1)/sNx - 1 )
0074 ytmin = sNy * ( bj+(myYGlobalLo-1)/sNy - 1 )
0075 ENDIF
2f38f768b3 Ed H*0076 #endif
0077 doit = 1
d77e828db7 Ed H*0078 nids = 1
0079 cv_did(1)= did
0080
0081
0082 IF (cvname(nnf:nnl) .EQ. 'X') THEN
0083
0084 cv_start(1) = 1
0085 cv_count(1) = sNx
2f38f768b3 Ed H*0086 #ifdef ALLOW_EXCH2
8b4eff4f81 Mart*0087 DO i = cv_start(1),cv_count(1)
0088 rtmp(i) = xtmin + i
0089 ENDDO
2f38f768b3 Ed H*0090 #else
f09d1f5f7d Mart*0091 IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
8b4eff4f81 Mart*0092 DO i = cv_start(1),cv_count(1)
0093 rtmp(i) = xtmin + i
0094 ENDDO
0095 ELSE
0096 DO i = cv_start(1),cv_count(1)
d77e828db7 Ed H*0097 rtmp(i) = xC(i,1,bi,bj)
8b4eff4f81 Mart*0098 ENDDO
0099 ENDIF
2f38f768b3 Ed H*0100 #endif
93077dbe26 Mart*0101 IF ( usingCartesianGrid ) THEN
0102 long_name = 'X-coordinate of cell center'
0103 units = 'meters'
0104 ELSEIF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
c424ee7cc7 Jean*0105 long_name = 'i-index of cell center'
93077dbe26 Mart*0106 units = 'none'
0107 ELSEIF ( usingSphericalPolarGrid ) THEN
0108 long_name = 'longitude of cell center'
0109 units = 'degrees_east'
0110 ELSEIF ( usingCylindricalGrid ) THEN
0111 long_name = 'polar angle coordinate of cell center'
0112 units = 'degrees'
0113 ELSE
0114
0115 print *, 'S/R MNC_CW_CVARS: Ooops, unknown horizontal grid!'
0116 ENDIF
d77e828db7 Ed H*0117
0118 ELSEIF (cvname(nnf:nnl) .EQ. 'Xp1') THEN
0119
0120 cv_start(1) = 1
0121 cv_count(1) = sNx + 1
2f38f768b3 Ed H*0122 #ifdef ALLOW_EXCH2
8b4eff4f81 Mart*0123 DO i = cv_start(1),cv_count(1)
0124 rtmp(i) = xtmin + i
0125 ENDDO
2f38f768b3 Ed H*0126 #else
f09d1f5f7d Mart*0127 IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
8b4eff4f81 Mart*0128 DO i = cv_start(1),cv_count(1)
0129 rtmp(i) = xtmin + i
0130 ENDDO
0131 ELSE
0132 DO i = cv_start(1),cv_count(1)
d77e828db7 Ed H*0133 rtmp(i) = xG(i,1,bi,bj)
8b4eff4f81 Mart*0134 ENDDO
0135 ENDIF
2f38f768b3 Ed H*0136 #endif
93077dbe26 Mart*0137 IF ( usingCartesianGrid ) THEN
0138 long_name = 'X-Coordinate of cell corner'
0139 units = 'meters'
0140 ELSEIF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
c424ee7cc7 Jean*0141 long_name = 'i-index of cell corner'
93077dbe26 Mart*0142 units = 'none'
0143 ELSEIF ( usingSphericalPolarGrid ) THEN
0144 long_name = 'longitude of cell corner'
0145 units = 'degrees_east'
0146 ELSEIF ( usingCylindricalGrid ) THEN
0147 long_name = 'polar angle of cell corner'
0148 units = 'degrees'
0149 ELSE
0150
0151 print *, 'S/R MNC_CW_CVARS: Ooops, unknown horizontal grid!'
0152 ENDIF
d77e828db7 Ed H*0153
7437aa2da1 Ed H*0154 ELSEIF (cvname(nnf:nnl) .EQ. 'Xwh') THEN
0155
0156 cv_start(1) = 1
0157 cv_count(1) = sNx + 2*OLx
2f38f768b3 Ed H*0158 #ifdef ALLOW_EXCH2
8b4eff4f81 Mart*0159 DO i = cv_start(1),cv_count(1)
0160 rtmp(i) = xtmin + i
0161 ENDDO
2f38f768b3 Ed H*0162 #else
f09d1f5f7d Mart*0163 IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
8b4eff4f81 Mart*0164 DO i = cv_start(1),cv_count(1)
0165 rtmp(i) = xtmin - OLx + i
0166 ENDDO
0167 ELSE
0168 DO i = cv_start(1),cv_count(1)
7437aa2da1 Ed H*0169 rtmp(i) = xC(i,1,bi,bj)
93077dbe26 Mart*0170
8b4eff4f81 Mart*0171 ENDDO
0172 ENDIF
2f38f768b3 Ed H*0173 #endif
93077dbe26 Mart*0174 IF ( usingCartesianGrid ) THEN
0175 long_name = 'X-Coordinate of cell center including overlaps'
0176 units = 'meters'
0177 ELSEIF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
c424ee7cc7 Jean*0178 long_name = 'i-index of cell center including overlaps'
93077dbe26 Mart*0179 units = 'none'
0180 ELSEIF ( usingSphericalPolarGrid ) THEN
0181 long_name = 'longitude of cell center including overlaps'
0182 units = 'degrees_east'
0183 ELSEIF ( usingCylindricalGrid ) THEN
c424ee7cc7 Jean*0184 long_name =
93077dbe26 Mart*0185 & 'polar angle coordinate of cell center including overlaps'
0186 units = 'degrees'
0187 ELSE
0188
0189 print *, 'S/R MNC_CW_CVARS: Ooops, unknown horizontal grid!'
0190 ENDIF
c424ee7cc7 Jean*0191
d77e828db7 Ed H*0192 ELSEIF (cvname(nnf:nnl) .EQ. 'Y') THEN
0193
0194 cv_start(1) = 1
0195 cv_count(1) = sNy
2f38f768b3 Ed H*0196 #ifdef ALLOW_EXCH2
8b4eff4f81 Mart*0197 DO i = cv_start(1),cv_count(1)
0198 rtmp(i) = ytmin + i
0199 ENDDO
2f38f768b3 Ed H*0200 #else
f09d1f5f7d Mart*0201 IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
8b4eff4f81 Mart*0202 DO i = cv_start(1),cv_count(1)
0203 rtmp(i) = ytmin + i
0204 ENDDO
0205 ELSE
0206 DO i = cv_start(1),cv_count(1)
d77e828db7 Ed H*0207 rtmp(i) = yC(1,i,bi,bj)
8b4eff4f81 Mart*0208 ENDDO
0209 ENDIF
2f38f768b3 Ed H*0210 #endif
93077dbe26 Mart*0211 IF ( usingCartesianGrid ) THEN
0212 long_name = 'Y-Coordinate of cell center'
0213 units = 'meters'
0214 ELSEIF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
c424ee7cc7 Jean*0215 long_name = 'j-index of cell center'
93077dbe26 Mart*0216 units = 'none'
0217 ELSEIF ( usingSphericalPolarGrid ) THEN
0218 long_name = 'latitude of cell center'
0219 units = 'degrees_north'
0220 ELSEIF ( usingCylindricalGrid ) THEN
0221 long_name = 'radial coordinate of cell center'
0222 units = 'meters'
0223 ELSE
0224
0225 print *, 'S/R MNC_CW_CVARS: Ooops, unknown horizontal grid!'
0226 ENDIF
d77e828db7 Ed H*0227
0228 ELSEIF (cvname(nnf:nnl) .EQ. 'Yp1') THEN
0229
0230 cv_start(1) = 1
0231 cv_count(1) = sNy + 1
2f38f768b3 Ed H*0232 #ifdef ALLOW_EXCH2
8b4eff4f81 Mart*0233 DO i = cv_start(1),cv_count(1)
0234 rtmp(i) = ytmin + i
0235 ENDDO
2f38f768b3 Ed H*0236 #else
f09d1f5f7d Mart*0237 IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
8b4eff4f81 Mart*0238 DO i = cv_start(1),cv_count(1)
0239 rtmp(i) = ytmin + i
0240 ENDDO
0241 ELSE
0242 DO i = cv_start(1),cv_count(1)
d77e828db7 Ed H*0243 rtmp(i) = yG(1,i,bi,bj)
8b4eff4f81 Mart*0244 ENDDO
0245 ENDIF
2f38f768b3 Ed H*0246 #endif
93077dbe26 Mart*0247 IF ( usingCartesianGrid ) THEN
0248 long_name = 'Y-Coordinate of cell corner'
0249 units = 'meters'
0250 ELSEIF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
c424ee7cc7 Jean*0251 long_name = 'j-index of cell corner'
93077dbe26 Mart*0252 units = 'none'
0253 ELSEIF ( usingSphericalPolarGrid ) THEN
0254 long_name = 'latitude of cell corner'
0255 units = 'degrees_north'
0256 ELSEIF ( usingCylindricalGrid ) THEN
0257 long_name = 'radial coordinate of cell corner'
0258 units = 'meters'
0259 ELSE
0260
0261 print *, 'S/R MNC_CW_CVARS: Ooops, unknown horizontal grid!'
0262 ENDIF
d77e828db7 Ed H*0263
7437aa2da1 Ed H*0264 ELSEIF (cvname(nnf:nnl) .EQ. 'Ywh') THEN
0265
0266 cv_start(1) = 1
0267 cv_count(1) = sNy + 2*OLy
2f38f768b3 Ed H*0268 #ifdef ALLOW_EXCH2
8b4eff4f81 Mart*0269 DO i = cv_start(1),cv_count(1)
0270 rtmp(i) = ytmin + i
0271 ENDDO
2f38f768b3 Ed H*0272 #else
f09d1f5f7d Mart*0273 IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
8b4eff4f81 Mart*0274 DO i = cv_start(1),cv_count(1)
0275 rtmp(i) = ytmin - OLy + i
0276 ENDDO
0277 ELSE
0278 DO i = cv_start(1),cv_count(1)
7437aa2da1 Ed H*0279 rtmp(i) = yC(1,i-OLy,bi,bj)
8b4eff4f81 Mart*0280 ENDDO
0281 ENDIF
2f38f768b3 Ed H*0282 #endif
93077dbe26 Mart*0283 IF ( usingCartesianGrid ) THEN
0284 long_name = 'Y-Coordinate of cell center including overlaps'
0285 units = 'meters'
0286 ELSEIF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
c424ee7cc7 Jean*0287 long_name = 'j-index of cell center including overlaps'
93077dbe26 Mart*0288 units = 'none'
0289 ELSEIF ( usingSphericalPolarGrid ) THEN
0290 long_name = 'latitude of cell center including overlaps'
0291 units = 'degrees_north'
0292 ELSEIF ( usingCylindricalGrid ) THEN
c424ee7cc7 Jean*0293 long_name =
93077dbe26 Mart*0294 & 'radial coordinate of cell center including overlaps'
0295 units = 'meters'
0296 ELSE
0297
0298 print *, 'S/R MNC_CW_CVARS: Ooops, unknown horizontal grid!'
0299 ENDIF
7437aa2da1 Ed H*0300
d77e828db7 Ed H*0301 ELSEIF (cvname(nnf:nnl) .EQ. 'Z') THEN
0302
0303 cv_start(1) = 1
0304 cv_count(1) = Nr
0305 DO i = cv_start(1),cv_count(1)
0306 rtmp(i) = rC(i)
0307 ENDDO
c424ee7cc7 Jean*0308
93077dbe26 Mart*0309 long_name = 'vertical coordinate of cell center'
0310 IF ( usingZCoords ) THEN
0311 units = 'meters'
0312 positive = 'up'
0313 ELSEIF ( usingPCoords ) THEN
0314 units = 'pascal'
0315 ELSE
0316
0317 print *, 'S/R MNC_CW_CVARS: Ooops, unknown vertical grid!'
0318 ENDIF
d77e828db7 Ed H*0319
0320 ELSEIF (cvname(nnf:nnl) .EQ. 'Zp1') THEN
0321
0322 cv_start(1) = 1
0323 cv_count(1) = Nr + 1
0324 DO i = cv_start(1),cv_count(1)
0325 rtmp(i) = rF(i)
0326 ENDDO
93077dbe26 Mart*0327
0328 long_name = 'vertical coordinate of cell interface'
0329 IF ( usingZCoords ) THEN
0330 units = 'meters'
0331 positive = 'up'
0332 ELSEIF ( usingPCoords ) THEN
0333 units = 'pascal'
0334 ELSE
0335
0336 print *, 'S/R MNC_CW_CVARS: Ooops, unknown vertical grid!'
0337 ENDIF
2f38f768b3 Ed H*0338
2cc3b69a26 Ed H*0339 ELSEIF (cvname(nnf:nnl) .EQ. 'Zu') THEN
0340
0341 cv_start(1) = 1
0342 cv_count(1) = Nr
0343 DO i = cv_start(1),cv_count(1)
0344 rtmp(i) = rF(i + 1)
0345 ENDDO
93077dbe26 Mart*0346
0347 IF ( usingZCoords ) THEN
0348 long_name = 'vertical coordinate of lower cell interface'
0349 units = 'meters'
0350 positive = 'up'
0351 ELSEIF ( usingPCoords ) THEN
0352 long_name = 'vertical coordinate of upper cell interface'
0353 units = 'pascal'
0354 ELSE
0355
0356 print *, 'S/R MNC_CW_CVARS: Ooops, unknown vertical grid!'
0357 ENDIF
2cc3b69a26 Ed H*0358
0359 ELSEIF (cvname(nnf:nnl) .EQ. 'Zl') THEN
0360
0361 cv_start(1) = 1
0362 cv_count(1) = Nr
0363 DO i = cv_start(1),cv_count(1)
0364 rtmp(i) = rF(i)
0365 ENDDO
93077dbe26 Mart*0366
0367 IF ( usingZCoords ) THEN
0368 long_name = 'vertical coordinate of upper cell interface'
0369 units = 'meters'
0370 positive = 'up'
0371 ELSEIF ( usingPCoords ) THEN
0372 long_name = 'vertical coordinate of lower cell interface'
0373 units = 'pascal'
0374 ELSE
0375
0376 print *, 'S/R MNC_CW_CVARS: Ooops, unknown vertical grid!'
0377 ENDIF
2cc3b69a26 Ed H*0378
0379 ELSEIF (cvname(nnf:nnl) .EQ. 'Zm1') THEN
0380
0381 cv_start(1) = 1
0382 cv_count(1) = Nr - 1
0383 DO i = cv_start(1),cv_count(1)
0384 rtmp(i) = rF(i + 1)
0385 ENDDO
93077dbe26 Mart*0386
0387 IF ( usingZCoords ) THEN
0388 long_name = 'vertical coordinate of lower cell interface'
0389 units = 'meters'
0390 positive = 'up'
0391 ELSEIF ( usingPCoords ) THEN
0392 long_name = 'vertical coordinate of upper cell interface'
0393 units = 'pascal'
0394 ELSE
0395
0396 print *, 'S/R MNC_CW_CVARS: Ooops, unknown vertical grid!'
0397 ENDIF
2cc3b69a26 Ed H*0398
2f38f768b3 Ed H*0399 ELSE
0400
0401 doit = 0
d77e828db7 Ed H*0402
0403 ENDIF
0404
0405 IF ( doit .EQ. 1 ) THEN
0406
0407 CALL MNC_FILE_REDEF(fname, myThid)
0cfbcf1186 Mart*0408 #ifdef REAL4_IS_SLOW
c424ee7cc7 Jean*0409 err = NF_DEF_VAR(fid, cvname, NF_DOUBLE,
d77e828db7 Ed H*0410 & nids, cv_did, vid)
0cfbcf1186 Mart*0411 #else
c424ee7cc7 Jean*0412 err = NF_DEF_VAR(fid, cvname, NF_FLOAT,
0cfbcf1186 Mart*0413 & nids, cv_did, vid)
0414 #endif /* REAL4_IS_SLOW */
16a9213e57 Ed H*0415 i = ILNBLNK( fname )
c424ee7cc7 Jean*0416 write(msgbuf,'(5a)') 'defining coordinate variable ''',
16a9213e57 Ed H*0417 & cvname(nnf:nnl), ''' in file ''', fname(1:i), ''''
d77e828db7 Ed H*0418 CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
93077dbe26 Mart*0419
0420 ia = ILNBLNK(long_name)
0421 IF ( ia .GT. 0 ) THEN
0422 err = NF_PUT_ATT_TEXT(fid, vid, 'long_name', ia, long_name)
c424ee7cc7 Jean*0423 write(msgbuf,'(5a)')
0424 & 'adding attribute ''long_name'' to coordinate variable ''',
93077dbe26 Mart*0425 & cvname(nnf:nnl), ''' in file ''', fname(1:i), ''''
0426 CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
0427 ENDIF
0428 ia = ILNBLNK(units)
0429 IF ( ia .GT. 0 ) THEN
0430 err = NF_PUT_ATT_TEXT(fid, vid, 'units', ia, units)
c424ee7cc7 Jean*0431 write(msgbuf,'(5a)')
0432 & 'adding attribute ''units'' to coordinate variable ''',
93077dbe26 Mart*0433 & cvname(nnf:nnl), ''' in file ''', fname(1:i), ''''
0434 CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
0435 ENDIF
0436 ia = ILNBLNK(positive)
0437 IF ( ia .GT. 0 ) THEN
0438 err = NF_PUT_ATT_TEXT(fid, vid, 'positive', ia, positive)
c424ee7cc7 Jean*0439 write(msgbuf,'(5a)')
0440 & 'adding attribute ''positive'' to coordinate variable ''',
93077dbe26 Mart*0441 & cvname(nnf:nnl), ''' in file ''', fname(1:i), ''''
0442 CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
0443 ENDIF
c424ee7cc7 Jean*0444
d77e828db7 Ed H*0445 CALL MNC_FILE_ENDDEF(fname, myThid)
0cfbcf1186 Mart*0446 #ifdef REAL4_IS_SLOW
c424ee7cc7 Jean*0447 err = NF_PUT_VARA_DOUBLE(fid, vid,
d77e828db7 Ed H*0448 & cv_start, cv_count, rtmp)
0cfbcf1186 Mart*0449 #else
c424ee7cc7 Jean*0450 err = NF_PUT_VARA_REAL(fid, vid,
0cfbcf1186 Mart*0451 & cv_start, cv_count, rtmp)
0452 #endif /* REAL4_IS_SLOW */
c424ee7cc7 Jean*0453 write(msgbuf,'(5a)') 'writing coordinate variable ''',
16a9213e57 Ed H*0454 & cvname(nnf:nnl), ''' in file ''', fname(1:i), ''''
d77e828db7 Ed H*0455 CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
c424ee7cc7 Jean*0456
d77e828db7 Ed H*0457 ENDIF
0458
0459 RETURN
0460 END
0461
0462
0463