File indexing completed on 2018-03-02 18:42:00 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
e9b72f2bd9 Ed H*0001 #include "MNC_OPTIONS.h"
c424ee7cc7 Jean*0002
b6432c788b Jean*0003
0004
0005
0006
0007
0008
0009
0010
0011
0012
0013
0014
0015
0016
0017
0018
0019
e9b72f2bd9 Ed H*0020
e6bb5b2cc3 Ed H*0021
1b5fb69d21 Ed H*0022
e9b72f2bd9 Ed H*0023
1b5fb69d21 Ed H*0024
c424ee7cc7 Jean*0025 SUBROUTINE MNC_CW_ADD_GNAME(
0026 I name,
0027 I ndim,
0028 I dlens,
0029 I dnames,
0030 I inds_beg, inds_end,
3f2ea2a4ed Ed H*0031 I myThid )
e9b72f2bd9 Ed H*0032
1b5fb69d21 Ed H*0033
0034
c424ee7cc7 Jean*0035
1b5fb69d21 Ed H*0036
e9b72f2bd9 Ed H*0037 implicit none
07155994b8 Mart*0038 #include "MNC_COMMON.h"
e9b72f2bd9 Ed H*0039 #include "EEPARAMS.h"
0040
1b5fb69d21 Ed H*0041
e9b72f2bd9 Ed H*0042 integer myThid, ndim
0043 character*(*) name
580dd6560d Ed H*0044 integer dlens(*), inds_beg(*), inds_end(*)
0045 character*(*) dnames(*)
e6bb5b2cc3 Ed H*0046
e9b72f2bd9 Ed H*0047
1b5fb69d21 Ed H*0048
e9b72f2bd9 Ed H*0049 integer i, nnf,nnl, indg
0050 character*(MAX_LEN_MBUF) msgbuf
e6bb5b2cc3 Ed H*0051
1b5fb69d21 Ed H*0052
0053 integer IFNBLNK, ILNBLNK
e9b72f2bd9 Ed H*0054
0055 nnf = IFNBLNK(name)
0056 nnl = ILNBLNK(name)
0057
0058
3f2ea2a4ed Ed H*0059 CALL MNC_GET_IND(MNC_MAX_ID, name, mnc_cw_gname, indg, myThid)
e9b72f2bd9 Ed H*0060 IF (indg .GT. 0) THEN
c424ee7cc7 Jean*0061 write(msgbuf,'(3a)') 'MNC_CW_ADD_GNAME ERROR: ''', name,
e9b72f2bd9 Ed H*0062 & ''' is already defined'
0063 CALL print_error(msgbuf, mythid)
15688ab4b4 Ed H*0064 stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME'
e9b72f2bd9 Ed H*0065 ENDIF
c424ee7cc7 Jean*0066 CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_gname,
9705a0d5c6 Ed H*0067 & 'mnc_cw_gname', indg, myThid)
e9b72f2bd9 Ed H*0068
15688ab4b4 Ed H*0069 mnc_cw_gname(indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
0070 mnc_cw_gname(indg)(1:(nnl-nnf+1)) = name(nnf:nnl)
e9b72f2bd9 Ed H*0071 mnc_cw_ndim(indg) = ndim
0072
0073 DO i = 1,ndim
0074 mnc_cw_dn(i,indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
0075 nnf = IFNBLNK(dnames(i))
0076 nnl = ILNBLNK(dnames(i))
0077 mnc_cw_dn(i,indg)(1:(nnl-nnf+1)) = dnames(i)(nnf:nnl)
0078 mnc_cw_dims(i,indg) = dlens(i)
0079 mnc_cw_is(i,indg) = inds_beg(i)
0080 mnc_cw_ie(i,indg) = inds_end(i)
0081 ENDDO
0082
0083 RETURN
0084 END
0085
15688ab4b4 Ed H*0086
ce33c3eabe Ed H*0087
0088
0089
0090
c424ee7cc7 Jean*0091 SUBROUTINE MNC_CW_DEL_GNAME(
0092 I name,
ce33c3eabe Ed H*0093 I myThid )
0094
0095
0096
c424ee7cc7 Jean*0097
ce33c3eabe Ed H*0098
0099 implicit none
07155994b8 Mart*0100 #include "MNC_COMMON.h"
ce33c3eabe Ed H*0101 #include "EEPARAMS.h"
0102
0103
0104 integer myThid
0105 character*(*) name
0106
0107
0108
0109 integer nnf,nnl, indg
0110
0111
0112 integer IFNBLNK, ILNBLNK
0113
0114 nnf = IFNBLNK(name)
0115 nnl = ILNBLNK(name)
0116
0117
0118 CALL MNC_GET_IND(MNC_MAX_ID, name, mnc_cw_gname, indg, myThid)
0119 IF (indg .LT. 1) THEN
0120 RETURN
0121 ENDIF
0122
0123 mnc_cw_gname(indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
0124 mnc_cw_ndim(indg) = 0
0125
0126 RETURN
0127 END
0128
0129
e6bb5b2cc3 Ed H*0130
1b5fb69d21 Ed H*0131
15688ab4b4 Ed H*0132
1b5fb69d21 Ed H*0133
1d48290185 Ed H*0134 SUBROUTINE MNC_CW_DUMP( myThid )
15688ab4b4 Ed H*0135
1b5fb69d21 Ed H*0136
0137
0138
c424ee7cc7 Jean*0139
1b5fb69d21 Ed H*0140
15688ab4b4 Ed H*0141 implicit none
07155994b8 Mart*0142 #include "MNC_COMMON.h"
1d48290185 Ed H*0143 #include "SIZE.h"
0144 #include "EEPARAMS.h"
0145 #include "PARAMS.h"
0146
1b5fb69d21 Ed H*0147
1d48290185 Ed H*0148 integer myThid
e6bb5b2cc3 Ed H*0149
15688ab4b4 Ed H*0150
1b5fb69d21 Ed H*0151
15688ab4b4 Ed H*0152 integer i,j, ntot
1d48290185 Ed H*0153 integer NBLNK
0154 parameter ( NBLNK = 150 )
0155 character s1*(NBLNK), blnk*(NBLNK)
15688ab4b4 Ed H*0156
1d48290185 Ed H*0157 _BEGIN_MASTER(myThid)
c424ee7cc7 Jean*0158
1d48290185 Ed H*0159 DO i = 1,NBLNK
0160 blnk(i:i) = ' '
0161 ENDDO
c424ee7cc7 Jean*0162
1d48290185 Ed H*0163 s1(1:NBLNK) = blnk(1:NBLNK)
0164 write(s1,'(a5,a)') 'MNC: ',
0165 & 'The currently defined Grid Types are:'
0166 CALL PRINT_MESSAGE(
0167 & s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
15688ab4b4 Ed H*0168 ntot = 0
0169 DO j = 1,MNC_MAX_ID
c424ee7cc7 Jean*0170 IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR)
15688ab4b4 Ed H*0171 & .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
c424ee7cc7 Jean*0172
15688ab4b4 Ed H*0173 ntot = ntot + 1
1d48290185 Ed H*0174 s1(1:NBLNK) = blnk(1:NBLNK)
c90c060abd Ed H*0175 write(s1,'(a5,2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a8)')
1d48290185 Ed H*0176 & 'MNC: ',
c424ee7cc7 Jean*0177 & j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),
0178 & ' : ', (mnc_cw_dims(i,j), i=1,5),
15688ab4b4 Ed H*0179 & ' | ', (mnc_cw_is(i,j), i=1,5),
0180 & ' | ', (mnc_cw_ie(i,j), i=1,5),
c90c060abd Ed H*0181 & ' | ', (mnc_cw_dn(i,j)(1:7), i=1,5)
1d48290185 Ed H*0182 CALL PRINT_MESSAGE(
0183 & s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
c424ee7cc7 Jean*0184
15688ab4b4 Ed H*0185 ENDIF
0186 ENDDO
c424ee7cc7 Jean*0187
1d48290185 Ed H*0188 s1(1:NBLNK) = blnk(1:NBLNK)
0189 write(s1,'(a5,a)') 'MNC: ',
0190 & 'The currently defined Variable Types are:'
0191 CALL PRINT_MESSAGE(
0192 & s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
3623ff8097 Ed H*0193 ntot = 0
0194 DO j = 1,MNC_MAX_ID
c424ee7cc7 Jean*0195 IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR)
3623ff8097 Ed H*0196 & .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
c424ee7cc7 Jean*0197
3623ff8097 Ed H*0198 ntot = ntot + 1
1d48290185 Ed H*0199 s1(1:NBLNK) = blnk(1:NBLNK)
0200 write(s1,'(a5,2i5,a3,a25,a3,i4)') 'MNC: ',
c424ee7cc7 Jean*0201 & j, ntot, ' | ',
1d48290185 Ed H*0202 & mnc_cw_vname(j)(1:20), ' | ', mnc_cw_vgind(j)
0203 CALL PRINT_MESSAGE(
0204 & s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
c424ee7cc7 Jean*0205
3623ff8097 Ed H*0206 DO i = 1,mnc_cw_vnat(1,j)
1d48290185 Ed H*0207 s1(1:NBLNK) = blnk(1:NBLNK)
c424ee7cc7 Jean*0208 write(s1,'(a5,a14,i4,a3,a25,a3,a55)')
0209 & 'MNC: ',' text_at:',i,
3623ff8097 Ed H*0210 & ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ',
9705a0d5c6 Ed H*0211 & mnc_cw_vtat(i,j)(1:MNC_MAX_CHAR)
1d48290185 Ed H*0212 CALL PRINT_MESSAGE(
0213 & s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
3623ff8097 Ed H*0214 ENDDO
0215 DO i = 1,mnc_cw_vnat(2,j)
1d48290185 Ed H*0216 s1(1:NBLNK) = blnk(1:NBLNK)
c424ee7cc7 Jean*0217 write(s1,'(a5,a14,i4,a3,a25,a3,i20)')
0218 & 'MNC: ',' int__at:',i,
3623ff8097 Ed H*0219 & ' : ', mnc_cw_vinm(i,j)(1:25), ' : ',
0220 & mnc_cw_viat(i,j)
1d48290185 Ed H*0221 CALL PRINT_MESSAGE(
0222 & s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
3623ff8097 Ed H*0223 ENDDO
0224 DO i = 1,mnc_cw_vnat(3,j)
1d48290185 Ed H*0225 s1(1:NBLNK) = blnk(1:NBLNK)
c424ee7cc7 Jean*0226 write(s1,'(a5,a14,i4,a3,a25,a3,f25.10)')
0227 & 'MNC: ',' dbl__at:',i,
3623ff8097 Ed H*0228 & ' : ', mnc_cw_vdnm(i,j)(1:25), ' : ',
0229 & mnc_cw_vdat(i,j)
1d48290185 Ed H*0230 CALL PRINT_MESSAGE(
0231 & s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
0232 ENDDO
c424ee7cc7 Jean*0233
3623ff8097 Ed H*0234 ENDIF
0235 ENDDO
0236 IF (ntot .EQ. 0) THEN
1d48290185 Ed H*0237 s1(1:NBLNK) = blnk(1:NBLNK)
0238 write(s1,'(a)') 'MNC: None defined!'
0239 CALL PRINT_MESSAGE(
0240 & s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
3623ff8097 Ed H*0241 ENDIF
c424ee7cc7 Jean*0242
1d48290185 Ed H*0243 _END_MASTER(myThid)
3623ff8097 Ed H*0244
15688ab4b4 Ed H*0245 RETURN
0246 END
e9b72f2bd9 Ed H*0247
0248
e6bb5b2cc3 Ed H*0249
357126def9 Ed H*0250
0251
0252
c424ee7cc7 Jean*0253 SUBROUTINE MNC_CW_APPEND_VNAME(
0254 I vname,
0255 I gname,
0256 I bi_dim, bj_dim,
357126def9 Ed H*0257 I myThid )
0258
0259
0260
0261
c424ee7cc7 Jean*0262
357126def9 Ed H*0263
0264 implicit none
07155994b8 Mart*0265 #include "MNC_COMMON.h"
357126def9 Ed H*0266
0267
0268 integer myThid, bi_dim, bj_dim
0269 character*(*) vname, gname
0270
0271
0272
0273 integer indv
0274
0275
0276 CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
0277 IF (indv .LT. 1) THEN
0278 CALL MNC_CW_ADD_VNAME(vname, gname, bi_dim, bj_dim, myThid)
0279 ENDIF
0280
0281
0282 RETURN
0283 END
0284
0285
0286
1b5fb69d21 Ed H*0287
e9b72f2bd9 Ed H*0288
1b5fb69d21 Ed H*0289
c424ee7cc7 Jean*0290 SUBROUTINE MNC_CW_ADD_VNAME(
0291 I vname,
0292 I gname,
0293 I bi_dim, bj_dim,
3f2ea2a4ed Ed H*0294 I myThid )
15688ab4b4 Ed H*0295
c424ee7cc7 Jean*0296
357126def9 Ed H*0297
0298
e6bb5b2cc3 Ed H*0299
0300
0301
0302
0303
0304
0305
c424ee7cc7 Jean*0306
1b5fb69d21 Ed H*0307
15688ab4b4 Ed H*0308 implicit none
07155994b8 Mart*0309 #include "MNC_COMMON.h"
15688ab4b4 Ed H*0310 #include "EEPARAMS.h"
0311
1b5fb69d21 Ed H*0312
ef84d10314 Ed H*0313 integer myThid, bi_dim, bj_dim
15688ab4b4 Ed H*0314 character*(*) vname, gname
e6bb5b2cc3 Ed H*0315
15688ab4b4 Ed H*0316
1b5fb69d21 Ed H*0317
15688ab4b4 Ed H*0318 integer i, nvf,nvl, ngf,ngl, indv,indg
0319 character*(MAX_LEN_MBUF) msgbuf
e6bb5b2cc3 Ed H*0320
1b5fb69d21 Ed H*0321
0322 integer IFNBLNK, ILNBLNK
15688ab4b4 Ed H*0323
0324 nvf = IFNBLNK(vname)
0325 nvl = ILNBLNK(vname)
0326 ngf = IFNBLNK(gname)
0327 ngl = ILNBLNK(gname)
0328
0329
3f2ea2a4ed Ed H*0330 CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
15688ab4b4 Ed H*0331 IF (indv .GT. 0) THEN
c424ee7cc7 Jean*0332 write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
15688ab4b4 Ed H*0333 & vname(nvf:nvl), ''' is already defined'
0334 CALL print_error(msgbuf, mythid)
0335 stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
0336 ENDIF
c424ee7cc7 Jean*0337 CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_vname,
9705a0d5c6 Ed H*0338 & 'mnc_cw_vname', indv, myThid)
15688ab4b4 Ed H*0339
0340
3f2ea2a4ed Ed H*0341 CALL MNC_GET_IND(MNC_MAX_ID, gname, mnc_cw_gname, indg, myThid)
15688ab4b4 Ed H*0342 IF (indg .LT. 1) THEN
c424ee7cc7 Jean*0343 write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
15688ab4b4 Ed H*0344 & gname(ngf:ngl), ''' is not defined'
0345 CALL print_error(msgbuf, mythid)
0346 stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
0347 ENDIF
0348
0349 mnc_cw_vname(indv)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
0350 mnc_cw_vname(indv)(1:(nvl-nvf+1)) = vname(nvf:nvl)
0351 mnc_cw_vgind(indv) = indg
0352 DO i = 1,3
0353 mnc_cw_vnat(i,indv) = 0
0354 ENDDO
ef84d10314 Ed H*0355 mnc_cw_vbij(1,indv) = bi_dim
0356 mnc_cw_vbij(2,indv) = bj_dim
15688ab4b4 Ed H*0357
1d87512e64 Ed H*0358 #ifdef MNC_DEBUG_GTYPE
3f2ea2a4ed Ed H*0359 CALL MNC_CW_ADD_VATTR_TEXT(vname,1,'mitgcm_grid',gname, myThid)
1d87512e64 Ed H*0360 #endif
119438a015 Ed H*0361
15688ab4b4 Ed H*0362 RETURN
0363 END
0364
0365
e6bb5b2cc3 Ed H*0366
ce33c3eabe Ed H*0367
0368
0369
c424ee7cc7 Jean*0370 SUBROUTINE MNC_CW_DEL_VNAME(
0371 I vname,
ce33c3eabe Ed H*0372 I myThid )
0373
c424ee7cc7 Jean*0374
ce33c3eabe Ed H*0375
c424ee7cc7 Jean*0376
ce33c3eabe Ed H*0377
0378 implicit none
07155994b8 Mart*0379 #include "MNC_COMMON.h"
ce33c3eabe Ed H*0380 #include "EEPARAMS.h"
0381
0382
0383 integer myThid
0384 character*(*) vname
0385
0386
0387
0388 integer i, indv
0389
0390
0391 CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
0392 IF (indv .LT. 1) THEN
0393 RETURN
0394 ENDIF
0395
0396 mnc_cw_vname(indv)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
0397 mnc_cw_vgind(indv) = 0
0398 DO i = 1,3
0399 mnc_cw_vnat(i,indv) = 0
0400 ENDDO
0401
0402 RETURN
0403 END
0404
0405
580dd6560d Ed H*0406
1b5fb69d21 Ed H*0407
0408
c424ee7cc7 Jean*0409 SUBROUTINE MNC_CW_ADD_VATTR_TEXT(
0410 I vname, tname, tval,
3f2ea2a4ed Ed H*0411 I myThid )
3623ff8097 Ed H*0412
1b5fb69d21 Ed H*0413
0414
c424ee7cc7 Jean*0415
1b5fb69d21 Ed H*0416
3623ff8097 Ed H*0417 implicit none
0418
1b5fb69d21 Ed H*0419
2509c39694 Ed H*0420 integer myThid
0421 character*(*) vname, tname, tval
580dd6560d Ed H*0422 integer ival
0423 REAL*8 dval
1b5fb69d21 Ed H*0424
580dd6560d Ed H*0425 ival = 0
0426 dval = 0.0D0
0427 CALL MNC_CW_ADD_VATTR_ANY(vname, 1,
0428 & tname, ' ', ' ', tval, ival, dval, myThid )
3623ff8097 Ed H*0429 RETURN
0430 END
0431
1b5fb69d21 Ed H*0432
0433
0434
c424ee7cc7 Jean*0435 SUBROUTINE MNC_CW_ADD_VATTR_INT(
0436 I vname, iname, ival,
3f2ea2a4ed Ed H*0437 I myThid )
3623ff8097 Ed H*0438
1b5fb69d21 Ed H*0439
580dd6560d Ed H*0440
1b5fb69d21 Ed H*0441
0442
3623ff8097 Ed H*0443 implicit none
0444
1b5fb69d21 Ed H*0445
2509c39694 Ed H*0446 integer myThid
0447 character*(*) vname, iname
0448 integer ival
580dd6560d Ed H*0449 REAL*8 dval
1b5fb69d21 Ed H*0450
580dd6560d Ed H*0451 dval = 0.0D0
0452 CALL MNC_CW_ADD_VATTR_ANY(vname, 2,
0453 & ' ', iname, ' ', ' ', ival, dval, myThid )
3623ff8097 Ed H*0454 RETURN
0455 END
0456
580dd6560d Ed H*0457
1b5fb69d21 Ed H*0458
0459
c424ee7cc7 Jean*0460 SUBROUTINE MNC_CW_ADD_VATTR_DBL(
0461 I vname, dname, dval,
3f2ea2a4ed Ed H*0462 I myThid )
3623ff8097 Ed H*0463
1b5fb69d21 Ed H*0464
c424ee7cc7 Jean*0465
1b5fb69d21 Ed H*0466
0467
3623ff8097 Ed H*0468 implicit none
0469
1b5fb69d21 Ed H*0470
2509c39694 Ed H*0471 integer myThid
0472 character*(*) vname, dname
580dd6560d Ed H*0473 integer ival
2509c39694 Ed H*0474 REAL*8 dval
1b5fb69d21 Ed H*0475
580dd6560d Ed H*0476 ival = 0
0477 CALL MNC_CW_ADD_VATTR_ANY(vname, 3,
0478 & ' ', ' ', dname, ' ', ival, dval, myThid )
3623ff8097 Ed H*0479 RETURN
0480 END
0481
e6bb5b2cc3 Ed H*0482
1b5fb69d21 Ed H*0483
3623ff8097 Ed H*0484
1b5fb69d21 Ed H*0485
c424ee7cc7 Jean*0486 SUBROUTINE MNC_CW_ADD_VATTR_ANY(
0487 I vname,
580dd6560d Ed H*0488 I atype,
2509c39694 Ed H*0489 I tname, iname, dname,
c424ee7cc7 Jean*0490 I tval, ival, dval,
3f2ea2a4ed Ed H*0491 I myThid )
15688ab4b4 Ed H*0492
1b5fb69d21 Ed H*0493
0494
0495
15688ab4b4 Ed H*0496 implicit none
07155994b8 Mart*0497 #include "MNC_COMMON.h"
15688ab4b4 Ed H*0498 #include "EEPARAMS.h"
0499
1b5fb69d21 Ed H*0500
2509c39694 Ed H*0501 integer myThid
580dd6560d Ed H*0502 integer atype
15688ab4b4 Ed H*0503 character*(*) vname
2509c39694 Ed H*0504 character*(*) tname, iname, dname
0505 character*(*) tval
0506 integer ival
0507 REAL*8 dval
e6bb5b2cc3 Ed H*0508
15688ab4b4 Ed H*0509
1b5fb69d21 Ed H*0510
a52c49e4a8 Ed H*0511 integer n, nvf,nvl, n1,n2, indv, ic
15688ab4b4 Ed H*0512 character*(MAX_LEN_MBUF) msgbuf
e6bb5b2cc3 Ed H*0513
1b5fb69d21 Ed H*0514
0515 integer IFNBLNK, ILNBLNK
15688ab4b4 Ed H*0516
0517 nvf = IFNBLNK(vname)
0518 nvl = ILNBLNK(vname)
0519
0520
3f2ea2a4ed Ed H*0521 CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
15688ab4b4 Ed H*0522 IF (indv .LT. 1) THEN
c424ee7cc7 Jean*0523 write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''',
15688ab4b4 Ed H*0524 & vname(nvf:nvl), ''' is not defined'
0525 CALL print_error(msgbuf, mythid)
0526 stop 'ABNORMAL END: S/R MNC_CW_ADD_VATTR_ANY'
0527 ENDIF
0528
580dd6560d Ed H*0529 IF (atype .EQ. 1) THEN
0530
0531 n = mnc_cw_vnat(1,indv) + 1
0532 n1 = IFNBLNK(tname)
0533 n2 = ILNBLNK(tname)
79116c6cc5 Ed H*0534 IF ((n2-n1+1) .GT. MNC_MAX_CHAR) THEN
c424ee7cc7 Jean*0535 write(msgbuf,'(3a,i6,2a)')
79116c6cc5 Ed H*0536 & 'MNC_CW_ADD_VATTR_ANY WARNING: attribute name ''',
0537 & tname(n1:n2), ''' has more than ', MNC_MAX_CHAR,
a52c49e4a8 Ed H*0538 & ' characters and has been truncated to fit--please',
0539 & 'use a smaller name or increase MNC_MAX_CHAR'
1111090fe8 Jean*0540 CALL PRINT_MESSAGE( msgbuf, errorMessageUnit,
0541 & SQUEEZE_RIGHT , myThid)
79116c6cc5 Ed H*0542
0543 n2 = MNC_MAX_CHAR + n1 - 1
0544 ENDIF
580dd6560d Ed H*0545
0546 mnc_cw_vtnm(n,indv)(1:MNC_MAX_CHAR) =
39c888b928 Ed H*0547 & mnc_blank_name(1:MNC_MAX_CHAR)
580dd6560d Ed H*0548 mnc_cw_vtnm(n,indv)(1:(n2-n1+1)) = tname(n1:n2)
79116c6cc5 Ed H*0549
580dd6560d Ed H*0550 n1 = IFNBLNK(tval)
0551 n2 = ILNBLNK(tval)
a52c49e4a8 Ed H*0552 IF ((n2-n1+1) .GT. MNC_MAX_CATT) THEN
c424ee7cc7 Jean*0553 write(msgbuf,'(3a,i6,2a)')
79116c6cc5 Ed H*0554 & 'MNC_CW_ADD_VATTR_ANY WARNING: attribute value ''',
a52c49e4a8 Ed H*0555 & tval(n1:n2), ''' has more than ', MNC_MAX_CATT,
0556 & ' characters and has been truncated to fit--please',
0557 & 'use a smaller name or increase MNC_MAX_CATT'
1111090fe8 Jean*0558 CALL PRINT_MESSAGE( msgbuf, errorMessageUnit,
0559 & SQUEEZE_RIGHT , myThid)
a52c49e4a8 Ed H*0560 n2 = MNC_MAX_CATT + n1 - 1
79116c6cc5 Ed H*0561 ENDIF
c424ee7cc7 Jean*0562
a52c49e4a8 Ed H*0563 mnc_cw_vnat(1,indv) = n
0564 DO ic = 1,MNC_MAX_CATT
0565 mnc_cw_vtat(n,indv)(ic:ic) = ' '
0566 ENDDO
0567 IF ((n1 .NE. 0) .AND. (n2 .NE. 0)) THEN
d65cc4075b Ed H*0568 mnc_cw_vtat(n,indv)(1:(n2-n1+1)) = tval(n1:n2)
0569 ENDIF
580dd6560d Ed H*0570 ENDIF
c424ee7cc7 Jean*0571
580dd6560d Ed H*0572 IF (atype .EQ. 2) THEN
0573
0574 n = mnc_cw_vnat(2,indv) + 1
0575 n1 = IFNBLNK(iname)
0576 n2 = ILNBLNK(iname)
0577
0578 mnc_cw_vinm(n,indv)(1:(n2-n1+1)) = iname(n1:n2)
0579 mnc_cw_viat(n,indv) = ival
0580 mnc_cw_vnat(2,indv) = n
0581 ENDIF
0582
0583 IF (atype .EQ. 3) THEN
0584
0585 n = mnc_cw_vnat(3,indv) + 1
0586 n1 = IFNBLNK(dname)
0587 n2 = ILNBLNK(dname)
0588
0589 mnc_cw_vdnm(n,indv)(1:(n2-n1+1)) = dname(n1:n2)
0590 mnc_cw_vdat(n,indv) = dval
0591 mnc_cw_vnat(3,indv) = n
0592 ENDIF
c424ee7cc7 Jean*0593
15688ab4b4 Ed H*0594 RETURN
0595 END
0596
0597
e6bb5b2cc3 Ed H*0598
1b5fb69d21 Ed H*0599
15688ab4b4 Ed H*0600
1b5fb69d21 Ed H*0601
c424ee7cc7 Jean*0602 SUBROUTINE MNC_CW_GET_TILE_NUM(
0603 I bi, bj,
0604 O uniq_tnum,
3f2ea2a4ed Ed H*0605 I myThid )
3623ff8097 Ed H*0606
1b5fb69d21 Ed H*0607
0608
0609
3623ff8097 Ed H*0610 implicit none
0611 #include "EEPARAMS.h"
0612 #include "SIZE.h"
da4209d891 Ed H*0613 #ifdef ALLOW_EXCH2
f9f661930b Jean*0614 #include "W2_EXCH2_SIZE.h"
da4209d891 Ed H*0615 #include "W2_EXCH2_TOPOLOGY.h"
0616 #endif
3623ff8097 Ed H*0617
1b5fb69d21 Ed H*0618
3623ff8097 Ed H*0619 integer myThid, bi,bj, uniq_tnum
e6bb5b2cc3 Ed H*0620
3623ff8097 Ed H*0621
1b5fb69d21 Ed H*0622
3623ff8097 Ed H*0623 integer iG,jG
0624
b11e5981be Ed H*0625 iG = 0
0626 jG = 0
0627
3623ff8097 Ed H*0628 #ifdef ALLOW_EXCH2
0629
c424ee7cc7 Jean*0630 uniq_tnum = W2_myTileList(bi,bj)
3623ff8097 Ed H*0631
0632 #else
0633
0634
0635 iG = bi+(myXGlobalLo-1)/sNx
0636 jG = bj+(myYGlobalLo-1)/sNy
b11e5981be Ed H*0637
0638 uniq_tnum = (jG - 1)*(nPx*nSx) + iG
3623ff8097 Ed H*0639
0640 #endif
0641
b11e5981be Ed H*0642
0643
3623ff8097 Ed H*0644 RETURN
0645 END
0646
0647
e6bb5b2cc3 Ed H*0648
5bc9611487 Ed H*0649
0650
0651
c424ee7cc7 Jean*0652 SUBROUTINE MNC_CW_GET_FACE_NUM(
0653 I bi, bj,
0654 O uniq_fnum,
5bc9611487 Ed H*0655 I myThid )
0656
0657
0658
0659
0660 implicit none
0661 #include "EEPARAMS.h"
0662 #include "SIZE.h"
0663 #ifdef ALLOW_EXCH2
f9f661930b Jean*0664 #include "W2_EXCH2_SIZE.h"
5bc9611487 Ed H*0665 #include "W2_EXCH2_TOPOLOGY.h"
0666 #endif
0667
0668
0669 integer myThid, bi,bj, uniq_fnum
0670
0671
0672 #ifdef ALLOW_EXCH2
0673
c424ee7cc7 Jean*0674 uniq_fnum = exch2_myFace( W2_myTileList(bi,bj) )
5bc9611487 Ed H*0675
0676 #else
0677
0678
0679 uniq_fnum = -1
0680
0681 #endif
0682
0683 RETURN
0684 END
0685
0686
0687
0688
0689
0690
c424ee7cc7 Jean*0691 SUBROUTINE MNC_CW_GET_XYFO(
0692 I bi, bj,
0693 O ixoff, iyoff,
5bc9611487 Ed H*0694 I myThid )
0695
0696
0697
0698
0699 implicit none
0700 #include "EEPARAMS.h"
0701 #include "SIZE.h"
0702 #ifdef ALLOW_EXCH2
f9f661930b Jean*0703 #include "W2_EXCH2_SIZE.h"
5bc9611487 Ed H*0704 #include "W2_EXCH2_TOPOLOGY.h"
0705 #endif
0706
0707
0708 integer myThid, bi,bj, ixoff,iyoff
0709
0710
0711
b6432c788b Jean*0712 #ifdef ALLOW_EXCH2
5bc9611487 Ed H*0713 integer uniq_tnum
b6432c788b Jean*0714 #endif
5bc9611487 Ed H*0715
0716 #ifdef ALLOW_EXCH2
0717
c424ee7cc7 Jean*0718 uniq_tnum = W2_myTileList(bi,bj)
5bc9611487 Ed H*0719 ixoff = exch2_tbasex( uniq_tnum )
0720 iyoff = exch2_tbasey( uniq_tnum )
0721
0722 #else
0723
0724
0725
0726
0727
0728 ixoff = myXGlobalLo + bi * sNx
0729 iyoff = myYGlobalLo + bj * sNy
0730
0731 #endif
0732
0733 RETURN
0734 END
0735
0736
0737
1b5fb69d21 Ed H*0738
c424ee7cc7 Jean*0739
1b5fb69d21 Ed H*0740
c424ee7cc7 Jean*0741 SUBROUTINE MNC_CW_FILE_AORC(
0742 I fname,
0743 O indf,
0744 I lbi, lbj, uniq_tnum,
3f2ea2a4ed Ed H*0745 I myThid )
3623ff8097 Ed H*0746
1b5fb69d21 Ed H*0747
357126def9 Ed H*0748
0749
1b5fb69d21 Ed H*0750
0751
3623ff8097 Ed H*0752 implicit none
07155994b8 Mart*0753 #include "MNC_COMMON.h"
3623ff8097 Ed H*0754 #include "EEPARAMS.h"
853ee6565e Jean*0755 #include "netcdf.inc"
3623ff8097 Ed H*0756
1b5fb69d21 Ed H*0757
c5f7d8f43a Ed H*0758 integer myThid, indf, lbi, lbj, uniq_tnum
3623ff8097 Ed H*0759 character*(*) fname
e6bb5b2cc3 Ed H*0760
3623ff8097 Ed H*0761
1b5fb69d21 Ed H*0762
c90c060abd Ed H*0763 integer ierr
3623ff8097 Ed H*0764
0765
ef92f00980 Ed H*0766 CALL MNC_GET_IND(MNC_MAX_FID, fname, mnc_f_names, indf, myThid)
3623ff8097 Ed H*0767 IF (indf .GT. 0) THEN
0768 RETURN
0769 ENDIF
0770
0771
3f2ea2a4ed Ed H*0772 CALL MNC_FILE_TRY_READ(fname, ierr, indf, myThid)
c5f7d8f43a Ed H*0773 IF (ierr .NE. NF_NOERR) THEN
0774
0775 CALL MNC_FILE_OPEN(fname, 0, indf, myThid)
3623ff8097 Ed H*0776 ENDIF
0777
c5f7d8f43a Ed H*0778
0779 CALL MNC_CW_SET_GATTR(fname, lbi,lbj, uniq_tnum, myThid)
3623ff8097 Ed H*0780
0781 RETURN
0782 END
0783
0784