5 |
|
|
6 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
7 |
CBOP 0 |
CBOP 0 |
8 |
|
C !ROUTINE: MNC_CW_RX_W_S |
9 |
|
|
10 |
|
C !INTERFACE: |
11 |
|
SUBROUTINE MNC_CW_RX_W_S( |
12 |
|
I stype, |
13 |
|
I fbname, bi,bj, |
14 |
|
I vtype, |
15 |
|
I var, |
16 |
|
I myThid ) |
17 |
|
|
18 |
|
C !DESCRIPTION: |
19 |
|
C A scalar version of MNC_CW_RX_W() for compilers that cannot |
20 |
|
C gracefully handle the conversion on their own. |
21 |
|
|
22 |
|
C !USES: |
23 |
|
implicit none |
24 |
|
|
25 |
|
C !INPUT PARAMETERS: |
26 |
|
integer myThid, bi,bj |
27 |
|
character*(*) stype, fbname, vtype |
28 |
|
__V var |
29 |
|
__V var_arr(1) |
30 |
|
CEOP |
31 |
|
|
32 |
|
var_arr(1) = var |
33 |
|
CALL MNC_CW_RX_W(stype,fbname,bi,bj,vtype, var_arr, myThid) |
34 |
|
|
35 |
|
RETURN |
36 |
|
END |
37 |
|
|
38 |
|
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
39 |
|
CBOP 0 |
40 |
C !ROUTINE: MNC_CW_RX_W |
C !ROUTINE: MNC_CW_RX_W |
41 |
|
|
42 |
C !INTERFACE: |
C !INTERFACE: |
48 |
I myThid ) |
I myThid ) |
49 |
|
|
50 |
C !DESCRIPTION: |
C !DESCRIPTION: |
51 |
|
C A scalar version of MNC_CW_RX_W() for compilers that cannot |
52 |
|
C gracefully handle the conversion on their own. |
53 |
|
|
54 |
|
C !USES: |
55 |
|
implicit none |
56 |
|
|
57 |
|
C !INPUT PARAMETERS: |
58 |
|
integer myThid, bi,bj |
59 |
|
character*(*) stype, fbname, vtype |
60 |
|
__V var |
61 |
|
__V var_arr(1) |
62 |
|
INTEGER offsets(9) |
63 |
|
CEOP |
64 |
|
INTEGER i |
65 |
|
|
66 |
|
DO i = 1,9 |
67 |
|
offsets(i) = 0 |
68 |
|
ENDDO |
69 |
|
var_arr(1) = var |
70 |
|
CALL MNC_CW_RX_W_OFFSET(stype,fbname,bi,bj,vtype, var_arr, |
71 |
|
& offsets, myThid) |
72 |
|
|
73 |
|
RETURN |
74 |
|
END |
75 |
|
|
76 |
|
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
77 |
|
CBOP 0 |
78 |
|
C !ROUTINE: MNC_CW_RX_W_OFFSET |
79 |
|
|
80 |
|
C !INTERFACE: |
81 |
|
SUBROUTINE MNC_CW_RX_W_OFFSET( |
82 |
|
I stype, |
83 |
|
I fbname, bi,bj, |
84 |
|
I vtype, |
85 |
|
I var, |
86 |
|
I offsets, |
87 |
|
I myThid ) |
88 |
|
|
89 |
|
C !DESCRIPTION: |
90 |
C This subroutine writes one variable to a file or a file group, |
C This subroutine writes one variable to a file or a file group, |
91 |
C depending upon the tile indicies. |
C depending upon the tile indicies. |
92 |
|
|
100 |
#include "MNC_PARAMS.h" |
#include "MNC_PARAMS.h" |
101 |
|
|
102 |
C !INPUT PARAMETERS: |
C !INPUT PARAMETERS: |
103 |
integer myThid, bi,bj, indu |
integer myThid, bi,bj |
104 |
character*(*) stype, fbname, vtype |
character*(*) stype, fbname, vtype |
105 |
__V var(*) |
__V var(*) |
106 |
|
INTEGER offsets(*) |
107 |
CEOP |
CEOP |
108 |
|
|
109 |
C !LOCAL VARIABLES: |
C !LOCAL VARIABLES: |
110 |
integer i,j,k, indv,nvf,nvl, n1,n2, igrid, ntot |
integer i,j,k, indv,nvf,nvl, n1,n2, igrid, ntot, indu |
111 |
integer bis,bie, bjs,bje, uniq_tnum, nfname |
integer bis,bie, bjs,bje, uniq_tnum, nfname |
112 |
integer fid, idv, indvids, ndim, indf, err |
integer fid, idv, indvids, ndim, indf, err |
113 |
integer lbi,lbj, bidim,bjdim, unlim_sz, kr |
integer lbi,lbj, bidim,bjdim, unlim_sz, kr |
267 |
ELSE |
ELSE |
268 |
p(i) = k * p(i-1) |
p(i) = k * p(i-1) |
269 |
ENDIF |
ENDIF |
270 |
|
IF (offsets(i) .GT. 0) THEN |
271 |
|
k = 1 |
272 |
|
p(i) = k * p(i-1) |
273 |
|
ENDIF |
274 |
ENDDO |
ENDDO |
275 |
|
|
276 |
C Set starting and ending indicies for the in-memory array and |
C Set starting and ending indicies for the in-memory array and |
308 |
s(bjdim) = lbj |
s(bjdim) = lbj |
309 |
e(bjdim) = lbj |
e(bjdim) = lbj |
310 |
ENDIF |
ENDIF |
311 |
CEH3 DO i = 1,9 |
|
312 |
CEH3 write(*,*) 'i,p(i),s(i),e(i) = ', i,p(i),s(i),e(i) |
C Check the offsets |
313 |
CEH3 ENDDO |
DO i = 1,9 |
314 |
|
IF (offsets(i) .GT. 0) THEN |
315 |
|
udo(i) = udo(i) + offsets(i) - 1 |
316 |
|
s(i) = 1 |
317 |
|
e(i) = 1 |
318 |
|
ENDIF |
319 |
|
ENDDO |
320 |
|
|
321 |
C Add the global attributes |
C Add the global attributes |
322 |
CALL MNC_CW_SET_GATTR( fname, lbi,lbj, uniq_tnum, myThid) |
CALL MNC_CW_SET_GATTR( fname, lbi,lbj, uniq_tnum, myThid) |
341 |
& vtype(nvf:nvl), ''' within file ''', |
& vtype(nvf:nvl), ''' within file ''', |
342 |
& fname(1:nfname), '''' |
& fname(1:nfname), '''' |
343 |
|
|
344 |
|
C DO i = 1,9 |
345 |
|
C write(*,*) 'i,p(i),s(i),e(i),udo(i),offsets(i) = ', |
346 |
|
C & i,p(i),s(i),e(i),udo(i),offsets(i) |
347 |
|
C ENDDO |
348 |
|
|
349 |
C Write the variable one vector at a time |
C Write the variable one vector at a time |
350 |
DO j7 = s(7),e(7) |
DO j7 = s(7),e(7) |
351 |
k7 = (j7 - 1)*p(6) |
k7 = (j7 - 1)*p(6) |
427 |
|
|
428 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
429 |
CBOP 0 |
CBOP 0 |
430 |
|
C !ROUTINE: MNC_CW_RX_R_S |
431 |
|
|
432 |
|
C !INTERFACE: |
433 |
|
SUBROUTINE MNC_CW_RX_R_S( |
434 |
|
I stype, |
435 |
|
I fbname, bi,bj, |
436 |
|
I vtype, |
437 |
|
I var, |
438 |
|
I myThid ) |
439 |
|
|
440 |
|
C !DESCRIPTION: |
441 |
|
C A scalar version of MNC_CW_RX_R() for compilers that cannot |
442 |
|
C gracefully handle the conversion on their own. |
443 |
|
|
444 |
|
C !USES: |
445 |
|
implicit none |
446 |
|
|
447 |
|
C !INPUT PARAMETERS: |
448 |
|
integer myThid, bi,bj |
449 |
|
character*(*) stype, fbname, vtype |
450 |
|
__V var |
451 |
|
__V var_arr(1) |
452 |
|
CEOP |
453 |
|
var_arr(1) = var |
454 |
|
|
455 |
|
CALL MNC_CW_RX_R(stype,fbname,bi,bj,vtype, var_arr, myThid) |
456 |
|
|
457 |
|
RETURN |
458 |
|
END |
459 |
|
|
460 |
|
|
461 |
|
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
462 |
|
CBOP 0 |
463 |
C !ROUTINE: MNC_CW_RX_R |
C !ROUTINE: MNC_CW_RX_R |
464 |
|
|
465 |
C !INTERFACE: |
C !INTERFACE: |
484 |
#include "MNC_PARAMS.h" |
#include "MNC_PARAMS.h" |
485 |
|
|
486 |
C !INPUT PARAMETERS: |
C !INPUT PARAMETERS: |
487 |
integer myThid, bi,bj, indu |
integer myThid, bi,bj |
488 |
character*(*) stype, fbname, vtype |
character*(*) stype, fbname, vtype |
489 |
__V var(*) |
__V var(*) |
490 |
CEOP |
CEOP |
491 |
|
|
492 |
C !LOCAL VARIABLES: |
C !LOCAL VARIABLES: |
493 |
integer i,k, nvf,nvl, n1,n2, igrid, ntot |
integer i,k, nvf,nvl, n1,n2, igrid, ntot, indu |
494 |
integer bis,bie, bjs,bje, uniq_tnum, nfname, fid, idv |
integer bis,bie, bjs,bje, uniq_tnum, nfname, fid, idv |
495 |
integer ndim, indf, err, lbi,lbj, bidim,bjdim, unlim_sz, kr |
integer ndim, indf, err, lbi,lbj, bidim,bjdim, unlim_sz, kr |
496 |
integer ind_fv_ids, ind_vt, ierr, atype, alen |
integer ind_fv_ids, ind_vt, ierr, atype, alen |